{-|
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 Hledger
import Hledger.Cli.CliOptions
import System.Exit (exitFailure)
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 qualified Data.ByteString.Char8 as B
import System.IO.Temp (withSystemTempFile)
import System.IO (hClose)
import System.Console.CmdArgs.Explicit (flagReq)

demos :: [Demo]
demos :: [Demo]
demos = 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 -> String
dtitle    :: String,      -- asciinema title field
  Demo -> ByteString
_dcontent :: ByteString   -- asciinema v2 content
}

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

optsstr :: String
optsstr = String
"[NUM|PREFIX|SUBSTR] [-- ASCIINEMAOPTS]"
usagestr :: String
usagestr = String
"Usage: hledger demo " forall a. Semigroup a => a -> a -> a
<> String
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 String -> RawOpts -> [String]
listofstringopt String
"args" RawOpts
rawopts of
    [] -> String -> IO ()
putStrLn String
usagestr forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ()
printDemos
    (String
a:[String]
as) ->
      case [Demo] -> String -> Maybe Demo
findDemo [Demo]
demos String
a of
        Maybe Demo
Nothing -> do
          String -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ String
"No demo \"" forall a. Semigroup a => a -> a -> a
<> String
a forall a. Semigroup a => a -> a -> a
<> String
"\" was found."
          String -> IO ()
putStrLn String
usagestr
          IO ()
printDemos
          forall a. IO a
exitFailure
        Just (Demo String
t ByteString
c) -> do
          let
            -- try to preserve the original pauses a bit while also moving things along
            defidlelimit :: Float
defidlelimit = Float
10
            defspeed :: Float
defspeed     = Float
2
            speed :: Float
speed =
              case String -> RawOpts -> Maybe String
maybestringopt String
"speed" RawOpts
rawopts of
                Maybe String
Nothing -> Float
defspeed
                Just String
s -> forall a. a -> Maybe a -> a
fromMaybe forall {a}. a
err forall a b. (a -> b) -> a -> b
$ forall a. Read a => String -> Maybe a
readMay String
s
                  where err :: a
err = forall a. String -> a
error' forall a b. (a -> b) -> a -> b
$ String
"could not parse --speed " forall a. Semigroup a => a -> a -> a
<> String
s forall a. Semigroup a => a -> a -> a
<> String
", numeric argument expected"
            idx :: Int
idx = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 (Int
1forall a. Num a => a -> a -> a
+) forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> Maybe Int
findIndex (\(Demo String
t2 ByteString
_) -> String
t2 forall a. Eq a => a -> a -> Bool
== String
t) [Demo]
demos  -- should succeed
          Maybe Int
mw <- IO (Maybe Int)
getTerminalWidth
          let line :: String
line = String -> String
red' forall a b. (a -> b) -> a -> b
$ forall a. Int -> a -> [a]
replicate Int
w Char
'.' where w :: Int
w = forall a. a -> Maybe a -> a
fromMaybe (forall (t :: * -> *) a. Foldable t => t a -> Int
length String
t) Maybe Int
mw
          forall r. PrintfType r => String -> r
printf String
"playing: %d) %s\nspace to pause, . to step, ctrl-c to quit\n" Int
idx (String -> String
bold' String
t)
          String -> IO ()
putStrLn String
line
          String -> IO ()
putStrLn String
""
          Int -> IO ()
threadDelay Int
1000000
          Float -> Float -> ByteString -> [String] -> IO ()
runAsciinemaPlay Float
speed Float
defidlelimit ByteString
c [String]
as
          String -> IO ()
putStrLn String
""
          String -> IO ()
putStrLn String
line

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

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

printDemos :: IO ()
printDemos :: IO ()
printDemos = String -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines forall a b. (a -> b) -> a -> b
$
  String
"Demos:" forall a. a -> [a] -> [a]
:
  -- "" :
  [forall a. Show a => a -> String
show Int
i forall a. Semigroup a => a -> a -> a
<> String
") " forall a. Semigroup a => a -> a -> a
<> String -> String
bold' String
t | (Int
i, Demo String
t ByteString
_) <- 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 -> [String] -> IO ()
runAsciinemaPlay Float
speed Float
idlelimit ByteString
content [String]
args =
    -- XXX try piping to stdin also
  forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
String -> (String -> Handle -> m a) -> m a
withSystemTempFile String
"hledger-cast" forall a b. (a -> b) -> a -> b
$ \String
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 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> IO ()
hClose Handle
h
    String -> [String] -> IO ()
callProcess String
"asciinema" (forall a. Show a => (a -> String) -> a -> a
dbg8With ((String
"asciinema: "forall a. [a] -> [a] -> [a]
++)forall b c a. (b -> c) -> (a -> b) -> a -> c
.[String] -> String
unwords) forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [
       [String
"play"]
      ,[String
"-s"forall a. Semigroup a => a -> a -> a
<> Float -> String
showwithouttrailingzero Float
speed]
      ,if Float
idlelimit forall a. Eq a => a -> a -> Bool
== Float
0 then [] else [String
"-i"forall a. Semigroup a => a -> a -> a
<>Float -> String
showwithouttrailingzero Float
idlelimit]
      ,[String
f]
      ,[String]
args
      ])
      forall a. IO a -> (IOError -> IO a) -> IO a
`catchIOError` \IOError
err -> do
        String -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ String
"\n" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show IOError
err
        String -> IO ()
putStrLn String
"Error: running asciinema failed. Trying 'asciinema --version':"
        String -> [String] -> IO ()
callProcess String
"asciinema" [String
"--version"] forall a. IO a -> (IOError -> IO a) -> IO a
`catchIOError` \IOError
_ ->
          String -> IO ()
putStrLn String
"This also failed. Check that asciinema is installed in your PATH."
        forall a. IO a
exitFailure
  where
    showwithouttrailingzero :: Float -> String
showwithouttrailingzero = forall a. (a -> Bool) -> [a] -> [a]
dropWhileEnd (forall a. Eq a => a -> a -> Bool
==Char
'.') forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
dropWhileEnd (forall a. Eq a => a -> a -> Bool
==Char
'0') forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show