    -----------------------------------------------------------------------------
    -- |
    -- Module      :  XMonad.Prompt.Man
    -- Description :  A manual page prompt.
    -- 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.Prelude
    import XMonad.Prompt
    import XMonad.Util.Run
    import XMonad.Prompt.Shell (split)

    import System.Directory
    import System.FilePath (dropExtensions, (</>))
    import System.IO
    import System.Process

    import qualified Control.Exception as E

    -- $usage
    -- 1. In your @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
    -- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.

    data Man = Man

    instance XPrompt Man where
        showXPrompt :: Man -> String
    showXPrompt Man
    Man = String
    "Manual page: "

    -- | Query for manual page to be displayed.
    manPrompt :: XPConfig -> X ()
    manPrompt :: XPConfig -> X ()
    manPrompt 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 (XPConfig -> [String] -> ComplFunction
    manCompl XPConfig
    c [String]
    mans) ((String -> X ()) -> X ()) -> (String -> X ()) -> X ()
    forall a b. (a -> b) -> a -> b
    $ String -> String -> X ()
    runInTerm String
    "" (String -> X ()) -> (String -> String) -> String -> X ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    forall a. [a] -> [a] -> [a]
    (++) String
    "man "

    getMans :: IO [String]
    getMans :: IO [String]
    getMans = do
      String
    paths <- do
        let getout :: String -> IO String
    getout 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 a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return String
    ""
        -- one of these combinations should give some output
        String
    p1 <- String -> IO String
    getout String
    "manpath -g 2>/dev/null"
        String
    p2 <- String -> IO String
    getout String
    "manpath 2>/dev/null"
        String -> IO String
    forall a. a -> IO a
    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] -> 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    = [String
    "man" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    forall a. Show a => a -> String
    show Int
    n | Int
    n <- [Int
    1..Int
    9 :: Int]]
          dirs :: [String]
    dirs     = [String
    d String -> String -> String
    </> String
    s | String
    d <- Char -> String -> [String]
    forall a. Eq a => a -> [a] -> [[a]]
    split Char
    ':' 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
    $ \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
    dropExtensions ([String] -> [String]) -> IO [String] -> IO [String]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ComplFunction
    getDirectoryContents String
    d
                  else [String] -> IO [String]
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return []
      [String] -> IO [String]
    forall a. a -> IO a
    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 :: XPConfig -> [String] -> String -> IO [String]
    manCompl :: XPConfig -> [String] -> ComplFunction
    manCompl XPConfig
    c [String]
    mans String
    s | String
    s String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    "" Bool -> Bool -> Bool
    || String -> Char
    forall a. HasCallStack => [a] -> a
    last String
    s Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    ' ' = [String] -> IO [String]
    forall a. a -> IO a
    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
    <$> String -> IO String
    getCommandOutput (String
    "bash -c 'compgen -A file " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    s String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "'")
      XPConfig -> [String] -> ComplFunction
    mkComplFunFromList XPConfig
    c ([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 String
    s = do
      -- we can ignore the process handle because we ignor SIGCHLD
      (Handle
    pin, Handle
    pout, Handle
    perr, ProcessHandle
    _) <- 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 a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length String
    output)
      Handle -> IO ()
    hClose Handle
    perr
      String -> IO String
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return String
    output