content: -----------------------------------------------------------------------------
  -- |
  -- Module      :  XMonad.Prompt.Man
  -- Copyright   :  (c) 2007 Valery V. Vorotyntsev
  -- License     :  BSD3-style (see LICENSE)
  --
  -- Maintainer  :  Valery V. Vorotyntsev <valery.vv@gmail.com>
  -- Portability :  non-portable (uses "manpath" and "bash")
  --
  -- A manual page prompt for XMonad window manager.
  --
  -- TODO
  --
  --   * narrow completions by section number, if the one is specified
  --     (like @\/etc\/bash_completion@ does)
  -----------------------------------------------------------------------------
  
  module XMonad.Prompt.Man (
                            -- * Usage
                            -- $usage
                            manPrompt
                           , getCommandOutput
                           , Man
                           ) where
  
  
  import XMonad
  import XMonad.Prompt
  import XMonad.Util.Run
  import XMonad.Prompt.Shell (split)
  
  import System.Directory
  import System.Process
  import System.IO
  
  import qualified Control.Exception.Extensible as E
  import Control.Monad
  import Data.List
  import Data.Maybe
  
  -- $usage
  -- 1. In your @~\/.xmonad\/xmonad.hs@:
  --
  -- > import XMonad.Prompt
  -- > import XMonad.Prompt.Man
  --
  -- 2. In your keybindings add something like:
  --
  -- >     , ((modm, xK_F1), manPrompt def)
  --
  -- For detailed instruction on editing the key binding see
  -- "XMonad.Doc.Extending#Editing_key_bindings".
  
  data Man = Man
  
  instance XPrompt Man where
      showXPrompt Man = "Manual page: "
  
  -- | Query for manual page to be displayed.
  manPrompt :: XPConfig -> X ()
  manPrompt c = do
    mans <- io getMans
    mkXPrompt Man c (manCompl mans) $ runInTerm "" . (++) "man "
  
  getMans :: IO [String]
  getMans = do
    paths <- do
      let getout cmd = getCommandOutput cmd `E.catch` \E.SomeException{} -> return ""
      -- one of these combinations should give some output
      p1 <- getout "manpath -g 2>/dev/null"
      p2 <- getout "manpath 2>/dev/null"
      return $ intercalate ":" $ lines $ p1 ++ p2
    let sects    = ["man" ++ show n | n <- [1..9 :: Int]]
        dirs     = [d ++ "/" ++ s | d <- split ':' paths, s <- sects]
    mans <- forM (nub dirs) $ \d -> do
              exists <- doesDirectoryExist d
              if exists
                then map (stripExt . stripSuffixes [".gz", ".bz2"]) `fmap`
                     getDirectoryContents d
                else return []
    return $ uniqSort $ concat mans
  
  manCompl :: [String] -> String -> IO [String]
  manCompl mans s | s == "" || last s == ' ' = return []
                  | otherwise                = do
    -- XXX readline instead of bash's compgen?
    f <- lines `fmap` getCommandOutput ("bash -c 'compgen -A file " ++ s ++ "'")
    mkComplFunFromList (f ++ mans) s
  
  -- | Run a command using shell and return its output.
  --
  -- XXX Merge into 'XMonad.Util.Run'?
  --
  -- (Ask \"gurus\" whether @evaluate (length ...)@ approach is
  -- better\/more idiomatic.)
  getCommandOutput :: String -> IO String
  getCommandOutput s = do
    -- we can ignore the process handle because we ignor SIGCHLD
    (pin, pout, perr, _) <- runInteractiveCommand s
    hClose pin
    output <- hGetContents pout
    E.evaluate (length output)
    hClose perr
    return output
  
  stripExt :: String -> String
  stripExt = reverse . drop 1 . dropWhile (/= '.') . reverse
  
  stripSuffixes :: Eq a => [[a]] -> [a] -> [a]
  stripSuffixes sufs fn =
      head . catMaybes $ map (flip rstrip fn) sufs ++ [Just fn]
  
  rstrip :: Eq a => [a] -> [a] -> Maybe [a]
  rstrip suf lst
      | suf `isSuffixOf` lst = Just $ take (length lst - length suf) lst
      | otherwise            = Nothing
  