{-# 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
Maybe DefaultRunJournal
-> CliOpts -> ((Journal, DefaultRunJournal) -> IO ()) -> IO ()
withJournalCached Maybe DefaultRunJournal
defaultJournalOverride CliOpts
cliopts (((Journal, DefaultRunJournal) -> IO ()) -> IO ())
-> ((Journal, DefaultRunJournal) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Journal
_,DefaultRunJournal
key) -> do
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
isTerminal <- IO Bool
isStdinTerminal
if args == [] && not isTerminal
then do
inputFiles <- journalFilePathFromOpts cliopts
let 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 journalFromStdin
then error' "'run' can't read commands from stdin, as one of the input files was stdin as well"
else runREPL key findBuiltinCommand addons
else do
case args of
PrefixedFilePath
"--":[PrefixedFilePath]
_ -> DefaultRunJournal
-> (PrefixedFilePath
-> Maybe (Mode RawOpts, CliOpts -> Journal -> IO ()))
-> [PrefixedFilePath]
-> [PrefixedFilePath]
-> IO ()
runFromArgs DefaultRunJournal
key 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
key 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
Maybe DefaultRunJournal
-> CliOpts -> ((Journal, DefaultRunJournal) -> IO ()) -> IO ()
withJournalCached Maybe DefaultRunJournal
forall a. Maybe a
Nothing CliOpts
cliopts (((Journal, DefaultRunJournal) -> IO ()) -> IO ())
-> ((Journal, DefaultRunJournal) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Journal
_,DefaultRunJournal
key) -> do
DefaultRunJournal
-> (PrefixedFilePath
-> Maybe (Mode RawOpts, CliOpts -> Journal -> IO ()))
-> [PrefixedFilePath]
-> IO ()
runREPL DefaultRunJournal
key 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
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
forM_ commands (runCommand defaultJournalOverride findBuiltinCommand addons . 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
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
dbg1IO "runCommand final args" (cmdname,args')
opts <- getHledgerCliOpts' cmdmode args'
let
rawopts = CliOpts -> RawOpts
rawopts_ CliOpts
opts
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 = PrefixedFilePath -> RawOpts -> Bool
boolopt PrefixedFilePath
"help" RawOpts
rawopts
tldrFlag = PrefixedFilePath -> RawOpts -> Bool
boolopt PrefixedFilePath
"tldr" RawOpts
rawopts
infoFlag = PrefixedFilePath -> RawOpts -> Bool
boolopt PrefixedFilePath
"info" RawOpts
rawopts
manFlag = PrefixedFilePath -> RawOpts -> Bool
boolopt PrefixedFilePath
"man" RawOpts
rawopts
if
| helpFlag -> runPager $ showModeUsage cmdmode ++ "\n"
| tldrFlag -> runTldrForPage $ maybe "hledger" (("hledger-"<>)) mmodecmdname
| infoFlag -> runInfoForTopic "hledger" mmodecmdname
| manFlag -> runManForTopic "hledger" mmodecmdname
| otherwise -> do
withJournalCached (Just defaultJournalOverride) opts $ \(Journal
j,DefaultRunJournal
key) -> 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
key) 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
isTerminal <- IO Bool
isStdinTerminal
if not isTerminal
then runInputT defaultSettings (loop "")
else do
putStrLn "Enter hledger commands. To exit, enter 'quit' or 'exit', or send EOF."
runInputT defaultSettings (loop "% ")
where
loop :: String -> InputT IO ()
loop :: PrefixedFilePath -> InputT IO ()
loop PrefixedFilePath
prompt = do
minput <- PrefixedFilePath -> InputT IO (Maybe PrefixedFilePath)
forall (m :: * -> *).
(MonadIO m, MonadMask m) =>
PrefixedFilePath -> InputT m (Maybe PrefixedFilePath)
getInputLine PrefixedFilePath
prompt
case 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
op <- Handle -> IO Bool
hIsOpen Handle
stdin
if op then hIsTerminalDevice stdin else return 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 #-}
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
(j,key) <- case Maybe DefaultRunJournal
defaultJournalOverride of
Maybe DefaultRunJournal
Nothing -> CliOpts -> IO (NonEmpty PrefixedFilePath)
journalFilePathFromOpts CliOpts
cliopts IO (NonEmpty PrefixedFilePath)
-> (NonEmpty PrefixedFilePath -> IO (Journal, DefaultRunJournal))
-> IO (Journal, DefaultRunJournal)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= NonEmpty PrefixedFilePath -> IO (Journal, DefaultRunJournal)
readFiles
Just (DefaultRunJournal NonEmpty PrefixedFilePath
defaultFiles) -> do
mbjournalpaths <- CliOpts -> IO (Maybe (NonEmpty PrefixedFilePath))
journalFilePathFromOptsNoDefault CliOpts
cliopts
case mbjournalpaths of
Maybe (NonEmpty PrefixedFilePath)
Nothing -> NonEmpty PrefixedFilePath -> IO (Journal, DefaultRunJournal)
readFiles NonEmpty PrefixedFilePath
defaultFiles
Just NonEmpty PrefixedFilePath
journalpaths -> NonEmpty PrefixedFilePath -> IO (Journal, DefaultRunJournal)
readFiles NonEmpty PrefixedFilePath
journalpaths
cmd (j,key)
where
readFiles :: NonEmpty PrefixedFilePath -> IO (Journal, DefaultRunJournal)
readFiles NonEmpty PrefixedFilePath
journalpaths = do
j <- 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
return (j, DefaultRunJournal 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
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
either 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)) journal
where
ioptsWithoutReportSpan :: InputOpts
ioptsWithoutReportSpan = InputOpts
iopts { reportspan_ = emptydatespan }
readStdin :: ExceptT PrefixedFilePath IO Journal
readStdin = do
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
"-"
stdinContent <- PrefixedFilePath -> IO Text
readFileOrStdinPortably PrefixedFilePath
"-"
return (Just stdinContent, stdinContent)
hndl <- liftIO $ inputToHandle stdinContent
readJournal iopts Nothing hndl