diff --git a/hledger-lib/Hledger/Read/TimedotReader.hs b/hledger-lib/Hledger/Read/TimedotReader.hs index 2708ae468..3a2d7ede2 100644 --- a/hledger-lib/Hledger/Read/TimedotReader.hs +++ b/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 +