fix:timeclock: --old-timeclock also affects included files [#2417]

This required changing the Reader type and passing InputOpts down to
journal's include directive parser.

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
+-- | A hledger journal reader is a storage format name,
--- detector of that format, and a parser from that format to Journal.
+-- a list of file extensions assumed to be in this format,
--- The type variable m appears here so that rParserr can hold a
+-- and an IO action that reads data in this format, returning a Journal.
--- journal parser, which depends on it.
+--
+-- 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. "journal", "timedot", "csv" etc.
-     -- The canonical name of the format handled by this reader
+   rFormat :: StorageFormat
-     rFormat   :: StorageFormat
+    -- The file extensions recognised as containing this format.
-
+  ,rExtensions :: [String]
-     -- The file extensions recognised as containing this format
+    -- An IO action for reading this format, producing a journal or an error message.
-    ,rExtensions :: [String]
+    -- 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 entry point for reading this format, accepting input options, file
+    -- The megaparsec parser called by the above, provided separately for parsing included files.
-     -- path for error messages and file contents via the handle, producing an exception-raising IO
+  ,rParser :: MonadIO m => InputOpts -> ErroringJournalParser m ParsedJournal
-     -- 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
-    }
 
 instance Show (Reader m) where show r = show (rFormat r) ++ " reader"
 

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 -

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 :: MonadIO m => InputOpts -> ErroringJournalParser m ParsedJournal
-journalp = do
+journalp iopts = do
-  many addJournalItemP
+  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 :: MonadIO m => InputOpts -> ErroringJournalParser m ()
-addJournalItemP =
+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 :: MonadIO m => InputOpts -> ErroringJournalParser m ()
-directivep = (do
+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 :: MonadIO m => InputOpts -> ErroringJournalParser m ()
-includedirectivep = do
+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 :: MonadIO m => InputOpts -> Int -> PrefixedFilePath -> ErroringJournalParser m ()
-    parseIncludedFile eoff prefixedpath = do
+    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 definputopts) "!account a\n"
-        assertParseE directivep "!D 1.0\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 "include" $ assertParseErrorE (includedirectivep definputopts) "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 "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
 

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

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 :: InputOpts -> JournalParser m ParsedJournal
-timedotp = preamblep >> many dayp >> eof >> get
+timedotp _ = preamblep >> many dayp >> eof >> get
 
 preamblep :: JournalParser m ()
 preamblep = do

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

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