diff --git a/hledger-lib/Hledger/Read/Common.hs b/hledger-lib/Hledger/Read/Common.hs index a4e55172b..5d5bcebfe 100644 --- a/hledger-lib/Hledger/Read/Common.hs +++ b/hledger-lib/Hledger/Read/Common.hs @@ -172,27 +172,25 @@ import Hledger.Read.InputOptions -- main types; a few more below --- | A hledger journal reader is a triple of storage format name, a --- detector of that format, and a parser from that format to Journal. --- The type variable m appears here so that rParserr can hold a --- journal parser, which depends on it. +-- | A hledger journal reader is a storage format name, +-- a list of file extensions assumed to be in this format, +-- and an IO action that reads data in this format, returning a Journal. +-- +-- The journal parser used by the latter is also stored separately for direct use +-- by the journal reader's includedirectivep to parse included files. +-- The type variable m is needed for this parser. +-- Lately it requires an InputOpts, basically to support --old-timeclock. data Reader m = Reader { - - -- The canonical name of the format handled by this reader - rFormat :: StorageFormat - - -- The file extensions recognised as containing this format - ,rExtensions :: [String] - - -- The entry point for reading this format, accepting input options, file - -- path for error messages and file contents via the handle, producing an exception-raising IO - -- action that produces a journal or error message. - ,rReadFn :: InputOpts -> FilePath -> Handle -> ExceptT String IO Journal - - -- The actual megaparsec parser called by the above, in case - -- another parser (includedirectivep) wants to use it directly. - ,rParser :: MonadIO m => ErroringJournalParser m ParsedJournal - } + -- The canonical name of the format handled by this reader. "journal", "timedot", "csv" etc. + rFormat :: StorageFormat + -- The file extensions recognised as containing this format. + ,rExtensions :: [String] + -- An IO action for reading this format, producing a journal or an error message. + -- It accepts input options, a file path to show in error messages, and a handle to read data from. + ,rReadFn :: InputOpts -> FilePath -> Handle -> ExceptT String IO Journal + -- The megaparsec parser called by the above, provided separately for parsing included files. + ,rParser :: MonadIO m => InputOpts -> ErroringJournalParser m ParsedJournal + } instance Show (Reader m) where show r = show (rFormat r) ++ " reader" diff --git a/hledger-lib/Hledger/Read/CsvReader.hs b/hledger-lib/Hledger/Read/CsvReader.hs index d5e41591a..9e54c47e4 100644 --- a/hledger-lib/Hledger/Read/CsvReader.hs +++ b/hledger-lib/Hledger/Read/CsvReader.hs @@ -46,7 +46,7 @@ reader sep = Reader {rFormat = Sep sep ,rExtensions = [show sep] ,rReadFn = parse sep - ,rParser = fail "sorry, CSV files can't be included yet" -- PARTIAL: + ,rParser = const $ fail "sorry, CSV files can't be included yet" -- PARTIAL: -- This unnecessarily shows the CSV file's first line in the error message, -- but gives a more useful message than just calling error'. -- XXX Note every call to error' in Hledger.Read.* is potentially a similar problem - diff --git a/hledger-lib/Hledger/Read/JournalReader.hs b/hledger-lib/Hledger/Read/JournalReader.hs index 643898ad0..06cca583b 100644 --- a/hledger-lib/Hledger/Read/JournalReader.hs +++ b/hledger-lib/Hledger/Read/JournalReader.hs @@ -220,7 +220,7 @@ parse iopts f = parseAndFinaliseJournal journalp' iopts f journalp' = do -- reverse parsed aliases to ensure that they are applied in order given on commandline mapM_ addAccountAlias (reverse $ aliasesFromOpts iopts) - journalp + journalp iopts --- ** parsers --- *** journal @@ -228,23 +228,23 @@ parse iopts f = parseAndFinaliseJournal journalp' iopts f -- | A journal parser. Accumulates and returns a "ParsedJournal", -- which should be finalised/validated before use. -- --- >>> rejp (journalp <* eof) "2015/1/1\n a 0\n" +-- >>> rejp (journalp definputopts <* eof) "2015/1/1\n a 0\n" -- Right (Right Journal (unknown) with 1 transactions, 1 accounts) -- -journalp :: MonadIO m => ErroringJournalParser m ParsedJournal -journalp = do - many addJournalItemP +journalp :: MonadIO m => InputOpts -> ErroringJournalParser m ParsedJournal +journalp iopts = do + many $ addJournalItemP iopts eof get -- | A side-effecting parser; parses any kind of journal item -- and updates the parse state accordingly. -addJournalItemP :: MonadIO m => ErroringJournalParser m () -addJournalItemP = +addJournalItemP :: MonadIO m => InputOpts -> ErroringJournalParser m () +addJournalItemP iopts = -- all journal line types can be distinguished by the first -- character, can use choice without backtracking choice [ - directivep + directivep iopts , transactionp >>= modify' . addTransaction , transactionmodifierp >>= modify' . addTransactionModifier , periodictransactionp >>= modify' . addPeriodicTransaction @@ -258,11 +258,11 @@ addJournalItemP = -- | Parse any journal directive and update the parse state accordingly. -- Cf http://hledger.org/hledger.html#directives, -- http://ledger-cli.org/3.0/doc/ledger3.html#Command-Directives -directivep :: MonadIO m => ErroringJournalParser m () -directivep = (do +directivep :: MonadIO m => InputOpts -> ErroringJournalParser m () +directivep iopts = (do optional $ oneOf ['!','@'] choice [ - includedirectivep + includedirectivep iopts ,aliasdirectivep ,endaliasesdirectivep ,accountdirectivep @@ -296,10 +296,11 @@ directivep = (do ) "directive" -- | Parse an include directive, and the file(s) it refers to, possibly recursively. +-- Input options are required since they may affect parsing (of timeclock files, specifically). -- include's argument is a file path or glob pattern (see findMatchedFiles for details), -- optionally with a file type prefix. Relative paths are relative to the current file. -includedirectivep :: MonadIO m => ErroringJournalParser m () -includedirectivep = do +includedirectivep :: MonadIO m => InputOpts -> ErroringJournalParser m () +includedirectivep iopts = do -- save the position at start of include directive, for error messages eoff <- getOffset -- and the parent file's path, for error messages and debug output @@ -335,7 +336,7 @@ includedirectivep = do Just fmt -> map ((show fmt++":")++) paths -- Parse each one, as if inlined here. - forM_ prefixedpaths $ parseIncludedFile eoff + forM_ prefixedpaths $ parseIncludedFile iopts eoff where @@ -432,8 +433,8 @@ includedirectivep = do -- Parse the given included file (and any deeper includes, recursively) as if it was inlined in the current (parent) file. -- The offset of the start of the include directive in the parent file is provided for error messages. - parseIncludedFile :: MonadIO m => Int -> PrefixedFilePath -> ErroringJournalParser m () - parseIncludedFile eoff prefixedpath = do + parseIncludedFile :: MonadIO m => InputOpts -> Int -> PrefixedFilePath -> ErroringJournalParser m () + parseIncludedFile iopts1 eoff prefixedpath = do let (_mprefix,filepath) = splitReaderPrefix prefixedpath -- Throw an error if a cycle is detected @@ -449,7 +450,7 @@ includedirectivep = do -- Choose a reader based on the file path prefix or file extension, -- defaulting to JournalReader. Duplicating readJournal a bit here. let r = fromMaybe reader $ findReader Nothing (Just prefixedpath) - parser = rParser r + parser = (rParser r) iopts1 dbg7IO "parseIncludedFile: trying reader" (rFormat r) -- Parse the file (and its own includes, if any) to a Journal @@ -1220,8 +1221,8 @@ tests_JournalReader = testGroup "JournalReader" [ ,testGroup "directivep" [ testCase "supports !" $ do - assertParseE directivep "!account a\n" - assertParseE directivep "!D 1.0\n" + assertParseE (directivep definputopts) "!account a\n" + assertParseE (directivep definputopts) "!D 1.0\n" ] ,testGroup "accountdirectivep" [ @@ -1255,8 +1256,8 @@ tests_JournalReader = testGroup "JournalReader" [ assertParse ignoredpricecommoditydirectivep "N $\n" ,testGroup "includedirectivep" [ - testCase "include" $ assertParseErrorE includedirectivep "include nosuchfile\n" "No files were matched by glob pattern: nosuchfile" - ,testCase "glob" $ assertParseErrorE includedirectivep "include nosuchfile*\n" "No files were matched by glob pattern: nosuchfile*" + testCase "include" $ assertParseErrorE (includedirectivep definputopts) "include nosuchfile\n" "No files were matched by glob pattern: nosuchfile" + ,testCase "glob" $ assertParseErrorE (includedirectivep definputopts) "include nosuchfile*\n" "No files were matched by glob pattern: nosuchfile*" ] ,testCase "marketpricedirectivep" $ assertParseEq marketpricedirectivep @@ -1283,12 +1284,12 @@ tests_JournalReader = testGroup "JournalReader" [ assertParse endtagdirectivep "end apply tag \n" ,testGroup "journalp" [ - testCase "empty file" $ assertParseEqE journalp "" nulljournal + testCase "empty file" $ assertParseEqE (journalp definputopts) "" nulljournal ] -- these are defined here rather than in Common so they can use journalp ,testCase "parseAndFinaliseJournal" $ do - ej <- runExceptT $ parseAndFinaliseJournal journalp definputopts "" "2019-1-1\n" + ej <- runExceptT $ parseAndFinaliseJournal (journalp definputopts) definputopts "" "2019-1-1\n" let Right j = ej assertEqual "" [""] $ journalFilePaths j diff --git a/hledger-lib/Hledger/Read/TimeclockReader.hs b/hledger-lib/Hledger/Read/TimeclockReader.hs index 88da58f71..d23cd6194 100644 --- a/hledger-lib/Hledger/Read/TimeclockReader.hs +++ b/hledger-lib/Hledger/Read/TimeclockReader.hs @@ -164,7 +164,7 @@ reader = Reader {rFormat = Timeclock ,rExtensions = ["timeclock"] ,rReadFn = handleReadFnToTextReadFn parse - ,rParser = timeclockfilep definputopts + ,rParser = timeclockfilep } -- | Parse and post-process a "Journal" from timeclock.el's timeclock diff --git a/hledger-lib/Hledger/Read/TimedotReader.hs b/hledger-lib/Hledger/Read/TimedotReader.hs index a755121f5..b8c385ed4 100644 --- a/hledger-lib/Hledger/Read/TimedotReader.hs +++ b/hledger-lib/Hledger/Read/TimedotReader.hs @@ -74,7 +74,7 @@ reader = Reader -- | Parse and post-process a "Journal" from the timedot format, or give an error. parse :: InputOpts -> FilePath -> Text -> ExceptT String IO Journal -parse iopts fp t = initialiseAndParseJournal timedotp iopts fp t +parse iopts fp t = initialiseAndParseJournal (timedotp iopts) iopts fp t >>= liftEither . journalApplyAliases (aliasesFromOpts iopts) >>= journalFinalise iopts fp t @@ -106,8 +106,8 @@ Org headings before the first date line are ignored, regardless of content. timedotfilep = timedotp -- XXX rename export above -timedotp :: JournalParser m ParsedJournal -timedotp = preamblep >> many dayp >> eof >> get +timedotp :: InputOpts -> JournalParser m ParsedJournal +timedotp _ = preamblep >> many dayp >> eof >> get preamblep :: JournalParser m () preamblep = do diff --git a/hledger/test/needs-old.timeclock b/hledger/test/needs-old.timeclock new file mode 100644 index 000000000..06c03aaff --- /dev/null +++ b/hledger/test/needs-old.timeclock @@ -0,0 +1,6 @@ +# A file that requires --old-timeclock. (Update when needed.) + +i 2000-01-01 09:00:00 a +o 2000-01-01 11:00:00 +i 2000-01-01 10:00:00 a +o 2000-01-01 11:00:00 diff --git a/hledger/test/timeclock.test b/hledger/test/timeclock.test index eb458b0e2..36a6ae766 100644 --- a/hledger/test/timeclock.test +++ b/hledger/test/timeclock.test @@ -203,6 +203,19 @@ $ hledger -f timeclock:- print >2 /Overlapping sessions with the same account name are not supported./ >=!0 +# ** 15. --old-timeclock also affects included files. +< +include needs-old.timeclock + +$ hledger -f- print --old-timeclock +2000-01-01 * 09:00-11:00 + (a) 2.00h + +2000-01-01 * 10:00-11:00 + (a) 1.00h + +>= + # ** OLD: ## multi-day sessions get a new transaction for each day