{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
module Hledger.Cli.Commands.Run (
runmode
,run
,replmode
,repl
,runOrReplStub
) where
import qualified Data.List.NonEmpty as NE
import qualified Data.Map.Strict as Map
import Data.Semigroup (sconcat)
import qualified Data.Text as T
import qualified Data.Text.IO as T
import System.Console.CmdArgs.Explicit as C ( Mode )
import Hledger
import Hledger.Cli.CliOptions
import Control.Exception
import Control.Concurrent.MVar
import Control.Monad (forM_)
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Extra (concatMapM)
import System.Exit (ExitCode, exitWith)
import System.Console.CmdArgs.Explicit (expandArgsAt, modeNames)
import System.IO (stdin, hIsTerminalDevice, hIsOpen)
import System.IO.Unsafe (unsafePerformIO)
import System.Console.Haskeline
import Safe (headMay)
import Hledger.Cli.DocFiles (runTldrForPage, runInfoForTopic, runManForTopic)
import Hledger.Cli.Utils (journalTransform)
import Text.Printf (printf)
import System.Process (system)
runmode :: Mode RawOpts
runmode = PrefixedFilePath
-> [Flag RawOpts]
-> [(PrefixedFilePath, [Flag RawOpts])]
-> [Flag RawOpts]
-> ([Arg RawOpts], Maybe (Arg RawOpts))
-> Mode RawOpts
hledgerCommandMode
$(embedFileRelative "Hledger/Cli/Commands/Run.txt")
(
[]
)
[(PrefixedFilePath, [Flag RawOpts])]
cligeneralflagsgroups1
[Flag RawOpts]
hiddenflags
([], 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
$ PrefixedFilePath -> Arg RawOpts
argsFlag PrefixedFilePath
"[COMMANDS_FILE1 COMMANDS_FILE2 ...] OR [-- command1 args... -- command2 args... -- command3 args...]")
replmode :: Mode RawOpts
replmode = PrefixedFilePath
-> [Flag RawOpts]
-> [(PrefixedFilePath, [Flag RawOpts])]
-> [Flag RawOpts]
-> ([Arg RawOpts], Maybe (Arg RawOpts))
-> Mode RawOpts
hledgerCommandMode
$(embedFileRelative "Hledger/Cli/Commands/Repl.txt")
(
[]
)
[(PrefixedFilePath, [Flag RawOpts])]
cligeneralflagsgroups1
[Flag RawOpts]
hiddenflags
([], Maybe (Arg RawOpts)
forall a. Maybe a
Nothing)
runOrReplStub :: CliOpts -> Journal -> IO ()
runOrReplStub :: CliOpts -> Journal -> IO ()
runOrReplStub CliOpts
_opts Journal
_j = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
newtype DefaultRunJournal = DefaultRunJournal (NE.NonEmpty String) deriving (Int -> DefaultRunJournal -> PrefixedFilePath -> PrefixedFilePath
[DefaultRunJournal] -> PrefixedFilePath -> PrefixedFilePath
DefaultRunJournal -> PrefixedFilePath
(Int -> DefaultRunJournal -> PrefixedFilePath -> PrefixedFilePath)
-> (DefaultRunJournal -> PrefixedFilePath)
-> ([DefaultRunJournal] -> PrefixedFilePath -> PrefixedFilePath)
-> Show DefaultRunJournal
forall a.
(Int -> a -> PrefixedFilePath -> PrefixedFilePath)
-> (a -> PrefixedFilePath)
-> ([a] -> PrefixedFilePath -> PrefixedFilePath)
-> Show a
$cshowsPrec :: Int -> DefaultRunJournal -> PrefixedFilePath -> PrefixedFilePath
showsPrec :: Int -> DefaultRunJournal -> PrefixedFilePath -> PrefixedFilePath
$cshow :: DefaultRunJournal -> PrefixedFilePath
show :: DefaultRunJournal -> PrefixedFilePath
$cshowList :: [DefaultRunJournal] -> PrefixedFilePath -> PrefixedFilePath
showList :: [DefaultRunJournal] -> PrefixedFilePath -> PrefixedFilePath
Show)
run :: Maybe DefaultRunJournal -> (String -> Maybe (Mode RawOpts, CliOpts -> Journal -> IO ())) -> [String] -> CliOpts -> IO ()
run :: Maybe DefaultRunJournal
-> (PrefixedFilePath
-> Maybe (Mode RawOpts, CliOpts -> Journal -> IO ()))
-> [PrefixedFilePath]
-> CliOpts
-> IO ()
run Maybe DefaultRunJournal
defaultJournalOverride PrefixedFilePath
-> Maybe (Mode RawOpts, CliOpts -> Journal -> IO ())
findBuiltinCommand [PrefixedFilePath]
addons cliopts :: CliOpts
cliopts@CliOpts{rawopts_ :: CliOpts -> RawOpts
rawopts_=RawOpts
rawopts} = do
DefaultRunJournal
jpaths <- NonEmpty PrefixedFilePath -> DefaultRunJournal
DefaultRunJournal (NonEmpty PrefixedFilePath -> DefaultRunJournal)
-> IO (NonEmpty PrefixedFilePath) -> IO DefaultRunJournal
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe DefaultRunJournal
-> CliOpts -> IO (NonEmpty PrefixedFilePath)
journalFilePathFromOptsOrDefault Maybe DefaultRunJournal
defaultJournalOverride CliOpts
cliopts
let args :: [PrefixedFilePath]
args = PrefixedFilePath -> [PrefixedFilePath] -> [PrefixedFilePath]
forall a. Show a => PrefixedFilePath -> a -> a
dbg1 PrefixedFilePath
"args" ([PrefixedFilePath] -> [PrefixedFilePath])
-> [PrefixedFilePath] -> [PrefixedFilePath]
forall a b. (a -> b) -> a -> b
$ PrefixedFilePath -> RawOpts -> [PrefixedFilePath]
listofstringopt PrefixedFilePath
"args" RawOpts
rawopts
Bool
isTerminal <- IO Bool
isStdinTerminal
if [PrefixedFilePath]
args [PrefixedFilePath] -> [PrefixedFilePath] -> Bool
forall a. Eq a => a -> a -> Bool
== [] Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
isTerminal
then do
NonEmpty PrefixedFilePath
inputFiles <- CliOpts -> IO (NonEmpty PrefixedFilePath)
journalFilePathFromOpts CliOpts
cliopts
let journalFromStdin :: Bool
journalFromStdin = (PrefixedFilePath -> Bool) -> [PrefixedFilePath] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (PrefixedFilePath -> PrefixedFilePath -> Bool
forall a. Eq a => a -> a -> Bool
== PrefixedFilePath
"-") ([PrefixedFilePath] -> Bool) -> [PrefixedFilePath] -> Bool
forall a b. (a -> b) -> a -> b
$ (PrefixedFilePath -> PrefixedFilePath)
-> [PrefixedFilePath] -> [PrefixedFilePath]
forall a b. (a -> b) -> [a] -> [b]
map ((Maybe StorageFormat, PrefixedFilePath) -> PrefixedFilePath
forall a b. (a, b) -> b
snd ((Maybe StorageFormat, PrefixedFilePath) -> PrefixedFilePath)
-> (PrefixedFilePath -> (Maybe StorageFormat, PrefixedFilePath))
-> PrefixedFilePath
-> PrefixedFilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrefixedFilePath -> (Maybe StorageFormat, PrefixedFilePath)
splitReaderPrefix) ([PrefixedFilePath] -> [PrefixedFilePath])
-> [PrefixedFilePath] -> [PrefixedFilePath]
forall a b. (a -> b) -> a -> b
$ NonEmpty PrefixedFilePath -> [PrefixedFilePath]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty PrefixedFilePath
inputFiles
if Bool
journalFromStdin
then PrefixedFilePath -> IO ()
forall a. PrefixedFilePath -> a
error' PrefixedFilePath
"'run' can't read commands from stdin, as one of the input files was stdin as well"
else DefaultRunJournal
-> (PrefixedFilePath
-> Maybe (Mode RawOpts, CliOpts -> Journal -> IO ()))
-> [PrefixedFilePath]
-> IO ()
runREPL DefaultRunJournal
jpaths PrefixedFilePath
-> Maybe (Mode RawOpts, CliOpts -> Journal -> IO ())
findBuiltinCommand [PrefixedFilePath]
addons
else do
case [PrefixedFilePath]
args of
PrefixedFilePath
"--":[PrefixedFilePath]
_ -> DefaultRunJournal
-> (PrefixedFilePath
-> Maybe (Mode RawOpts, CliOpts -> Journal -> IO ()))
-> [PrefixedFilePath]
-> [PrefixedFilePath]
-> IO ()
runFromArgs DefaultRunJournal
jpaths PrefixedFilePath
-> Maybe (Mode RawOpts, CliOpts -> Journal -> IO ())
findBuiltinCommand [PrefixedFilePath]
addons [PrefixedFilePath]
args
[PrefixedFilePath]
_ -> DefaultRunJournal
-> (PrefixedFilePath
-> Maybe (Mode RawOpts, CliOpts -> Journal -> IO ()))
-> [PrefixedFilePath]
-> [PrefixedFilePath]
-> IO ()
runFromFiles DefaultRunJournal
jpaths PrefixedFilePath
-> Maybe (Mode RawOpts, CliOpts -> Journal -> IO ())
findBuiltinCommand [PrefixedFilePath]
addons [PrefixedFilePath]
args
repl :: (String -> Maybe (Mode RawOpts, CliOpts -> Journal -> IO ())) -> [String] -> CliOpts -> IO ()
repl :: (PrefixedFilePath
-> Maybe (Mode RawOpts, CliOpts -> Journal -> IO ()))
-> [PrefixedFilePath] -> CliOpts -> IO ()
repl PrefixedFilePath
-> Maybe (Mode RawOpts, CliOpts -> Journal -> IO ())
findBuiltinCommand [PrefixedFilePath]
addons CliOpts
cliopts = do
DefaultRunJournal
jpaths <- NonEmpty PrefixedFilePath -> DefaultRunJournal
DefaultRunJournal (NonEmpty PrefixedFilePath -> DefaultRunJournal)
-> IO (NonEmpty PrefixedFilePath) -> IO DefaultRunJournal
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe DefaultRunJournal
-> CliOpts -> IO (NonEmpty PrefixedFilePath)
journalFilePathFromOptsOrDefault Maybe DefaultRunJournal
forall a. Maybe a
Nothing CliOpts
cliopts
DefaultRunJournal
-> (PrefixedFilePath
-> Maybe (Mode RawOpts, CliOpts -> Journal -> IO ()))
-> [PrefixedFilePath]
-> IO ()
runREPL DefaultRunJournal
jpaths PrefixedFilePath
-> Maybe (Mode RawOpts, CliOpts -> Journal -> IO ())
findBuiltinCommand [PrefixedFilePath]
addons
runFromFiles :: DefaultRunJournal -> (String -> Maybe (Mode RawOpts, CliOpts -> Journal -> IO ())) -> [String] -> [String] -> IO ()
runFromFiles :: DefaultRunJournal
-> (PrefixedFilePath
-> Maybe (Mode RawOpts, CliOpts -> Journal -> IO ()))
-> [PrefixedFilePath]
-> [PrefixedFilePath]
-> IO ()
runFromFiles DefaultRunJournal
defaultJournalOverride PrefixedFilePath
-> Maybe (Mode RawOpts, CliOpts -> Journal -> IO ())
findBuiltinCommand [PrefixedFilePath]
addons [PrefixedFilePath]
inputfiles = do
PrefixedFilePath -> [PrefixedFilePath] -> IO ()
forall (m :: * -> *) a.
(MonadIO m, Show a) =>
PrefixedFilePath -> a -> m ()
dbg1IO PrefixedFilePath
"inputfiles" [PrefixedFilePath]
inputfiles
[PrefixedFilePath]
commands <- (((PrefixedFilePath -> IO [PrefixedFilePath])
-> [PrefixedFilePath] -> IO [PrefixedFilePath])
-> [PrefixedFilePath]
-> (PrefixedFilePath -> IO [PrefixedFilePath])
-> IO [PrefixedFilePath]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (PrefixedFilePath -> IO [PrefixedFilePath])
-> [PrefixedFilePath] -> IO [PrefixedFilePath]
forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
concatMapM) [PrefixedFilePath]
inputfiles ((PrefixedFilePath -> IO [PrefixedFilePath])
-> IO [PrefixedFilePath])
-> (PrefixedFilePath -> IO [PrefixedFilePath])
-> IO [PrefixedFilePath]
forall a b. (a -> b) -> a -> b
$ \PrefixedFilePath
f -> do
PrefixedFilePath -> PrefixedFilePath -> IO ()
forall (m :: * -> *) a.
(MonadIO m, Show a) =>
PrefixedFilePath -> a -> m ()
dbg1IO PrefixedFilePath
"reading commands" PrefixedFilePath
f
PrefixedFilePath -> [PrefixedFilePath]
lines (PrefixedFilePath -> [PrefixedFilePath])
-> (Text -> PrefixedFilePath) -> Text -> [PrefixedFilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> PrefixedFilePath
T.unpack (Text -> [PrefixedFilePath]) -> IO Text -> IO [PrefixedFilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PrefixedFilePath -> IO Text
T.readFile PrefixedFilePath
f
[PrefixedFilePath] -> (PrefixedFilePath -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [PrefixedFilePath]
commands (DefaultRunJournal
-> (PrefixedFilePath
-> Maybe (Mode RawOpts, CliOpts -> Journal -> IO ()))
-> [PrefixedFilePath]
-> [PrefixedFilePath]
-> IO ()
runCommand DefaultRunJournal
defaultJournalOverride PrefixedFilePath
-> Maybe (Mode RawOpts, CliOpts -> Journal -> IO ())
findBuiltinCommand [PrefixedFilePath]
addons ([PrefixedFilePath] -> IO ())
-> (PrefixedFilePath -> [PrefixedFilePath])
-> PrefixedFilePath
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrefixedFilePath -> [PrefixedFilePath]
parseCommand)
runFromArgs :: DefaultRunJournal -> (String -> Maybe (Mode RawOpts, CliOpts -> Journal -> IO ())) -> [String] -> [String] -> IO ()
runFromArgs :: DefaultRunJournal
-> (PrefixedFilePath
-> Maybe (Mode RawOpts, CliOpts -> Journal -> IO ()))
-> [PrefixedFilePath]
-> [PrefixedFilePath]
-> IO ()
runFromArgs DefaultRunJournal
defaultJournalOverride PrefixedFilePath
-> Maybe (Mode RawOpts, CliOpts -> Journal -> IO ())
findBuiltinCommand [PrefixedFilePath]
addons [PrefixedFilePath]
args = do
let commands :: [[PrefixedFilePath]]
commands = PrefixedFilePath -> [[PrefixedFilePath]] -> [[PrefixedFilePath]]
forall a. Show a => PrefixedFilePath -> a -> a
dbg1 PrefixedFilePath
"commands from args" ([[PrefixedFilePath]] -> [[PrefixedFilePath]])
-> [[PrefixedFilePath]] -> [[PrefixedFilePath]]
forall a b. (a -> b) -> a -> b
$ PrefixedFilePath -> [PrefixedFilePath] -> [[PrefixedFilePath]]
forall a. Eq a => a -> [a] -> [[a]]
splitAtElement PrefixedFilePath
"--" [PrefixedFilePath]
args
[[PrefixedFilePath]] -> ([PrefixedFilePath] -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [[PrefixedFilePath]]
commands (DefaultRunJournal
-> (PrefixedFilePath
-> Maybe (Mode RawOpts, CliOpts -> Journal -> IO ()))
-> [PrefixedFilePath]
-> [PrefixedFilePath]
-> IO ()
runCommand DefaultRunJournal
defaultJournalOverride PrefixedFilePath
-> Maybe (Mode RawOpts, CliOpts -> Journal -> IO ())
findBuiltinCommand [PrefixedFilePath]
addons)
parseCommand :: String -> [String]
parseCommand :: PrefixedFilePath -> [PrefixedFilePath]
parseCommand PrefixedFilePath
line =
(PrefixedFilePath -> Bool)
-> [PrefixedFilePath] -> [PrefixedFilePath]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Bool -> Bool
not(Bool -> Bool)
-> (PrefixedFilePath -> Bool) -> PrefixedFilePath -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'#')Maybe Char -> Maybe Char -> Bool
forall a. Eq a => a -> a -> Bool
==) (Maybe Char -> Bool)
-> (PrefixedFilePath -> Maybe Char) -> PrefixedFilePath -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrefixedFilePath -> Maybe Char
forall a. [a] -> Maybe a
headMay) ([PrefixedFilePath] -> [PrefixedFilePath])
-> [PrefixedFilePath] -> [PrefixedFilePath]
forall a b. (a -> b) -> a -> b
$ PrefixedFilePath -> [PrefixedFilePath]
words' (PrefixedFilePath -> PrefixedFilePath
strip PrefixedFilePath
line)
runCommand :: DefaultRunJournal -> (String -> Maybe (Mode RawOpts, CliOpts -> Journal -> IO ())) -> [String] -> [String] -> IO ()
runCommand :: DefaultRunJournal
-> (PrefixedFilePath
-> Maybe (Mode RawOpts, CliOpts -> Journal -> IO ()))
-> [PrefixedFilePath]
-> [PrefixedFilePath]
-> IO ()
runCommand DefaultRunJournal
defaultJournalOverride PrefixedFilePath
-> Maybe (Mode RawOpts, CliOpts -> Journal -> IO ())
findBuiltinCommand [PrefixedFilePath]
addons [PrefixedFilePath]
cmdline = do
PrefixedFilePath -> [PrefixedFilePath] -> IO ()
forall (m :: * -> *) a.
(MonadIO m, Show a) =>
PrefixedFilePath -> a -> m ()
dbg1IO PrefixedFilePath
"runCommand for" [PrefixedFilePath]
cmdline
case [PrefixedFilePath]
cmdline of
PrefixedFilePath
"echo":[PrefixedFilePath]
args -> PrefixedFilePath -> IO ()
putStrLn (PrefixedFilePath -> IO ()) -> PrefixedFilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ [PrefixedFilePath] -> PrefixedFilePath
unwords ([PrefixedFilePath] -> PrefixedFilePath)
-> [PrefixedFilePath] -> PrefixedFilePath
forall a b. (a -> b) -> a -> b
$ [PrefixedFilePath]
args
PrefixedFilePath
cmdname:[PrefixedFilePath]
args ->
case PrefixedFilePath
-> Maybe (Mode RawOpts, CliOpts -> Journal -> IO ())
findBuiltinCommand PrefixedFilePath
cmdname of
Just (Mode RawOpts
cmdmode,CliOpts -> Journal -> IO ()
cmdaction) -> do
[PrefixedFilePath]
args' <- [PrefixedFilePath] -> [PrefixedFilePath]
replaceNumericFlags ([PrefixedFilePath] -> [PrefixedFilePath])
-> IO [PrefixedFilePath] -> IO [PrefixedFilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [PrefixedFilePath] -> IO [PrefixedFilePath]
expandArgsAt [PrefixedFilePath]
args
PrefixedFilePath -> (PrefixedFilePath, [PrefixedFilePath]) -> IO ()
forall (m :: * -> *) a.
(MonadIO m, Show a) =>
PrefixedFilePath -> a -> m ()
dbg1IO PrefixedFilePath
"runCommand final args" (PrefixedFilePath
cmdname,[PrefixedFilePath]
args')
CliOpts
opts <- Mode RawOpts -> [PrefixedFilePath] -> IO CliOpts
getHledgerCliOpts' Mode RawOpts
cmdmode [PrefixedFilePath]
args'
let
rawopts :: RawOpts
rawopts = CliOpts -> RawOpts
rawopts_ CliOpts
opts
mmodecmdname :: Maybe PrefixedFilePath
mmodecmdname = [PrefixedFilePath] -> Maybe PrefixedFilePath
forall a. [a] -> Maybe a
headMay ([PrefixedFilePath] -> Maybe PrefixedFilePath)
-> [PrefixedFilePath] -> Maybe PrefixedFilePath
forall a b. (a -> b) -> a -> b
$ Mode RawOpts -> [PrefixedFilePath]
forall a. Mode a -> [PrefixedFilePath]
modeNames Mode RawOpts
cmdmode
helpFlag :: Bool
helpFlag = PrefixedFilePath -> RawOpts -> Bool
boolopt PrefixedFilePath
"help" RawOpts
rawopts
tldrFlag :: Bool
tldrFlag = PrefixedFilePath -> RawOpts -> Bool
boolopt PrefixedFilePath
"tldr" RawOpts
rawopts
infoFlag :: Bool
infoFlag = PrefixedFilePath -> RawOpts -> Bool
boolopt PrefixedFilePath
"info" RawOpts
rawopts
manFlag :: Bool
manFlag = PrefixedFilePath -> RawOpts -> Bool
boolopt PrefixedFilePath
"man" RawOpts
rawopts
if
| Bool
helpFlag -> PrefixedFilePath -> IO ()
runPager (PrefixedFilePath -> IO ()) -> PrefixedFilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ Mode RawOpts -> PrefixedFilePath
forall a. Mode a -> PrefixedFilePath
showModeUsage Mode RawOpts
cmdmode PrefixedFilePath -> PrefixedFilePath -> PrefixedFilePath
forall a. [a] -> [a] -> [a]
++ PrefixedFilePath
"\n"
| Bool
tldrFlag -> PrefixedFilePath -> IO ()
runTldrForPage (PrefixedFilePath -> IO ()) -> PrefixedFilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ PrefixedFilePath
-> (PrefixedFilePath -> PrefixedFilePath)
-> Maybe PrefixedFilePath
-> PrefixedFilePath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe PrefixedFilePath
"hledger" ((PrefixedFilePath
"hledger-"PrefixedFilePath -> PrefixedFilePath -> PrefixedFilePath
forall a. Semigroup a => a -> a -> a
<>)) Maybe PrefixedFilePath
mmodecmdname
| Bool
infoFlag -> PrefixedFilePath -> Maybe PrefixedFilePath -> IO ()
runInfoForTopic PrefixedFilePath
"hledger" Maybe PrefixedFilePath
mmodecmdname
| Bool
manFlag -> PrefixedFilePath -> Maybe PrefixedFilePath -> IO ()
runManForTopic PrefixedFilePath
"hledger" Maybe PrefixedFilePath
mmodecmdname
| Bool
otherwise -> do
Maybe DefaultRunJournal
-> CliOpts -> ((Journal, DefaultRunJournal) -> IO ()) -> IO ()
withJournalCached (DefaultRunJournal -> Maybe DefaultRunJournal
forall a. a -> Maybe a
Just DefaultRunJournal
defaultJournalOverride) CliOpts
opts (((Journal, DefaultRunJournal) -> IO ()) -> IO ())
-> ((Journal, DefaultRunJournal) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Journal
j,DefaultRunJournal
jpaths) -> do
if PrefixedFilePath
cmdname PrefixedFilePath -> PrefixedFilePath -> Bool
forall a. Eq a => a -> a -> Bool
== PrefixedFilePath
"run"
then Maybe DefaultRunJournal
-> (PrefixedFilePath
-> Maybe (Mode RawOpts, CliOpts -> Journal -> IO ()))
-> [PrefixedFilePath]
-> CliOpts
-> IO ()
run (DefaultRunJournal -> Maybe DefaultRunJournal
forall a. a -> Maybe a
Just DefaultRunJournal
jpaths) PrefixedFilePath
-> Maybe (Mode RawOpts, CliOpts -> Journal -> IO ())
findBuiltinCommand [PrefixedFilePath]
addons CliOpts
opts
else CliOpts -> Journal -> IO ()
cmdaction CliOpts
opts Journal
j
Maybe (Mode RawOpts, CliOpts -> Journal -> IO ())
Nothing | PrefixedFilePath
cmdname PrefixedFilePath -> [PrefixedFilePath] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [PrefixedFilePath]
addons ->
PrefixedFilePath -> IO ExitCode
system (PrefixedFilePath
-> PrefixedFilePath
-> PrefixedFilePath
-> PrefixedFilePath
-> PrefixedFilePath
forall r. PrintfType r => PrefixedFilePath -> r
printf PrefixedFilePath
"%s-%s %s" PrefixedFilePath
progname PrefixedFilePath
cmdname ([PrefixedFilePath] -> PrefixedFilePath
unwords' [PrefixedFilePath]
args)) IO ExitCode -> (ExitCode -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ExitCode -> IO ()
forall a. ExitCode -> IO a
exitWith
Maybe (Mode RawOpts, CliOpts -> Journal -> IO ())
Nothing ->
PrefixedFilePath -> IO ()
forall a. PrefixedFilePath -> a
error' (PrefixedFilePath -> IO ()) -> PrefixedFilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ PrefixedFilePath
"Unrecognized command: " PrefixedFilePath -> PrefixedFilePath -> PrefixedFilePath
forall a. [a] -> [a] -> [a]
++ [PrefixedFilePath] -> PrefixedFilePath
unwords (PrefixedFilePath
cmdnamePrefixedFilePath -> [PrefixedFilePath] -> [PrefixedFilePath]
forall a. a -> [a] -> [a]
:[PrefixedFilePath]
args)
[] -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
runREPL :: DefaultRunJournal -> (String -> Maybe (Mode RawOpts, CliOpts -> Journal -> IO ())) -> [String] -> IO ()
runREPL :: DefaultRunJournal
-> (PrefixedFilePath
-> Maybe (Mode RawOpts, CliOpts -> Journal -> IO ()))
-> [PrefixedFilePath]
-> IO ()
runREPL DefaultRunJournal
defaultJournalOverride PrefixedFilePath
-> Maybe (Mode RawOpts, CliOpts -> Journal -> IO ())
findBuiltinCommand [PrefixedFilePath]
addons = do
Bool
isTerminal <- IO Bool
isStdinTerminal
if Bool -> Bool
not Bool
isTerminal
then Settings IO -> InputT IO () -> IO ()
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
Settings m -> InputT m a -> m a
runInputT Settings IO
forall (m :: * -> *). MonadIO m => Settings m
defaultSettings (PrefixedFilePath -> InputT IO ()
loop PrefixedFilePath
"")
else do
PrefixedFilePath -> IO ()
putStrLn PrefixedFilePath
"Enter hledger commands. To exit, enter 'quit' or 'exit', or send EOF."
Settings IO -> InputT IO () -> IO ()
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
Settings m -> InputT m a -> m a
runInputT Settings IO
forall (m :: * -> *). MonadIO m => Settings m
defaultSettings (PrefixedFilePath -> InputT IO ()
loop PrefixedFilePath
"% ")
where
loop :: String -> InputT IO ()
loop :: PrefixedFilePath -> InputT IO ()
loop PrefixedFilePath
prompt = do
Maybe PrefixedFilePath
minput <- PrefixedFilePath -> InputT IO (Maybe PrefixedFilePath)
forall (m :: * -> *).
(MonadIO m, MonadMask m) =>
PrefixedFilePath -> InputT m (Maybe PrefixedFilePath)
getInputLine PrefixedFilePath
prompt
case Maybe PrefixedFilePath
minput of
Maybe PrefixedFilePath
Nothing -> () -> InputT IO ()
forall a. a -> InputT IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just PrefixedFilePath
"quit" -> () -> InputT IO ()
forall a. a -> InputT IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just PrefixedFilePath
"exit" -> () -> InputT IO ()
forall a. a -> InputT IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just PrefixedFilePath
input -> do
IO () -> InputT IO ()
forall a. IO a -> InputT IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> InputT IO ()) -> IO () -> InputT IO ()
forall a b. (a -> b) -> a -> b
$ (DefaultRunJournal
-> (PrefixedFilePath
-> Maybe (Mode RawOpts, CliOpts -> Journal -> IO ()))
-> [PrefixedFilePath]
-> [PrefixedFilePath]
-> IO ()
runCommand DefaultRunJournal
defaultJournalOverride PrefixedFilePath
-> Maybe (Mode RawOpts, CliOpts -> Journal -> IO ())
findBuiltinCommand [PrefixedFilePath]
addons ([PrefixedFilePath] -> IO ()) -> [PrefixedFilePath] -> IO ()
forall a b. (a -> b) -> a -> b
$ [PrefixedFilePath] -> [PrefixedFilePath]
forall {a}. (Eq a, IsString a) => [a] -> [a]
argsAddDoubleDash ([PrefixedFilePath] -> [PrefixedFilePath])
-> [PrefixedFilePath] -> [PrefixedFilePath]
forall a b. (a -> b) -> a -> b
$ PrefixedFilePath -> [PrefixedFilePath]
parseCommand PrefixedFilePath
input)
IO () -> [Handler ()] -> IO ()
forall a. IO a -> [Handler a] -> IO a
`catches`
[(ErrorCall -> IO ()) -> Handler ()
forall a e. Exception e => (e -> IO a) -> Handler a
Handler (\(ErrorCall
e::ErrorCall) -> PrefixedFilePath -> IO ()
putStrLn (PrefixedFilePath -> IO ()) -> PrefixedFilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ PrefixedFilePath -> PrefixedFilePath
rstrip (PrefixedFilePath -> PrefixedFilePath)
-> PrefixedFilePath -> PrefixedFilePath
forall a b. (a -> b) -> a -> b
$ ErrorCall -> PrefixedFilePath
forall a. Show a => a -> PrefixedFilePath
show ErrorCall
e)
,(IOError -> IO ()) -> Handler ()
forall a e. Exception e => (e -> IO a) -> Handler a
Handler (\(IOError
e::IOError) -> PrefixedFilePath -> IO ()
putStrLn (PrefixedFilePath -> IO ()) -> PrefixedFilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ PrefixedFilePath -> PrefixedFilePath
rstrip (PrefixedFilePath -> PrefixedFilePath)
-> PrefixedFilePath -> PrefixedFilePath
forall a b. (a -> b) -> a -> b
$ IOError -> PrefixedFilePath
forall a. Show a => a -> PrefixedFilePath
show IOError
e)
,(ExitCode -> IO ()) -> Handler ()
forall a e. Exception e => (e -> IO a) -> Handler a
Handler (\(ExitCode
_::ExitCode) -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
,(AsyncException -> IO ()) -> Handler ()
forall a e. Exception e => (e -> IO a) -> Handler a
Handler (\AsyncException
UserInterrupt -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
]
PrefixedFilePath -> InputT IO ()
loop PrefixedFilePath
prompt
isStdinTerminal :: IO Bool
isStdinTerminal = do
Bool
op <- Handle -> IO Bool
hIsOpen Handle
stdin
if Bool
op then Handle -> IO Bool
hIsTerminalDevice Handle
stdin else Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
journalCache :: MVar (Map.Map (InputOpts,PrefixedFilePath) Journal)
journalCache :: MVar (Map (InputOpts, PrefixedFilePath) Journal)
journalCache = IO (MVar (Map (InputOpts, PrefixedFilePath) Journal))
-> MVar (Map (InputOpts, PrefixedFilePath) Journal)
forall a. IO a -> a
unsafePerformIO (IO (MVar (Map (InputOpts, PrefixedFilePath) Journal))
-> MVar (Map (InputOpts, PrefixedFilePath) Journal))
-> IO (MVar (Map (InputOpts, PrefixedFilePath) Journal))
-> MVar (Map (InputOpts, PrefixedFilePath) Journal)
forall a b. (a -> b) -> a -> b
$ Map (InputOpts, PrefixedFilePath) Journal
-> IO (MVar (Map (InputOpts, PrefixedFilePath) Journal))
forall a. a -> IO (MVar a)
newMVar Map (InputOpts, PrefixedFilePath) Journal
forall k a. Map k a
Map.empty
{-# NOINLINE journalCache #-}
stdinCache :: MVar (Maybe T.Text)
stdinCache :: MVar (Maybe Text)
stdinCache = IO (MVar (Maybe Text)) -> MVar (Maybe Text)
forall a. IO a -> a
unsafePerformIO (IO (MVar (Maybe Text)) -> MVar (Maybe Text))
-> IO (MVar (Maybe Text)) -> MVar (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Maybe Text -> IO (MVar (Maybe Text))
forall a. a -> IO (MVar a)
newMVar Maybe Text
forall a. Maybe a
Nothing
{-# NOINLINE stdinCache #-}
journalFilePathFromOptsOrDefault :: Maybe DefaultRunJournal -> CliOpts -> IO (NE.NonEmpty PrefixedFilePath)
journalFilePathFromOptsOrDefault :: Maybe DefaultRunJournal
-> CliOpts -> IO (NonEmpty PrefixedFilePath)
journalFilePathFromOptsOrDefault Maybe DefaultRunJournal
defaultJournalOverride CliOpts
cliopts = do
case Maybe DefaultRunJournal
defaultJournalOverride of
Maybe DefaultRunJournal
Nothing -> CliOpts -> IO (NonEmpty PrefixedFilePath)
journalFilePathFromOpts CliOpts
cliopts
Just (DefaultRunJournal NonEmpty PrefixedFilePath
defaultFiles) -> do
Maybe (NonEmpty PrefixedFilePath)
mbjournalpaths <- CliOpts -> IO (Maybe (NonEmpty PrefixedFilePath))
journalFilePathFromOptsNoDefault CliOpts
cliopts
case Maybe (NonEmpty PrefixedFilePath)
mbjournalpaths of
Maybe (NonEmpty PrefixedFilePath)
Nothing -> NonEmpty PrefixedFilePath -> IO (NonEmpty PrefixedFilePath)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return NonEmpty PrefixedFilePath
defaultFiles
Just NonEmpty PrefixedFilePath
journalpaths -> NonEmpty PrefixedFilePath -> IO (NonEmpty PrefixedFilePath)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return NonEmpty PrefixedFilePath
journalpaths
withJournalCached :: Maybe DefaultRunJournal -> CliOpts -> ((Journal, DefaultRunJournal) -> IO ()) -> IO ()
withJournalCached :: Maybe DefaultRunJournal
-> CliOpts -> ((Journal, DefaultRunJournal) -> IO ()) -> IO ()
withJournalCached Maybe DefaultRunJournal
defaultJournalOverride CliOpts
cliopts (Journal, DefaultRunJournal) -> IO ()
cmd = do
NonEmpty PrefixedFilePath
journalpaths <- Maybe DefaultRunJournal
-> CliOpts -> IO (NonEmpty PrefixedFilePath)
journalFilePathFromOptsOrDefault Maybe DefaultRunJournal
defaultJournalOverride CliOpts
cliopts
Journal
j <- NonEmpty PrefixedFilePath -> IO Journal
readFiles NonEmpty PrefixedFilePath
journalpaths
(Journal, DefaultRunJournal) -> IO ()
cmd (Journal
j,NonEmpty PrefixedFilePath -> DefaultRunJournal
DefaultRunJournal NonEmpty PrefixedFilePath
journalpaths)
where
readFiles :: NonEmpty PrefixedFilePath -> IO Journal
readFiles NonEmpty PrefixedFilePath
journalpaths =
CliOpts -> Journal -> Journal
journalTransform CliOpts
cliopts (Journal -> Journal)
-> (NonEmpty Journal -> Journal) -> NonEmpty Journal -> Journal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty Journal -> Journal
forall a. Semigroup a => NonEmpty a -> a
sconcat (NonEmpty Journal -> Journal)
-> IO (NonEmpty Journal) -> IO Journal
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PrefixedFilePath -> IO Journal)
-> NonEmpty PrefixedFilePath -> IO (NonEmpty Journal)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> NonEmpty a -> m (NonEmpty b)
mapM (InputOpts -> PrefixedFilePath -> IO Journal
readAndCacheJournalFile (CliOpts -> InputOpts
inputopts_ CliOpts
cliopts)) NonEmpty PrefixedFilePath
journalpaths
readAndCacheJournalFile :: InputOpts -> PrefixedFilePath -> IO Journal
readAndCacheJournalFile :: InputOpts -> PrefixedFilePath -> IO Journal
readAndCacheJournalFile InputOpts
iopts PrefixedFilePath
fp = do
MVar (Map (InputOpts, PrefixedFilePath) Journal)
-> (Map (InputOpts, PrefixedFilePath) Journal
-> IO (Map (InputOpts, PrefixedFilePath) Journal, Journal))
-> IO Journal
forall a b. MVar a -> (a -> IO (a, b)) -> IO b
modifyMVar MVar (Map (InputOpts, PrefixedFilePath) Journal)
journalCache ((Map (InputOpts, PrefixedFilePath) Journal
-> IO (Map (InputOpts, PrefixedFilePath) Journal, Journal))
-> IO Journal)
-> (Map (InputOpts, PrefixedFilePath) Journal
-> IO (Map (InputOpts, PrefixedFilePath) Journal, Journal))
-> IO Journal
forall a b. (a -> b) -> a -> b
$ \Map (InputOpts, PrefixedFilePath) Journal
cache ->
case (InputOpts, PrefixedFilePath)
-> Map (InputOpts, PrefixedFilePath) Journal -> Maybe Journal
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (InputOpts
ioptsWithoutReportSpan,PrefixedFilePath
fp) Map (InputOpts, PrefixedFilePath) Journal
cache of
Just Journal
journal -> do
PrefixedFilePath -> InputOpts -> IO ()
forall (m :: * -> *) a.
(MonadIO m, Show a) =>
PrefixedFilePath -> a -> m ()
dbg1IO (PrefixedFilePath
"readAndCacheJournalFile using cache for "PrefixedFilePath -> PrefixedFilePath -> PrefixedFilePath
forall a. [a] -> [a] -> [a]
++PrefixedFilePath
fp) InputOpts
iopts
(Map (InputOpts, PrefixedFilePath) Journal, Journal)
-> IO (Map (InputOpts, PrefixedFilePath) Journal, Journal)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Map (InputOpts, PrefixedFilePath) Journal
cache, Journal
journal)
Maybe Journal
Nothing -> do
PrefixedFilePath -> InputOpts -> IO ()
forall (m :: * -> *) a.
(MonadIO m, Show a) =>
PrefixedFilePath -> a -> m ()
dbg1IO (PrefixedFilePath
"readAndCacheJournalFile reading and caching "PrefixedFilePath -> PrefixedFilePath -> PrefixedFilePath
forall a. [a] -> [a] -> [a]
++PrefixedFilePath
fp) InputOpts
iopts
Either PrefixedFilePath Journal
journal <- ExceptT PrefixedFilePath IO Journal
-> IO (Either PrefixedFilePath Journal)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT PrefixedFilePath IO Journal
-> IO (Either PrefixedFilePath Journal))
-> ExceptT PrefixedFilePath IO Journal
-> IO (Either PrefixedFilePath Journal)
forall a b. (a -> b) -> a -> b
$ if (Maybe StorageFormat, PrefixedFilePath) -> PrefixedFilePath
forall a b. (a, b) -> b
snd (PrefixedFilePath -> (Maybe StorageFormat, PrefixedFilePath)
splitReaderPrefix PrefixedFilePath
fp) PrefixedFilePath -> PrefixedFilePath -> Bool
forall a. Eq a => a -> a -> Bool
== PrefixedFilePath
"-" then ExceptT PrefixedFilePath IO Journal
readStdin else InputOpts
-> PrefixedFilePath -> ExceptT PrefixedFilePath IO Journal
readJournalFile InputOpts
iopts PrefixedFilePath
fp
(PrefixedFilePath
-> IO (Map (InputOpts, PrefixedFilePath) Journal, Journal))
-> (Journal
-> IO (Map (InputOpts, PrefixedFilePath) Journal, Journal))
-> Either PrefixedFilePath Journal
-> IO (Map (InputOpts, PrefixedFilePath) Journal, Journal)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either PrefixedFilePath
-> IO (Map (InputOpts, PrefixedFilePath) Journal, Journal)
forall a. PrefixedFilePath -> a
error' (\Journal
j -> (Map (InputOpts, PrefixedFilePath) Journal, Journal)
-> IO (Map (InputOpts, PrefixedFilePath) Journal, Journal)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((InputOpts, PrefixedFilePath)
-> Journal
-> Map (InputOpts, PrefixedFilePath) Journal
-> Map (InputOpts, PrefixedFilePath) Journal
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (InputOpts
ioptsWithoutReportSpan,PrefixedFilePath
fp) Journal
j Map (InputOpts, PrefixedFilePath) Journal
cache, Journal
j)) Either PrefixedFilePath Journal
journal
where
ioptsWithoutReportSpan :: InputOpts
ioptsWithoutReportSpan = InputOpts
iopts{ reportspan_ = forecastreportspan }
where
forecastreportspan :: DateSpan
forecastreportspan = case InputOpts -> Maybe DateSpan
forecast_ InputOpts
iopts of
Maybe DateSpan
Nothing -> DateSpan
emptydatespan
Just DateSpan
forecastspan -> DateSpan
forecastspan DateSpan -> DateSpan -> DateSpan
`spanDefaultsFrom` InputOpts -> DateSpan
reportspan_ InputOpts
iopts
readStdin :: ExceptT PrefixedFilePath IO Journal
readStdin = do
Text
stdinContent <- IO Text -> ExceptT PrefixedFilePath IO Text
forall a. IO a -> ExceptT PrefixedFilePath IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> ExceptT PrefixedFilePath IO Text)
-> IO Text -> ExceptT PrefixedFilePath IO Text
forall a b. (a -> b) -> a -> b
$ MVar (Maybe Text)
-> (Maybe Text -> IO (Maybe Text, Text)) -> IO Text
forall a b. MVar a -> (a -> IO (a, b)) -> IO b
modifyMVar MVar (Maybe Text)
stdinCache ((Maybe Text -> IO (Maybe Text, Text)) -> IO Text)
-> (Maybe Text -> IO (Maybe Text, Text)) -> IO Text
forall a b. (a -> b) -> a -> b
$ \Maybe Text
cache ->
case Maybe Text
cache of
Just Text
cached -> do
PrefixedFilePath -> PrefixedFilePath -> IO ()
forall (m :: * -> *) a.
(MonadIO m, Show a) =>
PrefixedFilePath -> a -> m ()
dbg1IO PrefixedFilePath
"readStdin using cached stdin" PrefixedFilePath
"-"
(Maybe Text, Text) -> IO (Maybe Text, Text)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Text
cache, Text
cached)
Maybe Text
Nothing -> do
PrefixedFilePath -> PrefixedFilePath -> IO ()
forall (m :: * -> *) a.
(MonadIO m, Show a) =>
PrefixedFilePath -> a -> m ()
dbg1IO PrefixedFilePath
"readStdin reading and caching stdin" PrefixedFilePath
"-"
Text
stdinContent <- PrefixedFilePath -> IO Text
readFileOrStdinPortably PrefixedFilePath
"-"
(Maybe Text, Text) -> IO (Maybe Text, Text)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
stdinContent, Text
stdinContent)
Handle
hndl <- IO Handle -> ExceptT PrefixedFilePath IO Handle
forall a. IO a -> ExceptT PrefixedFilePath IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Handle -> ExceptT PrefixedFilePath IO Handle)
-> IO Handle -> ExceptT PrefixedFilePath IO Handle
forall a b. (a -> b) -> a -> b
$ Text -> IO Handle
inputToHandle Text
stdinContent
InputOpts
-> Maybe PrefixedFilePath
-> Handle
-> ExceptT PrefixedFilePath IO Journal
readJournal InputOpts
iopts Maybe PrefixedFilePath
forall a. Maybe a
Nothing Handle
hndl