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

debug: move command parsing debug output down to level 8

Browse Source
This commit is contained in:
Simon Michael 2020-07-03 11:37:01 -07:00
parent 6cc896a8fe
commit 765fb732c9
10 changed files with 32 additions and 32 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
hledger-lib/Hledger/Data/Journal.hs
View File

@ -969,7 +969,7 @@ journalInferCommodityStyles :: Journal -> Either String Journal
journalInferCommodityStyles j = journalInferCommodityStyles j =
case case
commodityStylesFromAmounts $ commodityStylesFromAmounts $
dbg8 "journalInferCommodityStyles using amounts" $ dbg7 "journalInferCommodityStyles using amounts" $
journalStyleInfluencingAmounts j journalStyleInfluencingAmounts j
of of
Left e -> Left e Left e -> Left e

2
hledger-lib/Hledger/Data/Posting.hs
View File

@ -294,7 +294,7 @@ accountNameApplyAliases aliases a = accountNameWithPostingType atype aname'
where where
(aname,atype) = (accountNameWithoutPostingType a, accountNamePostingType a) (aname,atype) = (accountNameWithoutPostingType a, accountNamePostingType a)
aname' = foldl aname' = foldl
(\acct alias -> dbg7 "result" $ aliasReplace (dbg6 "alias" alias) (dbg6 "account" acct)) (\acct alias -> dbg6 "result" $ aliasReplace (dbg6 "alias" alias) (dbg6 "account" acct))
aname aname
aliases aliases

8
hledger-lib/Hledger/Data/TransactionModifier.hs
View File

