    {-|
    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 = (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
              | String -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    s = String
    ""
              | Bool
    otherwise = String -> String
    readTitle (String -> String) -> String -> String
    forall a b. (a -> b) -> a -> b
    $ String -> String
    forall a. HasCallStack => [a] -> [a]
    tail 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 =
      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  -- try piping to stdin also
        Handle -> ByteString -> IO ()
    B.hPutStrLn 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
    "There was a problem. Is asciinema installed ?\n" String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> IOError -> String
    forall a. Show a => a -> String
    show IOError
    err  --  (or PowerSession on Windows)
            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