{-# 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 [
$(embedFileRelative "embeddedfiles/add.cast"),
$(embedFileRelative "embeddedfiles/print.cast"),
$(embedFileRelative "embeddedfiles/balance.cast"),
$(embedFileRelative "embeddedfiles/install.cast")
]
data Demo = Demo {
Demo -> String
dtitle :: String,
Demo -> ByteString
_dcontent :: ByteString
}
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
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
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
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
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)
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
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
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]
runAsciinemaPlay :: Float -> Float -> ByteString -> [String] -> IO ()
runAsciinemaPlay :: Float -> Float -> ByteString -> [String] -> IO ()
runAsciinemaPlay Float
speed Float
idlelimit ByteString
content [String]
args =
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
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