From 74502f7e506c78b0f1cdb8209ad73703d0668872 Mon Sep 17 00:00:00 2001 From: Johannes Gerer Date: Sat, 10 Dec 2016 00:57:17 +0100 Subject: [PATCH] more general parser types enabling reuse outside of IO (#439) --- hledger-lib/Hledger/Read/Common.hs | 52 ++++++++++---------- hledger-lib/Hledger/Read/JournalReader.hs | 54 +++++++++++---------- hledger-lib/Hledger/Read/TimeclockReader.hs | 4 +- hledger-lib/Hledger/Read/TimedotReader.hs | 15 +++--- hledger-lib/Hledger/Utils/Parse.hs | 2 +- tests/cli/multiple-files.test | 2 + 6 files changed, 68 insertions(+), 61 deletions(-) diff --git a/hledger-lib/Hledger/Read/Common.hs b/hledger-lib/Hledger/Read/Common.hs index c30cef5be..54795c736 100644 --- a/hledger-lib/Hledger/Read/Common.hs +++ b/hledger-lib/Hledger/Read/Common.hs @@ -57,7 +57,7 @@ runJournalParser p t = runParserT p "" t rjp = runJournalParser -- | Run an error-raising journal parser with a null journal-parsing state. -runErroringJournalParser, rejp :: ErroringJournalParser a -> Text -> IO (Either String a) +runErroringJournalParser, rejp :: Monad m => ErroringJournalParser m a -> Text -> m (Either String a) runErroringJournalParser p t = runExceptT $ runJournalParser (evalStateT p mempty) @@ -70,7 +70,8 @@ genericSourcePos p = GenericSourcePos (sourceName p) (fromIntegral . unPos $ sou -- | Given a megaparsec ParsedJournal parser, balance assertion flag, file -- path and file content: parse and post-process a Journal, or give an error. -parseAndFinaliseJournal :: ErroringJournalParser ParsedJournal -> Bool -> FilePath -> Text -> ExceptT String IO Journal +parseAndFinaliseJournal :: ErroringJournalParser IO ParsedJournal -> Bool + -> FilePath -> Text -> ExceptT String IO Journal parseAndFinaliseJournal parser assrt f txt = do t <- liftIO getClockTime y <- liftIO getCurrentYear @@ -98,26 +99,26 @@ setYear y = modify' (\j -> j{jparsedefaultyear=Just y}) getYear :: JournalStateParser m (Maybe Year) getYear = fmap jparsedefaultyear get -setDefaultCommodityAndStyle :: (CommoditySymbol,AmountStyle) -> ErroringJournalParser () +setDefaultCommodityAndStyle :: (CommoditySymbol,AmountStyle) -> JournalStateParser m () setDefaultCommodityAndStyle cs = modify' (\j -> j{jparsedefaultcommodity=Just cs}) getDefaultCommodityAndStyle :: JournalStateParser m (Maybe (CommoditySymbol,AmountStyle)) getDefaultCommodityAndStyle = jparsedefaultcommodity `fmap` get -pushAccount :: AccountName -> ErroringJournalParser () +pushAccount :: AccountName -> JournalStateParser m () pushAccount acct = modify' (\j -> j{jaccounts = acct : jaccounts j}) -pushParentAccount :: AccountName -> ErroringJournalParser () +pushParentAccount :: AccountName -> JournalStateParser m () pushParentAccount acct = modify' (\j -> j{jparseparentaccounts = acct : jparseparentaccounts j}) -popParentAccount :: ErroringJournalParser () +popParentAccount :: JournalStateParser m () popParentAccount = do j <- get case jparseparentaccounts j of [] -> unexpected (Tokens ('E' :| "nd of apply account block with no beginning")) (_:rest) -> put j{jparseparentaccounts=rest} -getParentAccount :: ErroringJournalParser AccountName +getParentAccount :: JournalStateParser m AccountName getParentAccount = fmap (concatAccountNames . reverse . jparseparentaccounts) get addAccountAlias :: MonadState Journal m => AccountAlias -> m () @@ -155,7 +156,7 @@ journalAddFile f j@Journal{jfiles=fs} = j{jfiles=fs++[f]} -- | Terminate parsing entirely, returning the given error message -- with the given parse position prepended. -parserErrorAt :: SourcePos -> String -> ErroringJournalParser a +parserErrorAt :: Monad m => SourcePos -> String -> ErroringJournalParser m a parserErrorAt pos s = throwError $ sourcePosPretty pos ++ ":\n" ++ s --- * parsers @@ -173,7 +174,7 @@ statusp = codep :: TextParser m String codep = try (do { some spacenonewline; char '(' "codep"; anyChar `manyTill` char ')' } ) <|> return "" -descriptionp :: ErroringJournalParser String +descriptionp :: JournalStateParser m String descriptionp = many (noneOf (";\n" :: [Char])) --- ** dates @@ -212,7 +213,7 @@ datep = do -- Seconds are optional. -- The timezone is optional and ignored (the time is always interpreted as a local time). -- Leading zeroes may be omitted (except in a timezone). -datetimep :: ErroringJournalParser LocalTime +datetimep :: JournalStateParser m LocalTime datetimep = do day <- datep lift $ some spacenonewline @@ -240,7 +241,7 @@ datetimep = do -- return $ localTimeToUTC tz' $ LocalTime day $ TimeOfDay h' m' (fromIntegral s') return $ LocalTime day $ TimeOfDay h' m' (fromIntegral s') -secondarydatep :: Day -> ErroringJournalParser Day +secondarydatep :: Day -> JournalStateParser m Day secondarydatep primarydate = do char '=' -- kludgy way to use primary date for default year @@ -266,7 +267,7 @@ secondarydatep primarydate = do --- ** account names -- | Parse an account name, then apply any parent account prefix and/or account aliases currently in effect. -modifiedaccountnamep :: ErroringJournalParser AccountName +modifiedaccountnamep :: JournalStateParser m AccountName modifiedaccountnamep = do parent <- getParentAccount aliases <- getAccountAliases @@ -305,7 +306,7 @@ accountnamep = do -- | Parse whitespace then an amount, with an optional left or right -- currency symbol and optional price, or return the special -- "missing" marker amount. -spaceandamountormissingp :: ErroringJournalParser MixedAmount +spaceandamountormissingp :: Monad m => JournalStateParser m MixedAmount spaceandamountormissingp = try (do lift $ some spacenonewline @@ -426,7 +427,7 @@ priceamountp = return $ UnitPrice a)) <|> return NoPrice -partialbalanceassertionp :: ErroringJournalParser (Maybe MixedAmount) +partialbalanceassertionp :: Monad m => JournalStateParser m (Maybe MixedAmount) partialbalanceassertionp = try (do lift (many spacenonewline) @@ -447,7 +448,7 @@ partialbalanceassertionp = -- <|> return Nothing -- http://ledger-cli.org/3.0/doc/ledger3.html#Fixing-Lot-Prices -fixedlotpricep :: ErroringJournalParser (Maybe Amount) +fixedlotpricep :: Monad m => JournalStateParser m (Maybe Amount) fixedlotpricep = try (do lift (many spacenonewline) @@ -547,7 +548,7 @@ numberp = do --- ** comments -multilinecommentp :: ErroringJournalParser () +multilinecommentp :: JournalStateParser m () multilinecommentp = do string "comment" >> lift (many spacenonewline) >> newline go @@ -556,13 +557,13 @@ multilinecommentp = do <|> (anyLine >> go) anyLine = anyChar `manyTill` newline -emptyorcommentlinep :: ErroringJournalParser () +emptyorcommentlinep :: JournalStateParser m () emptyorcommentlinep = do lift (many spacenonewline) >> (commentp <|> (lift (many spacenonewline) >> newline >> return "")) return () -- | Parse a possibly multi-line comment following a semicolon. -followingcommentp :: ErroringJournalParser Text +followingcommentp :: JournalStateParser m Text followingcommentp = -- ptrace "followingcommentp" do samelinecomment <- lift (many spacenonewline) >> (try semicoloncommentp <|> (newline >> return "")) @@ -588,7 +589,8 @@ followingcommentp = -- >>> rejp (followingcommentandtagsp (Just $ fromGregorian 2000 1 2)) "; date:3/4=5/6" -- Right ("date:3/4=5/6\n",[("date","3/4=5/6")],Just 2000-03-04,Nothing) -- -followingcommentandtagsp :: Maybe Day -> ErroringJournalParser (Text, [Tag], Maybe Day, Maybe Day) +followingcommentandtagsp :: MonadIO m => Maybe Day + -> ErroringJournalParser m (Text, [Tag], Maybe Day, Maybe Day) followingcommentandtagsp mdefdate = do -- pdbg 0 "followingcommentandtagsp" @@ -623,16 +625,16 @@ followingcommentandtagsp mdefdate = do return (comment, tags, mdate, mdate2) -commentp :: ErroringJournalParser Text +commentp :: JournalStateParser m Text commentp = commentStartingWithp commentchars commentchars :: [Char] commentchars = "#;*" -semicoloncommentp :: ErroringJournalParser Text +semicoloncommentp :: JournalStateParser m Text semicoloncommentp = commentStartingWithp ";" -commentStartingWithp :: [Char] -> ErroringJournalParser Text +commentStartingWithp :: [Char] -> JournalStateParser m Text commentStartingWithp cs = do -- ptrace "commentStartingWith" oneOf cs @@ -714,7 +716,7 @@ tagvaluep = do -- are parsed fully to give useful errors. Missing years can be -- inferred only if a default date is provided. -- -postingdatesp :: Maybe Day -> ErroringJournalParser [(TagName,Day)] +postingdatesp :: Monad m => Maybe Day -> ErroringJournalParser m [(TagName,Day)] postingdatesp mdefdate = do -- pdbg 0 $ "postingdatesp" let p = ((:[]) <$> datetagp mdefdate) <|> bracketeddatetagsp mdefdate @@ -739,7 +741,7 @@ postingdatesp mdefdate = do -- >>> rejp (datetagp Nothing) "date: 3/4" -- Left ...1:9...partial date 3/4 found, but the current year is unknown... -- -datetagp :: Maybe Day -> ErroringJournalParser (TagName,Day) +datetagp :: Monad m => Maybe Day -> ErroringJournalParser m (TagName,Day) datetagp mdefdate = do -- pdbg 0 "datetagp" string "date" @@ -795,7 +797,7 @@ datetagp mdefdate = do -- >>> rejp (bracketeddatetagsp Nothing) "[0123456789/-.=/-.=]" -- Left ...1:15:...bad date, different separators... -- -bracketeddatetagsp :: Maybe Day -> ErroringJournalParser [(TagName, Day)] +bracketeddatetagsp :: Monad m => Maybe Day -> ErroringJournalParser m [(TagName, Day)] bracketeddatetagsp mdefdate = do -- pdbg 0 "bracketeddatetagsp" char '[' diff --git a/hledger-lib/Hledger/Read/JournalReader.hs b/hledger-lib/Hledger/Read/JournalReader.hs index 19755012e..37b582631 100644 --- a/hledger-lib/Hledger/Read/JournalReader.hs +++ b/hledger-lib/Hledger/Read/JournalReader.hs @@ -127,7 +127,7 @@ parse _ = parseAndFinaliseJournal journalp -- >>> rejp (journalp <* eof) "2015/1/1\n a 0\n" -- Right Journal with 1 transactions, 1 accounts -- -journalp :: ErroringJournalParser ParsedJournal +journalp :: MonadIO m => ErroringJournalParser m ParsedJournal journalp = do many addJournalItemP eof @@ -135,7 +135,7 @@ journalp = do -- | A side-effecting parser; parses any kind of journal item -- and updates the parse state accordingly. -addJournalItemP :: ErroringJournalParser () +addJournalItemP :: MonadIO m => ErroringJournalParser m () addJournalItemP = -- all journal line types can be distinguished by the first -- character, can use choice without backtracking @@ -154,7 +154,7 @@ addJournalItemP = -- | Parse any journal directive and update the parse state accordingly. -- Cf http://hledger.org/manual.html#directives, -- http://ledger-cli.org/3.0/doc/ledger3.html#Command-Directives -directivep :: ErroringJournalParser () +directivep :: MonadIO m => ErroringJournalParser m () directivep = (do optional $ char '!' choiceInState [ @@ -174,7 +174,7 @@ directivep = (do ] ) "directive" -includedirectivep :: ErroringJournalParser () +includedirectivep :: MonadIO m => ErroringJournalParser m () includedirectivep = do string "include" lift (some spacenonewline) @@ -227,15 +227,17 @@ orRethrowIOError io msg = (Right <$> io) `C.catch` \(e::C.IOException) -> return $ Left $ printf "%s:\n%s" msg (show e) -accountdirectivep :: ErroringJournalParser () +accountdirectivep :: JournalStateParser m () accountdirectivep = do string "account" lift (some spacenonewline) acct <- lift accountnamep newline - _ <- many indentedlinep + many indentedlinep modify' (\j -> j{jaccounts = acct : jaccounts j}) + +indentedlinep :: JournalStateParser m String indentedlinep = lift (some spacenonewline) >> (rstrip <$> lift restofline) -- | Parse a one-line or multi-line commodity directive. @@ -244,14 +246,14 @@ indentedlinep = lift (some spacenonewline) >> (rstrip <$> lift restofline) -- >>> Right _ <- rejp commoditydirectivep "commodity $\n format $1.00" -- >>> Right _ <- rejp commoditydirectivep "commodity $\n\n" -- a commodity with no format -- >>> Right _ <- rejp commoditydirectivep "commodity $1.00\n format $1.00" -- both, what happens ? -commoditydirectivep :: ErroringJournalParser () +commoditydirectivep :: Monad m => ErroringJournalParser m () commoditydirectivep = try commoditydirectiveonelinep <|> commoditydirectivemultilinep -- | Parse a one-line commodity directive. -- -- >>> Right _ <- rejp commoditydirectiveonelinep "commodity $1.00" -- >>> Right _ <- rejp commoditydirectiveonelinep "commodity $1.00 ; blah\n" -commoditydirectiveonelinep :: ErroringJournalParser () +commoditydirectiveonelinep :: Monad m => JournalStateParser m () commoditydirectiveonelinep = do string "commodity" lift (some spacenonewline) @@ -264,7 +266,7 @@ commoditydirectiveonelinep = do -- | Parse a multi-line commodity directive, containing 0 or more format subdirectives. -- -- >>> Right _ <- rejp commoditydirectivemultilinep "commodity $ ; blah \n format $1.00 ; blah" -commoditydirectivemultilinep :: ErroringJournalParser () +commoditydirectivemultilinep :: Monad m => ErroringJournalParser m () commoditydirectivemultilinep = do string "commodity" lift (some spacenonewline) @@ -278,7 +280,7 @@ commoditydirectivemultilinep = do -- | Parse a format (sub)directive, throwing a parse error if its -- symbol does not match the one given. -formatdirectivep :: CommoditySymbol -> ErroringJournalParser AmountStyle +formatdirectivep :: Monad m => CommoditySymbol -> ErroringJournalParser m AmountStyle formatdirectivep expectedsym = do string "format" lift (some spacenonewline) @@ -290,7 +292,7 @@ formatdirectivep expectedsym = do else parserErrorAt pos $ printf "commodity directive symbol \"%s\" and format directive symbol \"%s\" should be the same" expectedsym acommodity -applyaccountdirectivep :: ErroringJournalParser () +applyaccountdirectivep :: JournalStateParser m () applyaccountdirectivep = do string "apply" >> lift (some spacenonewline) >> string "account" lift (some spacenonewline) @@ -298,12 +300,12 @@ applyaccountdirectivep = do newline pushParentAccount parent -endapplyaccountdirectivep :: ErroringJournalParser () +endapplyaccountdirectivep :: JournalStateParser m () endapplyaccountdirectivep = do string "end" >> lift (some spacenonewline) >> string "apply" >> lift (some spacenonewline) >> string "account" popParentAccount -aliasdirectivep :: ErroringJournalParser () +aliasdirectivep :: JournalStateParser m () aliasdirectivep = do string "alias" lift (some spacenonewline) @@ -334,12 +336,12 @@ regexaliasp = do repl <- rstrip <$> anyChar `manyTill` eolof return $ RegexAlias re repl -endaliasesdirectivep :: ErroringJournalParser () +endaliasesdirectivep :: JournalStateParser m () endaliasesdirectivep = do string "end aliases" clearAccountAliases -tagdirectivep :: ErroringJournalParser () +tagdirectivep :: JournalStateParser m () tagdirectivep = do string "tag" "tag directive" lift (some spacenonewline) @@ -347,13 +349,13 @@ tagdirectivep = do lift restofline return () -endtagdirectivep :: ErroringJournalParser () +endtagdirectivep :: JournalStateParser m () endtagdirectivep = do (string "end tag" <|> string "pop") "end tag or pop directive" lift restofline return () -defaultyeardirectivep :: ErroringJournalParser () +defaultyeardirectivep :: JournalStateParser m () defaultyeardirectivep = do char 'Y' "default year" lift (many spacenonewline) @@ -362,7 +364,7 @@ defaultyeardirectivep = do failIfInvalidYear y setYear y' -defaultcommoditydirectivep :: ErroringJournalParser () +defaultcommoditydirectivep :: Monad m => JournalStateParser m () defaultcommoditydirectivep = do char 'D' "default commodity" lift (some spacenonewline) @@ -370,7 +372,7 @@ defaultcommoditydirectivep = do lift restofline setDefaultCommodityAndStyle (acommodity, astyle) -marketpricedirectivep :: ErroringJournalParser MarketPrice +marketpricedirectivep :: Monad m => JournalStateParser m MarketPrice marketpricedirectivep = do char 'P' "market price" lift (many spacenonewline) @@ -382,7 +384,7 @@ marketpricedirectivep = do lift restofline return $ MarketPrice date symbol price -ignoredpricecommoditydirectivep :: ErroringJournalParser () +ignoredpricecommoditydirectivep :: JournalStateParser m () ignoredpricecommoditydirectivep = do char 'N' "ignored-price commodity" lift (some spacenonewline) @@ -390,7 +392,7 @@ ignoredpricecommoditydirectivep = do lift restofline return () -commodityconversiondirectivep :: ErroringJournalParser () +commodityconversiondirectivep :: Monad m => JournalStateParser m () commodityconversiondirectivep = do char 'C' "commodity conversion" lift (some spacenonewline) @@ -404,7 +406,7 @@ commodityconversiondirectivep = do --- ** transactions -modifiertransactionp :: ErroringJournalParser ModifierTransaction +modifiertransactionp :: MonadIO m => ErroringJournalParser m ModifierTransaction modifiertransactionp = do char '=' "modifier transaction" lift (many spacenonewline) @@ -412,7 +414,7 @@ modifiertransactionp = do postings <- postingsp Nothing return $ ModifierTransaction valueexpr postings -periodictransactionp :: ErroringJournalParser PeriodicTransaction +periodictransactionp :: MonadIO m => ErroringJournalParser m PeriodicTransaction periodictransactionp = do char '~' "periodic transaction" lift (many spacenonewline) @@ -421,7 +423,7 @@ periodictransactionp = do return $ PeriodicTransaction periodexpr postings -- | Parse a (possibly unbalanced) transaction. -transactionp :: ErroringJournalParser Transaction +transactionp :: MonadIO m => ErroringJournalParser m Transaction transactionp = do -- ptrace "transactionp" sourcepos <- genericSourcePos <$> getPosition @@ -533,7 +535,7 @@ test_transactionp = do -- Parse the following whitespace-beginning lines as postings, posting -- tags, and/or comments (inferring year, if needed, from the given date). -postingsp :: Maybe Day -> ErroringJournalParser [Posting] +postingsp :: MonadIO m => Maybe Day -> ErroringJournalParser m [Posting] postingsp mdate = many (try $ postingp mdate) "postings" -- linebeginningwithspaces :: Monad m => JournalParser m String @@ -543,7 +545,7 @@ postingsp mdate = many (try $ postingp mdate) "postings" -- cs <- lift restofline -- return $ sp ++ (c:cs) ++ "\n" -postingp :: Maybe Day -> ErroringJournalParser Posting +postingp :: MonadIO m => Maybe Day -> ErroringJournalParser m Posting postingp mtdate = do -- pdbg 0 "postingp" lift (some spacenonewline) diff --git a/hledger-lib/Hledger/Read/TimeclockReader.hs b/hledger-lib/Hledger/Read/TimeclockReader.hs index 2854491f5..412b71735 100644 --- a/hledger-lib/Hledger/Read/TimeclockReader.hs +++ b/hledger-lib/Hledger/Read/TimeclockReader.hs @@ -82,7 +82,7 @@ reader = Reader parse :: Maybe FilePath -> Bool -> FilePath -> Text -> ExceptT String IO Journal parse _ = parseAndFinaliseJournal timeclockfilep -timeclockfilep :: ErroringJournalParser ParsedJournal +timeclockfilep :: ErroringJournalParser IO ParsedJournal timeclockfilep = do many timeclockitemp eof j@Journal{jparsetimeclockentries=es} <- get @@ -105,7 +105,7 @@ timeclockfilep = do many timeclockitemp ] "timeclock entry, or default year or historical price directive" -- | Parse a timeclock entry. -timeclockentryp :: ErroringJournalParser TimeclockEntry +timeclockentryp :: JournalStateParser m TimeclockEntry timeclockentryp = do sourcepos <- genericSourcePos <$> lift getPosition code <- oneOf ("bhioO" :: [Char]) diff --git a/hledger-lib/Hledger/Read/TimedotReader.hs b/hledger-lib/Hledger/Read/TimedotReader.hs index 6fcb0873f..cc661ebf5 100644 --- a/hledger-lib/Hledger/Read/TimedotReader.hs +++ b/hledger-lib/Hledger/Read/TimedotReader.hs @@ -51,6 +51,7 @@ import Hledger.Utils hiding (ptrace) -- easier to toggle this here sometimes -- import qualified Hledger.Utils (ptrace) -- ptrace = Hledger.Utils.ptrace +ptrace :: Monad m => a -> m a ptrace = return reader :: Reader @@ -65,12 +66,12 @@ reader = Reader parse :: Maybe FilePath -> Bool -> FilePath -> Text -> ExceptT String IO Journal parse _ = parseAndFinaliseJournal timedotfilep -timedotfilep :: ErroringJournalParser ParsedJournal +timedotfilep :: JournalStateParser m ParsedJournal timedotfilep = do many timedotfileitemp eof get where - timedotfileitemp :: ErroringJournalParser () + timedotfileitemp :: JournalStateParser m () timedotfileitemp = do ptrace "timedotfileitemp" choice [ @@ -88,7 +89,7 @@ addTransactions ts j = foldl' (flip ($)) j (map addTransaction ts) -- biz.research . -- inc.client1 .... .... .... .... .... .... -- @ -timedotdayp :: ErroringJournalParser [Transaction] +timedotdayp :: JournalStateParser m [Transaction] timedotdayp = do ptrace " timedotdayp" d <- datep <* lift eolof @@ -100,7 +101,7 @@ timedotdayp = do -- @ -- fos.haskell .... .. -- @ -timedotentryp :: ErroringJournalParser Transaction +timedotentryp :: JournalStateParser m Transaction timedotentryp = do ptrace " timedotentryp" pos <- genericSourcePos <$> getPosition @@ -124,14 +125,14 @@ timedotentryp = do } return t -timedotdurationp :: ErroringJournalParser Quantity +timedotdurationp :: JournalStateParser m Quantity timedotdurationp = try timedotnumberp <|> timedotdotsp -- | Parse a duration written as a decimal number of hours (optionally followed by the letter h). -- @ -- 1.5h -- @ -timedotnumberp :: ErroringJournalParser Quantity +timedotnumberp :: JournalStateParser m Quantity timedotnumberp = do (q, _, _, _) <- lift numberp lift (many spacenonewline) @@ -143,7 +144,7 @@ timedotnumberp = do -- @ -- .... .. -- @ -timedotdotsp :: ErroringJournalParser Quantity +timedotdotsp :: JournalStateParser m Quantity timedotdotsp = do dots <- filter (not.isSpace) <$> many (oneOf (". " :: [Char])) return $ (/4) $ fromIntegral $ length dots diff --git a/hledger-lib/Hledger/Utils/Parse.hs b/hledger-lib/Hledger/Utils/Parse.hs index c2da33d8c..75fa0fc82 100644 --- a/hledger-lib/Hledger/Utils/Parse.hs +++ b/hledger-lib/Hledger/Utils/Parse.hs @@ -22,7 +22,7 @@ type JournalStateParser m a = StateT Journal (ParsecT Dec Text m) a type JournalParser a = StateT Journal (ParsecT Dec Text Identity) a -- | A journal parser that runs in IO and can throw an error mid-parse. -type ErroringJournalParser a = StateT Journal (ParsecT Dec Text (ExceptT String IO)) a +type ErroringJournalParser m a = StateT Journal (ParsecT Dec Text (ExceptT String m)) a -- | Backtracking choice, use this when alternatives share a prefix. -- Consumes no input if all choices fail. diff --git a/tests/cli/multiple-files.test b/tests/cli/multiple-files.test index d53c73fbc..a8e4ffc8c 100644 --- a/tests/cli/multiple-files.test +++ b/tests/cli/multiple-files.test @@ -56,3 +56,5 @@ hledger print -f personal.journal -f a.timeclock -f b.timedot (b.bb) 1.00 >>>=0 + +u \ No newline at end of file