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

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

|-}

module Hledger.Cli.DocFiles (

   Topic
  ,printHelpForTopic
  ,runManForTopic
  ,runInfoForTopic
  ,runPagerForTopic
  ,runTldrForPage

  ) where

import Control.Exception
import Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as BC
import Data.Maybe (fromMaybe)
import Data.String
import System.Environment (setEnv)
import System.IO
import System.IO.Temp
import System.Process

import Hledger.Utils (first3, second3, third3, embedFileRelative, error')
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

-- Any name of a hledger tldr page (hledger, hledger-ui, hledger-print etc.)
type TldrPage = String

-- | All hledger-related pages from the tldr-pages project.
-- All are symlinked into the hledger package directory to allow embeddeding.
tldrs :: [(TldrPage, ByteString)]
tldrs :: [([Char], ByteString)]
tldrs = [
   ([Char]
"hledger-accounts",        $(embedFileRelative "embeddedfiles/hledger-accounts.md"))
  ,([Char]
"hledger-add",             $(embedFileRelative "embeddedfiles/hledger-add.md"))
  ,([Char]
"hledger-aregister",       $(embedFileRelative "embeddedfiles/hledger-aregister.md"))
  ,([Char]
"hledger-balance",         $(embedFileRelative "embeddedfiles/hledger-balance.md"))
  ,([Char]
"hledger-balancesheet",    $(embedFileRelative "embeddedfiles/hledger-balancesheet.md"))
  ,([Char]
"hledger-import",          $(embedFileRelative "embeddedfiles/hledger-import.md"))
  ,([Char]
"hledger-incomestatement", $(embedFileRelative "embeddedfiles/hledger-incomestatement.md"))
  ,([Char]
"hledger-print",           $(embedFileRelative "embeddedfiles/hledger-print.md"))
  ,([Char]
"hledger-ui",              $(embedFileRelative "embeddedfiles/hledger-ui.md"))
  ,([Char]
"hledger-web",             $(embedFileRelative "embeddedfiles/hledger-web.md"))
  ,([Char]
"hledger",                 $(embedFileRelative "embeddedfiles/hledger.md"))
  ]

-- | The main hledger manuals as source for man, info and as plain text.
-- All are symlinked into the hledger package directory to allow embeddeding.
manuals :: [(Tool, (ByteString, ByteString, ByteString))]
manuals :: [([Char], (ByteString, ByteString, ByteString))]
manuals = [
   ([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")
    ))
  ]

-- | Get the manual as plain text for this tool, or a not found message.
manualTxt :: Tool -> ByteString
manualTxt :: [Char] -> ByteString
manualTxt [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))]
manuals

-- | Get the manual as man source (nroff) for this tool, or a not found message.
manualMan :: Tool -> ByteString
manualMan :: [Char] -> ByteString
manualMan [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))]
manuals

-- | Get the manual as info source (texinfo) for this tool, or a not found message.
manualInfo :: Tool -> ByteString
manualInfo :: [Char] -> ByteString
manualInfo [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))]
manuals

-- | 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
manualTxt [Char]
tool)

-- | Display an info manual for this topic, opened at the given topic if provided,
-- using the "info" executable in $PATH.
-- Topic can be an exact heading or a heading prefix; info will favour an exact match.
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
manualInfo [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

-- less with any vertical whitespace squashed, case-insensitive searching, the $ regex metacharacter accessible as \$.
less :: [Char]
less = [Char]
"less -s -i --use-backslash"

-- | Display plain text help for this tool, scrolled to the given topic if any, using the users $PAGER or "less".
-- When a topic is provided we always use less, ignoring $PAGER.
--
-- This is less robust than the newer Hledger.Utils.IO.runPager,
-- but that one doesn't yet support scrolling to a topic.
runPagerForTopic :: Tool -> Maybe Topic -> IO ()
runPagerForTopic :: [Char] -> Maybe [Char] -> IO ()
runPagerForTopic [Char]
tool Maybe [Char]
mtopic = do
  [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
manualTxt [Char]
tool
    Handle -> IO ()
hClose Handle
h
    [Char]
envpager <- [Char] -> Maybe [Char] -> [Char]
forall a. a -> Maybe a -> a
fromMaybe [Char]
less (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"
    let
      exactmatch :: Bool
exactmatch = Bool
True
      ([Char]
pager, [Char]
searcharg) =
        case Maybe [Char]
mtopic of
          Maybe [Char]
Nothing -> ([Char]
envpager, [Char]
"")
          Just [Char]
t  -> ([Char]
less, [Char]
"-p'^(   )?" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
t [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ if Bool
exactmatch then [Char]
"\\$'" else [Char]
"")
    [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]] -> [Char]
unwords [[Char]
pager, [Char]
searcharg, [Char]
f]

-- | Display a man page for this tool, scrolled to the given topic if provided, using "man".
-- When a topic is provided we force man to use "less", ignoring $MANPAGER and $PAGER.
runManForTopic :: Tool -> Maybe Topic -> IO ()
runManForTopic :: [Char] -> Maybe [Char] -> IO ()
runManForTopic [Char]
tool Maybe [Char]
mtopic =
  -- This temp file path should have a slash in it, man requires at least one.
  [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]
".1") (([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
manualMan [Char]
tool
    Handle -> IO ()
hClose Handle
h
    let
      exactmatch :: Bool
exactmatch = Bool
True
      pagerarg :: [Char]
pagerarg =
        case Maybe [Char]
mtopic of
          Maybe [Char]
Nothing -> [Char]
""
          Just [Char]
t  -> [Char]
"-P \"" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
less [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" -p'^(   )?" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
t [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ (if Bool
exactmatch then [Char]
"\\\\$" else [Char]
"") [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"'\""
    [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]] -> [Char]
unwords [[Char]
"man", [Char]
pagerarg, [Char]
f]

-- | Get the named tldr page's source, if we know it.
tldr :: TldrPage -> Maybe ByteString
tldr :: [Char] -> Maybe ByteString
tldr [Char]
name = [Char] -> [([Char], ByteString)] -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup [Char]
name [([Char], ByteString)]
tldrs

-- | Display one of the hledger tldr pages, using "tldr".
runTldrForPage :: TldrPage -> IO ()
runTldrForPage :: [Char] -> IO ()
runTldrForPage [Char]
name =
  case [Char] -> Maybe ByteString
tldr [Char]
name of
    Maybe ByteString
Nothing -> [Char] -> IO ()
forall a. [Char] -> a
error' ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"sorry, there's no " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
name [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
" tldr page yet"
    Just ByteString
b -> (do
      [Char] -> ([Char] -> Handle -> IO ()) -> IO ()
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
[Char] -> ([Char] -> Handle -> m a) -> m a
withSystemTempFile ([Char]
name[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
".md") (([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
b
        Handle -> IO ()
hClose Handle
h
        -- tldr clients tend to auto-update their data, try to discourage that here
        -- tealdeer - doesn't auto-update by default
        -- tlrc - ?
        -- tldr-node-client - undocumented env var suggested in output
        [Char] -> [Char] -> IO ()
setEnv [Char]
"TLDR_AUTO_UPDATE_DISABLED" [Char]
"1"
        [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]
"tldr command" ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ [Char]
"tldr --render " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
f
      ) IO () -> (IOException -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` (\(IOException
_e::IOException) -> do
        Handle -> [Char] -> IO ()
hPutStrLn Handle
stderr ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Warning: could not run tldr --render, using fallback viewer instead.\n"
        ByteString -> IO ()
BC.putStrLn ByteString
b
      )