slaesvuo/hledger
1
0
Fork 0
Code Issues Pull Requests Actions 2 Packages Projects Releases Wiki Activity

imp: TimedotReader: trace parsing at debug level 9

Browse Source
This commit is contained in:
Simon Michael 2024-06-24 11:31:05 +01:00
parent b3e648a2db
commit 713c3f4067
1 changed files with 32 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

52
hledger-lib/Hledger/Read/TimedotReader.hs
View File

@ -80,12 +80,10 @@ parse iopts fp t = initialiseAndParseJournal timedotp iopts fp t
--- ** utilities --- ** utilities
traceparse, traceparse' :: String -> TextParser m () -- Trace parser state above a certain --debug level ?
traceparse = const $ return () tracelevel = 9
traceparse' = const $ return () dp :: String -> JournalParser m ()
-- for debugging: dp = if tracelevel >= 0 then lift . dbgparse tracelevel else const $ return ()
-- traceparse s = traceParse (s++"?")
-- traceparse' s = trace s $ return ()
--- ** parsers --- ** parsers
{- {-
@ -113,9 +111,8 @@ timedotp = preamblep >> many dayp >> eof >> get
preamblep :: JournalParser m () preamblep :: JournalParser m ()
preamblep = do preamblep = do
lift $ traceparse "preamblep" dp "preamblep"
many $ notFollowedBy datelinep >> (lift $ emptyorcommentlinep' "#;*") void $ many $ notFollowedBy datelinep >> (lift $ emptyorcommentlinep "#;*")
lift $ traceparse' "preamblep"
-- | Parse timedot day entries to multi-posting time transactions for that day. -- | Parse timedot day entries to multi-posting time transactions for that day.
-- @ -- @
@ -126,11 +123,13 @@ preamblep = do
-- @ -- @
dayp :: JournalParser m () dayp :: JournalParser m ()
dayp = label "timedot day entry" $ do dayp = label "timedot day entry" $ do
lift $ traceparse "dayp" dp "dayp"
pos <- getSourcePos pos <- getSourcePos
(date,desc,comment,tags) <- datelinep (date,desc,comment,tags) <- datelinep
dp "dayp1"
commentlinesp commentlinesp
ps <- (many $ timedotentryp <* commentlinesp) <&> concat dp "dayp2"
ps <- (many $ dp "dayp3" >> timedotentryp <* commentlinesp) <&> concat
endpos <- getSourcePos endpos <- getSourcePos
let t = txnTieKnot $ nulltransaction{ let t = txnTieKnot $ nulltransaction{
tsourcepos = (pos, endpos), tsourcepos = (pos, endpos),
@ -145,7 +144,7 @@ dayp = label "timedot day entry" $ do
datelinep :: JournalParser m (Day,Text,Text,[Tag]) datelinep :: JournalParser m (Day,Text,Text,[Tag])
datelinep = do datelinep = do
lift $ traceparse "datelinep" dp "datelinep"
lift $ optional orgheadingprefixp lift $ optional orgheadingprefixp
date <- datep date <- datep
desc <- T.strip <$> lift descriptionp desc <- T.strip <$> lift descriptionp
@ -156,16 +155,15 @@ datelinep = do
-- or org headlines which do not start a new day. -- or org headlines which do not start a new day.
commentlinesp :: JournalParser m () commentlinesp :: JournalParser m ()
commentlinesp = do commentlinesp = do
lift $ traceparse "commentlinesp" dp "commentlinesp"
void $ many $ try $ lift $ emptyorcommentlinep' "#;" void $ many $ try $ lift $ emptyorcommentlinep "#;"
-- orgnondatelinep :: JournalParser m () -- orgnondatelinep :: JournalParser m ()
-- orgnondatelinep = do -- orgnondatelinep = do
-- lift $ traceparse "orgnondatelinep" -- dp "orgnondatelinep"
-- lift orgheadingprefixp -- lift orgheadingprefixp
-- notFollowedBy datelinep -- notFollowedBy datelinep
-- void $ lift restofline -- void $ lift restofline
-- lift $ traceparse' "orgnondatelinep"
orgheadingprefixp = skipSome (char '*') >> skipNonNewlineSpaces1 orgheadingprefixp = skipSome (char '*') >> skipNonNewlineSpaces1
@ -175,7 +173,7 @@ orgheadingprefixp = skipSome (char '*') >> skipNonNewlineSpaces1
-- @ -- @
timedotentryp :: JournalParser m [Posting] timedotentryp :: JournalParser m [Posting]
timedotentryp = do timedotentryp = do
lift $ traceparse "timedotentryp" dp "timedotentryp"
notFollowedBy datelinep notFollowedBy datelinep
lift $ optional $ choice [orgheadingprefixp, skipNonNewlineSpaces1] lift $ optional $ choice [orgheadingprefixp, skipNonNewlineSpaces1]
a <- modifiedaccountnamep a <- modifiedaccountnamep
@ -225,7 +223,7 @@ durationsp =
-- @ -- @
numericquantityp :: TextParser m Hours numericquantityp :: TextParser m Hours
numericquantityp = do numericquantityp = do
-- lift $ traceparse "numericquantityp" -- dp "numericquantityp"
(q, _, _, _) <- numberp Nothing (q, _, _, _) <- numberp Nothing
msymbol <- optional $ choice $ map (string . fst) timeUnits msymbol <- optional $ choice $ map (string . fst) timeUnits
skipNonNewlineSpaces skipNonNewlineSpaces
@ -257,7 +255,7 @@ timeUnits =
-- @ -- @
dotquantityp :: TextParser m Hours dotquantityp :: TextParser m Hours
dotquantityp = do dotquantityp = do
-- lift $ traceparse "dotquantityp" -- dp "dotquantityp"
char '.' char '.'
dots <- many (oneOf ['.', ' ']) <&> filter (not.isSpace) dots <- many (oneOf ['.', ' ']) <&> filter (not.isSpace)
return $ fromIntegral (1 + length dots) / 4 return $ fromIntegral (1 + length dots) / 4
@ -267,7 +265,7 @@ dotquantityp = do
-- ignoring any interspersed spaces after the first letter. -- ignoring any interspersed spaces after the first letter.
letterquantitiesp :: TextParser m [(Hours, TagValue)] letterquantitiesp :: TextParser m [(Hours, TagValue)]
letterquantitiesp = letterquantitiesp =
-- dbg "letterquantitiesp" $ -- dp "letterquantitiesp"
do do
letter1 <- letterChar letter1 <- letterChar
letters <- many (letterChar <|> spacenonewline) <&> filter (not.isSpace) letters <- many (letterChar <|> spacenonewline) <&> filter (not.isSpace)
@ -277,3 +275,17 @@ letterquantitiesp =
] ]
return groups return groups
-- | 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
dbgparse tracelevel "emptyorcommentlinep"
skipNonNewlineSpaces
void newline <|> void commentp
where
commentp = do
choice (map (some.char) cs)
takeWhileP Nothing (/='\n') <* newline