hledger-lib 1.25 → 1.26

raw patch · 30 files changed

+1024/−611 lines, 30 filesdep ~doclayoutPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: doclayout

API changes (from Hackage documentation)

Files

• CHANGES.md +70/−0
• Hledger/Data.hs +4/−0
• Hledger/Data/Amount.hs +3/−27
• Hledger/Data/Balancing.hs +2/−2
• Hledger/Data/Dates.hs +42/−34
• Hledger/Data/Errors.hs +100/−0
• Hledger/Data/Journal.hs +20/−29
• Hledger/Data/JournalChecks.hs +131/−0
• Hledger/Data/JournalChecks/Ordereddates.hs +59/−0
• Hledger/Data/JournalChecks/Uniqueleafnames.hs +65/−0
• Hledger/Data/PeriodicTransaction.hs +5/−5
• Hledger/Data/Posting.hs +8/−1
• Hledger/Data/Transaction.hs +11/−6
• Hledger/Data/Types.hs +2/−1
• Hledger/Data/Valuation.hs +17/−0
• Hledger/Query.hs +108/−67
• Hledger/Read.hs +72/−54
• Hledger/Read/Common.hs +37/−106
• Hledger/Read/CsvReader.hs +102/−114
• Hledger/Read/JournalReader.hs +2/−2
• Hledger/Read/TimeclockReader.hs +4/−4
• Hledger/Read/TimedotReader.hs +11/−9
• Hledger/Reports/AccountTransactionsReport.hs +6/−1
• Hledger/Reports/PostingsReport.hs +5/−0
• Hledger/Reports/ReportOptions.hs +2/−2
• Hledger/Utils.hs +17/−1
• Hledger/Utils/Parse.hs +21/−26
• Hledger/Utils/Test.hs +56/−86
• Text/Megaparsec/Custom.hs +29/−25
• hledger-lib.cabal +13/−9

@@ -9,6 +9,76 @@ Internal/api/developer-ish changes in the hledger-lib (and hledger) packages. For user-visible changes, see the hledger package changelog. +# 1.26 2022-06-04+- ;doc: update manuals++- ;cabal: update cabal files++- ;pkg: bump version to 1.26++- ;doc: update changelogs++Breaking changes++- readJournal, readJournalFile, readJournalFiles now return+  `ExceptT String IO a` instead of `IO (Either String a)`.+  Internally, this increases composability and avoids some ugly case handling.+  It means that these must now be evaluated with `runExceptT`.+  That can be imported from `Control.Monad.Except` in the `mtl` package,+  but `Hledger.Read` also re-exports it for convenience.++  New variants readJournal', readJournalFiles', readJournalFile' are+  also provided; these are like the old functions but more convenient,+  assuming default input options and needing one less argument.+  (Stephen Morgan)++- parseAndFinaliseJournal' (a variant of parseAndFinaliseJournal) has been removed. +  In the unlikely event you needed it in your code, you can replace:+  ```haskell+  parseAndFinaliseJournal' parser iopts fp t+  ```+  with:+  ```haskell+  initialiseAndParseJournal parser iopts fp t+  >>= liftEither . journalApplyAliases (aliasesFromOpts iopts)+  >>= journalFinalise iopts fp t+  ```++- Some parsers have been generalised from JournalParser to TextParser.+  (Stephen Morgan)++Misc. changes++- Allow doclayout 0.4.++- Our doctests now run with GHC 9.2+ only, to avoid doctest issues.++- Hledger.Data.JournalChecks: some Journal checks have been moved and renamed:+  journalCheckAccounts,+  journalCheckCommodities,+  journalCheckPayees+  +- Hledger.Data.Errors: new error formatting helpers+  makeTransactionErrorExcerpt,+  makePostingErrorExcerpt,+  transactionFindPostingIndex++- HledgerParseErrors is a new type alias for our parse errors.+  CustomErr has been renamed to HledgerParseErrorData.++- Hledger.Query: added+  matchesQuery,+  queryIsCode,+  queryIsTransactionRelated++- Improve ergonomics of SmartDate constructors. +  (Stephen Morgan)++- Hledger.Utils: Add a helper function numDigitsInt to get the number+  of digits in an integer, which has a surprising number of ways to+  get it wrong.+  ([#1813](https://github.com/simonmichael/hledger/issues/1813) (Stephen Morgan)+ # 1.25 2022-03-04  - hledger-lib now builds with GHC 9.2 and latest deps. 

@@ -14,7 +14,9 @@                module Hledger.Data.Amount,                module Hledger.Data.Balancing,                module Hledger.Data.Dates,+               module Hledger.Data.Errors,                module Hledger.Data.Journal,+               module Hledger.Data.JournalChecks,                module Hledger.Data.Json,                module Hledger.Data.Ledger,                module Hledger.Data.Period,@@ -37,7 +39,9 @@ import Hledger.Data.Amount import Hledger.Data.Balancing import Hledger.Data.Dates+import Hledger.Data.Errors import Hledger.Data.Journal+import Hledger.Data.JournalChecks import Hledger.Data.Json import Hledger.Data.Ledger import Hledger.Data.Period

@@ -67,7 +67,6 @@   amountLooksZero,   divideAmount,   multiplyAmount,-  amountTotalPriceToUnitPrice,   -- ** rendering   AmountDisplayOpts(..),   noColour,@@ -125,7 +124,6 @@   maIsZero,   maIsNonZero,   mixedAmountLooksZero,-  mixedAmountTotalPriceToUnitPrice,   -- ** rendering   styleMixedAmount,   mixedAmountUnstyled,@@ -171,7 +169,7 @@ import Test.Tasty.HUnit ((@?=), assertBool, testCase)  import Hledger.Data.Types-import Hledger.Utils (colorB)+import Hledger.Utils (colorB, numDigitsInt) import Hledger.Utils.Text (textQuoteIfNeeded) import Text.WideString (WideBuilder(..), wbFromText, wbToText, wbUnpack) @@ -312,22 +310,6 @@       Just (UnitPrice  p@Amount{aquantity=pq}) -> p{aquantity=pq * q}       Just (TotalPrice p@Amount{aquantity=pq}) -> p{aquantity=pq} --- | Replace an amount's TotalPrice, if it has one, with an equivalent UnitPrice.--- Has no effect on amounts without one.--- Also increases the unit price's display precision to show one extra decimal place,--- to help keep transaction amounts balancing.--- Does Decimal division, might be some rounding/irrational number issues.-amountTotalPriceToUnitPrice :: Amount -> Amount-amountTotalPriceToUnitPrice-    a@Amount{aquantity=q, aprice=Just (TotalPrice pa@Amount{aquantity=pq, astyle=ps})}-    = a{aprice = Just $ UnitPrice pa{aquantity=abs (pq/q), astyle=ps{asprecision=pp}}}-  where-    -- Increase the precision by 1, capping at the max bound.-    pp = case asprecision ps of-                NaturalPrecision -> NaturalPrecision-                Precision p      -> Precision $ if p == maxBound then maxBound else p + 1-amountTotalPriceToUnitPrice a = a- -- | Apply a function to an amount's quantity (and its total price, if it has one). transformAmount :: (Quantity -> Quantity) -> Amount -> Amount transformAmount f a@Amount{aquantity=q,aprice=p} = a{aquantity=f q, aprice=f' <$> p}@@ -950,8 +932,8 @@   | otherwise = Nothing   where     fullString = T.pack $ show n ++ " more.."-    -- sep from the separator, 7 from " more..", 1 + floor (logBase 10 n) from number-    fullLength = sep + 8 + floor (logBase 10 $ fromIntegral n)+    -- sep from the separator, 7 from " more..", numDigits n from number+    fullLength = sep + 7 + numDigitsInt n      str | Just m <- mmax, fullLength > m = T.take (m - 2) fullString <> ".."         | otherwise                      = fullString@@ -984,12 +966,6 @@ -- | Canonicalise a mixed amount's display styles using the provided commodity style map. canonicaliseMixedAmount :: M.Map CommoditySymbol AmountStyle -> MixedAmount -> MixedAmount canonicaliseMixedAmount styles = mapMixedAmountUnsafe (canonicaliseAmount styles)---- | Replace each component amount's TotalPrice, if it has one, with an equivalent UnitPrice.--- Has no effect on amounts without one.--- Does Decimal division, might be some rounding/irrational number issues.-mixedAmountTotalPriceToUnitPrice :: MixedAmount -> MixedAmount-mixedAmountTotalPriceToUnitPrice = mapMixedAmount amountTotalPriceToUnitPrice   -------------------------------------------------------------------------------

