Refactor embedded files

hledger-lib/Hledger/Utils.hs

@@ -56,6 +56,7 @@ module Hledger.Utils (
 
   -- * Other
   module Hledger.Utils.Debug,
+  module Hledger.Utils.DocFiles,
   module Hledger.Utils.Parse,
   module Hledger.Utils.IO,
   module Hledger.Utils.Regex,
@@ -83,6 +84,7 @@ import Lens.Micro ((&), (.~))
 import Lens.Micro.TH (DefName(TopName), lensClass, lensField, makeLensesWith, classyRules)
 
 import Hledger.Utils.Debug
+import Hledger.Utils.DocFiles
 import Hledger.Utils.Parse
 import Hledger.Utils.IO
 import Hledger.Utils.Regex

hledger-lib/Hledger/Utils/DocFiles.hs

@@ -0,0 +1,115 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+{-|
+
+Helpers for viewing documentation files in various formats.
+
+|-}
+
+module Hledger.Utils.DocFiles (
+   Topic
+  ,TldrPage
+
+  ,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 System.Environment (setEnv)
+import System.IO
+import System.IO.Temp
+import System.Process
+
+import Hledger.Utils.IO (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
+
+-- | Print plain text help for this tool.
+-- Takes an optional topic argument for convenience but it is currently ignored.
+printHelpForTopic' :: ByteString -> Maybe Topic -> IO ()
+printHelpForTopic' b _mtopic = BC.putStr b
+
+-- | 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 -> ByteString -> Maybe Topic -> IO ()
+runInfoForTopic' tool b mtopic =
+  withSystemTempFile ("hledger-"++tool++".info") $ \f h -> do
+    BC.hPutStrLn h b
+    hClose h
+    callCommand $ dbg1 "info command" $
+      "info -f " ++ f ++ maybe "" (printf " -n '%s'") mtopic
+
+-- less with any vertical whitespace squashed, case-insensitive searching, the $ regex metacharacter accessible as \$.
+less = "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 -> ByteString -> Maybe Topic -> IO ()
+runPagerForTopic' tool b mtopic = do
+  withSystemTempFile ("hledger-"++tool++".txt") $ \f h -> do
+    BC.hPutStrLn h b
+    hClose h
+    envpager <- fromMaybe less <$> lookupEnv "PAGER"
+    let
+      exactmatch = True
+      (pager, searcharg) =
+        case mtopic of
+          Nothing -> (envpager, "")
+          Just t  -> (less, "-p'^(   )?" ++ t ++ if exactmatch then "\\$'" else "")
+    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 -> ByteString -> Maybe Topic -> IO ()
+runManForTopic' tool b mtopic =
+  -- This temp file path should have a slash in it, man requires at least one.
+  withSystemTempFile ("hledger-"++tool++".1") $ \f h -> do
+    BC.hPutStrLn h b
+    hClose h
+    let
+      exactmatch = True
+      pagerarg =
+        case mtopic of
+          Nothing -> ""
+          Just t  -> "-P \"" ++ less ++ " -p'^(   )?" ++ t ++ (if exactmatch then "\\\\$" else "") ++ "'\""
+    callCommand $ dbg1 "man command" $ unwords ["man", pagerarg, f]
+
+-- | Display one of the tldr pages, using "tldr".
+runTldrForPage' :: [(TldrPage, ByteString)] -> TldrPage -> IO ()
+runTldrForPage' tldrs name =
+  case lookup name tldrs of
+    Nothing -> error' $ "sorry, there's no " <> name <> " tldr page yet"
+    Just b -> (do
+      withSystemTempFile (name++".md") $ \f h -> do
+        BC.hPutStrLn h b
+        hClose 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
+        setEnv "TLDR_AUTO_UPDATE_DISABLED" "1"
+        callCommand $ dbg1 "tldr command" $ "tldr --render " <> f
+      ) `catch` (\(_e::IOException) -> do
+        hPutStrLn stderr $ "Warning: could not run tldr --render, using fallback viewer instead.\n"
+        BC.putStrLn b
+      )

hledger-lib/hledger-lib.cabal

@@ -106,6 +106,7 @@ library
       Hledger.Reports.PostingsReport
       Hledger.Utils
       Hledger.Utils.Debug
+      Hledger.Utils.DocFiles
       Hledger.Utils.IO
       Hledger.Utils.Parse
       Hledger.Utils.Regex
@@ -160,6 +161,7 @@ library
     , tasty >=1.2.3
     , tasty-hunit >=0.10.0.2
     , template-haskell
+    , temporary
     , terminal-size >=0.3.3
     , text >=1.2.4.1
     , time >=1.5
@@ -220,6 +222,7 @@ test-suite doctest
     , tasty >=1.2.3
     , tasty-hunit >=0.10.0.2
     , template-haskell
+    , temporary
     , terminal-size >=0.3.3
     , text >=1.2.4.1
     , time >=1.5
@@ -282,6 +285,7 @@ test-suite unittest
     , tasty >=1.2.3
     , tasty-hunit >=0.10.0.2
     , template-haskell
+    , temporary
     , terminal-size >=0.3.3
     , text >=1.2.4.1
     , time >=1.5

hledger-lib/package.yaml

@@ -76,6 +76,7 @@ dependencies:
 - tabular >=0.2
 - tasty >=1.2.3
 - tasty-hunit >=0.10.0.2
+- temporary
 - template-haskell
 - terminal-size >=0.3.3
 - text >=1.2.4.1
@@ -172,6 +173,7 @@ library:
   - Hledger.Reports.PostingsReport
   - Hledger.Utils
   - Hledger.Utils.Debug
+  - Hledger.Utils.DocFiles
   - Hledger.Utils.IO
   - Hledger.Utils.Parse
   - Hledger.Utils.Regex

hledger-ui/Hledger/UI/DocFiles.hs

@@ -0,0 +1,48 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-|
+
+Embedded documentation files in various formats, and helpers for viewing them.
+
+|-}
+
+module Hledger.UI.DocFiles (
+   printHelpForTopic
+  ,runManForTopic
+  ,runInfoForTopic
+  ,runPagerForTopic
+  ,runTldrForPage
+  ) where
+
+import Data.ByteString (ByteString)
+
+import Hledger.Utils (embedFileRelative)
+import Hledger.Utils.DocFiles
+
+-- | All hledger-ui pages from the tldr-pages project.
+tldrs :: [(TldrPage, ByteString)]
+tldrs = [
+   ("hledger-ui", $(embedFileRelative "embeddedfiles/hledger-ui.md"))
+  ]
+
+-- | The main hledger-ui manuals as source for man, info and as plain text.
+man :: ByteString
+man = $(embedFileRelative "embeddedfiles/hledger-ui.1")
+txt :: ByteString
+txt = $(embedFileRelative "embeddedfiles/hledger-ui.txt")
+info :: ByteString
+info = $(embedFileRelative "embeddedfiles/hledger-ui.info")
+
+printHelpForTopic :: Maybe Topic -> IO ()
+printHelpForTopic = printHelpForTopic' txt
+
+runManForTopic :: Maybe Topic -> IO ()
+runManForTopic = runManForTopic' "hledger-ui" man
+
+runInfoForTopic :: Maybe Topic -> IO ()
+runInfoForTopic = runInfoForTopic' "hledger-ui" info
+
+runPagerForTopic :: Maybe Topic -> IO ()
+runPagerForTopic = runPagerForTopic' "hledger-ui" txt
+
+runTldrForPage :: TldrPage -> IO ()
+runTldrForPage = runTldrForPage' tldrs

hledger-ui/Hledger/UI/Main.hs

@@ -35,7 +35,9 @@ import Brick hiding (bsDraw)
 import qualified Brick.BChan as BC
 
 import Hledger
-import Hledger.Cli hiding (progname,prognameandversion)
+import Hledger.Cli (withJournalDo)
+import Hledger.Cli.CliOptions hiding (progname,prognameandversion)
+import Hledger.UI.DocFiles
 import Hledger.UI.Theme
 import Hledger.UI.UIOptions
 import Hledger.UI.UITypes
@@ -100,8 +102,8 @@ hledgerUiMain = withGhcDebug' $ withProgName "hledger-ui.log" $ do  -- force Hle
   case True of
     _ | boolopt "help"    rawopts -> runPager $ showModeUsage uimode ++ "\n"
     _ | boolopt "tldr"    rawopts -> runTldrForPage "hledger-ui"
-    _ | boolopt "info"    rawopts -> runInfoForTopic "hledger-ui" Nothing
-    _ | boolopt "man"     rawopts -> runManForTopic  "hledger-ui" Nothing
+    _ | boolopt "info"    rawopts -> runInfoForTopic Nothing
+    _ | boolopt "man"     rawopts -> runManForTopic  Nothing
     _ | boolopt "version" rawopts -> putStrLn prognameandversion
     -- _ | boolopt "binary-filename" rawopts -> putStrLn (binaryfilename progname)
     _                                         -> withJournalDo copts' (runBrickUi opts)

hledger-ui/Hledger/UI/UIUtils.hs

@@ -64,7 +64,7 @@ import Lens.Micro.Platform
 
 import Hledger
 -- import Hledger.Cli.CliOptions (CliOpts(reportspec_))
-import Hledger.Cli.DocFiles
+import Hledger.UI.DocFiles
 -- import Hledger.UI.UIOptions (UIOpts(uoCliOpts))
 import Hledger.UI.UITypes
 
@@ -228,9 +228,9 @@ helpHandle ev = do
   let ui' = ui{aMode=Normal}
   case ev of
     VtyEvent e | e `elem` closeHelpEvents -> put' ui'
-    VtyEvent (EvKey (KChar 'p') []) -> suspendAndResume (runPagerForTopic "hledger-ui" Nothing >> return ui')
-    VtyEvent (EvKey (KChar 'm') []) -> suspendAndResume (runManForTopic   "hledger-ui" Nothing >> return ui')
-    VtyEvent (EvKey (KChar 'i') []) -> suspendAndResume (runInfoForTopic  "hledger-ui" Nothing >> return ui')
+    VtyEvent (EvKey (KChar 'p') []) -> suspendAndResume (runPagerForTopic Nothing >> return ui')
+    VtyEvent (EvKey (KChar 'm') []) -> suspendAndResume (runManForTopic   Nothing >> return ui')
+    VtyEvent (EvKey (KChar 'i') []) -> suspendAndResume (runInfoForTopic  Nothing >> return ui')
     _ -> return ()
   where
     closeHelpEvents = moveLeftEvents ++ [EvKey KEsc [], EvKey (KChar '?') [], EvKey (KChar 'q') []]

hledger-ui/embeddedfiles/hledger-ui.1

@@ -0,0 +1 @@
+../hledger-ui.1

hledger-ui/embeddedfiles/hledger-ui.info

@@ -0,0 +1 @@
+../hledger-ui.info

hledger-ui/embeddedfiles/hledger-ui.txt

@@ -0,0 +1 @@
+../hledger-ui.txt

hledger-ui/hledger-ui.cabal

@@ -31,9 +31,10 @@ tested-with:
 extra-source-files:
     CHANGES.md
     README.md
-    hledger-ui.1
-    hledger-ui.txt
-    hledger-ui.info
+    embeddedfiles/hledger-ui.md
+    embeddedfiles/hledger-ui.1
+    embeddedfiles/hledger-ui.txt
+    embeddedfiles/hledger-ui.info
 
 source-repository head
   type: git
@@ -59,6 +60,7 @@ library
       Hledger.UI.AccountsScreen
       Hledger.UI.BalancesheetScreen
       Hledger.UI.CashScreen
+      Hledger.UI.DocFiles
       Hledger.UI.Editor
       Hledger.UI.ErrorScreen
       Hledger.UI.IncomestatementScreen
@@ -79,6 +81,7 @@ library
     , async
     , base >=4.14 && <4.21
     , brick >=2.1.1 && <2.3.2 || >2.3.2 && <2.9
+    , bytestring
     , cmdargs >=0.8
     , containers >=0.5.9
     , data-default

hledger-ui/package.yaml

@@ -24,11 +24,12 @@ stability   : stable
 tested-with: GHC==8.10.7, GHC==9.0.2, GHC==9.2.8, GHC==9.4.5, GHC==9.6.2
 
 extra-source-files:
-  - CHANGES.md
-  - README.md
-  - hledger-ui.1
-  - hledger-ui.txt
-  - hledger-ui.info
+- CHANGES.md
+- README.md
+- embeddedfiles/hledger-ui.md
+- embeddedfiles/hledger-ui.1
+- embeddedfiles/hledger-ui.txt
+- embeddedfiles/hledger-ui.info
 
 #data-files:
 
@@ -95,6 +96,7 @@ library:
   - hledger >=1.42.99 && <1.43
   - ansi-terminal >=0.9
   - async
+  - bytestring
   - cmdargs >=0.8
   - containers >=0.5.9
   - data-default

hledger-web/Hledger/Web/DocFiles.hs

@@ -0,0 +1,48 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-|
+
+Embedded documentation files in various formats, and helpers for viewing them.
+
+|-}
+
+module Hledger.Web.DocFiles (
+   printHelpForTopic
+  ,runManForTopic
+  ,runInfoForTopic
+  ,runPagerForTopic
+  ,runTldrForPage
+  ) where
+
+import Data.ByteString (ByteString)
+
+import Hledger.Utils (embedFileRelative)
+import Hledger.Utils.DocFiles
+
+-- | All hledger-web pages from the tldr-pages project.
+tldrs :: [(TldrPage, ByteString)]
+tldrs = [
+   ("hledger-web", $(embedFileRelative "embeddedfiles/hledger-web.md"))
+  ]
+
+-- | The main hledger-web manuals as source for man, info and as plain text.
+man :: ByteString
+man = $(embedFileRelative "embeddedfiles/hledger-web.1")
+txt :: ByteString
+txt = $(embedFileRelative "embeddedfiles/hledger-web.txt")
+info :: ByteString
+info = $(embedFileRelative "embeddedfiles/hledger-web.info")
+
+printHelpForTopic :: Maybe Topic -> IO ()
+printHelpForTopic = printHelpForTopic' txt
+
+runManForTopic :: Maybe Topic -> IO ()
+runManForTopic = runManForTopic' "hledger-web" man
+
+runInfoForTopic :: Maybe Topic -> IO ()
+runInfoForTopic = runInfoForTopic' "hledger-web" info
+
+runPagerForTopic :: Maybe Topic -> IO ()
+runPagerForTopic = runPagerForTopic' "hledger-web" txt
+
+runTldrForPage :: TldrPage -> IO ()
+runTldrForPage = runTldrForPage' tldrs