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

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

|-}

module Hledger.Cli.DocFiles (

   Topic
  ,docFiles
  ,docTopics
  ,lookupDocNroff
  ,lookupDocTxt
  ,lookupDocInfo
  ,printHelpForTopic
  ,runManForTopic
  ,runInfoForTopic
  ,runPagerForTopic

  ) where

import Prelude ()
import "base-compat-batteries" Prelude.Compat
import Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as BC
import Data.String
import System.IO
import System.IO.Temp
import System.Process

import Hledger.Utils (first3, second3, third3, embedFileRelative)

type Topic = String

-- | These are all the main hledger manuals, in man, txt, and info formats.
-- Only files under the current package directory can be embedded,
-- so most of these are symlinked here from the other package directories.
docFiles :: [(Topic, (ByteString, ByteString, ByteString))]
docFiles :: [(Topic, (ByteString, ByteString, ByteString))]
docFiles = [
   (Topic
"hledger",
    ($(embedFileRelative "embeddedfiles/hledger.1")
    ,$(embedFileRelative "embeddedfiles/hledger.txt")
    ,$(embedFileRelative "embeddedfiles/hledger.info")
    ))
  ,(Topic
"hledger-ui",
    ($(embedFileRelative "embeddedfiles/hledger-ui.1")
    ,$(embedFileRelative "embeddedfiles/hledger-ui.txt")
    ,$(embedFileRelative "embeddedfiles/hledger-ui.info")
    ))
  ,(Topic
"hledger-web",
    ($(embedFileRelative "embeddedfiles/hledger-web.1")
    ,$(embedFileRelative "embeddedfiles/hledger-web.txt")
    ,$(embedFileRelative "embeddedfiles/hledger-web.info")
    ))
  ,(Topic
"journal",
    ($(embedFileRelative "embeddedfiles/hledger_journal.5")
    ,$(embedFileRelative "embeddedfiles/hledger_journal.txt")
    ,$(embedFileRelative "embeddedfiles/hledger_journal.info")
    ))
  ,(Topic
"csv",
    ($(embedFileRelative "embeddedfiles/hledger_csv.5")
    ,$(embedFileRelative "embeddedfiles/hledger_csv.txt")
    ,$(embedFileRelative "embeddedfiles/hledger_csv.info")
    ))
  ,(Topic
"timeclock",
    ($(embedFileRelative "embeddedfiles/hledger_timeclock.5")
    ,$(embedFileRelative "embeddedfiles/hledger_timeclock.txt")
    ,$(embedFileRelative "embeddedfiles/hledger_timeclock.info")
    ))
  ,(Topic
"timedot",
    ($(embedFileRelative "embeddedfiles/hledger_timedot.5")
    ,$(embedFileRelative "embeddedfiles/hledger_timedot.txt")
    ,$(embedFileRelative "embeddedfiles/hledger_timedot.info")
    ))
  ]

docTopics :: [Topic]
docTopics :: [Topic]
docTopics = ((Topic, (ByteString, ByteString, ByteString)) -> Topic)
-> [(Topic, (ByteString, ByteString, ByteString))] -> [Topic]
forall a b. (a -> b) -> [a] -> [b]
map (Topic, (ByteString, ByteString, ByteString)) -> Topic
forall a b. (a, b) -> a
fst [(Topic, (ByteString, ByteString, ByteString))]
docFiles

lookupDocTxt :: Topic -> ByteString
lookupDocTxt :: Topic -> ByteString
lookupDocTxt Topic
name =
  ByteString
-> ((ByteString, ByteString, ByteString) -> ByteString)
-> Maybe (ByteString, ByteString, ByteString)
-> ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Topic -> ByteString
forall a. IsString a => Topic -> a
fromString (Topic -> ByteString) -> Topic -> ByteString
forall a b. (a -> b) -> a -> b
$ Topic
"No text manual found for topic: "Topic -> Topic -> Topic
forall a. [a] -> [a] -> [a]
++Topic
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
$ Topic
-> [(Topic, (ByteString, ByteString, ByteString))]
-> Maybe (ByteString, ByteString, ByteString)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Topic
name [(Topic, (ByteString, ByteString, ByteString))]
docFiles

lookupDocNroff :: Topic -> ByteString
lookupDocNroff :: Topic -> ByteString
lookupDocNroff Topic
name =
  ByteString