@ -120,13 +120,13 @@ tmPostingRuleToFunction querytxt pr =
Just n -> \p -> Just n -> \p ->
-- Multiply the old posting's amount by the posting rule's multiplier. -- Multiply the old posting's amount by the posting rule's multiplier.
let let
pramount = dbg7 "pramount" $ head $ amounts $ pamount pr pramount = dbg6 "pramount" $ head $ amounts $ pamount pr
matchedamount = dbg7 "matchedamount" $ pamount p matchedamount = dbg6 "matchedamount" $ pamount p
-- Handle a matched amount with a total price carefully so as to keep the transaction balanced (#928). -- Handle a matched amount with a total price carefully so as to keep the transaction balanced (#928).
-- Approach 1: convert to a unit price and increase the display precision slightly -- Approach 1: convert to a unit price and increase the display precision slightly
-- Mixed as = dbg7 "multipliedamount" $ n `multiplyMixedAmount` mixedAmountTotalPriceToUnitPrice matchedamount -- Mixed as = dbg6 "multipliedamount" $ n `multiplyMixedAmount` mixedAmountTotalPriceToUnitPrice matchedamount
-- Approach 2: multiply the total price (keeping it positive) as well as the quantity -- Approach 2: multiply the total price (keeping it positive) as well as the quantity
Mixed as = dbg7 "multipliedamount" $ n `multiplyMixedAmountAndPrice` matchedamount Mixed as = dbg6 "multipliedamount" $ n `multiplyMixedAmountAndPrice` matchedamount
in in
case acommodity pramount of case acommodity pramount of
"" -> Mixed as "" -> Mixed as

2
hledger-lib/Hledger/Read.hs
View File

@ -111,7 +111,7 @@ readJournal :: InputOpts -> Maybe FilePath -> Text -> IO (Either String Journal)
readJournal iopts mpath txt = do readJournal iopts mpath txt = do
let r :: Reader IO = let r :: Reader IO =
fromMaybe JournalReader.reader $ findReader (mformat_ iopts) mpath fromMaybe JournalReader.reader $ findReader (mformat_ iopts) mpath
dbg7IO "trying reader" (rFormat r) dbg6IO "trying reader" (rFormat r)
(runExceptT . (rReadFn r) iopts (fromMaybe "(string)" mpath)) txt (runExceptT . (rReadFn r) iopts (fromMaybe "(string)" mpath)) txt
-- | Read the default journal file specified by the environment, or raise an error. -- | Read the default journal file specified by the environment, or raise an error.

6
hledger-lib/Hledger/Read/Common.hs
View File

@ -816,8 +816,8 @@ numberp suggestedStyle = label "number" $ do
sign <- signp sign <- signp
rawNum <- either (disambiguateNumber suggestedStyle) id <$> rawnumberp rawNum <- either (disambiguateNumber suggestedStyle) id <$> rawnumberp
mExp <- optional $ try $ exponentp mExp <- optional $ try $ exponentp
dbg8 "numberp suggestedStyle" suggestedStyle `seq` return () dbg7 "numberp suggestedStyle" suggestedStyle `seq` return ()
case dbg8 "numberp quantity,precision,mdecimalpoint,mgrps" case dbg7 "numberp quantity,precision,mdecimalpoint,mgrps"
$ fromRawNumber rawNum mExp of $ fromRawNumber rawNum mExp of
Left errMsg -> Fail.fail errMsg Left errMsg -> Fail.fail errMsg
Right (q, p, d, g) -> pure (sign q, p, d, g) Right (q, p, d, g) -> pure (sign q, p, d, g)
@ -930,7 +930,7 @@ rawnumberp = label "number" $ do
parseErrorAt off "invalid number (excessive trailing digits)" parseErrorAt off "invalid number (excessive trailing digits)"
Nothing -> pure () Nothing -> pure ()
return $ dbg8 "rawnumberp" rawNumber return $ dbg7 "rawnumberp" rawNumber
where where
leadingDecimalPt :: TextParser m RawNumber leadingDecimalPt :: TextParser m RawNumber

24
hledger-lib/Hledger/Read/CsvReader.hs
View File

@ -684,12 +684,12 @@ readJournalFromCsv mrulesfile csvfile csvdata =
rulestext <- rulestext <-
if rulesfileexists if rulesfileexists
then do then do
dbg7IO "using conversion rules file" rulesfile dbg6IO "using conversion rules file" rulesfile
readFilePortably rulesfile >>= expandIncludes (takeDirectory rulesfile) readFilePortably rulesfile >>= expandIncludes (takeDirectory rulesfile)
else else
return $ defaultRulesText rulesfile return $ defaultRulesText rulesfile
rules <- either throwerr return $ parseAndValidateCsvRules rulesfile rulestext rules <- either throwerr return $ parseAndValidateCsvRules rulesfile rulestext
dbg7IO "rules" rules dbg6IO "rules" rules
-- parse the skip directive's value, if any -- parse the skip directive's value, if any
let skiplines = case getDirective "skip" rules of let skiplines = case getDirective "skip" rules of
@ -701,12 +701,12 @@ readJournalFromCsv mrulesfile csvfile csvdata =
-- parsec seems to fail if you pass it "-" here TODO: try again with megaparsec -- parsec seems to fail if you pass it "-" here TODO: try again with megaparsec
let parsecfilename = if csvfile == "-" then "(stdin)" else csvfile let parsecfilename = if csvfile == "-" then "(stdin)" else csvfile
let separator = fromMaybe ',' (getDirective "separator" rules >>= parseSeparator) let separator = fromMaybe ',' (getDirective "separator" rules >>= parseSeparator)
dbg7IO "separator" separator dbg6IO "separator" separator
records <- (either throwerr id . records <- (either throwerr id .
dbg8 "validateCsv" . validateCsv rules skiplines . dbg7 "validateCsv" . validateCsv rules skiplines .
dbg8 "parseCsv") dbg7 "parseCsv")
`fmap` parseCsv separator parsecfilename csvdata `fmap` parseCsv separator parsecfilename csvdata
dbg7IO "first 3 csv records" $ take 3 records dbg6IO "first 3 csv records" $ take 3 records
-- identify header lines -- identify header lines
-- let (headerlines, datalines) = identifyHeaderLines records -- let (headerlines, datalines) = identifyHeaderLines records
@ -733,8 +733,8 @@ readJournalFromCsv mrulesfile csvfile csvdata =
txns' = txns' =
(if newestfirst || mdataseemsnewestfirst == Just True then reverse else id) txns (if newestfirst || mdataseemsnewestfirst == Just True then reverse else id) txns
where where
newestfirst = dbg7 "newestfirst" $ isJust $ getDirective "newest-first" rules newestfirst = dbg6 "newestfirst" $ isJust $ getDirective "newest-first" rules
mdataseemsnewestfirst = dbg7 "mdataseemsnewestfirst" $ mdataseemsnewestfirst = dbg6 "mdataseemsnewestfirst" $
case nub $ map tdate txns of case nub $ map tdate txns of
ds | length ds > 1 -> Just $ head ds > last ds ds | length ds > 1 -> Just $ head ds > last ds
_ -> Nothing _ -> Nothing
@ -1138,7 +1138,7 @@ getEffectiveAssignment :: CsvRules -> CsvRecord -> HledgerFieldName -> Maybe Fie
getEffectiveAssignment rules record f = lastMay $ map snd $ assignments getEffectiveAssignment rules record f = lastMay $ map snd $ assignments
where where
-- all active assignments to field f, in order -- all active assignments to field f, in order
assignments = dbg8 "assignments" $ filter ((==f).fst) $ toplevelassignments ++ conditionalassignments assignments = dbg7 "assignments" $ filter ((==f).fst) $ toplevelassignments ++ conditionalassignments
where where
-- all top level field assignments -- all top level field assignments
toplevelassignments = rassignments rules toplevelassignments = rassignments rules
@ -1153,18 +1153,18 @@ getEffectiveAssignment rules record f = lastMay $ map snd $ assignments
matcherMatches :: Matcher -> Bool matcherMatches :: Matcher -> Bool
matcherMatches (RecordMatcher pat) = regexMatchesCI pat' wholecsvline matcherMatches (RecordMatcher pat) = regexMatchesCI pat' wholecsvline
where where
pat' = dbg8 "regex" pat pat' = dbg7 "regex" pat
-- A synthetic whole CSV record to match against. Note, this can be -- A synthetic whole CSV record to match against. Note, this can be
-- different from the original CSV data: -- different from the original CSV data:
-- - any whitespace surrounding field values is preserved -- - any whitespace surrounding field values is preserved
-- - any quotes enclosing field values are removed -- - any quotes enclosing field values are removed
-- - and the field separator is always comma -- - and the field separator is always comma
-- which means that a field containing a comma will look like two fields. -- which means that a field containing a comma will look like two fields.
wholecsvline = dbg8 "wholecsvline" $ intercalate "," record wholecsvline = dbg7 "wholecsvline" $ intercalate "," record
matcherMatches (FieldMatcher csvfieldref pat) = regexMatchesCI pat csvfieldvalue matcherMatches (FieldMatcher csvfieldref pat) = regexMatchesCI pat csvfieldvalue
where where
-- the value of the referenced CSV field to match against. -- the value of the referenced CSV field to match against.
csvfieldvalue = dbg8 "csvfieldvalue" $ replaceCsvFieldReference rules record csvfieldref csvfieldvalue = dbg7 "csvfieldvalue" $ replaceCsvFieldReference rules record csvfieldref
-- | Render a field assignment's template, possibly interpolating referenced -- | Render a field assignment's template, possibly interpolating referenced
-- CSV field values. Outer whitespace is removed from interpolated values. -- CSV field values. Outer whitespace is removed from interpolated values.

6
hledger-lib/Hledger/Read/JournalReader.hs
View File

@ -296,7 +296,7 @@ includedirectivep = do
-- on journal. Duplicating readJournal a bit here. -- on journal. Duplicating readJournal a bit here.
let r = fromMaybe reader $ findReader Nothing (Just prefixedpath) let r = fromMaybe reader $ findReader Nothing (Just prefixedpath)
parser = rParser r parser = rParser r
dbg7IO "trying reader" (rFormat r) dbg6IO "trying reader" (rFormat r)
updatedChildj <- journalAddFile (filepath, childInput) <$> updatedChildj <- journalAddFile (filepath, childInput) <$>
parseIncludeFile parser initChildj filepath childInput parseIncludeFile parser initChildj filepath childInput
@ -425,7 +425,7 @@ commoditydirectiveonelinep = do
pure $ (off, amount) pure $ (off, amount)
lift (skipMany spacenonewline) lift (skipMany spacenonewline)
_ <- lift followingcommentp _ <- lift followingcommentp
let comm = Commodity{csymbol=acommodity, cformat=Just $ dbg7 "style from commodity directive" astyle} let comm = Commodity{csymbol=acommodity, cformat=Just $ dbg6 "style from commodity directive" astyle}
if asdecimalpoint astyle == Nothing if asdecimalpoint astyle == Nothing
then customFailure $ parseErrorAt off pleaseincludedecimalpoint then customFailure $ parseErrorAt off pleaseincludedecimalpoint
else modify' (\j -> j{jcommodities=M.insert acommodity comm $ jcommodities j}) else modify' (\j -> j{jcommodities=M.insert acommodity comm $ jcommodities j})
@ -469,7 +469,7 @@ formatdirectivep expectedsym = do
then then
if asdecimalpoint astyle == Nothing if asdecimalpoint astyle == Nothing
then customFailure $ parseErrorAt off pleaseincludedecimalpoint then customFailure $ parseErrorAt off pleaseincludedecimalpoint
else return $ dbg7 "style from format subdirective" astyle else return $ dbg6 "style from format subdirective" astyle
else customFailure $ parseErrorAt off $ else customFailure $ parseErrorAt off $
printf "commodity directive symbol \"%s\" and format directive symbol \"%s\" should be the same" expectedsym acommodity printf "commodity directive symbol \"%s\" and format directive symbol \"%s\" should be the same" expectedsym acommodity

6
hledger-lib/Hledger/Read/LedgerReader.hs.disabled
View File

@ -56,7 +56,7 @@ parse _mrulespath assrt path txt = do
case r of case r of
Failure ei -> throwError $ show ei Failure ei -> throwError $ show ei
Success res -> do Success res -> do
-- dbg7IO "raw entities" res -- dbg6IO "raw entities" res
ejus <- liftIO $ sequence <$> mapM rawEntityInSituToJournalUpdate res ejus <- liftIO $ sequence <$> mapM rawEntityInSituToJournalUpdate res
case ejus of case ejus of
Left err -> throwError err Left err -> throwError err
@ -106,8 +106,8 @@ rawEntityInSituToJournalUpdate RawEntityInSitu{rawEntity=RawTransactionEntity (r
, tpostings = ps -- :: [Posting], -- ^ this transaction's postings , tpostings = ps -- :: [Posting], -- ^ this transaction's postings
-- tpreceding_comment_lines -- :: Text -- ^ any comment lines immediately preceding this transaction -- tpreceding_comment_lines -- :: Text -- ^ any comment lines immediately preceding this transaction
} }
dbg7IO "raw transaction" rt dbg6IO "raw transaction" rt
dbg7IO "cooked transaction" t dbg6IO "cooked transaction" t
return $ Right $ addTransaction t return $ Right $ addTransaction t
-- TODO convert other entities -- TODO convert other entities
rawEntityInSituToJournalUpdate _ = return $ Right id rawEntityInSituToJournalUpdate _ = return $ Right id

6
hledger-lib/Hledger/Utils/Debug.hs
View File

@ -17,9 +17,9 @@ Debug level: What to show:
3 report options selection 3 report options selection
4 report generation 4 report generation
5 report generation, more detail 5 report generation, more detail
6 command line parsing 6 input file reading
7 input file reading 7 input file reading, more detail
8 input file reading, more detail 8 command line parsing
9 any other rarely needed / more in-depth info 9 any other rarely needed / more in-depth info
Tip: when debugging with GHCI, the first run after loading Debug.hs sets the Tip: when debugging with GHCI, the first run after loading Debug.hs sets the

2
hledger/Hledger/Cli/Main.hs
View File

@ -115,7 +115,7 @@ main = do
(argsbeforecmd, argsaftercmd') = break (==rawcmd) args (argsbeforecmd, argsaftercmd') = break (==rawcmd) args
argsaftercmd = drop 1 argsaftercmd' argsaftercmd = drop 1 argsaftercmd'
dbgIO :: Show a => String -> a -> IO () dbgIO :: Show a => String -> a -> IO ()
dbgIO = ptraceAtIO 6 dbgIO = ptraceAtIO 8
dbgIO "running" prognameandversion dbgIO "running" prognameandversion
dbgIO "raw args" args dbgIO "raw args" args