simonmichael/hledger
1
1
Fork 0
mirror of https://github.com/simonmichael/hledger.git synced 2024-09-19 10:17:35 +03:00
Code Issues 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 =
case
commodityStylesFromAmounts $
dbg8 "journalInferCommodityStyles using amounts" $
dbg7 "journalInferCommodityStyles using amounts" $
journalStyleInfluencingAmounts j
of
Left e -> Left e

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

@ -294,7 +294,7 @@ accountNameApplyAliases aliases a = accountNameWithPostingType atype aname'
where
(aname,atype) = (accountNameWithoutPostingType a, accountNamePostingType a)
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
aliases

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

@ -120,13 +120,13 @@ tmPostingRuleToFunction querytxt pr =
Just n -> \p ->
-- Multiply the old posting's amount by the posting rule's multiplier.
let
pramount = dbg7 "pramount" $ head $ amounts $ pamount pr
matchedamount = dbg7 "matchedamount" $ pamount p
pramount = dbg6 "pramount" $ head $ amounts $ pamount pr
matchedamount = dbg6 "matchedamount" $ pamount p
-- 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
-- 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
Mixed as = dbg7 "multipliedamount" $ n `multiplyMixedAmountAndPrice` matchedamount
Mixed as = dbg6 "multipliedamount" $ n `multiplyMixedAmountAndPrice` matchedamount
in
case acommodity pramount of
"" -> 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
let r :: Reader IO =
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
-- | 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
rawNum <- either (disambiguateNumber suggestedStyle) id <$> rawnumberp
mExp <- optional $ try $ exponentp
dbg8 "numberp suggestedStyle" suggestedStyle `seq` return ()
case dbg8 "numberp quantity,precision,mdecimalpoint,mgrps"
dbg7 "numberp suggestedStyle" suggestedStyle `seq` return ()
case dbg7 "numberp quantity,precision,mdecimalpoint,mgrps"
$ fromRawNumber rawNum mExp of
Left errMsg -> Fail.fail errMsg
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)"
Nothing -> pure ()
return $ dbg8 "rawnumberp" rawNumber
return $ dbg7 "rawnumberp" rawNumber
where
leadingDecimalPt :: TextParser m RawNumber

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

@ -684,12 +684,12 @@ readJournalFromCsv mrulesfile csvfile csvdata =
rulestext <-
if rulesfileexists
then do
dbg7IO "using conversion rules file" rulesfile
dbg6IO "using conversion rules file" rulesfile
readFilePortably rulesfile >>= expandIncludes (takeDirectory rulesfile)
else
return $ defaultRulesText rulesfile
rules <- either throwerr return $ parseAndValidateCsvRules rulesfile rulestext
dbg7IO "rules" rules
dbg6IO "rules" rules
-- parse the skip directive's value, if any
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
let parsecfilename = if csvfile == "-" then "(stdin)" else csvfile
let separator = fromMaybe ',' (getDirective "separator" rules >>= parseSeparator)
dbg7IO "separator" separator
dbg6IO "separator" separator
records <- (either throwerr id .
dbg8 "validateCsv" . validateCsv rules skiplines .
dbg8 "parseCsv")
dbg7 "validateCsv" . validateCsv rules skiplines .
dbg7 "parseCsv")
`fmap` parseCsv separator parsecfilename csvdata
dbg7IO "first 3 csv records" $ take 3 records
dbg6IO "first 3 csv records" $ take 3 records
-- identify header lines
-- let (headerlines, datalines) = identifyHeaderLines records
@ -733,8 +733,8 @@ readJournalFromCsv mrulesfile csvfile csvdata =
txns' =
(if newestfirst || mdataseemsnewestfirst == Just True then reverse else id) txns
where
newestfirst = dbg7 "newestfirst" $ isJust $ getDirective "newest-first" rules
mdataseemsnewestfirst = dbg7 "mdataseemsnewestfirst" $
newestfirst = dbg6 "newestfirst" $ isJust $ getDirective "newest-first" rules
mdataseemsnewestfirst = dbg6 "mdataseemsnewestfirst" $
case nub $ map tdate txns of
ds | length ds > 1 -> Just $ head ds > last ds
_ -> Nothing
@ -1138,7 +1138,7 @@ getEffectiveAssignment :: CsvRules -> CsvRecord -> HledgerFieldName -> Maybe Fie
getEffectiveAssignment rules record f = lastMay $ map snd $ assignments
where
-- 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
-- all top level field assignments
toplevelassignments = rassignments rules
@ -1153,18 +1153,18 @@ getEffectiveAssignment rules record f = lastMay $ map snd $ assignments
matcherMatches :: Matcher -> Bool
matcherMatches (RecordMatcher pat) = regexMatchesCI pat' wholecsvline
where
pat' = dbg8 "regex" pat
pat' = dbg7 "regex" pat
-- A synthetic whole CSV record to match against. Note, this can be
-- different from the original CSV data:
-- - any whitespace surrounding field values is preserved
-- - any quotes enclosing field values are removed
-- - and the field separator is always comma
-- 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
where
-- 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
-- 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.
let r = fromMaybe reader $ findReader Nothing (Just prefixedpath)
parser = rParser r
dbg7IO "trying reader" (rFormat r)
dbg6IO "trying reader" (rFormat r)
updatedChildj <- journalAddFile (filepath, childInput) <$>
parseIncludeFile parser initChildj filepath childInput
@ -425,7 +425,7 @@ commoditydirectiveonelinep = do
pure $ (off, amount)
lift (skipMany spacenonewline)
_ <- 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
then customFailure $ parseErrorAt off pleaseincludedecimalpoint
else modify' (\j -> j{jcommodities=M.insert acommodity comm $ jcommodities j})
@ -469,7 +469,7 @@ formatdirectivep expectedsym = do
then
if asdecimalpoint astyle == Nothing
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 $
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
Failure ei -> throwError $ show ei
Success res -> do
-- dbg7IO "raw entities" res
-- dbg6IO "raw entities" res
ejus <- liftIO $ sequence <$> mapM rawEntityInSituToJournalUpdate res
case ejus of
Left err -> throwError err
@ -106,8 +106,8 @@ rawEntityInSituToJournalUpdate RawEntityInSitu{rawEntity=RawTransactionEntity (r
, tpostings = ps -- :: [Posting], -- ^ this transaction's postings
-- tpreceding_comment_lines -- :: Text -- ^ any comment lines immediately preceding this transaction
}
dbg7IO "raw transaction" rt
dbg7IO "cooked transaction" t
dbg6IO "raw transaction" rt
dbg6IO "cooked transaction" t
return $ Right $ addTransaction t
-- TODO convert other entities
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
4 report generation
5 report generation, more detail
6 command line parsing
7 input file reading
8 input file reading, more detail
6 input file reading
7 input file reading, more detail
8 command line parsing
9 any other rarely needed / more in-depth info
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
argsaftercmd = drop 1 argsaftercmd'
dbgIO :: Show a => String -> a -> IO ()
dbgIO = ptraceAtIO 6
dbgIO = ptraceAtIO 8
dbgIO "running" prognameandversion
dbgIO "raw args" args