-----------------------------------------------------------------------------
-- |
-- 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.Process
import System.IO

import qualified Control.Exception as E

-- $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
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 (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 (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
forall a. [a] -> [a] -> [a]
++ String
"/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ 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
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 [String
".gz", String
".bz2"]) ([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 (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 :: 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. [a] -> a
last String
s Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ' = [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
<$> 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 (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 Int
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
/= Char
'.') (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 [[a]]
sufs [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]
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 [a]
suf [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