    {-|
    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