{-# LANGUAGE TemplateHaskell, OverloadedStrings, PackageImports #-}
{-|

Embedded documentation files in various formats, and helpers for viewing them.

|-}

module Hledger.Cli.DocFiles (

   Topic
  -- ,toolDocs
  -- ,toolDocNames
  -- ,toolDocMan
  -- ,toolDocTxt
  -- ,toolDocInfo
  ,printHelpForTopic
  ,runManForTopic
  ,runInfoForTopic
  ,runPagerForTopic

  ) where

import Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as BC
import Data.Maybe (fromMaybe, isNothing)
import Data.String
import System.IO
import System.IO.Temp
import System.Process

import Hledger.Utils (first3, second3, third3, embedFileRelative)
import Text.Printf (printf)
import System.Environment (lookupEnv)
import Hledger.Utils.Debug

-- The name of any hledger executable.
type Tool = String

-- Any heading in the hledger user manual (and perhaps later the hledger-ui/hledger-web manuals).
type Topic = String

-- | The main hledger manuals as source for man, info and as plain text.
-- Only files under the current package directory can be embedded,
-- so some of these are symlinked from the other package directories.
toolDocs :: [(Tool, (ByteString, ByteString, ByteString))]
toolDocs :: [([Char], (ByteString, ByteString, ByteString))]
toolDocs = [
   ([Char]
"hledger",
    ($(embedFileRelative "embeddedfiles/hledger.1")
    ,$(embedFileRelative "embeddedfiles/hledger.txt")
    ,$(embedFileRelative "embeddedfiles/hledger.info")
    ))
  ,([Char]
"hledger-ui",
    ($(embedFileRelative "embeddedfiles/hledger-ui.1")
    ,$(embedFileRelative "embeddedfiles/hledger-ui.txt")
    ,$(embedFileRelative "embeddedfiles/hledger-ui.info")
    ))
  ,([Char]
"hledger-web",
    ($(embedFileRelative "embeddedfiles/hledger-web.1")
    ,$(embedFileRelative "embeddedfiles/hledger-web.txt")
    ,$(embedFileRelative "embeddedfiles/hledger-web.info")
    ))
  ]

-- toolNames :: [Tool]
-- toolNames = map fst toolDocs

-- | Get the manual as plain text for this tool, or a not found message.
toolDocTxt :: Tool -> ByteString
toolDocTxt :: [Char] -> ByteString
toolDocTxt [Char]
name =
  ByteString
-> ((ByteString, ByteString, ByteString) -> ByteString)
-> Maybe (ByteString, ByteString, ByteString)
-> ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Char] -> ByteString
forall a. IsString a => [Char] -> a
fromString ([Char] -> ByteString) -> [Char] -> ByteString
forall a b. (a -> b) -> a -> b
$ [Char]
"No text manual found for tool: "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
name) (ByteString, ByteString, ByteString) -> ByteString
forall {a} {b} {c}. (a, b, c) -> b
second3 (Maybe (ByteString, ByteString, ByteString) -> ByteString)
-> Maybe (ByteString, ByteString, ByteString) -> ByteString
forall a b. (a -> b) -> a -> b
$ [Char]
-> [([Char], (ByteString, ByteString, ByteString))]
-> Maybe (ByteString, ByteString, ByteString)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup [Char]
name [([Char], (ByteString, ByteString, ByteString))]
toolDocs

-- | Get the manual as man source (nroff) for this tool, or a not found message.
toolDocMan :: Tool -> ByteString
toolDocMan :: [Char] -> ByteString
toolDocMan [Char]
name =
  ByteString
-> ((ByteString, ByteString, ByteString) -> ByteString)
-> Maybe (ByteString, ByteString, ByteString)
-> ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Char] -> ByteString
forall a. IsString a => [Char] -> a
fromString ([Char] -> ByteString) -> [Char] -> ByteString
forall a b. (a -> b) -> a -> b
$ [Char]
"No man page found for tool: "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
name) (ByteString, ByteString, ByteString) -> ByteString
forall {a} {b} {c}. (a, b, c) -> a
first3 (Maybe (ByteString, ByteString, ByteString) -> ByteString)
-> Maybe (ByteString, ByteString, ByteString) -> ByteString
forall a b. (a -> b) -> a -> b
$ [Char]
-> [([Char], (ByteString, ByteString, ByteString))]
-> Maybe (ByteString, ByteString, ByteString)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup [Char]
name [([Char], (ByteString, ByteString, ByteString))]
toolDocs

-- | Get the manual as info source (texinfo) for this tool, or a not found message.
toolDocInfo :: Tool -> ByteString
toolDocInfo :: [Char] -> ByteString
toolDocInfo [Char]
name =
  ByteString
-> ((ByteString, ByteString, ByteString) -> ByteString)
-> Maybe (ByteString, ByteString, ByteString)
-> ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Char] -> ByteString
forall a. IsString a => [Char] -> a
fromString ([Char] -> ByteString) -> [Char] -> ByteString
forall a b. (a -> b) -> a -> b
$ [Char]
"No info manual found for tool: "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
name) (ByteString, ByteString, ByteString) -> ByteString
forall {a} {b} {c}. (a, b, c) -> c
third3 (Maybe (ByteString, ByteString, ByteString) -> ByteString)
-> Maybe (ByteString, ByteString, ByteString) -> ByteString
forall a b. (a -> b) -> a -> b
$ [Char]
-> [([Char], (ByteString, ByteString, ByteString))]
-> Maybe (ByteString, ByteString, ByteString)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup [Char]
name [([Char], (ByteString, ByteString, ByteString))]
toolDocs

