{-|
The @demo@ command lists and plays small hledger demos in the terminal, using asciinema.
-}
{-
PROJECTS
improve cast output
 install
  command line editing glitches
  shrink / compress ?
 help
  screen corrupted by pager
 demo
  update (or drop till stable)
 add
 print
 balance
document cast production tips
 always clear screen after running pager/curses apps ?
 record with tall window to avoid showing pager in playback ?
improve functionality
 show "done" in final red line ?
 mirror common asciinema flags like -s, -i and/or set speed/max idle with optional arguments
 support other asciinema operations (cat)
 show hledger.org player urls
 windows/PowerSession support
 attract/continuous play mode
more casts
 clarify goals/target user(s)/scenarios
 identify and prioritise some casts needed
-}

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

module Hledger.Cli.Commands.Demo (
  demomode
 ,demo
) where

import Text.Printf
import Control.Concurrent (threadDelay)
import System.Process (callProcess)
import System.IO.Error (catchIOError)
import Safe (readMay, atMay, headMay)
import Data.List (isPrefixOf, find, findIndex, isInfixOf, dropWhileEnd)
import Control.Applicative ((<|>))
import Data.ByteString as B (ByteString)
import Data.Maybe
import Data.ByteString.Char8 qualified as B
import Safe (tailMay)
import System.IO.Temp (withSystemTempFile)
import System.IO (hClose)
import System.Console.CmdArgs.Explicit (flagReq)

import Hledger
import Hledger.Cli.CliOptions
import System.Directory (findExecutable)
import Control.Monad (when)

demos :: [Demo]
demos :: [Demo]
demos = (ByteString -> Demo) -> [ByteString] -> [Demo]
forall a b. (a -> b) -> [a] -> [b]
map ByteString -> Demo
readDemo [
  -- XXX these are confusing, redo
  -- (embedFileRelative "embeddedfiles/help.cast"),     -- https://asciinema.org/a/568112 Getting help
  -- (embedFileRelative "embeddedfiles/demo.cast"),     -- https://asciinema.org/a/567944 Watching the built-in demos
  $(embedFileRelative "embeddedfiles/add.cast"),      -- https://asciinema.org/a/567935 The easiest way to start a journal (add)
  $(embedFileRelative "embeddedfiles/print.cast"),    -- https://asciinema.org/a/567936 Show full transactions (print)
  $(embedFileRelative "embeddedfiles/balance.cast"),   -- https://asciinema.org/a/567937 Show account balances and changes (balance)
  $(embedFileRelative "embeddedfiles/install.cast")  -- https://asciinema.org/a/567934 Installing hledger from source with hledger-install
  ]

-- | An embedded asciinema cast, with some of the metadata separated out.
-- The original file name is not preserved.
data Demo = Demo {
  Demo -> [Char]
dtitle    :: String,      -- asciinema title field
  Demo -> ByteString
_dcontent :: ByteString   -- asciinema v2 content
}

-- | Command line options for this command.
demomode :: Mode RawOpts
demomode = [Char]
-> [Flag RawOpts]
-> [([Char], [Flag RawOpts])]
-> [Flag RawOpts]
-> ([Arg RawOpts], Maybe (Arg RawOpts))
-> Mode RawOpts
hledgerCommandMode
  $(embedFileRelative "Hledger/Cli/Commands/Demo.txt")
  [
   [[Char]] -> Update RawOpts -> [Char] -> [Char] -> Flag RawOpts
forall a. [[Char]] -> Update a -> [Char] -> [Char] -> Flag a
flagReq  [[Char]
"speed",[Char]
"s"] (\[Char]
s RawOpts
opts -> RawOpts -> Either [Char] RawOpts
forall a b. b -> Either a b
Right (RawOpts -> Either [Char] RawOpts)
-> RawOpts -> Either [Char] RawOpts
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> RawOpts -> RawOpts
setopt [Char]
"speed" [Char]
s RawOpts
opts) [Char]
"SPEED"
    ([Char]
"playback speed (1 is original speed, .5 is half, 2 is double, etc (default: 2))")
  ]
  [([Char], [Flag RawOpts])
generalflagsgroup3]
  []
  ([], Arg RawOpts -> Maybe (Arg RawOpts)
forall a. a -> Maybe a
Just (Arg RawOpts -> Maybe (Arg RawOpts))
-> Arg RawOpts -> Maybe (Arg RawOpts)
forall a b. (a -> b) -> a -> b
$ [Char] -> Arg RawOpts
argsFlag [Char]
optsstr)

optsstr :: [Char]
optsstr = [Char]
"[NUM|PREFIX|SUBSTR]"
-- optsstr = "[NUM|PREFIX|SUBSTR] [-- ASCIINEMAOPTS]"
usagestr :: [Char]
usagestr = [Char]
"Usage: hledger demo " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
optsstr