@@ -169,7 +169,7 @@  annotateErrorWithTransaction :: Transaction -> String -> String annotateErrorWithTransaction t s =-  unlines [ showSourcePosPair $ tsourcepos t, s+  unlines [ sourcePosPairPretty $ tsourcepos t, s           , T.unpack . T.stripEnd $ showTransaction t           ] @@ -586,7 +586,7 @@       (case ptransaction p of          Nothing -> "?" -- shouldn't happen          Just t ->  printf "%s\ntransaction:\n%s"-                      (showSourcePos pos)+                      (sourcePosPretty pos)                       (textChomp $ showTransaction t)                       :: String                       where

@@ -1,7 +1,6 @@ {-# LANGUAGE FlexibleContexts    #-} {-# LANGUAGE NoMonoLocalBinds    #-} {-# LANGUAGE OverloadedStrings   #-}-{-# LANGUAGE PackageImports      #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TupleSections       #-} {-# LANGUAGE TypeFamilies        #-}@@ -106,7 +105,7 @@ import Text.Megaparsec import Text.Megaparsec.Char (char, char', digitChar, string, string') import Text.Megaparsec.Char.Lexer (decimal, signed)-import Text.Megaparsec.Custom (customErrorBundlePretty)+import Text.Megaparsec.Custom (customErrorBundlePretty, HledgerParseErrors) import Text.Printf (printf)  import Hledger.Data.Types@@ -361,7 +360,7 @@ -- | Parse a period expression to an Interval and overall DateSpan using -- the provided reference date, or return a parse error. parsePeriodExpr-  :: Day -> Text -> Either (ParseErrorBundle Text CustomErr) (Interval, DateSpan)+  :: Day -> Text -> Either HledgerParseErrors (Interval, DateSpan) parsePeriodExpr refdate s = parsewith (periodexprp refdate <* eof) (T.toLower s)  -- | Like parsePeriodExpr, but call error' on failure.@@ -390,16 +389,16 @@       (ry,rm,_) = toGregorian refdate       (b,e) = span sdate       span :: SmartDate -> (Day,Day)-      span (SmartRelative n Day)                    = (addDays n refdate, addDays (n+1) refdate)-      span (SmartRelative n Week)                   = let d = thisweek refdate in (addDays (7*n) d, addDays (7*n+7) d)-      span (SmartRelative n Month)                  = let d = thismonth refdate in (addGregorianMonthsClip n d, addGregorianMonthsClip (n+1) d)-      span (SmartRelative n Quarter)                = let d = thisquarter refdate in (addGregorianMonthsClip (3*n) d, addGregorianMonthsClip (3*n+3) d)-      span (SmartRelative n Year)                   = let d = thisyear refdate in (addGregorianYearsClip n d, addGregorianYearsClip (n+1) d)-      span (SmartAssumeStart y Nothing)             = (startofyear day, nextyear day) where day = fromGregorian y 1 1-      span (SmartAssumeStart y (Just (m, Nothing))) = (startofmonth day, nextmonth day) where day = fromGregorian y m 1-      span (SmartAssumeStart y (Just (m, Just d)))  = (day, nextday day) where day = fromGregorian y m d-      span (SmartFromReference m d)                 = (day, nextday day) where day = fromGregorian ry (fromMaybe rm m) d-      span (SmartMonth m)                           = (startofmonth day, nextmonth day) where day = fromGregorian ry m 1+      span (SmartCompleteDate day)       = (day, nextday day)+      span (SmartAssumeStart y Nothing)  = (startofyear day, nextyear day) where day = fromGregorian y 1 1+      span (SmartAssumeStart y (Just m)) = (startofmonth day, nextmonth day) where day = fromGregorian y m 1+      span (SmartFromReference m d)      = (day, nextday day) where day = fromGregorian ry (fromMaybe rm m) d+      span (SmartMonth m)                = (startofmonth day, nextmonth day) where day = fromGregorian ry m 1+      span (SmartRelative n Day)         = (addDays n refdate, addDays (n+1) refdate)+      span (SmartRelative n Week)        = (addDays (7*n) d, addDays (7*n+7) d) where d = thisweek refdate+      span (SmartRelative n Month)       = (addGregorianMonthsClip n d, addGregorianMonthsClip (n+1) d) where d = thismonth refdate+      span (SmartRelative n Quarter)     = (addGregorianMonthsClip (3*n) d, addGregorianMonthsClip (3*n+3) d) where d = thisquarter refdate+      span (SmartRelative n Year)        = (addGregorianYearsClip n d, addGregorianYearsClip (n+1) d) where d = thisyear refdate  -- showDay :: Day -> String -- showDay day = printf "%04d/%02d/%02d" y m d where (y,m,d) = toGregorian day@@ -409,14 +408,14 @@ fixSmartDateStr :: Day -> Text -> Text fixSmartDateStr d s =   either (error' . printf "could not parse date %s %s" (show s) . show) id $  -- PARTIAL:-  (fixSmartDateStrEither d s :: Either (ParseErrorBundle Text CustomErr) Text)+  (fixSmartDateStrEither d s :: Either HledgerParseErrors Text)  -- | A safe version of fixSmartDateStr.-fixSmartDateStrEither :: Day -> Text -> Either (ParseErrorBundle Text CustomErr) Text+fixSmartDateStrEither :: Day -> Text -> Either HledgerParseErrors Text fixSmartDateStrEither d = fmap showDate . fixSmartDateStrEither' d  fixSmartDateStrEither'-  :: Day -> Text -> Either (ParseErrorBundle Text CustomErr) Day+  :: Day -> Text -> Either HledgerParseErrors Day fixSmartDateStrEither' d s = case parsewith smartdateonly (T.toLower s) of                                Right sd -> Right $ fixSmartDate d sd                                Left e -> Left e@@ -508,14 +507,15 @@ fixSmartDate refdate = fix   where     fix :: SmartDate -> Day+    fix (SmartCompleteDate d)     = d+    fix (SmartAssumeStart y m)    = fromGregorian y (fromMaybe 1 m) 1+    fix (SmartFromReference m d)  = fromGregorian ry (fromMaybe rm m) d+    fix (SmartMonth m)            = fromGregorian ry m 1     fix (SmartRelative n Day)     = addDays n refdate     fix (SmartRelative n Week)    = addDays (7*n) $ thisweek refdate     fix (SmartRelative n Month)   = addGregorianMonthsClip n $ thismonth refdate     fix (SmartRelative n Quarter) = addGregorianMonthsClip (3*n) $ thisquarter refdate     fix (SmartRelative n Year)    = addGregorianYearsClip n $ thisyear refdate-    fix (SmartAssumeStart y md)   = fromGregorian y (maybe 1 fst md) (fromMaybe 1 $ snd =<< md)-    fix (SmartFromReference m d)  = fromGregorian ry (fromMaybe rm m) d-    fix (SmartMonth m)            = fromGregorian ry m 1     (ry, rm, _) = toGregorian refdate  prevday :: Day -> Day@@ -673,8 +673,8 @@ -- -- | Parse a couple of date-time string formats to a time type. -- parsedatetimeM :: String -> Maybe LocalTime -- parsedatetimeM s = asum [---     parseTime defaultTimeLocale "%Y/%m/%d %H:%M:%S" s,---     parseTime defaultTimeLocale "%Y-%m-%d %H:%M:%S" s+--     parseTimeM TruedefaultTimeLocale "%Y/%m/%d %H:%M:%S" s,+--     parseTimeM TruedefaultTimeLocale "%Y-%m-%d %H:%M:%S" s --     ]  -- | Try to parse a couple of date string formats:@@ -725,11 +725,11 @@ YYYYMMDD is parsed as year-month-date if those parts are valid (>=4 digits, 1-12, and 1-31 respectively): >>> parsewith (smartdate <* eof) "20181201"-Right (SmartAssumeStart 2018 (Just (12,Just 1)))+Right (SmartCompleteDate 2018-12-01)  YYYYMM is parsed as year-month-01 if year and month are valid: >>> parsewith (smartdate <* eof) "201804"-Right (SmartAssumeStart 2018 (Just (4,Nothing)))+Right (SmartAssumeStart 2018 (Just 4))  With an invalid month, it's parsed as a year: >>> parsewith (smartdate <* eof) "201813"@@ -788,31 +788,39 @@ failIfInvalidDate :: Fail.MonadFail m => SmartDate -> m SmartDate failIfInvalidDate s = unless isValid (Fail.fail $ "bad smart date: " ++ show s) $> s   where isValid = case s of-            SmartAssumeStart y (Just (m, md)) -> isJust $ fromGregorianValid y m (fromMaybe 1 md)-            SmartFromReference mm d           -> isJust $ fromGregorianValid 2004 (fromMaybe 1 mm) d-            SmartMonth m                      -> validMonth m-            _                                 -> True+            SmartAssumeStart _ (Just m) -> validMonth m+            SmartFromReference mm d     -> isJust $ fromGregorianValid 2004 (fromMaybe 1 mm) d+            SmartMonth m                -> validMonth m+            _                           -> True +showBadDate :: Integer -> Int -> Int -> String+showBadDate y m d = "bad smart date: " ++ show y ++ "-" ++ show m ++ "-" ++ show d+ yyyymmdd :: TextParser m SmartDate yyyymmdd = do   y <- read <$> count 4 digitChar   m <- read <$> count 2 digitChar-  d <- optional $ read <$> count 2 digitChar-  let date = SmartAssumeStart y $ Just (m, d)-  failIfInvalidDate date+  md <- optional $ read <$> count 2 digitChar+  case md of+      Nothing -> failIfInvalidDate $ SmartAssumeStart y (Just m)+      Just d  -> maybe (Fail.fail $ showBadDate y m d) (return . SmartCompleteDate) $+                   fromGregorianValid y m d  ymd :: TextParser m SmartDate ymd = do     y <- yearp-    fmap (SmartAssumeStart y) . optional . try $ do+    emd <- optional . try $ do         sep <- datesepchar         m <- decimal         unless (validMonth m) $ Fail.fail ("Bad month " <> show m)-        fmap (m,) . optional . try $ do+        option (Left m) . try $ Right <$> do             _ <- char sep             d <- decimal-            failIfInvalidDate $ SmartAssumeStart y (Just (m, Just d))-            return d+            maybe (Fail.fail $ showBadDate y m d) return $ fromGregorianValid y m d+    return $ case emd of+        Nothing          -> SmartAssumeStart y Nothing+        Just (Left m)    -> SmartAssumeStart y (Just m)+        Just (Right day) -> SmartCompleteDate day  md :: TextParser m (Month, MonthDay) md = do

@@ -0,0 +1,100 @@+{-|+Helpers for making error messages.+-}++{-# LANGUAGE OverloadedStrings #-}++module Hledger.Data.Errors (+  makeTransactionErrorExcerpt,+  makePostingErrorExcerpt,+  transactionFindPostingIndex,+)+where++import Data.Function ((&))+import Data.List (find)+import Data.Text (Text)+import qualified Data.Text as T++import Hledger.Data.Transaction (showTransaction)+import Hledger.Data.Types+import Hledger.Utils++-- | Given a problem transaction and a function calculating the best+-- column(s) for marking the error region:+-- render it as a megaparsec-style excerpt, showing the original line number+-- on the transaction line, and a column(s) marker.+-- Returns the file path, line number, column(s) if known,+-- and the rendered excerpt, or as much of these as is possible.+makeTransactionErrorExcerpt :: Transaction -> (Transaction -> Maybe (Int, Maybe Int)) -> (FilePath, Int, Maybe (Int, Maybe Int), Text)+makeTransactionErrorExcerpt t findtxnerrorcolumns = (f, tl, merrcols, ex)+  -- XXX findtxnerrorcolumns is awkward, I don't think this is the final form+  where+    (SourcePos f tpos _) = fst $ tsourcepos t+    tl = unPos tpos+    txntxt = showTransaction t & textChomp & (<>"\n")+    merrcols = findtxnerrorcolumns t+    ex = decorateTransactionErrorExcerpt tl merrcols txntxt++-- | Add megaparsec-style left margin, line number, and optional column marker(s).+decorateTransactionErrorExcerpt :: Int -> Maybe (Int, Maybe Int) -> Text -> Text+decorateTransactionErrorExcerpt l mcols txt =+  T.unlines $ ls' <> colmarkerline <> map (lineprefix<>) ms+  where+    (ls,ms) = splitAt 1 $ T.lines txt+    ls' = map ((T.pack (show l) <> " | ") <>) ls+    colmarkerline =+      [lineprefix <> T.replicate (col-1) " " <> T.replicate regionw "^"+      | Just (col, mendcol) <- [mcols]+      , let regionw = maybe 1 (subtract col) mendcol + 1+      ]+    lineprefix = T.replicate marginw " " <> "| "+      where  marginw = length (show l) + 1++-- | Given a problem posting and a function calculating the best+-- column(s) for marking the error region:+-- look up error info from the parent transaction, and render the transaction+-- as a megaparsec-style excerpt, showing the original line number+-- on the problem posting's line, and a column indicator.+-- Returns the file path, line number, column(s) if known,+-- and the rendered excerpt, or as much of these as is possible.+makePostingErrorExcerpt :: Posting -> (Posting -> Transaction -> Text -> Maybe (Int, Maybe Int)) -> (FilePath, Int, Maybe (Int, Maybe Int), Text)+makePostingErrorExcerpt p findpostingerrorcolumns =+  case ptransaction p of+    Nothing -> ("-", 0, Nothing, "")+    Just t  -> (f, errabsline, merrcols, ex)+      where+        (SourcePos f tl _) = fst $ tsourcepos t+        tcommentlines = max 0 (length (T.lines $ tcomment t) - 1)+        mpindex = transactionFindPostingIndex (==p) t+        errrelline = maybe 0 (tcommentlines+) mpindex   -- XXX doesn't count posting coment lines+        errabsline = unPos tl + errrelline+        txntxt = showTransaction t & textChomp & (<>"\n")+        merrcols = findpostingerrorcolumns p t txntxt+        ex = decoratePostingErrorExcerpt errabsline errrelline merrcols txntxt++-- | Add megaparsec-style left margin, line number, and optional column marker(s).+decoratePostingErrorExcerpt :: Int -> Int -> Maybe (Int, Maybe Int) -> Text -> Text+decoratePostingErrorExcerpt absline relline mcols txt =+  T.unlines $ js' <> ks' <> colmarkerline <> ms'+  where+    (ls,ms) = splitAt (relline+1) $ T.lines txt+    (js,ks) = splitAt (length ls - 1) ls+    (js',ks') = case ks of+      [k] -> (map (lineprefix<>) js, [T.pack (show absline) <> " | " <> k])+      _   -> ([], [])+    ms' = map (lineprefix<>) ms+    colmarkerline =+      [lineprefix <> T.replicate (col-1) " " <> T.replicate regionw "^"+      | Just (col, mendcol) <- [mcols]+      , let regionw = 1 + maybe 0 (subtract col) mendcol+      ]+    lineprefix = T.replicate marginw " " <> "| "+      where  marginw = length (show absline) + 1++-- | Find the 1-based index of the first posting in this transaction+-- satisfying the given predicate.+transactionFindPostingIndex :: (Posting -> Bool) -> Transaction -> Maybe Int+transactionFindPostingIndex ppredicate = +  fmap fst . find (ppredicate.snd) . zip [1..] . tpostings+

@@ -142,13 +142,13 @@   -- | A parser of text that runs in some monad, keeping a Journal as state.-type JournalParser m a = StateT Journal (ParsecT CustomErr Text m) a+type JournalParser m a = StateT Journal (ParsecT HledgerParseErrorData Text m) a  -- | A parser of text that runs in some monad, keeping a Journal as -- state, that can throw an exception to end parsing, preventing -- further parser backtracking. type ErroringJournalParser m a =-  StateT Journal (ParsecT CustomErr Text (ExceptT FinalParseError m)) a+  StateT Journal (ParsecT HledgerParseErrorData Text (ExceptT FinalParseError m)) a  -- deriving instance Show Journal instance Show Journal where@@ -428,6 +428,8 @@ letterPairs (a:b:rest) = [a,b] : letterPairs (b:rest) letterPairs _ = [] +-- Older account type code+ -- queries for standard account types  -- | Get a query for accounts of the specified types in this journal. @@ -538,7 +540,7 @@     . M.findWithDefault [] Conversion     . jdeclaredaccounttypes --- Newer account type functionality.+-- Newer account type code.  journalAccountType :: Journal -> AccountName -> Maybe AccountType journalAccountType Journal{jaccounttypes} = accountNameType jaccounttypes@@ -553,19 +555,21 @@ journalAccountTypes j = M.fromList [(a,acctType) | (a, Just (acctType,_)) <- flatten t']   where     t = accountNameTreeFrom $ journalAccountNames j :: Tree AccountName-    t' = settypes Nothing t :: Tree (AccountName, Maybe (AccountType, Bool))     -- Map from the top of the account tree down to the leaves, propagating     -- account types downward. Keep track of whether the account is declared     -- (True), in which case the parent account should be preferred, or merely     -- inferred (False), in which case the inferred type should be preferred.-    settypes :: Maybe (AccountType, Bool) -> Tree AccountName -> Tree (AccountName, Maybe (AccountType, Bool))-    settypes mparenttype (Node a subs) = Node (a, mtype) (map (settypes mtype) subs)+    t' = settypes Nothing t :: Tree (AccountName, Maybe (AccountType, Bool))       where-        mtype = M.lookup a declaredtypes <|> minferred-        minferred = if maybe False snd mparenttype-                       then mparenttype-                       else (,False) <$> accountNameInferType a <|> mparenttype-    declaredtypes = (,True) <$> journalDeclaredAccountTypes j+        settypes :: Maybe (AccountType, Bool) -> Tree AccountName -> Tree (AccountName, Maybe (AccountType, Bool))+        settypes mparenttype (Node a subs) = Node (a, mtype) (map (settypes mtype) subs)+          where+            mtype = M.lookup a declaredtypes <|> minferred+              where +                declaredtypes = (,True) <$> journalDeclaredAccountTypes j+                minferred = if maybe False snd mparenttype+                            then mparenttype+                            else (,False) <$> accountNameInferType a <|> mparenttype  -- | Build a map of the account types explicitly declared. journalDeclaredAccountTypes :: Journal -> M.Map AccountName AccountType@@ -926,26 +930,12 @@ journalInferMarketPricesFromTransactions :: Journal -> Journal journalInferMarketPricesFromTransactions j =   j{jinferredmarketprices =-       dbg4 "jinferredmarketprices" $-       mapMaybe postingInferredmarketPrice $ journalPostings j+       dbg4 "jinferredmarketprices" .+       map priceDirectiveToMarketPrice .+       concatMap postingPriceDirectivesFromCost $+       journalPostings j    } --- | Make a market price equivalent to this posting's amount's unit--- price, if any. If the posting amount is multicommodity, only the--- first commodity amount is considered.-postingInferredmarketPrice :: Posting -> Maybe MarketPrice-postingInferredmarketPrice p@Posting{pamount} =-    -- convert any total prices to unit prices-    case amountsRaw $ mixedAmountTotalPriceToUnitPrice pamount of-      Amount{acommodity=fromcomm, aprice = Just (UnitPrice Amount{acommodity=tocomm, aquantity=rate})}:_ ->-        Just MarketPrice {-           mpdate = postingDate p-          ,mpfrom = fromcomm-          ,mpto   = tocomm-          ,mprate = rate-          }-      _ -> Nothing- -- | Convert all this journal's amounts to cost using the transaction prices, if any. -- The journal's commodity styles are applied to the resulting amounts. journalToCost :: ConversionOp -> Journal -> Journal@@ -1111,6 +1101,7 @@       | Just t <- ptransaction p, fieldortagname == "description" = tdescription t       | Just t <- ptransaction p, fieldortagname == "payee"       = transactionPayee t       | Just t <- ptransaction p, fieldortagname == "note"        = transactionNote t+      | Just t <- ptransaction p, fieldortagname == "status"      = T.pack . show . tstatus $ t       | Just (_, value) <- postingFindTag fieldortagname p        = value       | otherwise                                                 = "" 

@@ -0,0 +1,131 @@+{-|+Various additional validation checks that can be performed on a Journal.+Some are called as part of reading a file in strict mode,+others can be called only via the check command.+-}++{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE NamedFieldPuns #-}++module Hledger.Data.JournalChecks (+  journalCheckAccounts,+  journalCheckCommodities,+  journalCheckPayees,+  module Hledger.Data.JournalChecks.Ordereddates,+  module Hledger.Data.JournalChecks.Uniqueleafnames,+)+where++import Data.Char (isSpace)+import Data.List (find)+import Data.Maybe+import qualified Data.Map.Strict as M+import qualified Data.Text as T+import Safe (atMay)+import Text.Printf (printf)++import Hledger.Data.Errors+import Hledger.Data.Journal+import Hledger.Data.JournalChecks.Ordereddates+import Hledger.Data.JournalChecks.Uniqueleafnames+import Hledger.Data.Posting (isVirtual)+import Hledger.Data.Types+import Hledger.Data.Amount (amountIsZero, amountsRaw, missingamt)+import Hledger.Data.Transaction (transactionPayee, showTransactionLineFirstPart)++-- | Check that all the journal's postings are to accounts  with+-- account directives, returning an error message otherwise.+journalCheckAccounts :: Journal -> Either String ()+journalCheckAccounts j = mapM_ checkacct (journalPostings j)+  where+    checkacct p@Posting{paccount=a}+      | a `elem` journalAccountNamesDeclared j = Right ()+      | otherwise = Left $ +        printf "%s:%d:%d-%d:\n%sundeclared account \"%s\"\n" f l col col2 ex a+        where+          (f,l,mcols,ex) = makePostingErrorExcerpt p finderrcols+          col  = maybe 0 fst mcols+          col2 = maybe 0 (fromMaybe 0 . snd) mcols+          finderrcols p _ _ = Just (col, Just col2)+            where+              col = 5 + if isVirtual p then 1 else 0+              col2 = col + T.length a - 1++-- | Check that all the commodities used in this journal's postings have been declared+-- by commodity directives, returning an error message otherwise.+journalCheckCommodities :: Journal -> Either String ()+journalCheckCommodities j = mapM_ checkcommodities (journalPostings j)+  where+    checkcommodities p =+      case findundeclaredcomm p of+        Nothing -> Right ()+        Just (comm, _) ->+          Left $ printf "%s:%d:%d-%d:\n%sundeclared commodity \"%s\"\n" f l col col2 ex comm+          where+            (f,l,mcols,ex) = makePostingErrorExcerpt p finderrcols+            col  = maybe 0 fst mcols+            col2 = maybe 0 (fromMaybe 0 . snd) mcols+      where+        -- Find the first undeclared commodity symbol in this posting's amount+        -- or balance assertion amount, if any. The boolean will be true if+        -- the undeclared symbol was in the posting amount.+        findundeclaredcomm :: Posting -> Maybe (CommoditySymbol, Bool)+        findundeclaredcomm Posting{pamount=amt,pbalanceassertion} =+          case (findundeclared postingcomms, findundeclared assertioncomms) of+            (Just c, _) -> Just (c, True)+            (_, Just c) -> Just (c, False)+            _           -> Nothing+          where+            postingcomms = map acommodity $ filter (not . isIgnorable) $ amountsRaw amt+              where+                -- Ignore missing amounts and zero amounts without commodity (#1767)+                isIgnorable a = (T.null (acommodity a) && amountIsZero a) || a == missingamt+            assertioncomms = [acommodity a | Just a <- [baamount <$> pbalanceassertion]]+            findundeclared = find (`M.notMember` jcommodities j)++        -- Find the best position for an error column marker when this posting+        -- is rendered by showTransaction.+        -- Reliably locating a problem commodity symbol in showTransaction output+        -- is really tricky. Some examples:+        --+        --     assets      "C $" -1 @ $ 2+        --                            ^+        --     assets      $1 = $$1+        --                      ^+        --     assets   [ANSI RED]$-1[ANSI RESET]+        --              ^+        --+        -- To simplify, we will mark the whole amount + balance assertion region, like:+        --     assets      "C $" -1 @ $ 2+        --                 ^^^^^^^^^^^^^^+        -- XXX refine this region when it's easy+        finderrcols p t txntxt =+          case transactionFindPostingIndex (==p) t of+            Nothing     -> Nothing+            Just pindex -> Just (amtstart, Just amtend)+              where+                tcommentlines = max 0 (length (T.lines $ tcomment t) - 1)+                errrelline = 1 + tcommentlines + pindex   -- XXX doesn't count posting coment lines+                errline = fromMaybe "" (T.lines txntxt `atMay` (errrelline-1))+                acctend = 4 + T.length (paccount p) + if isVirtual p then 2 else 0+                amtstart = acctend + (T.length $ T.takeWhile isSpace $ T.drop acctend errline) + 1+                amtend = amtstart + (T.length $ T.stripEnd $ T.takeWhile (/=';') $ T.drop amtstart errline)++-- | Check that all the journal's transactions have payees declared with+-- payee directives, returning an error message otherwise.+journalCheckPayees :: Journal -> Either String ()+journalCheckPayees j = mapM_ checkpayee (jtxns j)+  where+    checkpayee t+      | payee `elem` journalPayeesDeclared j = Right ()+      | otherwise = Left $+        printf "%s:%d:%d-%d:\n%sundeclared payee \"%s\"\n" f l col col2 ex payee+      where+        payee = transactionPayee t+        (f,l,mcols,ex) = makeTransactionErrorExcerpt t finderrcols+        col  = maybe 0 fst mcols+        col2 = maybe 0 (fromMaybe 0 . snd) mcols+        finderrcols t = Just (col, Just col2)+          where+            col = T.length (showTransactionLineFirstPart t) + 2+            col2 = col + T.length (transactionPayee t) - 1

@@ -0,0 +1,59 @@+module Hledger.Data.JournalChecks.Ordereddates (+  journalCheckOrdereddates+)+where++import Control.Monad (forM)+import Data.List (groupBy)+import Text.Printf (printf)+import Data.Maybe (fromMaybe)++import Hledger.Data.Errors (makeTransactionErrorExcerpt)+import Hledger.Data.Transaction (transactionFile, transactionDateOrDate2)+import Hledger.Data.Types++journalCheckOrdereddates :: WhichDate -> Journal -> Either String ()+journalCheckOrdereddates whichdate j = do+  let +    -- we check date ordering within each file, not across files+    -- note, relying on txns always being sorted by file here+    txnsbyfile = groupBy (\t1 t2 -> transactionFile t1 == transactionFile t2) $ jtxns j+    getdate = transactionDateOrDate2 whichdate+    compare a b = getdate a <= getdate b+  either Left (const $ Right ()) $ +   forM txnsbyfile $ \ts ->+    case checkTransactions compare ts of+      FoldAcc{fa_previous=Nothing} -> Right ()+      FoldAcc{fa_error=Nothing}    -> Right ()+      FoldAcc{fa_error=Just t, fa_previous=Just tprev} -> Left $ printf+        "%s:%d:%d-%d:\n%stransaction date%s is out of order with previous transaction date %s" +        f l col col2 ex datenum tprevdate+        where+          (f,l,mcols,ex) = makeTransactionErrorExcerpt t finderrcols+          col  = maybe 0 fst mcols+          col2 = maybe 0 (fromMaybe 0 . snd) mcols+          finderrcols _t = Just (1, Just 10)+          datenum   = if whichdate==SecondaryDate then "2" else ""+          tprevdate = show $ getdate tprev++data FoldAcc a b = FoldAcc+ { fa_error    :: Maybe a+ , fa_previous :: Maybe b+ }++checkTransactions :: (Transaction -> Transaction -> Bool)+  -> [Transaction] -> FoldAcc Transaction Transaction+checkTransactions compare = foldWhile f FoldAcc{fa_error=Nothing, fa_previous=Nothing}+  where+    f current acc@FoldAcc{fa_previous=Nothing} = acc{fa_previous=Just current}+    f current acc@FoldAcc{fa_previous=Just previous} =+      if compare previous current+      then acc{fa_previous=Just current}+      else acc{fa_error=Just current}++foldWhile :: (a -> FoldAcc a b -> FoldAcc a b) -> FoldAcc a b -> [a] -> FoldAcc a b+foldWhile _ acc [] = acc+foldWhile fold acc (a:as) =+  case fold a acc of+   acc@FoldAcc{fa_error=Just _} -> acc+   acc -> foldWhile fold acc as

@@ -0,0 +1,65 @@+{-# LANGUAGE NamedFieldPuns    #-}+{-# LANGUAGE OverloadedStrings #-}++module Hledger.Data.JournalChecks.Uniqueleafnames (+  journalCheckUniqueleafnames+)+where++import Data.Function (on)+import Data.List (groupBy, sortBy)+import Data.Text (Text)+import qualified Data.Text as T+import Text.Printf (printf)+import Data.Maybe (fromMaybe)++import Hledger.Data.AccountName (accountLeafName)+import Hledger.Data.Errors (makePostingErrorExcerpt)+import Hledger.Data.Journal (journalPostings, journalAccountNamesUsed)+import Hledger.Data.Posting (isVirtual)+import Hledger.Data.Types++-- | Check that all the journal's postings are to accounts with a unique leaf name.+-- Otherwise, return an error message for the first offending posting.+journalCheckUniqueleafnames :: Journal -> Either String ()+journalCheckUniqueleafnames j = do+  -- find all duplicate leafnames, and the full account names they appear in+  case finddupes $ journalLeafAndFullAccountNames j of+    [] -> Right ()+    dupes ->+      -- report the first posting that references one of them (and its position), for now+      mapM_ (checkposting dupes) $ journalPostings j++finddupes :: (Ord leaf, Eq full) => [(leaf, full)] -> [(leaf, [full])]+finddupes leafandfullnames = zip dupLeafs dupAccountNames+  where dupLeafs = map (fst . head) d+        dupAccountNames = map (map snd) d+        d = dupes' leafandfullnames+        dupes' = filter ((> 1) . length)+          . groupBy ((==) `on` fst)+          . sortBy (compare `on` fst)++journalLeafAndFullAccountNames :: Journal -> [(Text, AccountName)]+journalLeafAndFullAccountNames = map leafAndAccountName . journalAccountNamesUsed+  where leafAndAccountName a = (accountLeafName a, a)++checkposting :: [(Text,[AccountName])] -> Posting -> Either String ()+checkposting leafandfullnames p@Posting{paccount=a} =+  case [lf | lf@(_,fs) <- leafandfullnames, a `elem` fs] of+    []             -> Right ()+    (leaf,fulls):_ -> Left $ printf+      "%s:%d:%d-%d:\n%saccount leaf name \"%s\" is not unique\nit is used in account names: %s" +      f l col col2 ex leaf accts+      where+        -- t = fromMaybe nulltransaction ptransaction  -- XXX sloppy+        col  = maybe 0 fst mcols+        col2 = maybe 0 (fromMaybe 0 . snd) mcols+        (f,l,mcols,ex) = makePostingErrorExcerpt p finderrcols+          where+            finderrcols p _ _ = Just (col, Just col2)+              where+                alen = T.length $ paccount p+                llen = T.length $ accountLeafName a+                col = 5 + (if isVirtual p then 1 else 0) + alen - llen+                col2 = col + llen - 1+        accts = T.intercalate ", " $ map (("\""<>).(<>"\"")) fulls

@@ -189,20 +189,20 @@ -- <BLANKLINE> -- -- >>> _ptgen ""--- *** Exception: failed to parse...+-- *** Exception: Error: failed to parse... -- ... -- -- >>> _ptgen "weekly from 2017"--- *** Exception: Unable to generate transactions according to "weekly from 2017" because 2017-01-01 is not a first day of the Week+-- *** Exception: Error: Unable to generate transactions according to "weekly from 2017" because 2017-01-01 is not a first day of the Week -- -- >>> _ptgen "monthly from 2017/5/4"--- *** Exception: Unable to generate transactions according to "monthly from 2017/5/4" because 2017-05-04 is not a first day of the Month+-- *** Exception: Error: Unable to generate transactions according to "monthly from 2017/5/4" because 2017-05-04 is not a first day of the Month -- -- >>> _ptgen "every quarter from 2017/1/2"--- *** Exception: Unable to generate transactions according to "every quarter from 2017/1/2" because 2017-01-02 is not a first day of the Quarter+-- *** Exception: Error: Unable to generate transactions according to "every quarter from 2017/1/2" because 2017-01-02 is not a first day of the Quarter -- -- >>> _ptgen "yearly from 2017/1/14"--- *** Exception: Unable to generate transactions according to "yearly from 2017/1/14" because 2017-01-14 is not a first day of the Year+-- *** Exception: Error: Unable to generate transactions according to "yearly from 2017/1/14" because 2017-01-14 is not a first day of the Year -- -- >>> let reportperiod="daily from 2018/01/03" in let (i,s) = parsePeriodExpr' nulldate reportperiod in runPeriodicTransaction (nullperiodictransaction{ptperiodexpr=reportperiod, ptspan=s, ptinterval=i, ptpostings=["a" `post` usd 1]}) (DateSpan (Just $ fromGregorian 2018 01 01) (Just $ fromGregorian 2018 01 03)) -- []

@@ -66,6 +66,7 @@   postingApplyValuation,   postingToCost,   postingAddInferredEquityPostings,+  postingPriceDirectivesFromCost,   tests_Posting ) where@@ -73,7 +74,7 @@ import Data.Default (def) import Data.Foldable (asum) import qualified Data.Map as M-import Data.Maybe (fromMaybe, isJust)+import Data.Maybe (fromMaybe, isJust, mapMaybe) import Data.List (foldl', sort, union) import qualified Data.Set as S import Data.Text (Text)@@ -455,6 +456,12 @@      priceTag = ("cost", T.strip . wbToText $ foldMap showAmountPrice priceAmounts)     priceAmounts = filter (isJust . aprice) . amountsRaw $ pamount p++-- | Make a market price equivalent to this posting's amount's unit+-- price, if any.+postingPriceDirectivesFromCost :: Posting -> [PriceDirective]+postingPriceDirectivesFromCost p@Posting{pamount} =+    mapMaybe (amountPriceDirectiveFromCost $ postingDate p) $ amountsRaw pamount  -- | Apply a transform function to this posting's amount. postingTransformAmount :: (MixedAmount -> MixedAmount) -> Posting -> Posting

@@ -41,6 +41,7 @@   -- * rendering , showTransaction , showTransactionOneLineAmounts+, showTransactionLineFirstPart , transactionFile   -- * tests , tests_Transaction@@ -137,17 +138,21 @@     <> foldMap ((<> newline) . TB.fromText) (postingsAsLines onelineamounts $ tpostings t)     <> newline   where-    descriptionline = T.stripEnd $ T.concat [date, status, code, desc, samelinecomment]-    date = showDate (tdate t) <> maybe "" (("="<>) . showDate) (tdate2 t)-    status | tstatus t == Cleared = " *"-           | tstatus t == Pending = " !"-           | otherwise            = ""-    code = if T.null (tcode t) then "" else wrap " (" ")" $ tcode t+    descriptionline = T.stripEnd $ showTransactionLineFirstPart t <> T.concat [desc, samelinecomment]     desc = if T.null d then "" else " " <> d where d = tdescription t     (samelinecomment, newlinecomments) =       case renderCommentLines (tcomment t) of []   -> ("",[])                                               c:cs -> (c,cs)     newline = TB.singleton '\n'++-- Useful when rendering error messages.+showTransactionLineFirstPart t = T.concat [date, status, code]+  where+    date = showDate (tdate t) <> maybe "" (("="<>) . showDate) (tdate2 t)+    status | tstatus t == Cleared = " *"+           | tstatus t == Pending = " !"+           | otherwise            = ""+    code = if T.null (tcode t) then "" else wrap " (" ")" $ tcode t  hasRealPostings :: Transaction -> Bool hasRealPostings = not . null . realPostings

@@ -81,7 +81,8 @@ -- (last|this|next) (day|week|month|quarter|year), where "this" means the period -- containing the reference date. data SmartDate-  = SmartAssumeStart Year (Maybe (Month, Maybe MonthDay))+  = SmartCompleteDate Day+  | SmartAssumeStart Year (Maybe Month)   | SmartFromReference (Maybe Month) MonthDay   | SmartMonth Month   | SmartRelative Integer SmartInterval

@@ -24,6 +24,7 @@   ,mixedAmountGainAtDate   ,marketPriceReverse   ,priceDirectiveToMarketPrice+  ,amountPriceDirectiveFromCost   -- ,priceLookup   ,tests_Valuation )@@ -95,6 +96,22 @@              , mpto   = acommodity pdamount              , mprate = aquantity pdamount              }++-- | Make one or more `MarketPrice` from an 'Amount' and its price directives.+amountPriceDirectiveFromCost :: Day -> Amount -> Maybe PriceDirective+amountPriceDirectiveFromCost d amt@Amount{acommodity=fromcomm, aquantity=fromq} = case aprice amt of+    Just (UnitPrice pa)               -> Just $ pd{pdamount=pa}+    Just (TotalPrice pa) | fromq /= 0 -> Just $ pd{pdamount=fromq `divideAmountExtraPrecision` pa}+    _                                 -> Nothing+  where+    pd = PriceDirective{pddate = d, pdcommodity = fromcomm, pdamount = nullamt}++    divideAmountExtraPrecision n a = (n `divideAmount` a) { astyle = style' }+      where+        style' = (astyle a) { asprecision = precision' }+        precision' = case asprecision (astyle a) of+                          NaturalPrecision -> NaturalPrecision+                          Precision p      -> Precision $ (numDigitsInt $ truncate n) + p  ------------------------------------------------------------------------------ -- Converting things to value

@@ -22,23 +22,29 @@   parseQueryList,   parseQueryTerm,   parseAccountType,+  -- * modifying   simplifyQuery,   filterQuery,   filterQueryOrNotQuery,-  -- * accessors+  matchesQuery,+  -- * predicates   queryIsNull,-  queryIsAcct,-  queryIsAmt,-  queryIsDepth,   queryIsDate,   queryIsDate2,   queryIsDateOrDate2,-  queryIsStartDateOnly,-  queryIsSym,-  queryIsReal,   queryIsStatus,-  queryIsType,+  queryIsCode,+  queryIsDesc,   queryIsTag,+  queryIsAcct,+  queryIsType,+  queryIsDepth,+  queryIsReal,+  queryIsAmt,+  queryIsSym,+  queryIsStartDateOnly,+  queryIsTransactionRelated,+  -- * accessors   queryStartDate,   queryEndDate,   queryDateSpan,@@ -46,7 +52,7 @@   queryDepth,   inAccount,   inAccountQuery,-  -- * matching+  -- * matching things with queries   matchesTransaction,   matchesTransactionExtra,   matchesDescription,@@ -90,27 +96,28 @@  -- | A query is a composition of search criteria, which can be used to -- match postings, transactions, accounts and more.-data Query = Any              -- ^ always match-           | None             -- ^ never match-           | Not Query        -- ^ negate this match-           | Or [Query]       -- ^ match if any of these match-           | And [Query]      -- ^ match if all of these match-           | Code Regexp      -- ^ match if code matches this regexp-           | Desc Regexp      -- ^ match if description matches this regexp-           | Acct Regexp      -- ^ match postings whose account matches this regexp-           | Date DateSpan    -- ^ match if primary date in this date span-           | Date2 DateSpan   -- ^ match if secondary date in this date span-           | StatusQ Status  -- ^ match txns/postings with this status-           | Real Bool        -- ^ match if "realness" (involves a real non-virtual account ?) has this value-           | Amt OrdPlus Quantity  -- ^ match if the amount's numeric quantity is less than/greater than/equal to/unsignedly equal to some value-           | Sym Regexp       -- ^ match if the entire commodity symbol is matched by this regexp-           | Depth Int        -- ^ match if account depth is less than or equal to this value.-                              --   Depth is sometimes used like a query (for filtering report data)-                              --   and sometimes like a query option (for controlling display)-           | Tag Regexp (Maybe Regexp)  -- ^ match if a tag's name, and optionally its value, is matched by these respective regexps-                                        -- matching the regexp if provided, exists-           | Type [AccountType]  -- ^ match accounts whose type is one of these (or with no types, any account)-    deriving (Eq,Show)+data Query = +  -- compound queries+    Not Query                 -- ^ negate this match+  | And [Query]               -- ^ match if all of these match+  | Or  [Query]               -- ^ match if any of these match+  -- no-op queries+  | Any                       -- ^ always match+  | None                      -- ^ never match+  -- data queries (in "standard" order, roughly as they appear in a transaction)+  | Date DateSpan             -- ^ match primary dates in this date span+  | Date2 DateSpan            -- ^ match secondary dates in this date span+  | StatusQ Status            -- ^ match this txn/posting status+  | Code Regexp               -- ^ match txn codes infix-matched by this regexp+  | Desc Regexp               -- ^ match txn descriptions infix-matched by this regexp+  | Tag Regexp (Maybe Regexp) -- ^ match if a tag's name, and optionally its value, is infix-matched by the respective regexps+  | Acct Regexp               -- ^ match account names infix-matched by this regexp+  | Type [AccountType]        -- ^ match accounts whose type is one of these (or with no types, any account)+  | Depth Int                 -- ^ match if account depth is less than or equal to this value (or, sometimes used as a display option)+  | Real Bool                 -- ^ match postings with this "realness" value+  | Amt OrdPlus Quantity      -- ^ match if the amount's numeric quantity is less than/greater than/equal to/unsignedly equal to some value+  | Sym Regexp                -- ^ match if the commodity symbol is fully-matched by this regexp+  deriving (Eq,Show)  instance Default Query where def = Any @@ -402,6 +409,8 @@ truestrings :: [T.Text] truestrings = ["1"] +-- * modifying+ simplifyQuery :: Query -> Query simplifyQuery q =   let q' = simplify q@@ -428,32 +437,41 @@ same (a:as) = all (a==) as  -- | Remove query terms (or whole sub-expressions) from this query--- which do not match the given predicate.--- XXX Semantics not completely clear.+-- which do not match the given predicate. XXX Semantics not completely clear.+-- Also calls simplifyQuery on the result. filterQuery :: (Query -> Bool) -> Query -> Query filterQuery p = simplifyQuery . filterQuery' p-  where-    filterQuery' :: (Query -> Bool) -> Query -> Query-    filterQuery' p (And qs) = And $ map (filterQuery p) qs-    filterQuery' p (Or qs) = Or $ map (filterQuery p) qs-    filterQuery' p q = if p q then q else Any +-- | Like filterQuery, but returns the filtered query as is, without simplifying.+filterQuery' :: (Query -> Bool) -> Query -> Query+filterQuery' p (And qs) = And $ map (filterQuery p) qs+filterQuery' p (Or qs) = Or $ map (filterQuery p) qs+filterQuery' p q = if p q then q else Any+ -- | Remove query terms (or whole sub-expressions) from this query -- which match neither the given predicate nor that predicate negated  -- (eg, if predicate is queryIsAcct, this will keep both "acct:" and "not:acct:" terms).+-- Also calls simplifyQuery on the result. -- (Since 1.24.1, might be merged into filterQuery in future.) -- XXX Semantics not completely clear. filterQueryOrNotQuery :: (Query -> Bool) -> Query -> Query-filterQueryOrNotQuery p = simplifyQuery . filterQuery' p+filterQueryOrNotQuery p = simplifyQuery . filterQueryOrNotQuery' p   where-    filterQuery' :: (Query -> Bool) -> Query -> Query-    filterQuery' p (And qs)      = And $ map (filterQueryOrNotQuery p) qs-    filterQuery' p (Or qs)       = Or  $ map (filterQueryOrNotQuery p) qs-    filterQuery' p (Not q) | p q = Not $ filterQueryOrNotQuery p q-    filterQuery' p q = if p q then q else Any+    filterQueryOrNotQuery' :: (Query -> Bool) -> Query -> Query+    filterQueryOrNotQuery' p (And qs)      = And $ map (filterQueryOrNotQuery p) qs+    filterQueryOrNotQuery' p (Or qs)       = Or  $ map (filterQueryOrNotQuery p) qs+    filterQueryOrNotQuery' p (Not q) | p q = Not $ filterQueryOrNotQuery p q+    filterQueryOrNotQuery' p q = if p q then q else Any --- * accessors+-- * predicates +-- | Does this simple query predicate match any part of this possibly compound query ?+matchesQuery :: (Query -> Bool) -> Query -> Bool+matchesQuery p (And qs) = any (matchesQuery p) qs+matchesQuery p (Or qs)  = any (matchesQuery p) qs+matchesQuery p (Not q)  = p q+matchesQuery p q        = p q+ -- | Does this query match everything ? queryIsNull :: Query -> Bool queryIsNull Any = True@@ -461,13 +479,9 @@ queryIsNull (Not (Or [])) = True queryIsNull _ = False --- | Is this a simple query of this type ("depth:D") ? --- Note, does not match a compound query like "not:depth:D" or "depth:D acct:A".+-- | Is this a simple query of this type (date:) ? +-- Does not match a compound query involving and/or/not. -- Likewise for the following functions.-queryIsDepth :: Query -> Bool-queryIsDepth (Depth _) = True-queryIsDepth _ = False- queryIsDate :: Query -> Bool queryIsDate (Date _) = True queryIsDate _ = False@@ -481,37 +495,45 @@ queryIsDateOrDate2 (Date2 _) = True queryIsDateOrDate2 _ = False +queryIsStatus :: Query -> Bool+queryIsStatus (StatusQ _) = True+queryIsStatus _ = False++queryIsCode :: Query -> Bool+queryIsCode (Code _) = True+queryIsCode _ = False+ queryIsDesc :: Query -> Bool queryIsDesc (Desc _) = True queryIsDesc _ = False +queryIsTag :: Query -> Bool+queryIsTag (Tag _ _) = True+queryIsTag _ = False+ queryIsAcct :: Query -> Bool queryIsAcct (Acct _) = True queryIsAcct _ = False -queryIsAmt :: Query -> Bool-queryIsAmt (Amt _ _) = True-queryIsAmt _         = False+queryIsType :: Query -> Bool+queryIsType (Type _) = True+queryIsType _ = False -queryIsSym :: Query -> Bool-queryIsSym (Sym _) = True-queryIsSym _ = False+queryIsDepth :: Query -> Bool+queryIsDepth (Depth _) = True+queryIsDepth _ = False  queryIsReal :: Query -> Bool queryIsReal (Real _) = True queryIsReal _ = False -queryIsStatus :: Query -> Bool-queryIsStatus (StatusQ _) = True-queryIsStatus _ = False--queryIsType :: Query -> Bool-queryIsType (Type _) = True-queryIsType _ = False+queryIsAmt :: Query -> Bool+queryIsAmt (Amt _ _) = True+queryIsAmt _         = False -queryIsTag :: Query -> Bool-queryIsTag (Tag _ _) = True-queryIsTag _ = False+queryIsSym :: Query -> Bool+queryIsSym (Sym _) = True+queryIsSym _ = False  -- | Does this query specify a start date and nothing else (that would -- filter postings prior to the date) ?@@ -525,6 +547,25 @@ queryIsStartDateOnly True (Date2 (DateSpan (Just _) _)) = True queryIsStartDateOnly _ _ = False +-- | Does this query involve a property of transactions (or their postings),+-- making it inapplicable to account declarations ?+queryIsTransactionRelated :: Query -> Bool+queryIsTransactionRelated = matchesQuery (+      queryIsDate+  ||| queryIsDate2+  ||| queryIsStatus+  ||| queryIsCode+  ||| queryIsDesc+  ||| queryIsReal+  ||| queryIsAmt+  ||| queryIsSym+  )++(|||) :: (a->Bool) -> (a->Bool) -> (a->Bool)+p ||| q = \v -> p v || q v++-- * accessors+ -- | What start date (or secondary date) does this query specify, if any ? -- For OR expressions, use the earliest of the dates. NOT is ignored. queryStartDate :: Bool -> Query -> Maybe Day@@ -616,7 +657,7 @@ -- negateQuery :: Query -> Query -- negateQuery =  Not --- matching+-- matching things with queries  matchesCommodity :: Query -> CommoditySymbol -> Bool matchesCommodity (Sym r) = regexMatchText r

@@ -22,14 +22,20 @@   PrefixedFilePath,   defaultJournal,   defaultJournalPath,-  readJournalFiles,-  readJournalFile,   requireJournalFileExists,   ensureJournalFileExists,    -- * Journal parsing   readJournal,+  readJournalFile,+  readJournalFiles,+  runExceptT,++  -- * Easy journal parsing   readJournal',+  readJournalFile',+  readJournalFiles',+  orDieTrying,    -- * Re-exported   JournalReader.tmpostingrulep,@@ -45,10 +51,9 @@ ) where  --- ** imports-import Control.Arrow (right) import qualified Control.Exception as C import Control.Monad (unless, when)-import "mtl" Control.Monad.Except (runExceptT)+import "mtl" Control.Monad.Except (ExceptT(..), runExceptT, liftIO, MonadIO) import Data.Default (def) import Data.Foldable (asum) import Data.List (group, sort, sortBy)@@ -89,36 +94,9 @@ journalEnvVar2          = "LEDGER" journalDefaultFilename  = ".hledger.journal" --- | Read a Journal from the given text, assuming journal format; or--- throw an error.-readJournal' :: Text -> IO Journal-readJournal' t = readJournal definputopts Nothing t >>= either error' return  -- PARTIAL:---- | @readJournal iopts mfile txt@------ Read a Journal from some text, or return an error message.------ The reader (data format) is chosen based on, in this order:------ - a reader name provided in @iopts@------ - a reader prefix in the @mfile@ path------ - a file extension in @mfile@------ If none of these is available, or if the reader name is unrecognised,--- we use the journal reader. (We used to try all readers in this case;--- since hledger 1.17, we prefer predictability.)-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-  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. defaultJournal :: IO Journal-defaultJournal = defaultJournalPath >>= readJournalFile definputopts >>= either error' return  -- PARTIAL:+defaultJournal = defaultJournalPath >>= runExceptT . readJournalFile definputopts >>= either error' return  -- PARTIAL:  -- | Get the default journal file path specified by the environment. -- Like ledger, we look first for the LEDGER_FILE environment@@ -144,17 +122,27 @@ -- (journal:, csv:, timedot:, etc.). type PrefixedFilePath = FilePath --- | Read a Journal from each specified file path and combine them into one.--- Or, return the first error message.+-- | @readJournal iopts mfile txt@ ----- Combining Journals means concatenating them, basically.--- The parse state resets at the start of each file, which means that--- directives & aliases do not affect subsequent sibling or parent files.--- They do affect included child files though.--- Also the final parse state saved in the Journal does span all files.-readJournalFiles :: InputOpts -> [PrefixedFilePath] -> IO (Either String Journal)-readJournalFiles iopts =-  fmap (right (maybe def sconcat . nonEmpty) . sequence) . mapM (readJournalFile iopts)+-- Read a Journal from some text, or return an error message.+--+-- The reader (data format) is chosen based on, in this order:+--+-- - a reader name provided in @iopts@+--+-- - a reader prefix in the @mfile@ path+--+-- - a file extension in @mfile@+--+-- If none of these is available, or if the reader name is unrecognised,+-- we use the journal reader. (We used to try all readers in this case;+-- since hledger 1.17, we prefer predictability.)+readJournal :: InputOpts -> Maybe FilePath -> Text -> ExceptT String IO Journal+readJournal iopts mpath txt = do+  let r :: Reader IO =+        fromMaybe JournalReader.reader $ findReader (mformat_ iopts) mpath+  dbg6IO "trying reader" (rFormat r)+  rReadFn r iopts (fromMaybe "(string)" mpath) txt  -- | Read a Journal from this file, or from stdin if the file path is -, -- or return an error message. The file path can have a READER: prefix.@@ -167,25 +155,55 @@ -- -- The input options can also configure balance assertion checking, automated posting -- generation, a rules file for converting CSV data, etc.-readJournalFile :: InputOpts -> PrefixedFilePath -> IO (Either String Journal)+readJournalFile :: InputOpts -> PrefixedFilePath -> ExceptT String IO Journal readJournalFile iopts prefixedfile = do   let     (mfmt, f) = splitReaderPrefix prefixedfile     iopts' = iopts{mformat_=asum [mfmt, mformat_ iopts]}-  requireJournalFileExists f-  t <- readFileOrStdinPortably f+  liftIO $ requireJournalFileExists f+  t <- liftIO $ readFileOrStdinPortably f     -- <- T.readFile f  -- or without line ending translation, for testing-  ej <- readJournal iopts' (Just f) t-  case ej of-    Left e  -> return $ Left e-    Right j | new_ iopts -> do-      ds <- previousLatestDates f-      let (newj, newds) = journalFilterSinceLatestDates ds j-      when (new_save_ iopts && not (null newds)) $ saveLatestDates newds f-      return $ Right newj-    Right j -> return $ Right j+  j <- readJournal iopts' (Just f) t+  if new_ iopts+     then do+       ds <- liftIO $ previousLatestDates f+       let (newj, newds) = journalFilterSinceLatestDates ds j+       when (new_save_ iopts && not (null newds)) . liftIO $ saveLatestDates newds f+       return newj+     else return j +-- | Read a Journal from each specified file path and combine them into one.+-- Or, return the first error message.+--+-- Combining Journals means concatenating them, basically.+-- The parse state resets at the start of each file, which means that+-- directives & aliases do not affect subsequent sibling or parent files.+-- They do affect included child files though.+-- Also the final parse state saved in the Journal does span all files.+readJournalFiles :: InputOpts -> [PrefixedFilePath] -> ExceptT String IO Journal+readJournalFiles iopts =+  fmap (maybe def sconcat . nonEmpty) . mapM (readJournalFile iopts)++-- | An easy version of 'readJournal' which assumes default options, and fails+-- in the IO monad.+readJournal' :: Text -> IO Journal+readJournal' = orDieTrying . readJournal definputopts Nothing++-- | An easy version of 'readJournalFile' which assumes default options, and fails+-- in the IO monad.+readJournalFile' :: PrefixedFilePath -> IO Journal+readJournalFile' = orDieTrying . readJournalFile definputopts++-- | An easy version of 'readJournalFiles'' which assumes default options, and fails+-- in the IO monad.+readJournalFiles' :: [PrefixedFilePath] -> IO Journal+readJournalFiles' = orDieTrying . readJournalFiles definputopts+ --- ** utilities++-- | Extract ExceptT to the IO monad, failing with an error message if necessary.+orDieTrying :: MonadIO m => ExceptT String m a -> m a+orDieTrying a = either (liftIO . fail) return =<< runExceptT a  -- | If the specified journal file does not exist (and is not "-"), -- give a helpful error and quit.

@@ -35,11 +35,8 @@    -- * parsing utilities   parseAndFinaliseJournal,-  parseAndFinaliseJournal',+  initialiseAndParseJournal,   journalFinalise,-  journalCheckAccountsDeclared,-  journalCheckCommoditiesDeclared,-  journalCheckPayeesDeclared,   journalAddForecast,   journalAddAutoPostings,   setYear,@@ -121,7 +118,7 @@ --- ** imports import Control.Applicative.Permutations (runPermutation, toPermutationWithDefault) import qualified Control.Monad.Fail as Fail (fail)-import Control.Monad.Except (ExceptT(..), liftEither, runExceptT, throwError)+import Control.Monad.Except (ExceptT(..), liftEither, withExceptT) import Control.Monad.State.Strict hiding (fail) import Data.Bifunctor (bimap, second) import Data.Char (digitToInt, isDigit, isSpace)@@ -144,13 +141,12 @@ import Text.Megaparsec.Char (char, char', digitChar, newline, string) import Text.Megaparsec.Char.Lexer (decimal) import Text.Megaparsec.Custom-  (attachSource, customErrorBundlePretty, finalErrorBundlePretty, parseErrorAt, parseErrorAtRegion)+  (FinalParseError, attachSource, customErrorBundlePretty, finalErrorBundlePretty, parseErrorAt, parseErrorAtRegion, HledgerParseErrors)  import Hledger.Data import Hledger.Query (Query(..), filterQuery, parseQueryTerm, queryEndDate, queryStartDate, queryIsDate, simplifyQuery) import Hledger.Reports.ReportOptions (ReportOpts(..), queryFromFlags, rawOptsToReportOpts) import Hledger.Utils-import Text.Printf (printf) import Hledger.Read.InputOptions  --- ** doctest setup@@ -249,43 +245,35 @@     parseCommodity optStr = case amountp'' optStr of         Left _ -> Left optStr         Right (Amount acommodity _ astyle _) -> Right (acommodity, astyle)+ -- | Given a parser to ParsedJournal, input options, file path and -- content: run the parser on the content, and finalise the result to -- get a Journal; or throw an error. parseAndFinaliseJournal :: ErroringJournalParser IO ParsedJournal -> InputOpts                            -> FilePath -> Text -> ExceptT String IO Journal-parseAndFinaliseJournal parser iopts f txt = do-  let y = first3 . toGregorian $ _ioDay iopts-      initJournal = nulljournal{ jparsedefaultyear = Just y, jincludefilestack = [f] }-  eep <- liftIO $ runExceptT $ runParserT (evalStateT parser initJournal) f txt-  -- TODO: urgh.. clean this up somehow-  case eep of-    Left finalParseError -> throwError $ finalErrorBundlePretty $ attachSource f txt finalParseError-    Right ep -> case ep of-                  Left e   -> throwError $ customErrorBundlePretty e-                  Right pj -> journalFinalise iopts f txt pj+parseAndFinaliseJournal parser iopts f txt =+    initialiseAndParseJournal parser iopts f txt >>= journalFinalise iopts f txt --- | Like parseAndFinaliseJournal but takes a (non-Erroring) JournalParser.--- Also, applies command-line account aliases before finalising.--- Used for timeclock/timedot.--- TODO: get rid of this, use parseAndFinaliseJournal instead-parseAndFinaliseJournal' :: JournalParser IO ParsedJournal -> InputOpts-                           -> FilePath -> Text -> ExceptT String IO Journal-parseAndFinaliseJournal' parser iopts f txt = do-  let y = first3 . toGregorian $ _ioDay iopts-      initJournal = nulljournal-        { jparsedefaultyear = Just y-        , jincludefilestack = [f] }-  ep <- liftIO $ runParserT (evalStateT parser initJournal) f txt-  -- see notes above-  case ep of-    Left e   -> throwError $ customErrorBundlePretty e-    Right pj ->-      -- apply any command line account aliases. Can fail with a bad replacement pattern.-      case journalApplyAliases (aliasesFromOpts iopts) pj of-        Left e    -> throwError e-        Right pj' -> journalFinalise iopts f txt pj'+-- | Given a parser to ParsedJournal, input options, file path and+-- content: run the parser on the content. This is all steps of+-- 'parseAndFinaliseJournal' without the finalisation step, and is used when+-- you need to perform other actions before finalisation, as in parsing+-- Timeclock and Timedot files.+initialiseAndParseJournal :: ErroringJournalParser IO ParsedJournal -> InputOpts+                          -> FilePath -> Text -> ExceptT String IO Journal+initialiseAndParseJournal parser iopts f txt =+    prettyParseErrors $ runParserT (evalStateT parser initJournal) f txt+  where+    y = first3 . toGregorian $ _ioDay iopts+    initJournal = nulljournal{jparsedefaultyear = Just y, jincludefilestack = [f]}+    -- Flatten parse errors and final parse errors, and output each as a pretty String.+    prettyParseErrors :: ExceptT FinalParseError IO (Either (ParseErrorBundle Text HledgerParseErrorData) a)+                      -> ExceptT String IO a+    prettyParseErrors = withExceptT customErrorBundlePretty . liftEither+                    <=< withExceptT (finalErrorBundlePretty . attachSource f txt) +{- HLINT ignore journalFinalise "Redundant <&>" -} -- silence this warning, the code is clearer as is+-- NB activates TH, may slow compilation ? https://github.com/ndmitchell/hlint/blob/master/README.md#customizing-the-hints -- | Post-process a Journal that has just been parsed or generated, in this order: -- -- - add misc info (file path, read time) @@ -335,8 +323,8 @@       <&> (if infer_equity_ then journalAddInferredEquityPostings else id)  -- Add inferred equity postings, after balancing transactions and generating auto postings       <&> journalInferMarketPricesFromTransactions       -- infer market prices from commodity-exchanging transactions     when strict_ $ do-      journalCheckAccountsDeclared j                     -- If in strict mode, check all postings are to declared accounts-      journalCheckCommoditiesDeclared j                  -- and using declared commodities+      journalCheckAccounts j                     -- If in strict mode, check all postings are to declared accounts+      journalCheckCommodities j                  -- and using declared commodities     return j  -- | Apply any auto posting rules to generate extra postings on this journal's transactions.@@ -364,66 +352,6 @@       . concatMap (`runPeriodicTransaction` forecastspan)       $ jperiodictxns j --- | Check that all the journal's transactions have payees declared with--- payee directives, returning an error message otherwise.-journalCheckPayeesDeclared :: Journal -> Either String ()-journalCheckPayeesDeclared j = mapM_ checkpayee (jtxns j)-  where-    checkpayee t-      | p `elem` ps = Right ()-      | otherwise = Left $-          printf "undeclared payee \"%s\"\nat: %s\n\n%s"-            (T.unpack p)-            (showSourcePosPair $ tsourcepos t)-            (linesPrepend2 "> " "  " . (<>"\n") . textChomp $ showTransaction t)-      where-        p  = transactionPayee t-        ps = journalPayeesDeclared j---- | Check that all the journal's postings are to accounts declared with--- account directives, returning an error message otherwise.-journalCheckAccountsDeclared :: Journal -> Either String ()-journalCheckAccountsDeclared j = mapM_ checkacct (journalPostings j)-  where-    checkacct Posting{paccount,ptransaction}-      | paccount `elem` as = Right ()-      | otherwise = Left $-          (printf "undeclared account \"%s\"\n" (T.unpack paccount))-          ++ case ptransaction of-              Nothing -> ""-              Just t  -> printf "in transaction at: %s\n\n%s"-                          (showSourcePosPair $ tsourcepos t)-                          (linesPrepend "  " . (<>"\n") . textChomp $ showTransaction t)-      where-        as = journalAccountNamesDeclared j---- | Check that all the commodities used in this journal's postings have been declared--- by commodity directives, returning an error message otherwise.-journalCheckCommoditiesDeclared :: Journal -> Either String ()-journalCheckCommoditiesDeclared j =-  mapM_ checkcommodities (journalPostings j)-  where-    checkcommodities Posting{..} =-      case mfirstundeclaredcomm of-        Nothing -> Right ()-        Just c  -> Left $-          (printf "undeclared commodity \"%s\"\n" (T.unpack c))-          ++ case ptransaction of-              Nothing -> ""-              Just t  -> printf "in transaction at: %s\n\n%s"-                          (showSourcePosPair $ tsourcepos t)-                          (linesPrepend "  " . (<>"\n") . textChomp $ showTransaction t)-      where-        mfirstundeclaredcomm =-          find (`M.notMember` jcommodities j)-          . map acommodity-          . (maybe id ((:) . baamount) pbalanceassertion)-          . filter (not . isIgnorable)-          $ amountsRaw pamount--    -- Ignore missing amounts and zero amounts without commodity (#1767)-    isIgnorable a = (T.null (acommodity a) && amountIsZero a) || a == missingamt- setYear :: Year -> JournalParser m () setYear y = modify' (\j -> j{jparsedefaultyear=Just y}) @@ -863,7 +791,7 @@           Right (q,p,d,g) -> pure (q, Precision p, d, g)  -- | Try to parse an amount from a string-amountp'' :: String -> Either (ParseErrorBundle Text CustomErr) Amount+amountp'' :: String -> Either HledgerParseErrors Amount amountp'' s = runParser (evalStateT (amountp <* eof) nulljournal) "" (T.pack s)  -- | Parse an amount from a string, or get an error.@@ -1515,16 +1443,19 @@ regexaliasp :: TextParser m AccountAlias regexaliasp = do   -- dbgparse 0 "regexaliasp"-  char '/'-  off1 <- getOffset-  re <- some $ noneOf ("/\n\r" :: [Char]) -- paranoid: don't try to read past line end-  off2 <- getOffset-  char '/'+  (off1, off2, re) <- between (char '/') (char '/') $ do+    off1 <- getOffset+    re <- fmap T.concat . some $+             (T.singleton <$> noneOf ("/\\\n\r" :: [Char]))               -- paranoid: don't try to read past line end+             <|> string "\\/"                                             -- allow escaping forward slashes+             <|> (liftM2 T.cons (char '\\') (T.singleton <$> anySingle))  -- Otherwise leave backslashes in+    off2 <- getOffset+    return (off1, off2, re)   skipNonNewlineSpaces   char '='   skipNonNewlineSpaces   repl <- anySingle `manyTill` eolof-  case toRegexCI $ T.pack re of+  case toRegexCI re of     Right r -> return $! RegexAlias r repl     Left e  -> customFailure $! parseErrorAtRegion off1 off2 e 

@@ -38,15 +38,15 @@  --- ** imports import Control.Applicative        (liftA2)-import Control.Exception          (IOException, handle, throw) import Control.Monad              (unless, when)-import Control.Monad.Except       (ExceptT, throwError)+import Control.Monad.Except       (ExceptT(..), liftEither, throwError) import qualified Control.Monad.Fail as Fail import Control.Monad.IO.Class     (MonadIO, liftIO) import Control.Monad.State.Strict (StateT, get, modify', evalStateT) import Control.Monad.Trans.Class  (lift) import Data.Char                  (toLower, isDigit, isSpace, isAlphaNum, ord) import Data.Bifunctor             (first)+import Data.Functor               ((<&>)) import Data.List (elemIndex, foldl', intersperse, mapAccumL, nub, sortBy) import Data.Maybe (catMaybes, fromMaybe, isJust) import Data.MemoUgly (memo)@@ -60,7 +60,7 @@ import qualified Data.Text.Lazy.Builder as TB import Data.Time.Calendar (Day) import Data.Time.Format (parseTimeM, defaultTimeLocale)-import Safe (atMay, headMay, lastMay, readDef, readMay)+import Safe (atMay, headMay, lastMay, readMay) import System.Directory (doesFileExist) import System.FilePath ((</>), takeDirectory, takeExtension, takeFileName) import qualified Data.Csv as Cassava@@ -103,23 +103,20 @@ parse :: InputOpts -> FilePath -> Text -> ExceptT String IO Journal parse iopts f t = do   let rulesfile = mrules_file_ iopts-  r <- liftIO $ readJournalFromCsv rulesfile f t-  case r of Left e   -> throwError e-            Right pj ->-              -- journalFinalise assumes the journal's items are-              -- reversed, as produced by JournalReader's parser.-              -- But here they are already properly ordered. So we'd-              -- better preemptively reverse them once more. XXX inefficient-              let pj' = journalReverse pj-              -- apply any command line account aliases. Can fail with a bad replacement pattern.-              in case journalApplyAliases (aliasesFromOpts iopts) pj' of-                  Left e -> throwError e-                  Right pj'' -> journalFinalise iopts{balancingopts_=(balancingopts_ iopts){ignore_assertions_=True}} f t pj''+  readJournalFromCsv rulesfile f t+  -- journalFinalise assumes the journal's items are+  -- reversed, as produced by JournalReader's parser.+  -- But here they are already properly ordered. So we'd+  -- better preemptively reverse them once more. XXX inefficient+  <&> journalReverse+  -- apply any command line account aliases. Can fail with a bad replacement pattern.+  >>= liftEither . journalApplyAliases (aliasesFromOpts iopts)+  >>= journalFinalise iopts{balancingopts_=(balancingopts_ iopts){ignore_assertions_=True}} f t  --- ** reading rules files --- *** rules utilities --- Not used by hledger; just for lib users, +-- Not used by hledger; just for lib users, -- | An pure-exception-throwing IO action that parses this file's content -- as CSV conversion rules, interpolating any included files first, -- and runs some extra validation checks.@@ -219,14 +216,14 @@       parseErrorPretty (FancyError 0 (S.singleton $ ErrorFail errorString) :: ParseError Text String)  -- | Parse this text as CSV conversion rules. The file path is for error messages.-parseCsvRules :: FilePath -> T.Text -> Either (ParseErrorBundle T.Text CustomErr) CsvRules+parseCsvRules :: FilePath -> T.Text -> Either (ParseErrorBundle T.Text HledgerParseErrorData) CsvRules -- parseCsvRules rulesfile s = runParser csvrulesfile nullrules{baseAccount=takeBaseName rulesfile} rulesfile s parseCsvRules = runParser (evalStateT rulesp defrules)  -- | Return the validated rules, or an error. validateRules :: CsvRules -> Either String CsvRules validateRules rules = do-  unless (isAssigned "date")   $ Left "Please specify (at top level) the date field. Eg: date %1\n"+  unless (isAssigned "date")   $ Left "Please specify (at top level) the date field. Eg: date %1"   Right rules   where     isAssigned f = isJust $ getEffectiveAssignment rules [] f@@ -568,7 +565,7 @@                  , fmap Just fieldassignmentp                  ])   when (null as) $-    customFailure $ parseErrorAt start $  "start of conditional block found, but no assignment rules afterward\n(assignment rules in a conditional block should be indented)\n"+    customFailure $ parseErrorAt start $  "start of conditional block found, but no assignment rules afterward\n(assignment rules in a conditional block should be indented)"   return $ CB{cbMatchers=ms, cbAssignments=as}   <?> "conditional block" @@ -588,10 +585,10 @@     m <- matcherp' (char sep >> return ())     vs <- T.split (==sep) . T.pack <$> lift restofline     if (length vs /= length fields)-      then customFailure $ parseErrorAt off $ ((printf "line of conditional table should have %d values, but this one has only %d\n" (length fields) (length vs)) :: String)+      then customFailure $ parseErrorAt off $ ((printf "line of conditional table should have %d values, but this one has only %d" (length fields) (length vs)) :: String)       else return (m,vs)   when (null body) $-    customFailure $ parseErrorAt start $ "start of conditional table found, but no assignment rules afterward\n"+    customFailure $ parseErrorAt start $ "start of conditional table found, but no assignment rules afterward"   return $ flip map body $ \(m,vs) ->     CB{cbMatchers=[m], cbAssignments=zip fields vs}   <?> "conditional table"@@ -614,7 +611,7 @@   r <- regexp end   return $ RecordMatcher p r   -- when (null ps) $-  --   Fail.fail "start of record matcher found, but no patterns afterward\n(patterns should not be indented)\n"+  --   Fail.fail "start of record matcher found, but no patterns afterward\n(patterns should not be indented)"   <?> "record matcher"  -- | A single matcher for a specific field. A csv field reference@@ -686,93 +683,85 @@ -- 4. if the rules file didn't exist, create it with the default rules and filename -- -- 5. return the transactions as a Journal--- -readJournalFromCsv :: Maybe FilePath -> FilePath -> Text -> IO (Either String Journal)-readJournalFromCsv Nothing "-" _ = return $ Left "please use --rules-file when reading CSV from stdin"-readJournalFromCsv mrulesfile csvfile csvdata =- handle (\(e::IOException) -> return $ Left $ show e) $ do--  -- make and throw an IO exception.. which we catch and convert to an Either above ?-  let throwerr = throw . userError--  -- parse the csv rules-  let rulesfile = fromMaybe (rulesFileFor csvfile) mrulesfile-  rulesfileexists <- doesFileExist rulesfile-  rulestext <--    if rulesfileexists-    then do-      dbg6IO "using conversion rules file" rulesfile-      readFilePortably rulesfile >>= expandIncludes (takeDirectory rulesfile)-    else-      return $ defaultRulesText rulesfile-  rules <- either throwerr return $ parseAndValidateCsvRules rulesfile rulestext-  dbg6IO "csv rules" rules+--+readJournalFromCsv :: Maybe FilePath -> FilePath -> Text -> ExceptT String IO Journal+readJournalFromCsv Nothing "-" _ = throwError "please use --rules-file when reading CSV from stdin"+readJournalFromCsv mrulesfile csvfile csvdata = do+    -- parse the csv rules+    let rulesfile = fromMaybe (rulesFileFor csvfile) mrulesfile+    rulesfileexists <- liftIO $ doesFileExist rulesfile+    rulestext <- liftIO $ if rulesfileexists+      then do+        dbg6IO "using conversion rules file" rulesfile+        readFilePortably rulesfile >>= expandIncludes (takeDirectory rulesfile)+      else+        return $ defaultRulesText rulesfile+    rules <- liftEither $ parseAndValidateCsvRules rulesfile rulestext+    dbg6IO "csv rules" rules -  -- parse the skip directive's value, if any-  let skiplines = case getDirective "skip" rules of-                    Nothing -> 0-                    Just "" -> 1-                    Just s  -> readDef (throwerr $ "could not parse skip value: " ++ show s) $ T.unpack s+    -- parse the skip directive's value, if any+    skiplines <- case getDirective "skip" rules of+                      Nothing -> return 0+                      Just "" -> return 1+                      Just s  -> maybe (throwError $ "could not parse skip value: " ++ show s) return . readMay $ T.unpack s -  -- parse csv-  let-    -- parsec seems to fail if you pass it "-" here TODO: try again with megaparsec-    parsecfilename = if csvfile == "-" then "(stdin)" else csvfile-    separator =-      case getDirective "separator" rules >>= parseSeparator of-        Just c           -> c-        _ | ext == "ssv" -> ';'-        _ | ext == "tsv" -> '\t'-        _                -> ','-        where-          ext = map toLower $ drop 1 $ takeExtension csvfile-  dbg6IO "using separator" separator-  records <- (either throwerr id .-              dbg7 "validateCsv" . validateCsv rules skiplines .-              dbg7 "parseCsv")-             `fmap` parseCsv separator parsecfilename csvdata-  dbg6IO "first 3 csv records" $ take 3 records+    -- parse csv+    let+      -- parsec seems to fail if you pass it "-" here TODO: try again with megaparsec+      parsecfilename = if csvfile == "-" then "(stdin)" else csvfile+      separator =+        case getDirective "separator" rules >>= parseSeparator of+          Just c           -> c+          _ | ext == "ssv" -> ';'+          _ | ext == "tsv" -> '\t'+          _                -> ','+          where+            ext = map toLower $ drop 1 $ takeExtension csvfile+    dbg6IO "using separator" separator+    csv <- dbg7 "parseCsv" <$> parseCsv separator parsecfilename csvdata+    records <- liftEither $ dbg7 "validateCsv" <$> validateCsv rules skiplines csv+    dbg6IO "first 3 csv records" $ take 3 records -  -- identify header lines-  -- let (headerlines, datalines) = identifyHeaderLines records-  --     mfieldnames = lastMay headerlines+    -- identify header lines+    -- let (headerlines, datalines) = identifyHeaderLines records+    --     mfieldnames = lastMay headerlines -  let-    -- convert CSV records to transactions, saving the CSV line numbers for error positions-    txns = dbg7 "csv txns" $ snd $ mapAccumL-                   (\pos r ->-                      let-                        SourcePos name line col = pos-                        line' = (mkPos . (+1) . unPos) line-                        pos' = SourcePos name line' col-                      in-                        (pos', transactionFromCsvRecord pos rules r)-                   )-                   (initialPos parsecfilename) records+    let+      -- convert CSV records to transactions, saving the CSV line numbers for error positions+      txns = dbg7 "csv txns" $ snd $ mapAccumL+                     (\pos r ->+                        let+                          SourcePos name line col = pos+                          line' = (mkPos . (+1) . unPos) line+                          pos' = SourcePos name line' col+                        in+                          (pos', transactionFromCsvRecord pos rules r)+                     )+                     (initialPos parsecfilename) records -    -- Ensure transactions are ordered chronologically.-    -- First, if the CSV records seem to be most-recent-first (because-    -- there's an explicit "newest-first" directive, or there's more-    -- than one date and the first date is more recent than the last):-    -- reverse them to get same-date transactions ordered chronologically.-    txns' =-      (if newestfirst || mdataseemsnewestfirst == Just True -        then dbg7 "reversed csv txns" . reverse else id) -        txns-      where-        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-    -- Second, sort by date.-    txns'' = dbg7 "date-sorted csv txns" $ sortBy (comparing tdate) txns'+      -- Ensure transactions are ordered chronologically.+      -- First, if the CSV records seem to be most-recent-first (because+      -- there's an explicit "newest-first" directive, or there's more+      -- than one date and the first date is more recent than the last):+      -- reverse them to get same-date transactions ordered chronologically.+      txns' =+        (if newestfirst || mdataseemsnewestfirst == Just True +          then dbg7 "reversed csv txns" . reverse else id) +          txns+        where+          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+      -- Second, sort by date.+      txns'' = dbg7 "date-sorted csv txns" $ sortBy (comparing tdate) txns' -  when (not rulesfileexists) $ do-    dbg1IO "creating conversion rules file" rulesfile-    T.writeFile rulesfile rulestext+    liftIO $ when (not rulesfileexists) $ do+      dbg1IO "creating conversion rules file" rulesfile+      T.writeFile rulesfile rulestext -  return $ Right nulljournal{jtxns=txns''}+    return nulljournal{jtxns=txns''}  -- | Parse special separator names TAB and SPACE, or return the first -- character. Return Nothing on empty string@@ -782,8 +771,8 @@         specials "tab"   = Just '\t'         specials xs      = fst <$> T.uncons xs -parseCsv :: Char -> FilePath -> Text -> IO (Either String CSV)-parseCsv separator filePath csvdata =+parseCsv :: Char -> FilePath -> Text -> ExceptT String IO CSV+parseCsv separator filePath csvdata = ExceptT $   case filePath of     "-" -> parseCassava separator "(stdin)" <$> T.getContents     _   -> return $ if T.null csvdata then Right mempty else parseCassava separator filePath csvdata@@ -811,9 +800,8 @@           printField = wrap "\"" "\"" . T.replace "\"" "\"\""  -- | Return the cleaned up and validated CSV data (can be empty), or an error.-validateCsv :: CsvRules -> Int -> Either String CSV -> Either String [CsvRecord]-validateCsv _ _           (Left err) = Left err-validateCsv rules numhdrlines (Right rs) = validate $ applyConditionalSkips $ drop numhdrlines $ filternulls rs+validateCsv :: CsvRules -> Int -> CSV -> Either String [CsvRecord]+validateCsv rules numhdrlines = validate . applyConditionalSkips . drop numhdrlines . filternulls   where     filternulls = filter (/=[""])     skipCount r =@@ -1244,15 +1232,15 @@         <|> replaceCsvFieldReference rules record <$> referencep)     t   where-    referencep = liftA2 T.cons (char '%') (takeWhile1P (Just "reference") isFieldNameChar) :: Parsec CustomErr Text Text+    referencep = liftA2 T.cons (char '%') (takeWhile1P (Just "reference") isFieldNameChar) :: Parsec HledgerParseErrorData Text Text     isFieldNameChar c = isAlphaNum c || c == '_' || c == '-'  -- | Replace something that looks like a reference to a csv field ("%date" or "%1) -- with that field's value. If it doesn't look like a field reference, or if we--- can't find such a field, leave it unchanged.+-- can't find such a field, replace it with the empty string. replaceCsvFieldReference :: CsvRules -> CsvRecord -> CsvFieldReference -> Text replaceCsvFieldReference rules record s = case T.uncons s of-    Just ('%', fieldname) -> fromMaybe s $ csvFieldValue rules record fieldname+    Just ('%', fieldname) -> fromMaybe "" $ csvFieldValue rules record fieldname     _                     -> s  -- | Get the (whitespace-stripped) value of a CSV field, identified by its name or@@ -1275,10 +1263,10 @@                ,"%Y-%-m-%-d"                ,"%Y.%-m.%-d"                -- ,"%-m/%-d/%Y"-                -- ,parseTime defaultTimeLocale "%Y/%m/%e" (take 5 s ++ "0" ++ drop 5 s)-                -- ,parseTime defaultTimeLocale "%Y-%m-%e" (take 5 s ++ "0" ++ drop 5 s)-                -- ,parseTime defaultTimeLocale "%m/%e/%Y" ('0':s)-                -- ,parseTime defaultTimeLocale "%m-%e-%Y" ('0':s)+                -- ,parseTimeM TruedefaultTimeLocale "%Y/%m/%e" (take 5 s ++ "0" ++ drop 5 s)+                -- ,parseTimeM TruedefaultTimeLocale "%Y-%m-%e" (take 5 s ++ "0" ++ drop 5 s)+                -- ,parseTimeM TruedefaultTimeLocale "%m/%e/%Y" ('0':s)+                -- ,parseTimeM TruedefaultTimeLocale "%m-%e-%Y" ('0':s)                ]                (:[])                 mformat

@@ -113,7 +113,7 @@ -- | Run a journal parser in some monad. See also: parseWithState. runJournalParser, rjp   :: Monad m-  => JournalParser m a -> Text -> m (Either (ParseErrorBundle Text CustomErr) a)+  => JournalParser m a -> Text -> m (Either HledgerParseErrors a) runJournalParser p = runParserT (evalStateT p nulljournal) "" rjp = runJournalParser @@ -122,7 +122,7 @@   :: Monad m   => ErroringJournalParser m a   -> Text-  -> m (Either FinalParseError (Either (ParseErrorBundle Text CustomErr) a))+  -> m (Either FinalParseError (Either HledgerParseErrors a)) runErroringJournalParser p t =   runExceptT $ runParserT (evalStateT p nulljournal) "" t rejp = runErroringJournalParser

@@ -58,7 +58,7 @@  --- ** imports import           Control.Monad-import           Control.Monad.Except (ExceptT)+import           Control.Monad.Except (ExceptT, liftEither) import           Control.Monad.State.Strict import           Data.Maybe (fromMaybe) import           Data.Text (Text)@@ -88,7 +88,9 @@ -- format, saving the provided file path and the current time, or give an -- error. parse :: InputOpts -> FilePath -> Text -> ExceptT String IO Journal-parse = parseAndFinaliseJournal' timeclockfilep+parse iopts fp t = initialiseAndParseJournal timeclockfilep iopts fp t+                   >>= liftEither . journalApplyAliases (aliasesFromOpts iopts)+                   >>= journalFinalise iopts fp t  --- ** parsers @@ -124,5 +126,3 @@   account <- fromMaybe "" <$> optional (lift skipNonNewlineSpaces1 >> modifiedaccountnamep)   description <- T.pack . fromMaybe "" <$> lift (optional (skipNonNewlineSpaces1 >> restofline))   return $ TimeclockEntry sourcepos (read [code]) datetime account description--

@@ -41,7 +41,7 @@  --- ** imports import Control.Monad-import Control.Monad.Except (ExceptT)+import Control.Monad.Except (ExceptT, liftEither) import Control.Monad.State.Strict import Data.Char (isSpace) import Data.List (foldl')@@ -71,7 +71,9 @@  -- | Parse and post-process a "Journal" from the timedot format, or give an error. parse :: InputOpts -> FilePath -> Text -> ExceptT String IO Journal-parse = parseAndFinaliseJournal' timedotp+parse iopts fp t = initialiseAndParseJournal timedotp iopts fp t+                   >>= liftEither . journalApplyAliases (aliasesFromOpts iopts)+                   >>= journalFinalise iopts fp t  --- ** utilities @@ -173,7 +175,7 @@   lift skipNonNewlineSpaces   hrs <-     try (lift followingcommentp >> return 0)-    <|> (durationp <*+    <|> (lift durationp <*          (try (lift followingcommentp) <|> (newline >> return "")))   mcs <- getDefaultCommodityAndStyle   let @@ -194,9 +196,9 @@   lift $ traceparse' "entryp"   return t -durationp :: JournalParser m Quantity+durationp :: TextParser m Quantity durationp = do-  lift $ traceparse "durationp"+  traceparse "durationp"   try numericquantityp <|> dotquantityp     -- <* traceparse' "durationp" @@ -209,12 +211,12 @@ -- 1.5h -- 90m -- @-numericquantityp :: JournalParser m Quantity+numericquantityp :: TextParser m Quantity numericquantityp = do   -- lift $ traceparse "numericquantityp"-  (q, _, _, _) <- lift $ numberp Nothing+  (q, _, _, _) <- numberp Nothing   msymbol <- optional $ choice $ map (string . fst) timeUnits-  lift skipNonNewlineSpaces+  skipNonNewlineSpaces   let q' =         case msymbol of           Nothing  -> q@@ -239,7 +241,7 @@ -- @ -- .... .. -- @-dotquantityp :: JournalParser m Quantity+dotquantityp :: TextParser m Quantity dotquantityp = do   -- lift $ traceparse "dotquantityp"   dots <- filter (not.isSpace) <$> many (oneOf (". " :: [Char]))

@@ -116,7 +116,12 @@     -- Additional reportq filtering, such as date filtering, happens down in      -- accountTransactionsReportItem, which discards transactions with no matched postings.     acctJournal =-          ptraceAtWith 5 (("ts3:\n"++).pshowTransactions.jtxns)+        -- With most calls we will not require transaction prices past this point, and can get a big+        -- speed improvement by stripping them early. In some cases, such as in hledger-ui, we still+        -- want to keep prices around, so we can toggle between cost and no cost quickly. We can use+        -- the show_costs_ flag to be efficient when we can, and detailed when we have to.+          (if show_costs_ ropts then id else journalMapPostingAmounts mixedAmountStripPrices)+        . ptraceAtWith 5 (("ts3:\n"++).pshowTransactions.jtxns)         -- maybe convert these transactions to cost or value         . journalApplyValuationFromOpts rspec         . ptraceAtWith 5 (("ts2:\n"++).pshowTransactions.jtxns)

@@ -120,6 +120,11 @@         sortOn (postingDateOrDate2 (whichDate ropts))            -- sort postings by date or date2       . (if invert_ ropts then map negatePostingAmount else id)  -- with --invert, invert amounts       . journalPostings+      -- With most calls we will not require transaction prices past this point, and can get a big+      -- speed improvement by stripping them early. In some cases, such as in hledger-ui, we still+      -- want to keep prices around, so we can toggle between cost and no cost quickly. We can use+      -- the show_costs_ flag to be efficient when we can, and detailed when we have to.+      . (if show_costs_ ropts then id else journalMapPostingAmounts mixedAmountStripPrices)       $ journalValueAndFilterPostings rspec{_rsQuery=beforeandduringq} j      -- filter postings by the query, with no start date or depth limit

@@ -594,7 +594,7 @@     costing     = journalToCost (fromMaybe NoConversionOp $ conversionop_ ropts)      -- Find the end of the period containing this posting-    periodEnd  = addDays (-1) . fromMaybe err . mPeriodEnd . postingDate+    periodEnd  = addDays (-1) . fromMaybe err . mPeriodEnd . postingDateOrDate2 (whichDate ropts)     mPeriodEnd = case interval_ ropts of         NoInterval -> const . spanEnd . fst $ reportSpan j rspec         _          -> spanEnd <=< latestSpanContaining (historical : spans)@@ -801,7 +801,7 @@ -- >>> _rsQuery $ set querystring ["assets"] defreportspec -- Acct (RegexpCI "assets") -- >>> _rsQuery $ set querystring ["(assets"] defreportspec--- *** Exception: Updating ReportSpec failed: try using overEither instead of over or setEither instead of set+-- *** Exception: Error: Updating ReportSpec failed: try using overEither instead of over or setEither instead of set -- >>> _rsQuery $ set period (MonthPeriod 2021 08) defreportspec -- Date DateSpan 2021-08 class HasReportOptsNoUpdate a => HasReportOpts a where

@@ -234,9 +234,25 @@ mapM' :: Monad f => (a -> f b) -> [a] -> f [b] mapM' f = sequence' . map f +-- | Find the number of digits of an 'Int'.+numDigitsInt :: Integral a => Int -> a+numDigitsInt n+    | n == minBound = 19  -- negate minBound is out of the range of Int+    | n < 0         = go (negate n)+    | otherwise     = go n+  where+    go a | a < 10                 = 1+         | a < 100                = 2+         | a < 1000               = 3+         | a < 10000              = 4+         | a >= 10000000000000000 = 16 + go (a `quot` 10000000000000000)+         | a >= 100000000         = 8  + go (a `quot` 100000000)+         | otherwise              = 4  + go (a `quot` 10000)+{-# INLINE numDigitsInt #-}+ -- | Simpler alias for errorWithoutStackTrace error' :: String -> a-error' = errorWithoutStackTrace+error' = errorWithoutStackTrace . ("Error: " <>)  -- | A version of errorWithoutStackTrace that adds a usage hint. usageError :: String -> a

@@ -6,14 +6,13 @@   SimpleTextParser,   TextParser, +  -- * SourcePos   SourcePos(..),   mkPos,   unPos,   initialPos,--  -- * SourcePos-  showSourcePosPair,-  showSourcePos,+  sourcePosPretty,+  sourcePosPairPretty,    choice',   choiceInState,@@ -39,7 +38,7 @@   skipNonNewlineSpaces',    -- * re-exports-  CustomErr+  HledgerParseErrorData ) where @@ -55,24 +54,20 @@ import Text.Printf  -- | A parser of string to some type.-type SimpleStringParser a = Parsec CustomErr String a+type SimpleStringParser a = Parsec HledgerParseErrorData String a  -- | A parser of strict text to some type.-type SimpleTextParser = Parsec CustomErr Text  -- XXX an "a" argument breaks the CsvRulesParser declaration somehow+type SimpleTextParser = Parsec HledgerParseErrorData Text  -- XXX an "a" argument breaks the CsvRulesParser declaration somehow  -- | A parser of text that runs in some monad.-type TextParser m a = ParsecT CustomErr Text m a---- | Render source position in human-readable form.-showSourcePos :: SourcePos -> String-showSourcePos (SourcePos fp l c) =-    show fp ++ " (line " ++ show (unPos l) ++ ", column " ++ show (unPos c) ++ ")"+type TextParser m a = ParsecT HledgerParseErrorData Text m a --- | Render a pair of source position in human-readable form.-showSourcePosPair :: (SourcePos, SourcePos) -> String-showSourcePosPair (SourcePos fp l1 _, SourcePos _ l2 c2) =-    show fp ++ " (lines " ++ show (unPos l1) ++ "-" ++ show l2' ++ ")"-  where l2' = if unPos c2 == 1 then unPos l2 - 1 else unPos l2  -- might be at end of file withat last new-line+-- | Render a pair of source positions in human-readable form, only displaying the range of lines.+sourcePosPairPretty :: (SourcePos, SourcePos) -> String+sourcePosPairPretty (SourcePos fp l1 _, SourcePos _ l2 c2) =+    fp ++ ":" ++ show (unPos l1) ++ "-" ++ show l2'+  where+    l2' = if unPos c2 == 1 then unPos l2 - 1 else unPos l2  -- might be at end of file with a final new line  -- | Backtracking choice, use this when alternatives share a prefix. -- Consumes no input if all choices fail.@@ -81,7 +76,7 @@  -- | Backtracking choice, use this when alternatives share a prefix. -- Consumes no input if all choices fail.-choiceInState :: [StateT s (ParsecT CustomErr Text m) a] -> StateT s (ParsecT CustomErr Text m) a+choiceInState :: [StateT s (ParsecT HledgerParseErrorData Text m) a] -> StateT s (ParsecT HledgerParseErrorData Text m) a choiceInState = choice . map try  surroundedBy :: Applicative m => m openclose -> m a -> m a@@ -92,7 +87,7 @@  -- | Run a text parser in the identity monad. See also: parseWithState. runTextParser, rtp-  :: TextParser Identity a -> Text -> Either (ParseErrorBundle Text CustomErr) a+  :: TextParser Identity a -> Text -> Either HledgerParseErrors a runTextParser = parsewith rtp = runTextParser @@ -105,9 +100,9 @@ parseWithState   :: Monad m   => st-  -> StateT st (ParsecT CustomErr Text m) a+  -> StateT st (ParsecT HledgerParseErrorData Text m) a   -> Text-  -> m (Either (ParseErrorBundle Text CustomErr) a)+  -> m (Either HledgerParseErrors a) parseWithState ctx p = runParserT (evalStateT p ctx) ""  parseWithState'@@ -144,7 +139,7 @@ isNonNewlineSpace :: Char -> Bool isNonNewlineSpace c = not (isNewline c) && isSpace c -spacenonewline :: (Stream s, Char ~ Token s) => ParsecT CustomErr s m Char+spacenonewline :: (Stream s, Char ~ Token s) => ParsecT HledgerParseErrorData s m Char spacenonewline = satisfy isNonNewlineSpace {-# INLINABLE spacenonewline #-} @@ -152,17 +147,17 @@ restofline = anySingle `manyTill` eolof  -- Skip many non-newline spaces.-skipNonNewlineSpaces :: (Stream s, Token s ~ Char) => ParsecT CustomErr s m ()+skipNonNewlineSpaces :: (Stream s, Token s ~ Char) => ParsecT HledgerParseErrorData s m () skipNonNewlineSpaces = () <$ takeWhileP Nothing isNonNewlineSpace {-# INLINABLE skipNonNewlineSpaces #-}  -- Skip many non-newline spaces, failing if there are none.-skipNonNewlineSpaces1 :: (Stream s, Token s ~ Char) => ParsecT CustomErr s m ()+skipNonNewlineSpaces1 :: (Stream s, Token s ~ Char) => ParsecT HledgerParseErrorData s m () skipNonNewlineSpaces1 = () <$ takeWhile1P Nothing isNonNewlineSpace {-# INLINABLE skipNonNewlineSpaces1 #-}  -- Skip many non-newline spaces, returning True if any have been skipped.-skipNonNewlineSpaces' :: (Stream s, Token s ~ Char) => ParsecT CustomErr s m Bool+skipNonNewlineSpaces' :: (Stream s, Token s ~ Char) => ParsecT HledgerParseErrorData s m Bool skipNonNewlineSpaces' = True <$ skipNonNewlineSpaces1 <|> pure False {-# INLINABLE skipNonNewlineSpaces' #-} 

@@ -20,7 +20,7 @@ ) where -import Control.Monad.Except (ExceptT, runExceptT)+import Control.Monad.Except (ExceptT(..), liftEither, runExceptT, withExceptT, unless) import Control.Monad.State.Strict (StateT, evalStateT, execStateT) import Data.Default (Default(..)) import Data.List (isInfixOf)@@ -31,7 +31,7 @@ -- import Test.Tasty.SmallCheck as SC import Text.Megaparsec import Text.Megaparsec.Custom-  ( CustomErr,+  ( HledgerParseErrorData,     FinalParseError,     attachSource,     customErrorBundlePretty,@@ -54,55 +54,55 @@ assertRight (Right _) = return () assertRight (Left a)  = assertFailure $ "expected Right, got (Left " ++ show a ++ ")" +-- | Run a parser on the given text and display a helpful error.+parseHelper :: (HasCallStack, Default st, Monad m) =>+  StateT st (ParsecT HledgerParseErrorData T.Text m) a -> T.Text -> ExceptT String m a+parseHelper parser input =+  withExceptT (\e -> "\nparse error at " ++ customErrorBundlePretty e ++ "\n") . ExceptT+  $ runParserT (evalStateT (parser <* eof) def) "" input++-- | Run a stateful parser in IO and process either a failure or success to+-- produce an 'Assertion'. Suitable for hledger's JournalParser parsers.+assertParseHelper :: (HasCallStack, Default st) =>+  (String -> Assertion) -> (a -> Assertion)+  -> StateT st (ParsecT HledgerParseErrorData T.Text IO) a -> T.Text+  -> Assertion+assertParseHelper onFailure onSuccess parser input =+  either onFailure onSuccess =<< runExceptT (parseHelper parser input)+ -- | Assert that this stateful parser runnable in IO successfully parses -- all of the given input text, showing the parse error if it fails. -- Suitable for hledger's JournalParser parsers.-assertParse :: (HasCallStack, Eq a, Show a, Default st) =>-  StateT st (ParsecT CustomErr T.Text IO) a -> T.Text -> Assertion-assertParse parser input = do-  ep <- runParserT (evalStateT (parser <* eof) def) "" input-  either (assertFailure.(++"\n").("\nparse error at "++).customErrorBundlePretty)-         (const $ return ())-         ep+assertParse :: (HasCallStack, Default st) =>+  StateT st (ParsecT HledgerParseErrorData T.Text IO) a -> T.Text -> Assertion+assertParse = assertParseHelper assertFailure (const $ return ())  -- | Assert a parser produces an expected value. assertParseEq :: (HasCallStack, Eq a, Show a, Default st) =>-  StateT st (ParsecT CustomErr T.Text IO) a -> T.Text -> a -> Assertion+  StateT st (ParsecT HledgerParseErrorData T.Text IO) a -> T.Text -> a -> Assertion assertParseEq parser input = assertParseEqOn parser input id  -- | Like assertParseEq, but transform the parse result with the given function -- before comparing it. assertParseEqOn :: (HasCallStack, Eq b, Show b, Default st) =>-  StateT st (ParsecT CustomErr T.Text IO) a -> T.Text -> (a -> b) -> b -> Assertion-assertParseEqOn parser input f expected = do-  ep <- runParserT (evalStateT (parser <* eof) def) "" input-  either (assertFailure . (++"\n") . ("\nparse error at "++) . customErrorBundlePretty)-         (assertEqual "" expected . f)-         ep+  StateT st (ParsecT HledgerParseErrorData T.Text IO) a -> T.Text -> (a -> b) -> b -> Assertion+assertParseEqOn parser input f expected =+  assertParseHelper assertFailure (assertEqual "" expected . f) parser input  -- | Assert that this stateful parser runnable in IO fails to parse -- the given input text, with a parse error containing the given string. assertParseError :: (HasCallStack, Eq a, Show a, Default st) =>-  StateT st (ParsecT CustomErr T.Text IO) a -> String -> String -> Assertion-assertParseError parser input errstr = do-  ep <- runParserT (evalStateT parser def) "" (T.pack input)-  case ep of-    Right v -> assertFailure $ "\nparse succeeded unexpectedly, producing:\n" ++ pshow v ++ "\n"-    Left e  -> do-      let e' = customErrorBundlePretty e-      if errstr `isInfixOf` e'-      then return ()-      else assertFailure $ "\nparse error is not as expected:\n" ++ e' ++ "\n"+  StateT st (ParsecT HledgerParseErrorData T.Text IO) a -> T.Text -> String -> Assertion+assertParseError parser input errstr = assertParseHelper+  (\e -> unless (errstr `isInfixOf` e) $ assertFailure $ "\nparse error is not as expected:" ++ e)+  (\v -> assertFailure $ "\nparse succeeded unexpectedly, producing:\n" ++ pshow v ++ "\n")+  parser input  -- | Run a stateful parser in IO like assertParse, then assert that the -- final state (the wrapped state, not megaparsec's internal state), -- transformed by the given function, matches the given expected value. assertParseStateOn :: (HasCallStack, Eq b, Show b, Default st) =>-     StateT st (ParsecT CustomErr T.Text IO) a-  -> T.Text-  -> (st -> b)-  -> b-  -> Assertion+     StateT st (ParsecT HledgerParseErrorData T.Text IO) a -> T.Text -> (st -> b) -> b -> Assertion assertParseStateOn parser input f expected = do   es <- runParserT (execStateT (parser <* eof) def) "" input   case es of@@ -110,70 +110,40 @@     Right s  -> assertEqual "" expected $ f s  -- | These "E" variants of the above are suitable for hledger's ErroringJournalParser parsers.+parseHelperE :: (HasCallStack, Default st, Monad m) =>+  StateT st (ParsecT HledgerParseErrorData T.Text (ExceptT FinalParseError m)) a -> T.Text -> ExceptT String m a+parseHelperE parser input = do+  withExceptT (\e -> "\nparse error at " ++ customErrorBundlePretty e ++ "\n") . liftEither+  =<< withExceptT (\e -> "parse error at " ++ finalErrorBundlePretty (attachSource "" input e))+        (runParserT (evalStateT (parser <* eof) def) "" input)++assertParseHelperE :: (HasCallStack, Default st) =>+  (String -> Assertion) -> (a -> Assertion)+  -> StateT st (ParsecT HledgerParseErrorData T.Text (ExceptT FinalParseError IO)) a -> T.Text+  -> Assertion+assertParseHelperE onFailure onSuccess parser input =+  either onFailure onSuccess =<< runExceptT (parseHelperE parser input)+ assertParseE   :: (HasCallStack, Eq a, Show a, Default st)-  => StateT st (ParsecT CustomErr T.Text (ExceptT FinalParseError IO)) a-  -> T.Text-  -> Assertion-assertParseE parser input = do-  let filepath = ""-  eep <- runExceptT $-           runParserT (evalStateT (parser <* eof) def) filepath input-  case eep of-    Left finalErr ->-      let prettyErr = finalErrorBundlePretty $ attachSource filepath input finalErr-      in  assertFailure $ "parse error at " <> prettyErr-    Right ep ->-      either (assertFailure.(++"\n").("\nparse error at "++).customErrorBundlePretty)-             (const $ return ())-             ep+  => StateT st (ParsecT HledgerParseErrorData T.Text (ExceptT FinalParseError IO)) a -> T.Text -> Assertion+assertParseE = assertParseHelperE assertFailure (const $ return ())  assertParseEqE   :: (Default st, Eq a, Show a, HasCallStack)-  => StateT st (ParsecT CustomErr T.Text (ExceptT FinalParseError IO)) a-  -> T.Text-  -> a-  -> Assertion+  => StateT st (ParsecT HledgerParseErrorData T.Text (ExceptT FinalParseError IO)) a -> T.Text -> a -> Assertion assertParseEqE parser input = assertParseEqOnE parser input id  assertParseEqOnE   :: (HasCallStack, Eq b, Show b, Default st)-  => StateT st (ParsecT CustomErr T.Text (ExceptT FinalParseError IO)) a-  -> T.Text-  -> (a -> b)-  -> b-  -> Assertion-assertParseEqOnE parser input f expected = do-  let filepath = ""-  eep <- runExceptT $ runParserT (evalStateT (parser <* eof) def) filepath input-  case eep of-    Left finalErr ->-      let prettyErr = finalErrorBundlePretty $ attachSource filepath input finalErr-      in  assertFailure $ "parse error at " <> prettyErr-    Right ep ->-      either (assertFailure . (++"\n") . ("\nparse error at "++) . customErrorBundlePretty)-             (assertEqual "" expected . f)-             ep+  => StateT st (ParsecT HledgerParseErrorData T.Text (ExceptT FinalParseError IO)) a -> T.Text -> (a -> b) -> b -> Assertion+assertParseEqOnE parser input f expected =+  assertParseHelperE assertFailure (assertEqual "" expected . f) parser input  assertParseErrorE   :: (Default st, Eq a, Show a, HasCallStack)-  => StateT st (ParsecT CustomErr T.Text (ExceptT FinalParseError IO)) a-  -> T.Text-  -> String-  -> Assertion-assertParseErrorE parser input errstr = do-  let filepath = ""-  eep <- runExceptT $ runParserT (evalStateT parser def) filepath input-  case eep of-    Left finalErr -> do-      let prettyErr = finalErrorBundlePretty $ attachSource filepath input finalErr-      if errstr `isInfixOf` prettyErr-      then return ()-      else assertFailure $ "\nparse error is not as expected:\n" ++ prettyErr ++ "\n"-    Right ep -> case ep of-      Right v -> assertFailure $ "\nparse succeeded unexpectedly, producing:\n" ++ pshow v ++ "\n"-      Left e  -> do-        let e' = customErrorBundlePretty e-        if errstr `isInfixOf` e'-        then return ()-        else assertFailure $ "\nparse error is not as expected:\n" ++ e' ++ "\n"+  => StateT st (ParsecT HledgerParseErrorData T.Text (ExceptT FinalParseError IO)) a -> T.Text -> String -> Assertion+assertParseErrorE parser input errstr = assertParseHelperE+  (\e -> unless (errstr `isInfixOf` e) $ assertFailure $ "\nparse error is not as expected:" ++ e)+  (\v -> assertFailure $ "\nparse succeeded unexpectedly, producing:\n" ++ pshow v ++ "\n")+  parser input

@@ -3,13 +3,13 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} -- new {-# LANGUAGE LambdaCase #-}-{-# LANGUAGE PackageImports #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} -- new  module Text.Megaparsec.Custom (-  -- * Custom parse error type-  CustomErr,+  -- * Custom parse error types+  HledgerParseErrorData,+  HledgerParseErrors,    -- * Failing with an arbitrary source position   parseErrorAt,@@ -56,12 +56,10 @@ import Text.Megaparsec  ---- * Custom parse error type---- | A custom error type for the parser. The type is specialized to--- parsers of 'Text' streams.+--- * Custom parse error types -data CustomErr+-- | Custom error data for hledger parsers. Specialised for a 'Text' parse stream.+data HledgerParseErrorData   -- | Fail with a message at a specific source position interval. The   -- interval must be contained within a single line.   = ErrorFailAt Int -- Starting offset@@ -70,21 +68,27 @@   -- | Re-throw parse errors obtained from the "re-parsing" of an excerpt   -- of the source text.   | ErrorReparsing-      (NE.NonEmpty (ParseError Text CustomErr)) -- Source fragment parse errors+      (NE.NonEmpty (ParseError Text HledgerParseErrorData)) -- Source fragment parse errors   deriving (Show, Eq, Ord) +-- | A specialised version of ParseErrorBundle: +-- a non-empty collection of hledger parse errors, +-- equipped with PosState to help pretty-print them.+-- Specialised for a 'Text' parse stream.+type HledgerParseErrors = ParseErrorBundle Text HledgerParseErrorData+ -- We require an 'Ord' instance for 'CustomError' so that they may be -- stored in a 'Set'. The actual instance is inconsequential, so we just -- derive it, but the derived instance requires an (orphan) instance for -- 'ParseError'. Hopefully this does not cause any trouble. -deriving instance Ord (ParseError Text CustomErr)+deriving instance Ord (ParseError Text HledgerParseErrorData) --- Note: the pretty-printing of our 'CustomErr' type is only partally+-- Note: the pretty-printing of our 'HledgerParseErrorData' type is only partally -- defined in its 'ShowErrorComponent' instance; we perform additional -- adjustments in 'customErrorBundlePretty'. -instance ShowErrorComponent CustomErr where+instance ShowErrorComponent HledgerParseErrorData where   showErrorComponent (ErrorFailAt _ _ errMsg) = errMsg   showErrorComponent (ErrorReparsing _) = "" -- dummy value @@ -99,7 +103,7 @@ -- start of the input stream (the number of tokens processed at that -- point). -parseErrorAt :: Int -> String -> CustomErr+parseErrorAt :: Int -> String -> HledgerParseErrorData parseErrorAt offset = ErrorFailAt offset (offset+1)  -- | Fail at a specific source interval, given by the raw offsets of its@@ -113,7 +117,7 @@   :: Int    -- ^ Start offset   -> Int    -- ^ End end offset   -> String -- ^ Error message-  -> CustomErr+  -> HledgerParseErrorData parseErrorAtRegion startOffset endOffset msg =   if startOffset < endOffset     then ErrorFailAt startOffset endOffset msg@@ -143,7 +147,7 @@ -- This function could be extended to return the result of 'p', but we don't -- currently need this. -excerpt_ :: MonadParsec CustomErr Text m => m a -> m SourceExcerpt+excerpt_ :: MonadParsec HledgerParseErrorData Text m => m a -> m SourceExcerpt excerpt_ p = do   offset <- getOffset   (!txt, _) <- match p@@ -165,8 +169,8 @@ reparseExcerpt   :: Monad m   => SourceExcerpt-  -> ParsecT CustomErr Text m a-  -> ParsecT CustomErr Text m a+  -> ParsecT HledgerParseErrorData Text m a+  -> ParsecT HledgerParseErrorData Text m a reparseExcerpt (SourceExcerpt offset txt) p = do   (_, res) <- lift $ runParserT' p (offsetInitialState offset txt)   case res of@@ -211,7 +215,7 @@ -- 0 (that is, the beginning of the source file), which is the -- case for 'ParseErrorBundle's returned from 'runParserT'. -customErrorBundlePretty :: ParseErrorBundle Text CustomErr -> String+customErrorBundlePretty :: HledgerParseErrors -> String customErrorBundlePretty errBundle =   let errBundle' = errBundle { bundleErrors =         NE.sortWith errorOffset $ -- megaparsec requires that the list of errors be sorted by their offsets@@ -220,7 +224,7 @@    where     finalizeCustomError-      :: ParseError Text CustomErr -> NE.NonEmpty (ParseError Text CustomErr)+      :: ParseError Text HledgerParseErrorData -> NE.NonEmpty (ParseError Text HledgerParseErrorData)     finalizeCustomError err = case findCustomError err of       Nothing -> pure err @@ -234,7 +238,7 @@      -- If any custom errors are present, arbitrarily take the first one     -- (since only one custom error should be used at a time).-    findCustomError :: ParseError Text CustomErr -> Maybe CustomErr+    findCustomError :: ParseError Text HledgerParseErrorData -> Maybe HledgerParseErrorData     findCustomError err = case err of       FancyError _ errSet ->         finds (\case {ErrorCustom e -> Just e; _ -> Nothing}) errSet@@ -281,7 +285,7 @@   | FinalBundleWithStack (FinalParseErrorBundle' e)   deriving (Show) -type FinalParseError = FinalParseError' CustomErr+type FinalParseError = FinalParseError' HledgerParseErrorData  -- We need a 'Monoid' instance for 'FinalParseError' so that 'ExceptT -- FinalParseError m' is an instance of Alternative and MonadPlus, which@@ -309,7 +313,7 @@   , includeFileStack :: [FilePath]   } deriving (Show) -type FinalParseErrorBundle = FinalParseErrorBundle' CustomErr+type FinalParseErrorBundle = FinalParseErrorBundle' HledgerParseErrorData   --- * Constructing and throwing final parse errors@@ -348,7 +352,7 @@ -- 'attachSource' must be used on a "final" parse error before it can be -- pretty-printed. -finalErrorBundlePretty :: FinalParseErrorBundle' CustomErr -> String+finalErrorBundlePretty :: FinalParseErrorBundle' HledgerParseErrorData -> String finalErrorBundlePretty bundle =      concatMap showIncludeFilepath (includeFileStack bundle)   <> customErrorBundlePretty (finalErrorBundle bundle)@@ -392,11 +396,11 @@  parseIncludeFile   :: Monad m-  => StateT st (ParsecT CustomErr Text (ExceptT FinalParseError m)) a+  => StateT st (ParsecT HledgerParseErrorData Text (ExceptT FinalParseError m)) a   -> st   -> FilePath   -> Text-  -> StateT st (ParsecT CustomErr Text (ExceptT FinalParseError m)) a+  -> StateT st (ParsecT HledgerParseErrorData Text (ExceptT FinalParseError m)) a parseIncludeFile parser initialState filepath text =   catchError parser' handler   where

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           hledger-lib-version:        1.25+version:        1.26 synopsis:       A reusable library providing the core functionality of hledger description:    A reusable library containing hledger's core functionality.                 This is used by most hledger* packages so that they support the same@@ -47,8 +47,11 @@       Hledger.Data.Amount       Hledger.Data.Balancing       Hledger.Data.Dates-      Hledger.Read.InputOptions+      Hledger.Data.Errors       Hledger.Data.Journal+      Hledger.Data.JournalChecks+      Hledger.Data.JournalChecks.Ordereddates+      Hledger.Data.JournalChecks.Uniqueleafnames       Hledger.Data.Json       Hledger.Data.Ledger       Hledger.Data.Period@@ -65,6 +68,7 @@       Hledger.Read       Hledger.Read.Common       Hledger.Read.CsvReader+      Hledger.Read.InputOptions       Hledger.Read.JournalReader       Hledger.Read.TimedotReader       Hledger.Read.TimeclockReader@@ -91,7 +95,7 @@       Paths_hledger_lib   hs-source-dirs:       ./-  ghc-options: -Wall -fno-warn-unused-do-bind -fno-warn-name-shadowing -fno-warn-missing-signatures -fno-warn-type-defaults -fno-warn-orphans -fno-warn-incomplete-uni-patterns+  ghc-options: -Wall -Wno-incomplete-uni-patterns -Wno-missing-signatures -Wno-name-shadowing -Wno-orphans -Wno-type-defaults -Wno-unused-do-bind   build-depends:       Decimal >=0.5.1     , Glob >=0.9@@ -109,7 +113,7 @@     , containers >=0.5.9     , data-default >=0.5     , directory-    , doclayout ==0.3.*+    , doclayout >=0.3 && <0.5     , extra >=1.6.3     , file-embed >=0.0.10     , filepath@@ -141,7 +145,7 @@   hs-source-dirs:       ./       test-  ghc-options: -Wall -fno-warn-unused-do-bind -fno-warn-name-shadowing -fno-warn-missing-signatures -fno-warn-type-defaults -fno-warn-orphans -fno-warn-incomplete-uni-patterns+  ghc-options: -Wall -Wno-incomplete-uni-patterns -Wno-missing-signatures -Wno-name-shadowing -Wno-orphans -Wno-type-defaults -Wno-unused-do-bind   build-depends:       Decimal >=0.5.1     , Glob >=0.7@@ -159,7 +163,7 @@     , containers >=0.5.9     , data-default >=0.5     , directory-    , doclayout ==0.3.*+    , doclayout >=0.3 && <0.5     , doctest >=0.18.1     , extra >=1.6.3     , file-embed >=0.0.10@@ -184,7 +188,7 @@     , uglymemo     , unordered-containers >=0.2     , utf8-string >=0.3.5-  if impl(ghc >= 9.0)+  if impl(ghc < 9.2)     buildable: False   default-language: Haskell2010 @@ -194,7 +198,7 @@   hs-source-dirs:       ./       test-  ghc-options: -Wall -fno-warn-unused-do-bind -fno-warn-name-shadowing -fno-warn-missing-signatures -fno-warn-type-defaults -fno-warn-orphans -fno-warn-incomplete-uni-patterns+  ghc-options: -Wall -Wno-incomplete-uni-patterns -Wno-missing-signatures -Wno-name-shadowing -Wno-orphans -Wno-type-defaults -Wno-unused-do-bind   build-depends:       Decimal >=0.5.1     , Glob >=0.9@@ -212,7 +216,7 @@     , containers >=0.5.9     , data-default >=0.5     , directory-    , doclayout ==0.3.*+    , doclayout >=0.3 && <0.5     , extra >=1.6.3     , file-embed >=0.0.10     , filepath