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

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 Data.ByteString.Char8 qualified 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 :: [(Tool, ByteString)]
tldrs = [
   (Tool
"hledger-accounts",        $(embedFileRelative "embeddedfiles/hledger-accounts.md"))
  ,(Tool
"hledger-add",             $(embedFileRelative "embeddedfiles/hledger-add.md"))
  ,(Tool
"hledger-aregister",       $(embedFileRelative "embeddedfiles/hledger-aregister.md"))
  ,(Tool
"hledger-balance",         $(embedFileRelative "embeddedfiles/hledger-balance.md"))
  ,(Tool
"hledger-balancesheet",    $(embedFileRelative "embeddedfiles/hledger-balancesheet.md"))
  ,(Tool
"hledger-import",          $(embedFileRelative "embeddedfiles/hledger-import.md"))
  ,(Tool
"hledger-incomestatement", $(embedFileRelative "embeddedfiles/hledger-incomestatement.md"))
  ,(Tool
"hledger-print",           $(embedFileRelative "embeddedfiles/hledger-print.md"))
  ,(Tool
"hledger-ui",              $(embedFileRelative "embeddedfiles/hledger-ui.md"))
  ,(Tool
"hledger-web",             $(embedFileRelative "embeddedfiles/hledger-web.md"))
  ,(Tool
"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 :: [(Tool, (ByteString, ByteString, ByteString))]
manuals = [
   (Tool
"hledger",
    ($(embedFileRelative "embeddedfiles/hledger.1")
    ,$(embedFileRelative "embeddedfiles/hledger.txt")
    ,$(embedFileRelative "embeddedfiles/hledger.info")
    ))
  ,(Tool
"hledger-ui",
    ($(embedFileRelative "embeddedfiles/hledger-ui.1")
    ,$(embedFileRelative "embeddedfiles/hledger-ui.txt")
    ,$(embedFileRelative "embeddedfiles/hledger-ui.info")
    ))
  ,(Tool
"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 :: Tool -> ByteString
manualTxt Tool
name = ByteString
-> ((ByteString, ByteString, ByteString) -> ByteString)
-> Maybe (ByteString, ByteString, ByteString)
-> ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Tool -> ByteString
forall a. IsString a => Tool -> a
fromString (Tool -> ByteString) -> Tool -> ByteString
forall a b. (a -> b) -> a -> b
$ Tool
"No text manual found for tool: "Tool -> Tool -> Tool
forall a. [a] -> [a] -> [a]
++Tool
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
$ Tool
-> [(Tool, (ByteString, ByteString, ByteString))]
-> Maybe (ByteString, ByteString, ByteString)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Tool
name [(Tool, (ByteString, ByteString, ByteString))]
manuals

-- | Get the manual as man source (nroff) for this tool, or a not found message.
manualMan :: Tool -> ByteString
manualMan :: Tool -> ByteString
manualMan Tool
name = ByteString
-> ((ByteString, ByteString, ByteString) -> ByteString)
-> Maybe (ByteString, ByteString, ByteString)
-> ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Tool -> ByteString
forall a. IsString a => Tool -> a
fromString (Tool -> ByteString) -> Tool -> ByteString
forall a b. (a -> b) -> a -> b
$ Tool
"No man page found for tool: "Tool -> Tool -> Tool
forall a. [a] -> [a] -> [a]
++Tool
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
$ Tool
-> [(Tool, (ByteString, ByteString, ByteString))]
-> Maybe (ByteString, ByteString, ByteString)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Tool
name [(Tool, (ByteString, ByteString, ByteString))]
manuals

-- | Get the manual as info source (texinfo) for this tool, or a not found message.
manualInfo :: Tool -> ByteString
manualInfo :: Tool -> ByteString
manualInfo Tool
name = ByteString
-> ((ByteString, ByteString, ByteString) -> ByteString)
-> Maybe (ByteString, ByteString, ByteString)
-> ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Tool -> ByteString
forall a. IsString a => Tool -> a
fromString (Tool -> ByteString) -> Tool -> ByteString
forall a b. (a -> b) -> a -> b
$ Tool
"No info manual found for tool: "Tool -> Tool -> Tool
forall a. [a] -> [a] -> [a]
++Tool
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
$ Tool
-> [(Tool, (ByteString, ByteString, ByteString))]
-> Maybe (ByteString, ByteString, ByteString)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Tool
name [(Tool, (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 :: Tool -> Maybe Tool -> IO ()
printHelpForTopic Tool
tool Maybe Tool
_mtopic = ByteString -> IO ()
BC.putStr (Tool -> ByteString
manualTxt Tool
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 :: Tool -> Maybe Tool -> IO ()
runInfoForTopic Tool
tool Maybe Tool
mtopic =
  Tool -> (Tool -> Handle -> IO ()) -> IO ()
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
Tool -> (Tool -> Handle -> m a) -> m a
withSystemTempFile (Tool
"hledger-"Tool -> Tool -> Tool
forall a. [a] -> [a] -> [a]
++Tool
toolTool -> Tool -> Tool
forall a. [a] -> [a] -> [a]
++Tool
".info") ((Tool -> Handle -> IO ()) -> IO ())
-> (Tool -> Handle -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Tool
f Handle
h -> do
    Handle -> ByteString -> IO ()
BC.hPutStrLn Handle
h (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ Tool -> ByteString
manualInfo Tool
tool
    Handle -> IO ()
hClose Handle
h
    Tool -> IO ()
callCommand (Tool -> IO ()) -> Tool -> IO ()
forall a b. (a -> b) -> a -> b
$ Tool -> Tool -> Tool
forall a. Show a => Tool -> a -> a
dbg1 Tool
"info command" (Tool -> Tool) -> Tool -> Tool
forall a b. (a -> b) -> a -> b
$
      Tool
"info -f " Tool -> Tool -> Tool
forall a. [a] -> [a] -> [a]
++ Tool
f Tool -> Tool -> Tool
forall a. [a] -> [a] -> [a]
++ Tool -> (Tool -> Tool) -> Maybe Tool -> Tool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Tool
"" (Tool -> Tool -> Tool
forall r. PrintfType r => Tool -> r
printf Tool
" -n '%s'") Maybe Tool
mtopic

-- less with any vertical whitespace squashed, case-insensitive searching, the $ regex metacharacter accessible as \$.
less :: Tool
less = Tool
"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 :: Tool -> Maybe Tool -> IO ()
runPagerForTopic Tool
tool Maybe Tool
mtopic = do
  Tool -> (Tool -> Handle -> IO ()) -> IO ()
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
Tool -> (Tool -> Handle -> m a) -> m a
withSystemTempFile (Tool
"hledger-"Tool -> Tool -> Tool
forall a. [a] -> [a] -> [a]
++Tool
toolTool -> Tool -> Tool
forall a. [a] -> [a] -> [a]
++Tool
".txt") ((Tool -> Handle -> IO ()) -> IO ())
-> (Tool -> Handle -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Tool
f Handle
h -> do
    Handle -> ByteString -> IO ()
BC.hPutStrLn Handle
h (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ Tool -> ByteString
manualTxt Tool
tool
    Handle -> IO ()
hClose Handle
h
    envpager <- Tool -> Maybe Tool -> Tool
forall a. a -> Maybe a -> a
fromMaybe Tool
less (Maybe Tool -> Tool) -> IO (Maybe Tool) -> IO Tool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Tool -> IO (Maybe Tool)
lookupEnv Tool
"PAGER"
    let
      exactmatch = Bool
True
      (pager, searcharg) =
        case mtopic of
          Maybe Tool
Nothing -> (Tool
envpager, Tool
"")
          Just Tool
t  -> (Tool
less, Tool
"-p'^(   )?" Tool -> Tool -> Tool
forall a. [a] -> [a] -> [a]
++ Tool
t Tool -> Tool -> Tool
forall a. [a] -> [a] -> [a]
++ if Bool
exactmatch then Tool
"\\$'" else Tool
"")
    callCommand $ dbg1 "pager command" $ unwords [pager, searcharg, 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 :: Tool -> Maybe Tool -> IO ()
runManForTopic Tool
tool Maybe Tool
mtopic =
  -- This temp file path should have a slash in it, man requires at least one.
  Tool -> (Tool -> Handle -> IO ()) -> IO ()
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
Tool -> (Tool -> Handle -> m a) -> m a
withSystemTempFile (Tool
"hledger-"Tool -> Tool -> Tool
forall a. [a] -> [a] -> [a]
++Tool
toolTool -> Tool -> Tool
forall a. [a] -> [a] -> [a]
++Tool
".1") ((Tool -> Handle -> IO ()) -> IO ())
-> (Tool -> Handle -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Tool
f Handle
h -> do
    Handle -> ByteString -> IO ()
BC.hPutStrLn Handle
h (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ Tool -> ByteString
manualMan Tool
tool
    Handle -> IO ()
hClose Handle
h
    let
      exactmatch :: Bool
exactmatch = Bool
True
      pagerarg :: Tool
pagerarg =
        case Maybe Tool
mtopic of
          Maybe Tool
Nothing -> Tool
""
          Just Tool
t  -> Tool
"-P \"" Tool -> Tool -> Tool
forall a. [a] -> [a] -> [a]
++ Tool
less Tool -> Tool -> Tool
forall a. [a] -> [a] -> [a]
++ Tool
" -p'^(   )?" Tool -> Tool -> Tool
forall a. [a] -> [a] -> [a]
++ Tool
t Tool -> Tool -> Tool
forall a. [a] -> [a] -> [a]
++ (if Bool
exactmatch then Tool
"\\\\$" else Tool
"") Tool -> Tool -> Tool
forall a. [a] -> [a] -> [a]
++ Tool
"'\""
    Tool -> IO ()
callCommand (Tool -> IO ()) -> Tool -> IO ()
forall a b. (a -> b) -> a -> b
$ Tool -> Tool -> Tool
forall a. Show a => Tool -> a -> a
dbg1 Tool
"man command" (Tool -> Tool) -> Tool -> Tool
forall a b. (a -> b) -> a -> b
$ [Tool] -> Tool
unwords [Tool
"man", Tool
pagerarg, Tool
f]

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

-- | Display one of the hledger tldr pages, using "tldr".
runTldrForPage :: TldrPage -> IO ()
runTldrForPage :: Tool -> IO ()
runTldrForPage Tool
name =
  case Tool -> Maybe ByteString
tldr Tool
name of
    Maybe ByteString
Nothing -> Tool -> IO ()
forall a. Tool -> a
error' (Tool -> IO ()) -> Tool -> IO ()
forall a b. (a -> b) -> a -> b
$ Tool
"sorry, there's no " Tool -> Tool -> Tool
forall a. Semigroup a => a -> a -> a
<> Tool
name Tool -> Tool -> Tool
forall a. Semigroup a => a -> a -> a
<> Tool
" tldr page yet"
    Just ByteString
b -> (do
      Tool -> (Tool -> Handle -> IO ()) -> IO ()
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
Tool -> (Tool -> Handle -> m a) -> m a
withSystemTempFile (Tool
nameTool -> Tool -> Tool
forall a. [a] -> [a] -> [a]
++Tool
".md") ((Tool -> Handle -> IO ()) -> IO ())
-> (Tool -> Handle -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Tool
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
        Tool -> Tool -> IO ()
setEnv Tool
"TLDR_AUTO_UPDATE_DISABLED" Tool
"1"
        Tool -> IO ()
callCommand (Tool -> IO ()) -> Tool -> IO ()
forall a b. (a -> b) -> a -> b
$ Tool -> Tool -> Tool
forall a. Show a => Tool -> a -> a
dbg1 Tool
"tldr command" (Tool -> Tool) -> Tool -> Tool
forall a b. (a -> b) -> a -> b
$ Tool
"tldr --render " Tool -> Tool -> Tool
forall a. Semigroup a => a -> a -> a
<> Tool
f
      ) IO () -> (IOException -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` (\(IOException
_e::IOException) -> do
        Handle -> Tool -> IO ()
hPutStrLn Handle
stderr (Tool -> IO ()) -> Tool -> IO ()
forall a b. (a -> b) -> a -> b
$ Tool
"Warning: could not run tldr --render, using fallback viewer instead.\n"
        ByteString -> IO ()
BC.putStrLn ByteString
b
      )