-- | The demo command.
demo :: CliOpts -> Journal -> IO ()
demo :: CliOpts -> Journal -> IO ()
demo CliOpts{rawopts_ :: CliOpts -> RawOpts
rawopts_=RawOpts
rawopts, reportspec_ :: CliOpts -> ReportSpec
reportspec_=ReportSpec{_rsQuery :: ReportSpec -> Query
_rsQuery=Query
_query}} Journal
_j = do
  -- demos <- getCurrentDirectory >>= readDemos
  case [Char] -> RawOpts -> [[Char]]
listofstringopt [Char]
"args" RawOpts
rawopts of
    [] -> [Char] -> IO ()
putStrLn [Char]
usagestr IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Char] -> IO ()
putStr [Char]
listDemos
    ([Char]
a:[[Char]]
as) ->
      case [Demo] -> [Char] -> Maybe Demo
findDemo [Demo]
demos [Char]
a of
        Maybe Demo
Nothing -> [Char] -> IO ()
forall a. [Char] -> a
error' ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
unlines
          [[Char]
"No demo \"" [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
a [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
"\" was found."
          ,[Char]
usagestr
          ,[Char]
listDemos
          ]
        Just (Demo [Char]
t ByteString
c) -> do
          -- check if asciinema is installed, first
          masciinema <- [Char] -> IO (Maybe [Char])
findExecutable [Char]
"asciinema"
          when (isNothing masciinema) $ error' "Could not find 'asciinema'; please install that first."
          let
            -- try to preserve the original pauses a bit while also moving things along
            defidlelimit = Float
10
            defspeed     = Float
2
            speed =
              case [Char] -> RawOpts -> Maybe [Char]
maybestringopt [Char]
"speed" RawOpts
rawopts of
                Maybe [Char]
Nothing -> Float
defspeed
                Just [Char]
s -> Float -> Maybe Float -> Float
forall a. a -> Maybe a -> a
fromMaybe Float
forall {a}. a
err (Maybe Float -> Float) -> Maybe Float -> Float
forall a b. (a -> b) -> a -> b
$ [Char] -> Maybe Float
forall a. Read a => [Char] -> Maybe a
readMay [Char]
s
                  where err :: a
err = [Char] -> a
forall a. [Char] -> a
error' ([Char] -> a) -> [Char] -> a
forall a b. (a -> b) -> a -> b
$ [Char]
"could not parse --speed " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
s [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
", numeric argument expected"
            idx = Int -> (Int -> Int) -> Maybe Int -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+) (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ (Demo -> Bool) -> [Demo] -> Maybe Int
forall a. (a -> Bool) -> [a] -> Maybe Int
findIndex (\(Demo [Char]
t2 ByteString
_) -> [Char]
t2 [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
t) [Demo]
demos  -- should succeed
          mw <- getTerminalWidth
          let line = [Char] -> [Char]
red' ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate Int
w Char
'.' where w :: Int
w = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
t) Maybe Int
mw
          printf "playing: %d) %s\nspace to pause, . to step, ctrl-c to quit\n" idx (bold' t)
          putStrLn line
          putStrLn ""
          threadDelay 1000000
          -- XXX this used to see asciinema options after --, currently it doesn't
          runAsciinemaPlay speed defidlelimit c as
          putStrLn ""
          putStrLn line

readDemo :: ByteString -> Demo
readDemo :: ByteString -> Demo
readDemo ByteString
content = [Char] -> ByteString -> Demo
Demo [Char]
title ByteString
content
  where
    title :: [Char]
title = [Char] -> (ByteString -> [Char]) -> Maybe ByteString -> [Char]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Char]
"" ([Char] -> [Char]
readTitle ([Char] -> [Char])
-> (ByteString -> [Char]) -> ByteString -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Char]
B.unpack) (Maybe ByteString -> [Char]) -> Maybe ByteString -> [Char]
forall a b. (a -> b) -> a -> b
$ [ByteString] -> Maybe ByteString
forall a. [a] -> Maybe a
headMay ([ByteString] -> Maybe ByteString)
-> [ByteString] -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> [ByteString]
B.lines ByteString
content
      where
        readTitle :: [Char] -> [Char]
readTitle [Char]
s
          | [Char]
"\"title\":" [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [Char]
s = (Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
'"') ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
drop Int
1 ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char]
lstrip ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
drop Int
8 [Char]
s
          | Bool
otherwise = [Char] -> ([Char] -> [Char]) -> Maybe [Char] -> [Char]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Char]
"" [Char] -> [Char]
readTitle (Maybe [Char] -> [Char]) -> Maybe [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> Maybe [Char]
forall a. [a] -> Maybe [a]
tailMay [Char]
s

findDemo :: [Demo] -> String -> Maybe Demo
findDemo :: [Demo] -> [Char] -> Maybe Demo
findDemo [Demo]
ds [Char]
s =
      ([Char] -> Maybe Int
forall a. Read a => [Char] -> Maybe a
readMay [Char]
s Maybe Int -> (Int -> Maybe Demo) -> Maybe Demo
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Demo] -> Int -> Maybe Demo
forall a. [a] -> Int -> Maybe a
atMay [Demo]
ds (Int -> Maybe Demo) -> (Int -> Int) -> Int -> Maybe Demo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Int
forall a. Num a => a -> a -> a
subtract Int
1)         -- try to find by number
  Maybe Demo -> Maybe Demo -> Maybe Demo
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Demo -> Bool) -> [Demo] -> Maybe Demo
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (([Char]
sl [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`)([Char] -> Bool) -> (Demo -> [Char]) -> Demo -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.[Char] -> [Char]
lowercase([Char] -> [Char]) -> (Demo -> [Char]) -> Demo -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Demo -> [Char]
dtitle) [Demo]
ds  -- or by title prefix (ignoring case)
  Maybe Demo -> Maybe Demo -> Maybe Demo
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Demo -> Bool) -> [Demo] -> Maybe Demo
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (([Char]
sl [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf`) ([Char] -> Bool) -> (Demo -> [Char]) -> Demo -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.[Char] -> [Char]
lowercase([Char] -> [Char]) -> (Demo -> [Char]) -> Demo -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Demo -> [Char]
dtitle) [Demo]
ds  -- or by title substring (ignoring case)
  where
    sl :: [Char]
sl = [Char] -> [Char]
lowercase [Char]
s

listDemos :: String
listDemos :: [Char]
listDemos = [[Char]] -> [Char]
unlines ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$
  [Char]
"Demos:" [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
:
  -- "" :
  [Int -> [Char]
forall a. Show a => a -> [Char]
show Int
i [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
") " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char] -> [Char]
bold' [Char]
t | (Int
i, Demo [Char]
t ByteString
_) <- [Int] -> [Demo] -> [(Int, Demo)]
forall a b. [a] -> [b] -> [(a, b)]
zip [(Int
1::Int)..] [Demo]
demos]

-- | Run asciinema play with the given speed and idle limit, passing the given content to its stdin.
runAsciinemaPlay :: Float -> Float -> ByteString -> [String] -> IO ()
runAsciinemaPlay :: Float -> Float -> ByteString -> [[Char]] -> IO ()
runAsciinemaPlay Float
speed Float
idlelimit ByteString
content [[Char]]
args = do
  -- XXX try piping to stdin also
  [Char] -> ([Char] -> Handle -> IO ()) -> IO ()
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
[Char] -> ([Char] -> Handle -> m a) -> m a
withSystemTempFile [Char]
"hledger-cast" (([Char] -> Handle -> IO ()) -> IO ())
-> ([Char] -> Handle -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \[Char]
f Handle
h -> do
    -- don't add an extra newline here, it breaks asciinema 2.3.0 (#2094).
    -- XXX we could try harder and strip excess newlines/carriage returns+linefeeds here
    Handle -> ByteString -> IO ()
B.hPutStr Handle
h ByteString
content IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> IO ()
hClose Handle
h
    [Char] -> [[Char]] -> IO ()
callProcess [Char]
"asciinema" (([[Char]] -> [Char]) -> [[Char]] -> [[Char]]
forall a. (a -> [Char]) -> a -> a
dbg8With (([Char]
"asciinema: "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++)([Char] -> [Char]) -> ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.[[Char]] -> [Char]
unwords) ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ [[[Char]]] -> [[Char]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [
       [[Char]
"play"]
      ,[[Char]
"-s"[Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Float -> [Char]
showwithouttrailingzero Float
speed]
      ,if Float
idlelimit Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
== Float
0 then [] else [[Char]
"-i"[Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<>Float -> [Char]
showwithouttrailingzero Float
idlelimit]
      ,[[Char]
f]
      ,[[Char]]
args
      ])
    IO () -> (IOError -> IO ()) -> IO ()
forall a. IO a -> (IOError -> IO a) -> IO a
`catchIOError` \IOError
err -> do
      [Char] -> IO ()
printError ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
unlines
        [[Char]
""
        ,IOError -> [Char]
forall a. Show a => a -> [Char]
show IOError
err
        ,[Char]
"Running asciinema failed. Trying 'asciinema --version':"
        ]
      [Char] -> [[Char]] -> IO ()
callProcess [Char]
"asciinema" [[Char]
"--version"]
      IO () -> (IOError -> IO ()) -> IO ()
forall a. IO a -> (IOError -> IO a) -> IO a
`catchIOError` \IOError
_ -> [Char] -> IO ()
forall a. [Char] -> a
error' [Char]
"This also failed."
  where
    showwithouttrailingzero :: Float -> [Char]
showwithouttrailingzero = (Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
dropWhileEnd (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'.') ([Char] -> [Char]) -> (Float -> [Char]) -> Float -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
dropWhileEnd (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'0') ([Char] -> [Char]) -> (Float -> [Char]) -> Float -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> [Char]
forall a. Show a => a -> [Char]
show