    -----------------------------------------------------------------------------
    -- |
    -- 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 -> String
    showXPrompt Man = "Manual page: "

    -- | Query for manual page to be displayed.
    manPrompt :: XPConfig -> X ()
    manPrompt :: XPConfig -> X ()
    manPrompt c :: XPConfig
    c = do
      [String]
    mans <- IO [String] -> X [String]
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io IO [String]
    getMans
      Man -> XPConfig -> ComplFunction -> (String -> X ()) -> X ()
    forall p.
    XPrompt p =>
    p -> XPConfig -> ComplFunction -> (String -> X ()) -> X ()
    mkXPrompt Man
    Man XPConfig
    c ([String] -> ComplFunction
    manCompl [String]
    mans) ((String -> X ()) -> X ()) -> (String -> X ()) -> X ()
    forall a b. (a -> b) -> a -> b
    $ String -> String -> X ()
    runInTerm "" (String -> X ()) -> (String -> String) -> String -> X ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    forall a. [a] -> [a] -> [a]
    (++) "man "

    getMans :: IO [String]
    getMans :: IO [String]
    getMans = do
      String
    paths <- do
        let getout :: String -> IO String
    getout cmd :: String
    cmd = String -> IO String
    getCommandOutput String
    cmd IO String -> (SomeException -> IO String) -> IO String
    forall e a. Exception e => IO a -> (e -> IO a) -> IO a
    `E.catch` \E.SomeException{} -> String -> IO String
    forall (m :: * -> *) a. Monad m => a -> m a
    return ""
        -- one of these combinations should give some output
        String
    p1 <- String -> IO String
    getout "manpath -g 2>/dev/null"
        String
    p2 <- String -> IO String
    getout "manpath 2>/dev/null"
        String -> IO String
    forall (m :: * -> *) a. Monad m => a -> m a
    return (String -> IO String) -> String -> IO String
    forall a b. (a -> b) -> a -> b
    $ String -> [String] -> String
    forall a. [a] -> [[a]] -> [a]
    intercalate ":" ([String] -> String) -> [String] -> String
    forall a b. (a -> b) -> a -> b
    $ String -> [String]
    lines (String -> [String]) -> String -> [String]
    forall a b. (a -> b) -> a -> b
    $ String
    p1 String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    p2
      let sects :: [String]
    sects    = ["man" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    forall a. Show a => a -> String
    show Int
    n | Int
    n <- [1..9 :: Int]]
          dirs :: [String]
    dirs     = [String
    d String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ "/" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    s | String
    d <- Char -> String -> [String]
    forall a. Eq a => a -> [a] -> [[a]]
    split ':' String
    paths, String
    s <- [String]
    sects]
      [[String]]
    mans <- [String] -> ComplFunction -> IO [[String]]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    t a -> (a -> m b) -> m (t b)
    forM ([String] -> [String]
    forall a. Eq a => [a] -> [a]
    nub [String]
    dirs) (ComplFunction -> IO [[String]]) -> ComplFunction -> IO [[String]]
    forall a b. (a -> b) -> a -> b
    $ \d :: String
    d -> do
                Bool
    exists <- String -> IO Bool
    doesDirectoryExist String
    d
                if Bool
    exists
                  then (String -> String) -> [String] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (String -> String
    stripExt (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [String] -> String -> String
    forall a. Eq a => [[a]] -> [a] -> [a]
    stripSuffixes [".gz", ".bz2"]) ([String] -> [String]) -> IO [String] -> IO [String]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    `fmap`
                       ComplFunction
    getDirectoryContents String
    d
                  else [String] -> IO [String]
    forall (m :: * -> *) a. Monad m => a -> m a
    return []
      [String] -> IO [String]
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([String] -> IO [String]) -> [String] -> IO [String]
    forall a b. (a -> b) -> a -> b
    $ [String] -> [String]
    forall a. Ord a => [a] -> [a]
    uniqSort ([String] -> [String]) -> [String] -> [String]
    forall a b. (a -> b) -> a -> b
    $ [[String]] -> [String]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [[String]]
    mans

    manCompl :: [String] -> String -> IO [String]
    manCompl :: [String] -> ComplFunction
    manCompl mans :: [String]
    mans s :: String
    s | String
    s String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == "" Bool -> Bool -> Bool
    || String -> Char
    forall a. [a] -> a
    last String
    s Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == ' ' = [String] -> IO [String]
    forall (m :: * -> *) a. Monad m => a -> m a
    return []
                    | Bool
    otherwise                = do
      -- XXX readline instead of bash's compgen?
      [String]
    f <- String -> [String]
    lines (String -> [String]) -> IO String -> IO [String]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    `fmap` String -> IO String
    getCommandOutput ("bash -c 'compgen -A file " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    s String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ "'")
      [String] -> ComplFunction
    mkComplFunFromList ([String]
    f [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++ [String]
    mans) String
    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 :: String -> IO String
    getCommandOutput s :: String
    s = do
      -- we can ignore the process handle because we ignor SIGCHLD
      (pin :: Handle
    pin, pout :: Handle
    pout, perr :: Handle
    perr, _) <- String -> IO (Handle, Handle, Handle, ProcessHandle)
    runInteractiveCommand String
    s
      Handle -> IO ()
    hClose Handle
    pin
      String
    output <- Handle -> IO String
    hGetContents Handle
    pout
      Int -> IO Int
    forall a. a -> IO a
    E.evaluate (String -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length String
    output)
      Handle -> IO ()
    hClose Handle
    perr
      String -> IO String
    forall (m :: * -> *) a. Monad m => a -> m a
    return String
    output

    stripExt :: String -> String
    stripExt :: String -> String
    stripExt = String -> String
    forall a. [a] -> [a]
    reverse (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> String -> String
    forall a. Int -> [a] -> [a]
    drop 1 (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Char -> Bool) -> String -> String
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /= '.') (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    forall a. [a] -> [a]
    reverse

    stripSuffixes :: Eq a => [[a]] -> [a] -> [a]
    stripSuffixes :: [[a]] -> [a] -> [a]
    stripSuffixes sufs :: [[a]]
    sufs fn :: [a]
    fn =
        [[a]] -> [a]
    forall a. [a] -> a
    head ([[a]] -> [a]) -> ([Maybe [a]] -> [[a]]) -> [Maybe [a]] -> [a]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Maybe [a]] -> [[a]]
    forall a. [Maybe a] -> [a]
    catMaybes ([Maybe [a]] -> [a]) -> [Maybe [a]] -> [a]
    forall a b. (a -> b) -> a -> b
    $ ([a] -> Maybe [a]) -> [[a]] -> [Maybe [a]]
    forall a b. (a -> b) -> [a] -> [b]
    map (([a] -> [a] -> Maybe [a]) -> [a] -> [a] -> Maybe [a]
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip [a] -> [a] -> Maybe [a]
    forall a. Eq a => [a] -> [a] -> Maybe [a]
    rstrip [a]
    fn) [[a]]
    sufs [Maybe [a]] -> [Maybe [a]] -> [Maybe [a]]
    forall a. [a] -> [a] -> [a]
    ++ [[a] -> Maybe [a]
    forall a. a -> Maybe a
    Just [a]
    fn]

    rstrip :: Eq a => [a] -> [a] -> Maybe [a]
    rstrip :: [a] -> [a] -> Maybe [a]
    rstrip suf :: [a]
    suf lst :: [a]
    lst
        | [a]
    suf [a] -> [a] -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isSuffixOf` [a]
    lst = [a] -> Maybe [a]
    forall a. a -> Maybe a
    Just ([a] -> Maybe [a]) -> [a] -> Maybe [a]
    forall a b. (a -> b) -> a -> b
    $ Int -> [a] -> [a]
    forall a. Int -> [a] -> [a]
    take ([a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [a]
    lst Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [a]
    suf) [a]
    lst
        | Bool
    otherwise            = Maybe [a]
    forall a. Maybe a
    Nothing