{-|
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 qualified Data.ByteString.Char8 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

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
>> String -> IO ()
putStr String
listDemos
    (String
a:[String]
as) ->
      case [Demo] -> String -> Maybe Demo
findDemo [Demo]
demos String
a of
        Maybe Demo
Nothing -> String -> IO ()
forall a. String -> a
error' (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines
          [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
usagestr
          ,String
listDemos
          ]
        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

listDemos :: String
listDemos :: String
listDemos = [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. (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 ()
printError (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines
        [String
""
        ,IOError -> String
forall a. Show a => a -> String
show IOError
err
        ,String
"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 ()
forall a. String -> a
error' String
"This also failed. Check that asciinema is installed in your PATH."
  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