;timedot: parsing fixes; allow blank lines/comments within days

hledger-lib/Hledger/Read/TimedotReader.hs

@@ -77,9 +77,12 @@ parse = parseAndFinaliseJournal' timedotp
 
 -- ** utilities
 
-traceparse :: String -> TextParser m ()
-traceparse = const $ return ()
--- traceparse = traceParse  -- for debugging
+traceparse, traceparse' :: String -> TextParser m ()
+traceparse  = const $ return ()
+traceparse' = const $ return ()
+-- for debugging:
+-- traceparse  s = traceParse (s++"?")
+-- traceparse' s = trace s $ return ()
 
 -- ** parsers
 {-
@@ -108,21 +111,8 @@ timedotp = preamblep >> many dayp >> eof >> get
 preamblep :: JournalParser m ()
 preamblep = do
   lift $ traceparse "preamblep"
-  void $ many $ notFollowedBy datelinep >> (lift $ emptyorcommentlinep "#;*")
-
--- | XXX new comment line parser, move to Hledger.Read.Common.emptyorcommentlinep
--- Parse empty lines, all-blank lines, and lines beginning with any of the provided
--- comment-beginning characters.
-emptyorcommentlinep :: [Char] -> TextParser m ()
-emptyorcommentlinep cs =
-  label ("empty line or comment line beginning with "++cs) $ do
-    traceparse "emptyorcommentlinep" -- XXX possible to combine label and traceparse ?
-    skipMany spacenonewline
-    void newline <|> void commentp
-    where
-      commentp = do
-        choice (map (some.char) cs)
-        takeWhileP Nothing (/='\n') <* newline
+  many $ notFollowedBy datelinep >> (lift $ emptyorcommentlinep "#;*")
+  lift $ traceparse' "preamblep"
 
 -- | Parse timedot day entries to zero or more time transactions for that day.
 -- @
@@ -135,11 +125,10 @@ dayp :: JournalParser m ()
 dayp = label "timedot day entry" $ do
   lift $ traceparse "dayp"
   (d,desc) <- datelinep
-  ts <- many entryp
-  let ts' = map (\t -> t{tdate=d, tdescription=desc}) ts
-  modify' $ addTransactions ts'
-  void $ many $
-    (lift $ emptyorcommentlinep "#;") <|> orgnondatelinep
+  commentlinesp
+  ts <- many $ entryp <* commentlinesp
+  modify' $ addTransactions $ map (\t -> t{tdate=d, tdescription=desc}) ts
+  lift $ traceparse' "dayp"
   where
     addTransactions :: [Transaction] -> Journal -> Journal
     addTransactions ts j = foldl' (flip ($)) j (map addTransaction ts)
@@ -150,16 +139,27 @@ datelinep = do
   lift $ optional orgheadingprefixp
   d <- datep
   desc <- strip <$> lift restofline
+  lift $ traceparse' "datelinep"
   return (d, T.pack desc)
 
-orgnondatelinep :: JournalParser m ()
-orgnondatelinep = do
-  lift $ traceparse "orgnondatelinep"
-  notFollowedBy datelinep
-  lift orgheadingprefixp
-  void $ lift restofline
+-- | Zero or more empty lines or hash/semicolon comment lines
+-- or org headlines which do not start a new day.
+commentlinesp :: JournalParser m ()
+commentlinesp = do
+  lift $ traceparse "commentlinesp"
+  void $ many $ try $ lift $ emptyorcommentlinep "#;"
 
-orgheadingprefixp = skipSome (char '*') >> skipSome spacenonewline
+-- orgnondatelinep :: JournalParser m ()
+-- orgnondatelinep = do
+--   lift $ traceparse "orgnondatelinep"
+--   lift orgheadingprefixp
+--   notFollowedBy datelinep
+--   void $ lift restofline
+--   lift $ traceparse' "orgnondatelinep"
+
+orgheadingprefixp = do
+  -- traceparse "orgheadingprefixp"
+  skipSome (char '*') >> skipSome spacenonewline
 
 -- | Parse a single timedot entry to one (dateless) transaction.
 -- @
@@ -167,8 +167,9 @@ orgheadingprefixp = skipSome (char '*') >> skipSome spacenonewline
 -- @
 entryp :: JournalParser m Transaction
 entryp = do
-  lift $ traceparse "  entryp"
+  lift $ traceparse "entryp"
   pos <- genericSourcePos <$> getSourcePos
+  notFollowedBy datelinep
   lift $ optional $ choice [orgheadingprefixp, skipSome spacenonewline]
   a <- modifiedaccountnamep
   lift (skipMany spacenonewline)
@@ -187,10 +188,14 @@ entryp = do
                      }
           ]
         }
+  lift $ traceparse' "entryp"
   return t
 
 durationp :: JournalParser m Quantity
-durationp = try numericquantityp <|> dotquantityp
+durationp = do
+  lift $ traceparse "durationp"
+  try numericquantityp <|> dotquantityp
+    -- <* traceparse' "durationp"
 
 -- | Parse a duration of seconds, minutes, hours, days, weeks, months or years,
 -- written as a decimal number followed by s, m, h, d, w, mo or y, assuming h
@@ -203,6 +208,7 @@ durationp = try numericquantityp <|> dotquantityp
 -- @
 numericquantityp :: JournalParser m Quantity
 numericquantityp = do
+  -- lift $ traceparse "numericquantityp"
   (q, _, _, _) <- lift $ numberp Nothing
   msymbol <- optional $ choice $ map (string . fst) timeUnits
   lift (skipMany spacenonewline)
@@ -232,5 +238,22 @@ timeUnits =
 -- @
 dotquantityp :: JournalParser m Quantity
 dotquantityp = do
+  -- lift $ traceparse "dotquantityp"
   dots <- filter (not.isSpace) <$> many (oneOf (". " :: [Char]))
   return $ (/4) $ fromIntegral $ length dots
+
+-- | XXX new comment line parser, move to Hledger.Read.Common.emptyorcommentlinep
+-- Parse empty lines, all-blank lines, and lines beginning with any of the provided
+-- comment-beginning characters.
+emptyorcommentlinep :: [Char] -> TextParser m ()
+emptyorcommentlinep cs =
+  label ("empty line or comment line beginning with "++cs) $ do
+    traceparse "emptyorcommentlinep" -- XXX possible to combine label and traceparse ?
+    skipMany spacenonewline
+    void newline <|> void commentp
+    traceparse' "emptyorcommentlinep"
+    where
+      commentp = do
+        choice (map (some.char) cs)
+        takeWhileP Nothing (/='\n') <* newline
+