{-|
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 Safe (tailMay)
import System.IO.Temp (withSystemTempFile)
import System.IO (hClose)
import System.Console.CmdArgs.Explicit (flagReq)

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 -> 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")
  [
   [String] -> Update RawOpts -> String -> String -> Flag RawOpts
forall a. [String] -> Update a -> String -> String -> Flag a
flagReq  [String
"speed",String
"s"] (\String
s RawOpts
opts -> RawOpts -> Either String RawOpts
forall a b. b -> Either a b
Right (RawOpts -> Either String RawOpts)
-> RawOpts -> Either String RawOpts
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]
  []
  ([], 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
$ String -> Arg RawOpts
argsFlag String
optsstr)

optsstr :: String
optsstr = String
"[NUM|PREFIX|SUBSTR] [-- ASCIINEMAOPTS]"
usagestr :: String
usagestr = String
"Usage: hledger demo " String -> String -> String
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 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
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 (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"No demo \"" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
a String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"\" was found."
          String -> IO ()
putStrLn String
usagestr
          IO ()
printDemos
          IO ()
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 -> 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
$ String -> Maybe Float
forall a. Read a => String -> Maybe a
readMay String
s
                  where err :: a
err = String -> a
forall a. String -> a
error' (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"could not parse --speed " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
s String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
", numeric argument expected"
            idx :: Int
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 String
t2 ByteString
_) -> String
t2 String -> String -> Bool
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' (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
w Char
'.' where w :: Int
w = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe (String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
t) Maybe Int
mw
          String -> Int -> String -> IO ()
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 = String -> (ByteString -> String) -> Maybe ByteString -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" (String -> String
readTitle (String -> String)
-> (ByteString -> String) -> ByteString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
B.unpack) (Maybe ByteString -> String) -> Maybe ByteString -> String
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 :: String -> String
readTitle String
s
          | String
"\"title\":" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
s = (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
'"') (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
1 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String -> String
lstrip (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
8 String
s
          | Bool
otherwise = String -> (String -> String) -> Maybe String -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" String -> String
readTitle (Maybe String -> String) -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$ String -> Maybe String
forall a. [a] -> Maybe [a]
tailMay String
s

findDemo :: [Demo] -> String -> Maybe Demo
findDemo :: [Demo] -> String -> Maybe Demo
findDemo [Demo]
ds String
s =
      (String -> Maybe Int
forall a. Read a => String -> Maybe a
readMay String
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 ((String
sl String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`)(String -> Bool) -> (Demo -> String) -> Demo -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String
lowercase(String -> String) -> (Demo -> String) -> Demo -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Demo -> String
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 ((String
sl String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf`) (String -> Bool) -> (Demo -> String) -> Demo -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String
lowercase(String -> String) -> (Demo -> String) -> Demo -> String
forall 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 (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$
  String
"Demos:" String -> [String] -> [String]
forall a. a -> [a] -> [a]
:
  -- "" :
  [Int -> String
forall a. Show a => a -> String
show Int
i String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
") " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> String
bold' String
t | (Int
i, Demo String
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 -> [String] -> IO ()
runAsciinemaPlay Float
speed Float
idlelimit ByteString
content [String]
args =
    -- XXX try piping to stdin also
  String -> (String -> Handle -> IO ()) -> IO ()
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
String -> (String -> Handle -> m a) -> m a
withSystemTempFile String
"hledger-cast" ((String -> Handle -> IO ()) -> IO ())
-> (String -> Handle -> IO ()) -> IO ()
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 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
    String -> [String] -> IO ()
callProcess String
"asciinema" (([String] -> String) -> [String] -> [String]
forall a. Show a => (a -> String) -> a -> a
dbg8With ((String
"asciinema: "String -> String -> String
forall a. [a] -> [a] -> [a]
++)(String -> String) -> ([String] -> String) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.[String] -> String
unwords) ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [
       [String
"play"]
      ,[String
"-s"String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Float -> String
showwithouttrailingzero Float
speed]
      ,if Float
idlelimit Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
== Float
0 then [] else [String
"-i"String -> String -> String
forall a. Semigroup a => a -> a -> a
<>Float -> String
showwithouttrailingzero Float
idlelimit]
      ,[String
f]
      ,[String]
args
      ])
      IO () -> (IOError -> IO ()) -> IO ()
forall a. IO a -> (IOError -> IO a) -> IO a
`catchIOError` \IOError
err -> do
        String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"\n" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> IOError -> String
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"] IO () -> (IOError -> IO ()) -> IO ()
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."
        IO ()
forall a. IO a
exitFailure
  where
    showwithouttrailingzero :: Float -> String
showwithouttrailingzero = (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhileEnd (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'.') (String -> String) -> (Float -> String) -> Float -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhileEnd (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'0') (String -> String) -> (Float -> String) -> Float -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> String
forall a. Show a => a -> String
show