-- | Print plain text help for this tool.
-- Takes an optional topic argument for convenience but it is currently ignored.
printHelpForTopic :: Tool -> Maybe Topic -> IO ()
printHelpForTopic :: [Char] -> Maybe [Char] -> IO ()
printHelpForTopic [Char]
tool Maybe [Char]
_mtopic =
  ByteString -> IO ()
BC.putStr ([Char] -> ByteString
toolDocTxt [Char]
tool)

-- | Display plain text help for this tool, scrolled to the given topic
-- if provided, using the given pager executable.
-- Note when a topic is provided we ignore the provided pager and
-- use the "less" executable in $PATH.
runPagerForTopic :: Tool -> Maybe Topic -> IO ()
runPagerForTopic :: [Char] -> Maybe [Char] -> IO ()
runPagerForTopic [Char]
tool Maybe [Char]
mtopic = do
  -- avoids a temp file but different from the others and not sure how to make it scroll
  -- pager <- fromMaybe "less" <$> lookupEnv "PAGER"
  -- (Just inp, _, _, ph) <- createProcess (proc pager []){
  --   std_in=CreatePipe
  --   }
  -- BC.hPutStrLn inp (toolDocTxt tool)
  -- _ <- waitForProcess ph
  -- return ()
  
  [Char] -> ([Char] -> Handle -> IO ()) -> IO ()
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
[Char] -> ([Char] -> Handle -> m a) -> m a
withSystemTempFile ([Char]
"hledger-"[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
tool[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
".txt") (([Char] -> Handle -> IO ()) -> IO ())
-> ([Char] -> Handle -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \[Char]
f Handle
h -> do
    Handle -> ByteString -> IO ()
BC.hPutStrLn Handle
h (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> ByteString
toolDocTxt [Char]
tool
    Handle -> IO ()
hClose Handle
h
    let defpager :: [Char]
defpager = [Char]
"less -is"
    [Char]
envpager <- [Char] -> Maybe [Char] -> [Char]
forall a. a -> Maybe a -> a
fromMaybe [Char]
defpager (Maybe [Char] -> [Char]) -> IO (Maybe [Char]) -> IO [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> IO (Maybe [Char])
lookupEnv [Char]
"PAGER"
    -- force the use of less if a topic is provided, since we know how to scroll it
    let pager :: [Char]
pager = if Maybe [Char] -> Bool
forall a. Maybe a -> Bool
isNothing Maybe [Char]
mtopic then [Char]
envpager else [Char]
defpager
    [Char] -> IO ()
callCommand ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> [Char]
forall a. Show a => [Char] -> a -> a
dbg1 [Char]
"pager command" ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ 
      [Char]
pager [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> ([Char] -> [Char]) -> Maybe [Char] -> [Char]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Char]
"" ([Char] -> [Char] -> [Char]
forall r. PrintfType r => [Char] -> r
printf [Char]
" +'/^(   )?%s'") Maybe [Char]
mtopic [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
f

-- | Display a man page for this tool, scrolled to the given topic if provided, 
-- using the "man" executable in $PATH. Note when a topic is provided we force 
-- man to use the "less" executable in $PATH, ignoring $MANPAGER and $PAGER.
runManForTopic :: Tool -> Maybe Topic -> IO ()
runManForTopic :: [Char] -> Maybe [Char] -> IO ()
runManForTopic [Char]
tool Maybe [Char]
mtopic =
  [Char] -> ([Char] -> Handle -> IO ()) -> IO ()
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
[Char] -> ([Char] -> Handle -> m a) -> m a
withSystemTempFile ([Char]
"hledger-"[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
tool[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
".nroff") (([Char] -> Handle -> IO ()) -> IO ())
-> ([Char] -> Handle -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \[Char]
f Handle
h -> do
    Handle -> ByteString -> IO ()
BC.hPutStrLn Handle
h (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> ByteString
toolDocMan [Char]
tool
    Handle -> IO ()
hClose Handle
h
    -- the temp file path will presumably have a slash in it, so man should read it
    [Char] -> IO ()
callCommand ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> [Char]
forall a. Show a => [Char] -> a -> a
dbg1 [Char]
"man command" ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ 
      [Char]
"man " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
f [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> ([Char] -> [Char]) -> Maybe [Char] -> [Char]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Char]
"" ([Char] -> [Char] -> [Char]
forall r. PrintfType r => [Char] -> r
printf [Char]
" -P \"less -is +'/^(   )?%s'\"") Maybe [Char]
mtopic

-- | Display an info manual for this topic, opened at the given topic if provided,
-- using the "info" executable in $PATH.
runInfoForTopic :: Tool -> Maybe Topic -> IO ()
runInfoForTopic :: [Char] -> Maybe [Char] -> IO ()
runInfoForTopic [Char]
tool Maybe [Char]
mtopic =
  [Char] -> ([Char] -> Handle -> IO ()) -> IO ()
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
[Char] -> ([Char] -> Handle -> m a) -> m a
withSystemTempFile ([Char]
"hledger-"[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
tool[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
".info") (([Char] -> Handle -> IO ()) -> IO ())
-> ([Char] -> Handle -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \[Char]
f Handle
h -> do
    Handle -> ByteString -> IO ()
BC.hPutStrLn Handle
h (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> ByteString
toolDocInfo [Char]
tool
    Handle -> IO ()
hClose Handle
h
    [Char] -> IO ()
callCommand ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> [Char]
forall a. Show a => [Char] -> a -> a
dbg1 [Char]
"info command" ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$
      [Char]
"info -f " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
f [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> ([Char] -> [Char]) -> Maybe [Char] -> [Char]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Char]
"" ([Char] -> [Char] -> [Char]
forall r. PrintfType r => [Char] -> r
printf [Char]
" -n '%s'") Maybe [Char]
mtopic