-> ((ByteString, ByteString, ByteString) -> ByteString)
-> Maybe (ByteString, ByteString, ByteString)
-> ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Topic -> ByteString
forall a. IsString a => Topic -> a
fromString (Topic -> ByteString) -> Topic -> ByteString
forall a b. (a -> b) -> a -> b
$ Topic
"No man page found for topic: "Topic -> Topic -> Topic
forall a. [a] -> [a] -> [a]
++Topic
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
$ Topic
-> [(Topic, (ByteString, ByteString, ByteString))]
-> Maybe (ByteString, ByteString, ByteString)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Topic
name [(Topic, (ByteString, ByteString, ByteString))]
docFiles

lookupDocInfo :: Topic -> ByteString
lookupDocInfo :: Topic -> ByteString
lookupDocInfo Topic
name =
  ByteString
-> ((ByteString, ByteString, ByteString) -> ByteString)
-> Maybe (ByteString, ByteString, ByteString)
-> ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Topic -> ByteString
forall a. IsString a => Topic -> a
fromString (Topic -> ByteString) -> Topic -> ByteString
forall a b. (a -> b) -> a -> b
$ Topic
"No info manual found for topic: "Topic -> Topic -> Topic
forall a. [a] -> [a] -> [a]
++Topic
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
$ Topic
-> [(Topic, (ByteString, ByteString, ByteString))]
-> Maybe (ByteString, ByteString, ByteString)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Topic
name [(Topic, (ByteString, ByteString, ByteString))]
docFiles

printHelpForTopic :: Topic -> IO ()
printHelpForTopic :: Topic -> IO ()
printHelpForTopic Topic
t =
  ByteString -> IO ()
BC.putStr (Topic -> ByteString
lookupDocTxt Topic
t)

runPagerForTopic :: FilePath -> Topic -> IO ()
runPagerForTopic :: Topic -> Topic -> IO ()
runPagerForTopic Topic
exe Topic
t = do
  (Just Handle
inp, Maybe Handle
_, Maybe Handle
_, ProcessHandle
ph) <- CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
createProcess (Topic -> [Topic] -> CreateProcess
proc Topic
exe []){
    std_in :: StdStream
std_in=StdStream
CreatePipe
    }
  Handle -> ByteString -> IO ()
BC.hPutStrLn Handle
inp (Topic -> ByteString
lookupDocTxt Topic
t)
  ExitCode
_ <- ProcessHandle -> IO ExitCode
waitForProcess ProcessHandle
ph
  () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

runManForTopic :: Topic -> IO ()
runManForTopic :: Topic -> IO ()
runManForTopic Topic
t =
  Topic -> (Topic -> Handle -> IO ()) -> IO ()
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
Topic -> (Topic -> Handle -> m a) -> m a
withSystemTempFile (Topic
"hledger-"Topic -> Topic -> Topic
forall a. [a] -> [a] -> [a]
++Topic
tTopic -> Topic -> Topic
forall a. [a] -> [a] -> [a]
++Topic
".nroff") ((Topic -> Handle -> IO ()) -> IO ())
-> (Topic -> Handle -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Topic
f Handle
h -> do
    Handle -> ByteString -> IO ()
BC.hPutStrLn Handle
h (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ Topic -> ByteString
lookupDocNroff Topic
t
    Handle -> IO ()
hClose Handle
h
     -- the temp file path will presumably have a slash in it, so man should read it
    Topic -> IO ()
callCommand (Topic -> IO ()) -> Topic -> IO ()
forall a b. (a -> b) -> a -> b
$ Topic
"man " Topic -> Topic -> Topic
forall a. [a] -> [a] -> [a]
++ Topic
f

runInfoForTopic :: Topic -> IO ()
runInfoForTopic :: Topic -> IO ()
runInfoForTopic Topic
t =
  Topic -> (Topic -> Handle -> IO ()) -> IO ()
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
Topic -> (Topic -> Handle -> m a) -> m a
withSystemTempFile (Topic
"hledger-"Topic -> Topic -> Topic
forall a. [a] -> [a] -> [a]
++Topic
tTopic -> Topic -> Topic
forall a. [a] -> [a] -> [a]
++Topic
".info") ((Topic -> Handle -> IO ()) -> IO ())
-> (Topic -> Handle -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Topic
f Handle
h -> do
    Handle -> ByteString -> IO ()
BC.hPutStrLn Handle
h (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ Topic -> ByteString
lookupDocInfo Topic
t
    Handle -> IO ()
hClose Handle
h
    Topic -> IO ()
callCommand (Topic -> IO ()) -> Topic -> IO ()
forall a b. (a -> b) -> a -> b
$ Topic
"info " Topic -> Topic -> Topic
forall a. [a] -> [a] -> [a]
++ Topic
f