From c80c72d7cd2e6b84d466648cf3b3adef5caf8f0f Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Tue, 23 Aug 2022 11:58:31 +0100 Subject: [PATCH] dev: lib, cli, bin: enable/fix name shadowing warnings And a few other cleanups. --- Makefile | 3 +- bin/hledger-balance-as-budget.hs | 2 +- bin/hledger-combine-balances.hs | 2 +- bin/hledger-smooth.hs | 2 +- bin/hledger-swap-dates.hs | 2 +- hledger-lib/Hledger/Data/Account.hs | 6 +- hledger-lib/Hledger/Data/AccountName.hs | 14 +- hledger-lib/Hledger/Data/Amount.hs | 37 ++-- hledger-lib/Hledger/Data/Balancing.hs | 10 +- hledger-lib/Hledger/Data/Dates.hs | 72 ++++---- hledger-lib/Hledger/Data/Errors.hs | 16 +- hledger-lib/Hledger/Data/Journal.hs | 10 +- hledger-lib/Hledger/Data/JournalChecks.hs | 12 +- .../Data/JournalChecks/Ordereddates.hs | 21 ++- .../Data/JournalChecks/Uniqueleafnames.hs | 7 +- hledger-lib/Hledger/Data/Period.hs | 2 +- .../Hledger/Data/PeriodicTransaction.hs | 4 +- hledger-lib/Hledger/Data/Posting.hs | 8 +- hledger-lib/Hledger/Data/StringFormat.hs | 5 +- hledger-lib/Hledger/Data/Timeclock.hs | 4 +- hledger-lib/Hledger/Data/Transaction.hs | 13 +- hledger-lib/Hledger/Query.hs | 54 +++--- hledger-lib/Hledger/Read.hs | 8 +- hledger-lib/Hledger/Read/Common.hs | 36 ++-- hledger-lib/Hledger/Read/CsvReader.hs | 167 ++++++++++++++---- hledger-lib/Hledger/Read/JournalReader.hs | 22 +-- hledger-lib/Hledger/Read/TimedotReader.hs | 5 +- .../Reports/AccountTransactionsReport.hs | 8 +- hledger-lib/Hledger/Reports/BudgetReport.hs | 40 +++-- .../Hledger/Reports/MultiBalanceReport.hs | 20 +-- hledger-lib/Hledger/Reports/PostingsReport.hs | 12 +- hledger-lib/Hledger/Reports/ReportOptions.hs | 32 ++-- hledger-lib/Hledger/Utils.hs | 8 +- hledger-lib/Hledger/Utils/Regex.hs | 26 +-- hledger-lib/Text/Megaparsec/Custom.hs | 4 +- hledger-lib/Text/Tabular/AsciiWide.hs | 4 +- hledger-lib/package.yaml | 1 - hledger-ui/Hledger/UI/UIState.hs | 2 +- hledger-web/Hledger/Web/Widget/Common.hs | 4 +- hledger/Hledger/Cli/CliOptions.hs | 16 +- hledger/Hledger/Cli/Commands/Accounts.hs | 28 +-- hledger/Hledger/Cli/Commands/Add.hs | 30 ++-- hledger/Hledger/Cli/Commands/Aregister.hs | 10 +- hledger/Hledger/Cli/Commands/Balance.hs | 40 ++--- hledger/Hledger/Cli/Commands/Check.hs | 4 +- hledger/Hledger/Cli/Commands/Close.hs | 18 +- hledger/Hledger/Cli/Commands/Codes.hs | 4 +- hledger/Hledger/Cli/Commands/Descriptions.hs | 4 +- hledger/Hledger/Cli/Commands/Files.hs | 4 +- hledger/Hledger/Cli/Commands/Notes.hs | 4 +- hledger/Hledger/Cli/Commands/Payees.hs | 12 +- hledger/Hledger/Cli/Commands/Print.hs | 10 +- hledger/Hledger/Cli/Commands/Register.hs | 12 +- hledger/Hledger/Cli/Commands/Rewrite.hs | 6 +- hledger/Hledger/Cli/Commands/Roi.hs | 82 ++++----- hledger/Hledger/Cli/Commands/Stats.hs | 30 ++-- hledger/Hledger/Cli/CompoundBalanceCommand.hs | 22 +-- hledger/Hledger/Cli/Main.hs | 22 +-- hledger/Hledger/Cli/Utils.hs | 18 +- hledger/Hledger/Cli/Version.hs | 8 +- hledger/package.yaml | 1 - 61 files changed, 591 insertions(+), 499 deletions(-) diff --git a/Makefile b/Makefile index 59260d97e..98ccb6d93 100644 --- a/Makefile +++ b/Makefile @@ -206,7 +206,6 @@ WARNINGS:=\ -Wall \ -Wno-incomplete-uni-patterns \ -Wno-missing-signatures \ - -Wno-name-shadowing \ -Wno-orphans \ -Wno-type-defaults \ -Wno-unused-do-bind \ @@ -418,7 +417,7 @@ ghci-web-test: webdirs $(call def-help,ghci-web-test, start ghci REPL on hledger # better than stack exec ? # XXX does not see changes to files ghci-unit-test: $(call def-help,ghci-unit-test, start ghci REPL on hledger-lib + unit test suite) - $(STACKGHCI) ghci --ghc-options='-rtsopts -Wall -Wno-incomplete-uni-patterns -Wno-missing-signatures -Wno-name-shadowing -Wno-orphans -Wno-type-defaults -Wno-unused-do-bind -ihledger-lib -DDEVELOPMENT -DVERSION="\"1.26.99\""' hledger-lib/test/unittest.hs + $(STACKGHCI) ghci --ghc-options='-rtsopts $(WARNINGS) -ihledger-lib -DDEVELOPMENT -DVERSION="\"1.26.99\""' hledger-lib/test/unittest.hs # ghci-all: $(call def-help,ghci-all, start ghci REPL on all the hledger) # $(STACK) exec -- $(GHCI) $(BUILDFLAGS) \ diff --git a/bin/hledger-balance-as-budget.hs b/bin/hledger-balance-as-budget.hs index 8f4aa3ca3..486a91e00 100755 --- a/bin/hledger-balance-as-budget.hs +++ b/bin/hledger-balance-as-budget.hs @@ -3,7 +3,7 @@ -- Run from inside the hledger source tree, or compile with compile.sh. -- See hledger-check-fancyassertions.hs. --- {-# OPTIONS_GHC -Wno-missing-signatures -Wno-name-shadowing #-} +-- {-# OPTIONS_GHC -Wno-missing-signatures #-} {-| Construct two balance reports for two different time periods and use one of the as "budget" for the other, thus comparing them diff --git a/bin/hledger-combine-balances.hs b/bin/hledger-combine-balances.hs index 124f9af01..70bb922f0 100755 --- a/bin/hledger-combine-balances.hs +++ b/bin/hledger-combine-balances.hs @@ -5,7 +5,7 @@ {- Construct two balance reports for two different time periods and render them side by side -} -{-# OPTIONS_GHC -Wno-missing-signatures -Wno-name-shadowing #-} +{-# OPTIONS_GHC -Wno-missing-signatures #-} import System.Environment (getArgs) import Hledger.Cli diff --git a/bin/hledger-smooth.hs b/bin/hledger-smooth.hs index d0eaa3c3a..1bf5d25ea 100755 --- a/bin/hledger-smooth.hs +++ b/bin/hledger-smooth.hs @@ -15,7 +15,7 @@ {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE NamedFieldPuns #-} -{-# OPTIONS_GHC -Wall -Wno-missing-signatures -Wno-name-shadowing #-} +{-# OPTIONS_GHC -Wall -Wno-missing-signatures #-} import Data.List import Data.Maybe diff --git a/bin/hledger-swap-dates.hs b/bin/hledger-swap-dates.hs index 669a742c2..c553f09eb 100755 --- a/bin/hledger-swap-dates.hs +++ b/bin/hledger-swap-dates.hs @@ -3,7 +3,7 @@ -- Run from inside the hledger source tree, or compile with compile.sh. -- See hledger-check-fancyassertions.hs. -{-# OPTIONS_GHC -Wno-missing-signatures -Wno-name-shadowing #-} +{-# OPTIONS_GHC -Wno-missing-signatures #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE RecordWildCards #-} diff --git a/hledger-lib/Hledger/Data/Account.hs b/hledger-lib/Hledger/Data/Account.hs index a8bd8b22e..644468490 100644 --- a/hledger-lib/Hledger/Data/Account.hs +++ b/hledger-lib/Hledger/Data/Account.hs @@ -104,10 +104,10 @@ accountTree :: AccountName -> [AccountName] -> Account accountTree rootname as = nullacct{aname=rootname, asubs=map (uncurry accountTree') $ M.assocs m } where T m = treeFromPaths $ map expandAccountName as :: FastTree AccountName - accountTree' a (T m) = + accountTree' a (T m') = nullacct{ aname=a - ,asubs=map (uncurry accountTree') $ M.assocs m + ,asubs=map (uncurry accountTree') $ M.assocs m' } -- | An efficient-to-build tree suggested by Cale Gibbard, probably @@ -223,7 +223,7 @@ pruneAccounts p = headMay . prune -- tree's structure remains intact and can still be used. It's a tree/list! flattenAccounts :: Account -> [Account] flattenAccounts a = squish a [] - where squish a as = a : Prelude.foldr squish as (asubs a) + where squish a' as = a' : Prelude.foldr squish as (asubs a') -- | Filter an account tree (to a list). filterAccounts :: (Account -> Bool) -> Account -> [Account] diff --git a/hledger-lib/Hledger/Data/AccountName.hs b/hledger-lib/Hledger/Data/AccountName.hs index 95ed970ab..8d157bb4a 100644 --- a/hledger-lib/Hledger/Data/AccountName.hs +++ b/hledger-lib/Hledger/Data/AccountName.hs @@ -177,12 +177,12 @@ concatAccountNames as = accountNameWithPostingType t $ T.intercalate ":" $ map a -- Or, return any error arising from a bad regular expression in the aliases. accountNameApplyAliases :: [AccountAlias] -> AccountName -> Either RegexError AccountName accountNameApplyAliases aliases a = - let (aname,atype) = (accountNameWithoutPostingType a, accountNamePostingType a) + let (name,typ) = (accountNameWithoutPostingType a, accountNamePostingType a) in foldM (\acct alias -> dbg6 "result" $ aliasReplace (dbg6 "alias" alias) (dbg6 "account" acct)) - aname + name aliases - >>= Right . accountNameWithPostingType atype + >>= Right . accountNameWithPostingType typ -- | Memoising version of accountNameApplyAliases, maybe overkill. accountNameApplyAliasesMemo :: [AccountAlias] -> AccountName -> Either RegexError AccountName @@ -238,7 +238,7 @@ parentAccountNames :: AccountName -> [AccountName] parentAccountNames a = parentAccountNames' $ parentAccountName a where parentAccountNames' "" = [] - parentAccountNames' a = a : parentAccountNames' (parentAccountName a) + parentAccountNames' a2 = a2 : parentAccountNames' (parentAccountName a2) -- | Is the first account a parent or other ancestor of (and not the same as) the second ? isAccountNamePrefixOf :: AccountName -> AccountName -> Bool @@ -296,9 +296,9 @@ elideAccountName width s fitText Nothing (Just width) True False $ accountNameFromComponents $ elideparts width [] $ accountNameComponents s where elideparts :: Int -> [Text] -> [Text] -> [Text] - elideparts width done ss - | realLength (accountNameFromComponents $ done++ss) <= width = done++ss - | length ss > 1 = elideparts width (done++[textTakeWidth 2 $ head ss]) (tail ss) + elideparts w done ss + | realLength (accountNameFromComponents $ done++ss) <= w = done++ss + | length ss > 1 = elideparts w (done++[textTakeWidth 2 $ head ss]) (tail ss) | otherwise = done++ss -- | Keep only the first n components of an account name, where n diff --git a/hledger-lib/Hledger/Data/Amount.hs b/hledger-lib/Hledger/Data/Amount.hs index 91010046c..293eaa619 100644 --- a/hledger-lib/Hledger/Data/Amount.hs +++ b/hledger-lib/Hledger/Data/Amount.hs @@ -255,6 +255,7 @@ instance Num Amount where (-) = similarAmountsOp (-) (*) = similarAmountsOp (*) +-- TODO: amount, num are clashy -- | The empty simple amount. amount, nullamt :: Amount amount = Amount{acommodity="", aquantity=0, aprice=Nothing, astyle=amountstyle} @@ -314,8 +315,8 @@ amountCost a@Amount{aquantity=q, aprice=mp} = transformAmount :: (Quantity -> Quantity) -> Amount -> Amount transformAmount f a@Amount{aquantity=q,aprice=p} = a{aquantity=f q, aprice=f' <$> p} where - f' (TotalPrice a@Amount{aquantity=pq}) = TotalPrice a{aquantity = f pq} - f' p = p + f' (TotalPrice a1@Amount{aquantity=pq}) = TotalPrice a1{aquantity = f pq} + f' p' = p' -- | Divide an amount's quantity (and its total price, if it has one) by a constant. divideAmount :: Quantity -> Amount -> Amount @@ -522,15 +523,15 @@ showamountquantity amt@Amount{astyle=AmountStyle{asdecimalpoint=mdec, asdigitgro applyDigitGroupStyle :: Maybe DigitGroupStyle -> Int -> T.Text -> WideBuilder applyDigitGroupStyle Nothing l s = WideBuilder (TB.fromText s) l applyDigitGroupStyle (Just (DigitGroups _ [])) l s = WideBuilder (TB.fromText s) l -applyDigitGroupStyle (Just (DigitGroups c (g:gs))) l s = addseps (g:|gs) (toInteger l) s +applyDigitGroupStyle (Just (DigitGroups c (g0:gs0))) l0 s0 = addseps (g0:|gs0) (toInteger l0) s0 where - addseps (g:|gs) l s - | l' > 0 = addseps gs' l' rest <> WideBuilder (TB.singleton c <> TB.fromText part) (fromIntegral g + 1) - | otherwise = WideBuilder (TB.fromText s) (fromInteger l) + addseps (g1:|gs1) l1 s1 + | l2 > 0 = addseps gs2 l2 rest <> WideBuilder (TB.singleton c <> TB.fromText part) (fromIntegral g1 + 1) + | otherwise = WideBuilder (TB.fromText s1) (fromInteger l1) where - (rest, part) = T.splitAt (fromInteger l') s - gs' = fromMaybe (g:|[]) $ nonEmpty gs - l' = l - toInteger g + (rest, part) = T.splitAt (fromInteger l2) s1 + gs2 = fromMaybe (g1:|[]) $ nonEmpty gs1 + l2 = l1 - toInteger g1 -- like journalCanonicaliseAmounts -- | Canonicalise an amount's display style using the provided commodity style map. @@ -702,11 +703,11 @@ maCommodities = S.fromList . fmap acommodity . amounts' unifyMixedAmount :: MixedAmount -> Maybe Amount unifyMixedAmount = foldM combine 0 . amounts where - combine amount result - | amountIsZero amount = Just result - | amountIsZero result = Just amount - | acommodity amount == acommodity result = Just $ amount + result - | otherwise = Nothing + combine amt result + | amountIsZero amt = Just result + | amountIsZero result = Just amt + | acommodity amt == acommodity result = Just $ amt + result + | otherwise = Nothing -- | Sum same-commodity amounts in a lossy way, applying the first -- price to the result and discarding any other prices. Only used as a @@ -839,10 +840,10 @@ showMixedAmountDebug m | m == missingmixedamt = "(missing)" showMixedAmountB :: AmountDisplayOpts -> MixedAmount -> WideBuilder showMixedAmountB opts ma | displayOneLine opts = showMixedAmountOneLineB opts ma - | otherwise = WideBuilder (wbBuilder . mconcat $ intersperse sep lines) width + | otherwise = WideBuilder (wbBuilder . mconcat $ intersperse sep ls) width where - lines = showMixedAmountLinesB opts ma - width = headDef 0 $ map wbWidth lines + ls = showMixedAmountLinesB opts ma + width = headDef 0 $ map wbWidth ls sep = WideBuilder (TB.singleton '\n') 0 -- | Helper for showMixedAmountB to show a list of Amounts on multiple lines. This returns @@ -900,7 +901,7 @@ showMixedAmountOneLineB opts@AmountDisplayOpts{displayMaxWidth=mmax,displayMinWi dropWhileRev p = foldr (\x xs -> if null xs && p x then [] else x:xs) [] -- Add the elision strings (if any) to each amount - withElided = zipWith (\num amt -> (amt, elisionDisplay Nothing (wbWidth sep) num amt)) [n-1,n-2..0] + withElided = zipWith (\n2 amt -> (amt, elisionDisplay Nothing (wbWidth sep) n2 amt)) [n-1,n-2..0] orderedAmounts :: AmountDisplayOpts -> MixedAmount -> [Amount] orderedAmounts dopts = maybe id (mapM pad) (displayOrder dopts) . amounts diff --git a/hledger-lib/Hledger/Data/Balancing.hs b/hledger-lib/Hledger/Data/Balancing.hs index ad790191a..3e3e25f66 100644 --- a/hledger-lib/Hledger/Data/Balancing.hs +++ b/hledger-lib/Hledger/Data/Balancing.hs @@ -315,11 +315,11 @@ priceInferrerFor t pt = maybe id inferprice inferFromAndTo -- For each posting, if the posting type matches, there is only a single amount in the posting, -- and the commodity of the amount matches the amount we're converting from, -- then set its price based on the ratio between fromamount and toamount. - inferprice (fromamount, toamount) posting - | [a] <- amounts (pamount posting), ptype posting == pt, acommodity a == acommodity fromamount - = posting{ pamount = mixedAmount a{aprice=Just conversionprice} - , poriginal = Just $ originalPosting posting } - | otherwise = posting + inferprice (fromamount, toamount) p + | [a] <- amounts (pamount p), ptype p == pt, acommodity a == acommodity fromamount + = p{ pamount = mixedAmount a{aprice=Just conversionprice} + , poriginal = Just $ originalPosting p } + | otherwise = p where -- If only one Amount in the posting list matches fromamount we can use TotalPrice. -- Otherwise divide the conversion equally among the Amounts by using a unit price. diff --git a/hledger-lib/Hledger/Data/Dates.hs b/hledger-lib/Hledger/Data/Dates.hs index ff6982513..7ec2760f0 100644 --- a/hledger-lib/Hledger/Data/Dates.hs +++ b/hledger-lib/Hledger/Data/Dates.hs @@ -2,7 +2,6 @@ {-# LANGUAGE NoMonoLocalBinds #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeFamilies #-} {-| @@ -348,9 +347,9 @@ latestSpanContaining :: [DateSpan] -> Day -> Maybe DateSpan latestSpanContaining datespans = go where go day = do - span <- Set.lookupLT supSpan spanSet - guard $ spanContainsDate span day - return span + spn <- Set.lookupLT supSpan spanSet + guard $ spanContainsDate spn day + return spn where -- The smallest DateSpan larger than any DateSpan containing day. supSpan = DateSpan (Just $ addDays 1 day) Nothing @@ -387,18 +386,19 @@ spanFromSmartDate :: Day -> SmartDate -> DateSpan spanFromSmartDate refdate sdate = DateSpan (Just b) (Just e) where (ry,rm,_) = toGregorian refdate - (b,e) = span sdate - span :: SmartDate -> (Day,Day) - 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 + (b,e) = span' sdate + where + span' :: SmartDate -> (Day,Day) + 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 @@ -541,7 +541,7 @@ thisquarter = startofquarter startofquarter day = fromGregorian y (firstmonthofquarter m) 1 where (y,m,_) = toGregorian day - firstmonthofquarter m = ((m-1) `div` 3) * 3 + 1 + firstmonthofquarter m2 = ((m2-1) `div` 3) * 3 + 1 thisyear = startofyear prevyear = startofyear . addGregorianYearsClip (-1) @@ -577,14 +577,14 @@ intervalStartBefore int d = -- >>> nthdayofyearcontaining 1 1 wed22nd -- 2017-01-01 nthdayofyearcontaining :: Month -> MonthDay -> Day -> Day -nthdayofyearcontaining m md date +nthdayofyearcontaining m mdy date -- PARTIAL: | not (validMonth m) = error' $ "nthdayofyearcontaining: invalid month "++show m - | not (validDay md) = error' $ "nthdayofyearcontaining: invalid day " ++show md + | not (validDay mdy) = error' $ "nthdayofyearcontaining: invalid day " ++show mdy | mmddOfSameYear <= date = mmddOfSameYear | otherwise = mmddOfPrevYear - where mmddOfSameYear = addDays (toInteger md-1) $ applyN (m-1) nextmonth s - mmddOfPrevYear = addDays (toInteger md-1) $ applyN (m-1) nextmonth $ prevyear s + where mmddOfSameYear = addDays (toInteger mdy-1) $ applyN (m-1) nextmonth s + mmddOfPrevYear = addDays (toInteger mdy-1) $ applyN (m-1) nextmonth $ prevyear s s = startofyear date -- | For given date d find month-long interval that starts on nth day of month @@ -606,13 +606,13 @@ nthdayofyearcontaining m md date -- >>> nthdayofmonthcontaining 30 wed22nd -- 2017-10-30 nthdayofmonthcontaining :: MonthDay -> Day -> Day -nthdayofmonthcontaining md date +nthdayofmonthcontaining mdy date -- PARTIAL: - | not (validDay md) = error' $ "nthdayofmonthcontaining: invalid day " ++show md + | not (validDay mdy) = error' $ "nthdayofmonthcontaining: invalid day " ++show mdy | nthOfSameMonth <= date = nthOfSameMonth | otherwise = nthOfPrevMonth - where nthOfSameMonth = nthdayofmonth md s - nthOfPrevMonth = nthdayofmonth md $ prevmonth s + where nthOfSameMonth = nthdayofmonth mdy s + nthOfPrevMonth = nthdayofmonth mdy $ prevmonth s s = startofmonth date -- | For given date d find week-long interval that starts on nth day of week @@ -807,8 +807,8 @@ yyyymmdd :: TextParser m SmartDate yyyymmdd = do y <- read <$> count 4 digitChar m <- read <$> count 2 digitChar - md <- optional $ read <$> count 2 digitChar - case md of + mdy <- optional $ read <$> count 2 digitChar + case mdy of Nothing -> failIfInvalidDate $ SmartAssumeStart y (Just m) Just d -> maybe (Fail.fail $ showBadDate y m d) (return . SmartCompleteDate) $ fromGregorianValid y m d @@ -1080,19 +1080,19 @@ tests_Dates = testGroup "Dates" ] , testCase "match dayOfWeek" $ do - let dayofweek n s = splitspan (nthdayofweekcontaining n) (\w -> (if w == 0 then id else applyN (n-1) nextday . applyN (fromInteger w) nextweek)) 1 s - match ds day = splitSpan (DaysOfWeek [day]) ds @?= dayofweek day ds + let dayofweek n = splitspan (nthdayofweekcontaining n) (\w -> (if w == 0 then id else applyN (n-1) nextday . applyN (fromInteger w) nextweek)) 1 + matchdow ds day = splitSpan (DaysOfWeek [day]) ds @?= dayofweek day ds ys2021 = fromGregorian 2021 01 01 ye2021 = fromGregorian 2021 12 31 ys2022 = fromGregorian 2022 01 01 - mapM_ (match (DateSpan (Just ys2021) (Just ye2021))) [1..7] - mapM_ (match (DateSpan (Just ys2021) (Just ys2022))) [1..7] - mapM_ (match (DateSpan (Just ye2021) (Just ys2022))) [1..7] + mapM_ (matchdow (DateSpan (Just ys2021) (Just ye2021))) [1..7] + mapM_ (matchdow (DateSpan (Just ys2021) (Just ys2022))) [1..7] + mapM_ (matchdow (DateSpan (Just ye2021) (Just ys2022))) [1..7] - mapM_ (match (DateSpan (Just ye2021) Nothing)) [1..7] - mapM_ (match (DateSpan (Just ys2022) Nothing)) [1..7] + mapM_ (matchdow (DateSpan (Just ye2021) Nothing)) [1..7] + mapM_ (matchdow (DateSpan (Just ys2022) Nothing)) [1..7] - mapM_ (match (DateSpan Nothing (Just ye2021))) [1..7] - mapM_ (match (DateSpan Nothing (Just ys2022))) [1..7] + mapM_ (matchdow (DateSpan Nothing (Just ye2021))) [1..7] + mapM_ (matchdow (DateSpan Nothing (Just ys2022))) [1..7] ] diff --git a/hledger-lib/Hledger/Data/Errors.hs b/hledger-lib/Hledger/Data/Errors.hs index 83cbefb2b..f1964d3e1 100644 --- a/hledger-lib/Hledger/Data/Errors.hs +++ b/hledger-lib/Hledger/Data/Errors.hs @@ -111,24 +111,24 @@ makePostingAccountErrorExcerpt :: Posting -> (FilePath, Int, Maybe (Int, Maybe I makePostingAccountErrorExcerpt p = makePostingErrorExcerpt p finderrcols where -- Calculate columns suitable for highlighting the synthetic excerpt. - finderrcols p _ _ = Just (col, Just col2) + finderrcols p' _ _ = Just (col, Just col2) where - col = 5 + if isVirtual p then 1 else 0 - col2 = col + T.length (paccount p) - 1 + col = 5 + if isVirtual p' then 1 else 0 + col2 = col + T.length (paccount p') - 1 -- | From the given posting, make an error excerpt showing the transaction with -- the balance assertion highlighted. makeBalanceAssertionErrorExcerpt :: Posting -> (FilePath, Int, Maybe (Int, Maybe Int), Text) makeBalanceAssertionErrorExcerpt p = makePostingErrorExcerpt p finderrcols where - finderrcols p t trendered = Just (col, Just col2) + finderrcols p' t trendered = Just (col, Just col2) where -- Analyse the rendering to find the columns to highlight. tlines = dbg5 "tlines" $ max 1 $ length $ T.lines $ tcomment t -- transaction comment can generate extra lines (col, col2) = let def = (5, maximum (map T.length $ T.lines trendered)) -- fallback: underline whole posting. Shouldn't happen. in - case transactionFindPostingIndex (==p) t of + case transactionFindPostingIndex (==p') t of Nothing -> def Just idx -> fromMaybe def $ do let @@ -136,9 +136,9 @@ makeBalanceAssertionErrorExcerpt p = makePostingErrorExcerpt p finderrcols beforepslines = dbg5 "beforepslines" $ sum $ map (max 1 . length . T.lines . pcomment) beforeps -- posting comment can generate extra lines (assume only one commodity shown) assertionline <- dbg5 "assertionline" $ headMay $ drop (tlines + beforepslines) $ T.lines trendered let - col2 = T.length assertionline + col2' = T.length assertionline l = dropWhile (/= '=') $ reverse $ T.unpack assertionline l' = dropWhile (`elem` ['=','*']) l - col = length l' + 1 - return (col, col2) + col' = length l' + 1 + return (col', col2') diff --git a/hledger-lib/Hledger/Data/Journal.hs b/hledger-lib/Hledger/Data/Journal.hs index bc37aee3c..e3c17341d 100644 --- a/hledger-lib/Hledger/Data/Journal.hs +++ b/hledger-lib/Hledger/Data/Journal.hs @@ -252,14 +252,14 @@ dbgJournalAcctDeclOrder prefix where showAcctDeclsSummary :: [(AccountName,AccountDeclarationInfo)] -> String showAcctDeclsSummary adis - | length adis < (2*num+2) = "[" <> showadis adis <> "]" + | length adis < (2*n+2) = "[" <> showadis adis <> "]" | otherwise = - "[" <> showadis (take num adis) <> " ... " <> showadis (takelast num adis) <> "]" + "[" <> showadis (take n adis) <> " ... " <> showadis (takelast n adis) <> "]" where - num = 3 + n = 3 showadis = intercalate ", " . map showadi showadi (a,adi) = "("<>show (adideclarationorder adi)<>","<>T.unpack a<>")" - takelast n = reverse . take n . reverse + takelast n' = reverse . take n' . reverse instance Default Journal where def = nulljournal @@ -405,7 +405,7 @@ journalAccountTags Journal{jdeclaredaccounttags} a = M.findWithDefault [] a jdec -- | Which tags are in effect for this account, including tags inherited from parent accounts ? journalInheritedAccountTags :: Journal -> AccountName -> [Tag] journalInheritedAccountTags j a = - foldl' (\ts a -> ts `union` journalAccountTags j a) [] as + foldl' (\ts a' -> ts `union` journalAccountTags j a') [] as where as = a : parentAccountNames a -- PERF: cache in journal ? diff --git a/hledger-lib/Hledger/Data/JournalChecks.hs b/hledger-lib/Hledger/Data/JournalChecks.hs index b9528f12d..cc546d9b4 100644 --- a/hledger-lib/Hledger/Data/JournalChecks.hs +++ b/hledger-lib/Hledger/Data/JournalChecks.hs @@ -116,15 +116,15 @@ journalCheckCommodities j = mapM_ checkcommodities (journalPostings j) -- assets "C $" -1 @ $ 2 -- ^^^^^^^^^^^^^^ -- XXX refine this region when it's easy - finderrcols p t txntxt = - case transactionFindPostingIndex (==p) t of + 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 + 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) @@ -151,10 +151,10 @@ journalCheckPayees j = mapM_ checkpayee (jtxns j) -- Calculate columns suitable for highlighting the excerpt. -- We won't show these in the main error line as they aren't -- accurate for the actual data. - finderrcols t = Just (col, Just col2) + finderrcols t' = Just (col, Just col2) where - col = T.length (showTransactionLineFirstPart t) + 2 - col2 = col + T.length (transactionPayee t) - 1 + col = T.length (showTransactionLineFirstPart t') + 2 + col2 = col + T.length (transactionPayee t') - 1 ---------- diff --git a/hledger-lib/Hledger/Data/JournalChecks/Ordereddates.hs b/hledger-lib/Hledger/Data/JournalChecks/Ordereddates.hs index 51bb271ef..5fd81f08c 100755 --- a/hledger-lib/Hledger/Data/JournalChecks/Ordereddates.hs +++ b/hledger-lib/Hledger/Data/JournalChecks/Ordereddates.hs @@ -15,20 +15,19 @@ import Hledger.Utils (textChomp) journalCheckOrdereddates :: WhichDate -> Journal -> Either String () journalCheckOrdereddates whichdate j = do - let + 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 + compare' a b = getdate a <= getdate b + (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:\n%s\nOrdered dates checking is enabled, and this transaction's\n" - ++ "date%s (%s) is out of order with the previous transaction.\n" + ++ "date%s (%s) is out of order with the previous transaction.\n" ++ "Consider moving this entry into date order, or adjusting its date.") f l ex datenum (show $ getdate t) where @@ -37,7 +36,7 @@ journalCheckOrdereddates whichdate j = do -- separate the two excerpts by a space-beginning line to help flycheck-hledger parse them ex = T.unlines [textChomp ex1, T.pack " ", textChomp ex2] finderrcols _t = Just (1, Just 10) - datenum = if whichdate==SecondaryDate then "2" else "" + datenum = if whichdate==SecondaryDate then "2" else "") data FoldAcc a b = FoldAcc { fa_error :: Maybe a @@ -46,11 +45,11 @@ data FoldAcc a b = FoldAcc checkTransactions :: (Transaction -> Transaction -> Bool) -> [Transaction] -> FoldAcc Transaction Transaction -checkTransactions compare = foldWhile f FoldAcc{fa_error=Nothing, fa_previous=Nothing} +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 + if compare' previous current then acc{fa_previous=Just current} else acc{fa_error=Just current} @@ -58,5 +57,5 @@ foldWhile :: (a -> FoldAcc a b -> FoldAcc a b) -> FoldAcc a b -> [a] -> FoldAcc foldWhile _ acc [] = acc foldWhile fold acc (a:as) = case fold a acc of - acc@FoldAcc{fa_error=Just _} -> acc - acc -> foldWhile fold acc as + acc'@FoldAcc{fa_error=Just _} -> acc' + acc' -> foldWhile fold acc' as diff --git a/hledger-lib/Hledger/Data/JournalChecks/Uniqueleafnames.hs b/hledger-lib/Hledger/Data/JournalChecks/Uniqueleafnames.hs index 2e78f8039..c343acc81 100755 --- a/hledger-lib/Hledger/Data/JournalChecks/Uniqueleafnames.hs +++ b/hledger-lib/Hledger/Data/JournalChecks/Uniqueleafnames.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} module Hledger.Data.JournalChecks.Uniqueleafnames ( @@ -43,12 +42,12 @@ journalCheckUniqueleafnames j = do (f,l,_,ex2) = makePostingErrorExcerpt p2 finderrcols -- separate the two excerpts by a space-beginning line to help flycheck-hledger parse them ex = T.unlines [textChomp ex1, T.pack " ...", textChomp ex2] - finderrcols p _ _ = Just (col, Just col2) + finderrcols p' _ _ = Just (col, Just col2) where - a = paccount p + a = paccount p' alen = T.length a llen = T.length $ accountLeafName a - col = 5 + (if isVirtual p then 1 else 0) + alen - llen + col = 5 + (if isVirtual p' then 1 else 0) + alen - llen col2 = col + llen - 1 accts = T.unlines fulls diff --git a/hledger-lib/Hledger/Data/Period.hs b/hledger-lib/Hledger/Data/Period.hs index 8bfaa0569..ac9750a9b 100644 --- a/hledger-lib/Hledger/Data/Period.hs +++ b/hledger-lib/Hledger/Data/Period.hs @@ -59,7 +59,7 @@ periodAsDateSpan (QuarterPeriod y q) = DateSpan (Just $ fromGregorian y m 1) (Ju where (y', q') | q==4 = (y+1,1) | otherwise = (y,q+1) - quarterAsMonth q = (q-1) * 3 + 1 + quarterAsMonth q2 = (q2-1) * 3 + 1 m = quarterAsMonth q m' = quarterAsMonth q' periodAsDateSpan (YearPeriod y) = DateSpan (Just $ fromGregorian y 1 1) (Just $ fromGregorian (y+1) 1 1) diff --git a/hledger-lib/Hledger/Data/PeriodicTransaction.hs b/hledger-lib/Hledger/Data/PeriodicTransaction.hs index 7eecfcfd3..a119bb1ee 100644 --- a/hledger-lib/Hledger/Data/PeriodicTransaction.hs +++ b/hledger-lib/Hledger/Data/PeriodicTransaction.hs @@ -41,7 +41,7 @@ _ptgen str = do nullperiodictransaction{ ptperiodexpr=t , ptspan=s, ptinterval=i, ptpostings=["a" `post` usd 1] } nulldatespan -_ptgenspan str span = do +_ptgenspan str spn = do let t = T.pack str (i,s) = parsePeriodExpr' nulldate t @@ -51,7 +51,7 @@ _ptgenspan str span = do mapM_ (T.putStr . showTransaction) $ runPeriodicTransaction nullperiodictransaction{ ptperiodexpr=t , ptspan=s, ptinterval=i, ptpostings=["a" `post` usd 1] } - span + spn --deriving instance Show PeriodicTransaction -- for better pretty-printing: diff --git a/hledger-lib/Hledger/Data/Posting.hs b/hledger-lib/Hledger/Data/Posting.hs index a8142dbfb..c212fd714 100644 --- a/hledger-lib/Hledger/Data/Posting.hs +++ b/hledger-lib/Hledger/Data/Posting.hs @@ -86,7 +86,7 @@ import Data.Time.Calendar (Day) import Safe (maximumBound) import Text.DocLayout (realLength) -import Text.Tabular.AsciiWide +import Text.Tabular.AsciiWide hiding (render) import Hledger.Utils import Hledger.Data.Types @@ -396,7 +396,7 @@ postingApplyAliases aliases p@Posting{paccount} = Right a -> Right p{paccount=a} Left e -> Left err where - err = "problem while applying account aliases:\n" ++ pshow aliases + err = "problem while applying account aliases:\n" ++ pshow aliases ++ "\n to account name: "++T.unpack paccount++"\n "++e -- | Choose and apply a consistent display style to the posting @@ -427,7 +427,7 @@ postingToCost styles ToCost p | "_conversion-matched" `elem` map fst (ptags p) && noCost = Nothing | otherwise = Just $ postingTransformAmount (styleMixedAmount styles . mixedAmountCost) p where - noCost = null . filter (isJust . aprice) . amountsRaw $ pamount p + noCost = (not . any (isJust . aprice) . amountsRaw) $ pamount p -- | Generate inferred equity postings from a 'Posting' using transaction prices. -- Make sure not to generate equity postings when there are already matched @@ -497,7 +497,7 @@ commentAddTag c (t,v) -- A space is inserted following the colon, before the value. commentAddTagNextLine :: Text -> Tag -> Text commentAddTagNextLine cmt (t,v) = - cmt <> (if "\n" `T.isSuffixOf` cmt then "" else "\n") <> t <> ": " <> v + cmt <> (if "\n" `T.isSuffixOf` cmt then "" else "\n") <> t <> ": " <> v -- tests diff --git a/hledger-lib/Hledger/Data/StringFormat.hs b/hledger-lib/Hledger/Data/StringFormat.hs index 6f51b3874..39993a7a0 100644 --- a/hledger-lib/Hledger/Data/StringFormat.hs +++ b/hledger-lib/Hledger/Data/StringFormat.hs @@ -4,7 +4,6 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE PackageImports #-} {-# LANGUAGE TypeFamilies #-} module Hledger.Data.StringFormat ( @@ -154,8 +153,8 @@ fieldp = do formatStringTester fs value expected = actual @?= expected where actual = case fs of - FormatLiteral l -> formatText False Nothing Nothing l - FormatField leftJustify min max _ -> formatText leftJustify min max value + FormatLiteral l -> formatText False Nothing Nothing l + FormatField leftJustify mn mx _ -> formatText leftJustify mn mx value tests_StringFormat = testGroup "StringFormat" [ diff --git a/hledger-lib/Hledger/Data/Timeclock.hs b/hledger-lib/Hledger/Data/Timeclock.hs index 7acd2d3fa..606f7ec0c 100644 --- a/hledger-lib/Hledger/Data/Timeclock.hs +++ b/hledger-lib/Hledger/Data/Timeclock.hs @@ -139,8 +139,8 @@ entryFromTimeclockInOut i o -- since otherwise it will often have large recurring decimal parts which (since 1.21) -- print would display all 255 digits of. timeclock amounts have one second resolution, -- so two decimal places is precise enough (#1527). - amount = mixedAmount $ setAmountInternalPrecision 2 $ hrs hours - ps = [posting{paccount=acctname, pamount=amount, ptype=VirtualPosting, ptransaction=Just t}] + amt = mixedAmount $ setAmountInternalPrecision 2 $ hrs hours + ps = [posting{paccount=acctname, pamount=amt, ptype=VirtualPosting, ptransaction=Just t}] -- tests diff --git a/hledger-lib/Hledger/Data/Transaction.hs b/hledger-lib/Hledger/Data/Transaction.hs index 6d1be1706..09587597a 100644 --- a/hledger-lib/Hledger/Data/Transaction.hs +++ b/hledger-lib/Hledger/Data/Transaction.hs @@ -10,7 +10,6 @@ tags. {-# LANGUAGE MultiWayIf #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TupleSections #-} module Hledger.Data.Transaction ( -- * Transaction @@ -250,8 +249,8 @@ transactionAddPricesFromEquity acctTypes t = first (annotateErrorWithTransaction | isConversion p = Right ((cs, others), Just np) | hasPrice p = Right ((cs, (np:ps, os)), Nothing) | otherwise = Right ((cs, (ps, np:os)), Nothing) - select np@(_, p) ((cs, others), Just last) - | isConversion p = Right (((last, np):cs, others), Nothing) + select np@(_, p) ((cs, others), Just lst) + | isConversion p = Right (((lst, np):cs, others), Nothing) | otherwise = Left "Conversion postings must occur in adjacent pairs" -- Given a pair of indexed conversion postings, and a state consisting of lists of @@ -267,10 +266,10 @@ transactionAddPricesFromEquity acctTypes t = first (annotateErrorWithTransaction ca1 <- postingAmountNoPrice cp1 ca2 <- postingAmountNoPrice cp2 let -- The function to add transaction prices and tag postings in the indexed list of postings - transformPostingF np pricep = \(n, p) -> - (n, if | n == np -> pricep `postingAddTags` [("_price-matched","")] - | n == n1 || n == n2 -> p `postingAddTags` [("_conversion-matched","")] - | otherwise -> p) + transformPostingF np pricep (n,p) = + (n, if | n == np -> pricep `postingAddTags` [("_price-matched","")] + | n == n1 || n == n2 -> p `postingAddTags` [("_conversion-matched","")] + | otherwise -> p) -- All priced postings which match the conversion posting pair matchingPricePs = mapMaybe (mapM $ pricedPostingIfMatchesBothAmounts ca1 ca2) priceps -- All other postings which match at least one of the conversion posting pair diff --git a/hledger-lib/Hledger/Query.hs b/hledger-lib/Hledger/Query.hs index ae37d253f..5d13ebdd2 100644 --- a/hledger-lib/Hledger/Query.hs +++ b/hledger-lib/Hledger/Query.hs @@ -67,7 +67,7 @@ module Hledger.Query ( matchesTags, matchesPriceDirective, words'', - prefixes, + queryprefixes, -- * tests tests_Query ) @@ -167,7 +167,7 @@ data QueryOpt = QueryOptInAcctOnly AccountName -- ^ show an account register fo -- >>> parseQuery nulldate "\"expenses:dining out\"" -- Right (Acct (RegexpCI "expenses:dining out"),[]) parseQuery :: Day -> T.Text -> Either String (Query,[QueryOpt]) -parseQuery d = parseQueryList d . words'' prefixes +parseQuery d = parseQueryList d . words'' queryprefixes -- | Convert a list of query expression containing to a query and zero -- or more query options; or return an error message if query parsing fails. @@ -234,8 +234,8 @@ words'' prefixes = fromparse . parsewith maybeprefixedquotedphrases -- XXX -- XXX -- keep synced with patterns below, excluding "not" -prefixes :: [T.Text] -prefixes = map (<>":") [ +queryprefixes :: [T.Text] +queryprefixes = map (<>":") [ "inacctonly" ,"inacct" ,"amt" @@ -285,10 +285,10 @@ parseQueryTerm _ (T.stripPrefix "note:" -> Just s) = Left <$> noteTag (Just s) parseQueryTerm _ (T.stripPrefix "acct:" -> Just s) = Left . Acct <$> toRegexCI s parseQueryTerm d (T.stripPrefix "date2:" -> Just s) = case parsePeriodExpr d s of Left e -> Left $ "\"date2:"++T.unpack s++"\" gave a "++showDateParseError e - Right (_,span) -> Right $ Left $ Date2 span + Right (_,spn) -> Right $ Left $ Date2 spn parseQueryTerm d (T.stripPrefix "date:" -> Just s) = case parsePeriodExpr d s of Left e -> Left $ "\"date:"++T.unpack s++"\" gave a "++showDateParseError e - Right (_,span) -> Right $ Left $ Date span + Right (_,spn) -> Right $ Left $ Date spn parseQueryTerm _ (T.stripPrefix "status:" -> Just s) = case parseStatus s of Left e -> Left $ "\"status:"++T.unpack s++"\" gave a parse error: " ++ e Right st -> Right $ Left $ StatusQ st @@ -412,9 +412,9 @@ truestrings = ["1"] -- * modifying simplifyQuery :: Query -> Query -simplifyQuery q = - let q' = simplify q - in if q' == q then q else simplifyQuery q' +simplifyQuery q0 = + let q1 = simplify q0 + in if q1 == q0 then q0 else simplifyQuery q1 where simplify (And []) = Any simplify (And [q]) = simplify q @@ -455,7 +455,7 @@ filterQuery' p q = if p q then q else Any -- (Since 1.24.1, might be merged into filterQuery in future.) -- XXX Semantics not completely clear. filterQueryOrNotQuery :: (Query -> Bool) -> Query -> Query -filterQueryOrNotQuery p = simplifyQuery . filterQueryOrNotQuery' p +filterQueryOrNotQuery p0 = simplifyQuery . filterQueryOrNotQuery' p0 where filterQueryOrNotQuery' :: (Query -> Bool) -> Query -> Query filterQueryOrNotQuery' p (And qs) = And $ map (filterQueryOrNotQuery p) qs @@ -584,7 +584,7 @@ queryEndDate False (Date (DateSpan _ (Just d))) = Just d queryEndDate True (Date2 (DateSpan _ (Just d))) = Just d queryEndDate _ _ = Nothing -queryTermDateSpan (Date span) = Just span +queryTermDateSpan (Date spn) = Just spn queryTermDateSpan _ = Nothing -- | What date span (or with a true argument, what secondary date span) does this query specify ? @@ -594,8 +594,8 @@ queryTermDateSpan _ = Nothing queryDateSpan :: Bool -> Query -> DateSpan queryDateSpan secondary (Or qs) = spansUnion $ map (queryDateSpan secondary) qs queryDateSpan secondary (And qs) = spansIntersect $ map (queryDateSpan secondary) qs -queryDateSpan _ (Date span) = span -queryDateSpan True (Date2 span) = span +queryDateSpan _ (Date spn) = spn +queryDateSpan True (Date2 spn) = spn queryDateSpan _ _ = nulldatespan -- | What date span does this query specify, treating primary and secondary dates as equivalent ? @@ -605,8 +605,8 @@ queryDateSpan _ _ = nulldatespan queryDateSpan' :: Query -> DateSpan queryDateSpan' (Or qs) = spansUnion $ map queryDateSpan' qs queryDateSpan' (And qs) = spansIntersect $ map queryDateSpan' qs -queryDateSpan' (Date span) = span -queryDateSpan' (Date2 span) = span +queryDateSpan' (Date spn) = spn +queryDateSpan' (Date2 spn) = spn queryDateSpan' _ = nulldatespan -- | What is the earliest of these dates, where Nothing is earliest ? @@ -732,16 +732,16 @@ matchesPosting (And qs) p = all (`matchesPosting` p) qs matchesPosting (Code r) p = maybe False (regexMatchText r . tcode) $ ptransaction p matchesPosting (Desc r) p = maybe False (regexMatchText r . tdescription) $ ptransaction p matchesPosting (Acct r) p = matches p || maybe False matches (poriginal p) where matches = regexMatchText r . paccount -matchesPosting (Date span) p = span `spanContainsDate` postingDate p -matchesPosting (Date2 span) p = span `spanContainsDate` postingDate2 p +matchesPosting (Date spn) p = spn `spanContainsDate` postingDate p +matchesPosting (Date2 spn) p = spn `spanContainsDate` postingDate2 p matchesPosting (StatusQ s) p = postingStatus p == s matchesPosting (Real v) p = v == isReal p matchesPosting q@(Depth _) Posting{paccount=a} = q `matchesAccount` a matchesPosting q@(Amt _ _) Posting{pamount=as} = q `matchesMixedAmount` as matchesPosting (Sym r) Posting{pamount=as} = any (matchesCommodity (Sym r) . acommodity) $ amountsRaw as matchesPosting (Tag n v) p = case (reString n, v) of - ("payee", Just v) -> maybe False (regexMatchText v . transactionPayee) $ ptransaction p - ("note", Just v) -> maybe False (regexMatchText v . transactionNote) $ ptransaction p + ("payee", Just v') -> maybe False (regexMatchText v' . transactionPayee) $ ptransaction p + ("note", Just v') -> maybe False (regexMatchText v' . transactionNote) $ ptransaction p (_, mv) -> matchesTags n mv $ postingAllTags p matchesPosting (Type _) _ = False @@ -765,17 +765,17 @@ matchesTransaction (And qs) t = all (`matchesTransaction` t) qs matchesTransaction (Code r) t = regexMatchText r $ tcode t matchesTransaction (Desc r) t = regexMatchText r $ tdescription t matchesTransaction q@(Acct _) t = any (q `matchesPosting`) $ tpostings t -matchesTransaction (Date span) t = spanContainsDate span $ tdate t -matchesTransaction (Date2 span) t = spanContainsDate span $ transactionDate2 t +matchesTransaction (Date spn) t = spanContainsDate spn $ tdate t +matchesTransaction (Date2 spn) t = spanContainsDate spn $ transactionDate2 t matchesTransaction (StatusQ s) t = tstatus t == s matchesTransaction (Real v) t = v == hasRealPostings t matchesTransaction q@(Amt _ _) t = any (q `matchesPosting`) $ tpostings t matchesTransaction (Depth d) t = any (Depth d `matchesPosting`) $ tpostings t matchesTransaction q@(Sym _) t = any (q `matchesPosting`) $ tpostings t matchesTransaction (Tag n v) t = case (reString n, v) of - ("payee", Just v) -> regexMatchText v $ transactionPayee t - ("note", Just v) -> regexMatchText v $ transactionNote t - (_, v) -> matchesTags n v $ transactionAllTags t + ("payee", Just v') -> regexMatchText v' $ transactionPayee t + ("note", Just v') -> regexMatchText v' $ transactionNote t + (_, v') -> matchesTags n v' $ transactionAllTags t matchesTransaction (Type _) _ = False -- | Like matchesTransaction, but if the journal's account types are provided, @@ -821,7 +821,7 @@ matchesPriceDirective (Or qs) p = any (`matchesPriceDirective` p) qs matchesPriceDirective (And qs) p = all (`matchesPriceDirective` p) qs matchesPriceDirective q@(Amt _ _) p = matchesAmount q (pdamount p) matchesPriceDirective q@(Sym _) p = matchesCommodity q (pdcommodity p) -matchesPriceDirective (Date span) p = spanContainsDate span (pddate p) +matchesPriceDirective (Date spn) p = spanContainsDate spn (pddate p) matchesPriceDirective _ _ = True @@ -854,8 +854,8 @@ tests_Query = testGroup "Query" [ (words'' [] "not:'a b'") @?= ["not:a b"] (words'' [] "'not:a b'") @?= ["not:a b"] (words'' ["desc:"] "not:desc:'a b'") @?= ["not:desc:a b"] - (words'' prefixes "\"acct:expenses:autres d\233penses\"") @?= ["acct:expenses:autres d\233penses"] - (words'' prefixes "\"") @?= ["\""] + (words'' queryprefixes "\"acct:expenses:autres d\233penses\"") @?= ["acct:expenses:autres d\233penses"] + (words'' queryprefixes "\"") @?= ["\""] ,testCase "filterQuery" $ do filterQuery queryIsDepth Any @?= Any diff --git a/hledger-lib/Hledger/Read.hs b/hledger-lib/Hledger/Read.hs index c5c2585e7..b1b4f2191 100644 --- a/hledger-lib/Hledger/Read.hs +++ b/hledger-lib/Hledger/Read.hs @@ -108,15 +108,15 @@ defaultJournal = defaultJournalPath >>= runExceptT . readJournalFile definputopt defaultJournalPath :: IO String defaultJournalPath = do s <- envJournalPath - if null s then defaultJournalPath else return s + if null s then defpath else return s where envJournalPath = getEnv journalEnvVar `C.catch` (\(_::C.IOException) -> getEnv journalEnvVar2 `C.catch` (\(_::C.IOException) -> return "")) - defaultJournalPath = do - home <- getHomeDirectory `C.catch` (\(_::C.IOException) -> return "") - return $ home journalDefaultFilename + defpath = do + home <- getHomeDirectory `C.catch` (\(_::C.IOException) -> return "") + return $ home journalDefaultFilename -- | A file path optionally prefixed by a reader name and colon -- (journal:, csv:, timedot:, etc.). diff --git a/hledger-lib/Hledger/Read/Common.hs b/hledger-lib/Hledger/Read/Common.hs index 917e943bb..711553704 100644 --- a/hledger-lib/Hledger/Read/Common.hs +++ b/hledger-lib/Hledger/Read/Common.hs @@ -195,7 +195,7 @@ rawOptsToInputOpts day rawopts = argsquery = lefts . rights . map (parseQueryTerm day) $ querystring_ ropts datequery = simplifyQuery . filterQuery queryIsDate . And $ queryFromFlags ropts : argsquery - commodity_styles = either err id $ commodityStyleFromRawOpts rawopts + styles = either err id $ commodityStyleFromRawOpts rawopts where err e = error' $ "could not parse commodity-style: '" ++ e ++ "'" -- PARTIAL: in definputopts{ @@ -215,7 +215,7 @@ rawOptsToInputOpts day rawopts = ,balancingopts_ = defbalancingopts{ ignore_assertions_ = boolopt "ignore-assertions" rawopts , infer_transaction_prices_ = not noinferprice - , commodity_styles_ = Just commodity_styles + , commodity_styles_ = Just styles } ,strict_ = boolopt "strict" rawopts ,_ioDay = day @@ -446,8 +446,8 @@ journalAddFile f j@Journal{jfiles=fs} = j{jfiles=fs++[f]} -- A version of `match` that is strict in the returned text match' :: TextParser m a -> TextParser m (Text, a) match' p = do - (!txt, p) <- match p - pure (txt, p) + (!txt, p') <- match p + pure (txt, p') --- ** parsers --- *** transaction bits @@ -514,9 +514,9 @@ datep' mYear = do Just date -> pure $! date partialDate :: Int -> Maybe Year -> Month -> Char -> MonthDay -> TextParser m Day - partialDate startOffset mYear month sep day = do + partialDate startOffset myr month sep day = do endOffset <- getOffset - case mYear of + case myr of Just year -> case fromGregorianValid year month day of Nothing -> customFailure $ parseErrorAtRegion startOffset endOffset $ @@ -611,12 +611,12 @@ yearorintp = do modifiedaccountnamep :: JournalParser m AccountName modifiedaccountnamep = do parent <- getParentAccount - aliases <- getAccountAliases + als <- getAccountAliases -- off1 <- getOffset a <- lift accountnamep -- off2 <- getOffset -- XXX or accountNameApplyAliasesMemo ? doesn't seem to make a difference (retest that function) - case accountNameApplyAliases aliases $ joinAccountNames parent a of + case accountNameApplyAliases als $ joinAccountNames parent a of Right a' -> return $! a' -- should not happen, regexaliasp will have displayed a better error already: -- (XXX why does customFailure cause error to be displayed there, but not here ?) @@ -660,12 +660,12 @@ singlespacednoncommenttext1p = singlespacedtextsatisfying1p (not . isSameLineCom -- | Parse non-empty, single-spaced text starting and ending with non-whitespace, -- where all characters satisfy the given predicate. singlespacedtextsatisfying1p :: (Char -> Bool) -> TextParser m T.Text -singlespacedtextsatisfying1p pred = do +singlespacedtextsatisfying1p f = do firstPart <- partp otherParts <- many $ try $ singlespacep *> partp pure $! T.unwords $ firstPart : otherParts where - partp = takeWhile1P Nothing (\c -> pred c && not (isSpace c)) + partp = takeWhile1P Nothing (\c -> f c && not (isSpace c)) -- | Parse one non-newline whitespace character that is not followed by another one. singlespacep :: TextParser m () @@ -708,20 +708,20 @@ amountp = amountpwithmultiplier False amountpwithmultiplier :: Bool -> JournalParser m Amount amountpwithmultiplier mult = label "amount" $ do let spaces = lift $ skipNonNewlineSpaces - amount <- amountwithoutpricep mult <* spaces + amt <- amountwithoutpricep mult <* spaces (mprice, _elotprice, _elotdate) <- runPermutation $ - (,,) <$> toPermutationWithDefault Nothing (Just <$> priceamountp amount <* spaces) + (,,) <$> toPermutationWithDefault Nothing (Just <$> priceamountp amt <* spaces) <*> toPermutationWithDefault Nothing (Just <$> lotpricep <* spaces) <*> toPermutationWithDefault Nothing (Just <$> lotdatep <* spaces) - pure $ amount { aprice = mprice } + pure $ amt { aprice = mprice } amountpnolotpricesp :: JournalParser m Amount amountpnolotpricesp = label "amount" $ do let spaces = lift $ skipNonNewlineSpaces - amount <- amountwithoutpricep False + amt <- amountwithoutpricep False spaces - mprice <- optional $ priceamountp amount <* spaces - pure $ amount { aprice = mprice } + mprice <- optional $ priceamountp amt <* spaces + pure $ amt { aprice = mprice } amountwithoutpricep :: Bool -> JournalParser m Amount amountwithoutpricep mult = do @@ -1094,8 +1094,8 @@ data DigitGrp = DigitGrp { -- | A custom show instance, showing digit groups as the parser saw them. instance Show DigitGrp where - show (DigitGrp len num) = "\"" ++ padding ++ numStr ++ "\"" - where numStr = show num + show (DigitGrp len n) = "\"" ++ padding ++ numStr ++ "\"" + where numStr = show n padding = genericReplicate (toInteger len - toInteger (length numStr)) '0' instance Sem.Semigroup DigitGrp where diff --git a/hledger-lib/Hledger/Read/CsvReader.hs b/hledger-lib/Hledger/Read/CsvReader.hs index 8170762b0..57cfda9be 100644 --- a/hledger-lib/Hledger/Read/CsvReader.hs +++ b/hledger-lib/Hledger/Read/CsvReader.hs @@ -13,9 +13,7 @@ A reader for CSV data, using an extra rules file to help interpret the data. --- ** language {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE MultiWayIf #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE PackageImports #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} @@ -38,7 +36,7 @@ where --- ** imports import Control.Applicative (liftA2) -import Control.Monad (unless, when) +import Control.Monad (unless, when, void) import Control.Monad.Except (ExceptT(..), liftEither, throwError) import qualified Control.Monad.Fail as Fail import Control.Monad.IO.Class (MonadIO, liftIO) @@ -104,13 +102,13 @@ parse :: InputOpts -> FilePath -> Text -> ExceptT String IO Journal parse iopts f t = do let rulesfile = mrules_file_ iopts 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 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 >>= journalFinalise iopts{balancingopts_=(balancingopts_ iopts){ignore_assertions_=True}} f t --- ** reading rules files @@ -193,14 +191,14 @@ instance ShowErrorComponent String where -- Included file paths may be relative to the directory of the provided file path. -- This is done as a pre-parse step to simplify the CSV rules parser. expandIncludes :: FilePath -> Text -> IO Text -expandIncludes dir content = mapM (expandLine dir) (T.lines content) >>= return . T.unlines +expandIncludes dir0 content = mapM (expandLine dir0) (T.lines content) <&> T.unlines where - expandLine dir line = + expandLine dir1 line = case line of - (T.stripPrefix "include " -> Just f) -> expandIncludes dir' =<< T.readFile f' + (T.stripPrefix "include " -> Just f) -> expandIncludes dir2 =<< T.readFile f' where - f' = dir T.unpack (T.dropWhile isSpace f) - dir' = takeDirectory f' + f' = dir1 T.unpack (T.dropWhile isSpace f) + dir2 = takeDirectory f' _ -> return line -- | An error-throwing IO action that parses this text as CSV conversion rules @@ -257,7 +255,7 @@ type CsvRules = CsvRules' (Text -> [ConditionalBlock]) instance Eq CsvRules where r1 == r2 = (rdirectives r1, rcsvfieldindexes r1, rassignments r1) == - (rdirectives r2, rcsvfieldindexes r2, rassignments r2) + (rdirectives r2, rcsvfieldindexes r2, rassignments r2) -- Custom Show instance used for debug output: omit the rblocksassigning field, which isn't showable. instance Show CsvRules where @@ -582,7 +580,7 @@ conditionaltablep = do newline body <- flip manyTill (lift eolof) $ do off <- getOffset - m <- matcherp' (char sep >> return ()) + m <- matcherp' $ void $ char sep 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" (length fields) (length vs)) :: String) @@ -745,8 +743,8 @@ readJournalFromCsv mrulesfile csvfile csvdata = do -- 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) + (if newestfirst || mdataseemsnewestfirst == Just True + then dbg7 "reversed csv txns" . reverse else id) txns where newestfirst = dbg6 "newestfirst" $ isJust $ getDirective "newest-first" rules @@ -757,7 +755,7 @@ readJournalFromCsv mrulesfile csvfile csvdata = do -- Second, sort by date. txns'' = dbg7 "date-sorted csv txns" $ sortBy (comparing tdate) txns' - liftIO $ when (not rulesfileexists) $ do + liftIO $ unless rulesfileexists $ do dbg1IO "creating conversion rules file" rulesfile T.writeFile rulesfile rulestext @@ -804,7 +802,7 @@ validateCsv :: CsvRules -> Int -> CSV -> Either String [CsvRecord] validateCsv rules numhdrlines = validate . applyConditionalSkips . drop numhdrlines . filternulls where filternulls = filter (/=[""]) - skipCount r = + skipnum r = case (getEffectiveAssignment rules r "end", getEffectiveAssignment rules r "skip") of (Nothing, Nothing) -> Nothing (Just _, _) -> Just maxBound @@ -812,7 +810,7 @@ validateCsv rules numhdrlines = validate . applyConditionalSkips . drop numhdrli (Nothing, Just x) -> Just (read $ T.unpack x) applyConditionalSkips [] = [] applyConditionalSkips (r:rest) = - case skipCount r of + case skipnum r of Nothing -> r:(applyConditionalSkips rest) Just cnt -> applyConditionalSkips (drop (cnt-1) rest) validate [] = Right [] @@ -869,15 +867,15 @@ transactionFromCsvRecord sourcepos rules record = t field = hledgerField rules record :: HledgerFieldName -> Maybe FieldTemplate fieldval = hledgerFieldValue rules record :: HledgerFieldName -> Maybe Text parsedate = parseDateWithCustomOrDefaultFormats (rule "date-format") - mkdateerror datefield datevalue mdateformat = T.unpack $ T.unlines + mkdateerror datefield datevalue mdateformat' = T.unpack $ T.unlines ["error: could not parse \""<>datevalue<>"\" as a date using date format " - <>maybe "\"YYYY/M/D\", \"YYYY-M-D\" or \"YYYY.M.D\"" (T.pack . show) mdateformat + <>maybe "\"YYYY/M/D\", \"YYYY-M-D\" or \"YYYY.M.D\"" (T.pack . show) mdateformat' ,showRecord record ,"the "<>datefield<>" rule is: "<>(fromMaybe "required, but missing" $ field datefield) - ,"the date-format is: "<>fromMaybe "unspecified" mdateformat + ,"the date-format is: "<>fromMaybe "unspecified" mdateformat' ,"you may need to " <>"change your "<>datefield<>" rule, " - <>maybe "add a" (const "change your") mdateformat<>" date-format rule, " + <>maybe "add a" (const "change your") mdateformat'<>" date-format rule, " <>"or "<>maybe "add a" (const "change your") mskip<>" skip rule" ,"for m/d/y or d/m/y dates, use date-format %-m/%-d/%Y or date-format %-d/%-m/%Y" ] @@ -894,7 +892,7 @@ transactionFromCsvRecord sourcepos rules record = t -- PARTIAL: date' = fromMaybe (error' $ mkdateerror "date" date mdateformat) $ parsedate date mdate2 = fieldval "date2" - mdate2' = maybe Nothing (maybe (error' $ mkdateerror "date2" (fromMaybe "" mdate2) mdateformat) Just . parsedate) mdate2 + mdate2' = (maybe (error' $ mkdateerror "date2" (fromMaybe "" mdate2) mdateformat) Just . parsedate) =<< mdate2 status = case fieldval "status" of Nothing -> Unmarked @@ -904,12 +902,12 @@ transactionFromCsvRecord sourcepos rules record = t ["error: could not parse \""<>s<>"\" as a cleared status (should be *, ! or empty)" ,"the parse error is: "<>T.pack (customErrorBundlePretty err) ] - code = maybe "" singleline $ fieldval "code" - description = maybe "" singleline $ fieldval "description" + code = maybe "" singleline' $ fieldval "code" + description = maybe "" singleline' $ fieldval "description" comment = maybe "" unescapeNewlines $ fieldval "comment" precomment = maybe "" unescapeNewlines $ fieldval "precomment" - singleline = T.unwords . filter (not . T.null) . map T.strip . T.lines + singleline' = T.unwords . filter (not . T.null) . map T.strip . T.lines unescapeNewlines = T.intercalate "\n" . T.splitOn "\\n" ---------------------------------------------------------------------- @@ -918,7 +916,7 @@ transactionFromCsvRecord sourcepos rules record = t p1IsVirtual = (accountNamePostingType <$> fieldval "account1") == Just VirtualPosting ps = [p | n <- [1..maxpostings] - ,let comment = maybe "" unescapeNewlines $ fieldval ("comment"<> T.pack (show n)) + ,let cmt = maybe "" unescapeNewlines $ fieldval ("comment"<> T.pack (show n)) ,let currency = fromMaybe "" (fieldval ("currency"<> T.pack (show n)) <|> fieldval "currency") ,let mamount = getAmount rules record currency p1IsVirtual n ,let mbalance = getBalance rules record currency n @@ -930,7 +928,7 @@ transactionFromCsvRecord sourcepos rules record = t ,pamount = fromMaybe missingmixedamt mamount ,ptransaction = Just t ,pbalanceassertion = mkBalanceAssertion rules record <$> mbalance - ,pcomment = comment + ,pcomment = cmt ,ptype = accountNamePostingType acct } ] @@ -967,7 +965,7 @@ getAmount rules record currency p1IsVirtual n = unnumberedfieldnames = ["amount","amount-in","amount-out"] -- amount field names which can affect this posting - fieldnames = map (("amount"<> T.pack(show n))<>) ["","-in","-out"] + fieldnames = map (("amount"<> T.pack (show n))<>) ["","-in","-out"] -- For posting 1, also recognise the old amount/amount-in/amount-out names. -- For posting 2, the same but only if posting 1 needs balancing. ++ if n==1 || n==2 && not p1IsVirtual then unnumberedfieldnames else [] @@ -1000,6 +998,37 @@ getAmount rules record currency p1IsVirtual n = [] -> Nothing [(f,a)] -> Just $ negateIfOut f a fs -> error' . T.unpack . textChomp . T.unlines $ -- PARTIAL: + -- PARTIAL: + -- PARTIAL: + -- PARTIAL: + -- PARTIAL: + -- PARTIAL: + -- PARTIAL: + -- PARTIAL: + -- PARTIAL: + -- PARTIAL: + -- PARTIAL: + -- PARTIAL: + -- PARTIAL: + -- PARTIAL: + -- PARTIAL: + -- PARTIAL: + -- PARTIAL: + -- PARTIAL: + -- PARTIAL: + -- PARTIAL: + -- PARTIAL: + -- PARTIAL: + -- PARTIAL: + -- PARTIAL: + -- PARTIAL: + -- PARTIAL: + -- PARTIAL: + -- PARTIAL: + -- PARTIAL: + -- PARTIAL: + -- PARTIAL: + -- PARTIAL: ["in CSV rules:" ,"While processing " <> showRecord record ,"while calculating amount for posting " <> T.pack (show n) @@ -1038,6 +1067,37 @@ getBalance rules record currency n = do parseAmount :: CsvRules -> CsvRecord -> Text -> Text -> MixedAmount parseAmount rules record currency s = either mkerror mixedAmount $ -- PARTIAL: + -- PARTIAL: + -- PARTIAL: + -- PARTIAL: + -- PARTIAL: + -- PARTIAL: + -- PARTIAL: + -- PARTIAL: + -- PARTIAL: + -- PARTIAL: + -- PARTIAL: + -- PARTIAL: + -- PARTIAL: + -- PARTIAL: + -- PARTIAL: + -- PARTIAL: + -- PARTIAL: + -- PARTIAL: + -- PARTIAL: + -- PARTIAL: + -- PARTIAL: + -- PARTIAL: + -- PARTIAL: + -- PARTIAL: + -- PARTIAL: + -- PARTIAL: + -- PARTIAL: + -- PARTIAL: + -- PARTIAL: + -- PARTIAL: + -- PARTIAL: + -- PARTIAL: runParser (evalStateT (amountp <* eof) journalparsestate) "" $ currency <> simplifySign s where @@ -1068,8 +1128,8 @@ parseBalanceAmount rules record currency n s = -- the csv record's line number would be good where journalparsestate = nulljournal{jparsedecimalmark=parseDecimalMark rules} - mkerror n s e = error' . T.unpack $ T.unlines - ["error: could not parse \"" <> s <> "\" as balance"<> T.pack (show n) <> " amount" + mkerror n' s' e = error' . T.unpack $ T.unlines + ["error: could not parse \"" <> s' <> "\" as balance"<> T.pack (show n') <> " amount" ,showRecord record ,showRules rules record -- ,"the default-currency is: "++fromMaybe "unspecified" mdefaultcurrency @@ -1252,17 +1312,19 @@ replaceCsvFieldReference rules record s = case T.uncons s of -- column number, ("date" or "1"), from the given CSV record, if such a field exists. csvFieldValue :: CsvRules -> CsvRecord -> CsvFieldName -> Maybe Text csvFieldValue rules record fieldname = do - fieldindex <- if | T.all isDigit fieldname -> readMay $ T.unpack fieldname - | otherwise -> lookup (T.toLower fieldname) $ rcsvfieldindexes rules + fieldindex <- + if T.all isDigit fieldname + then readMay $ T.unpack fieldname + else lookup (T.toLower fieldname) $ rcsvfieldindexes rules T.strip <$> atMay record (fieldindex-1) -- | Parse the date string using the specified date-format, or if unspecified -- the "simple date" formats (YYYY/MM/DD, YYYY-MM-DD, YYYY.MM.DD, leading -- zeroes optional). parseDateWithCustomOrDefaultFormats :: Maybe DateFormat -> Text -> Maybe Day -parseDateWithCustomOrDefaultFormats mformat s = asum $ map parsewith formats +parseDateWithCustomOrDefaultFormats mformat s = asum $ map parsewith' formats where - parsewith = flip (parseTimeM True defaultTimeLocale) (T.unpack s) + parsewith' = flip (parseTimeM True defaultTimeLocale) (T.unpack s) formats = map T.unpack $ maybe ["%Y/%-m/%-d" ,"%Y-%-m-%-d" @@ -1299,6 +1361,37 @@ tests_CsvReader = testGroup "CsvReader" [ ] ,testGroup "conditionalblockp" [ testCase "space after conditional" $ -- #1120 + -- #1120 + -- #1120 + -- #1120 + -- #1120 + -- #1120 + -- #1120 + -- #1120 + -- #1120 + -- #1120 + -- #1120 + -- #1120 + -- #1120 + -- #1120 + -- #1120 + -- #1120 + -- #1120 + -- #1120 + -- #1120 + -- #1120 + -- #1120 + -- #1120 + -- #1120 + -- #1120 + -- #1120 + -- #1120 + -- #1120 + -- #1120 + -- #1120 + -- #1120 + -- #1120 + -- #1120 parseWithState' defrules conditionalblockp "if a\n account2 b\n \n" @?= (Right $ CB{cbMatchers=[RecordMatcher None $ toRegexCI' "a"],cbAssignments=[("account2","b")]}) diff --git a/hledger-lib/Hledger/Read/JournalReader.hs b/hledger-lib/Hledger/Read/JournalReader.hs index a0a3180b9..a7073ff99 100644 --- a/hledger-lib/Hledger/Read/JournalReader.hs +++ b/hledger-lib/Hledger/Read/JournalReader.hs @@ -261,8 +261,8 @@ includedirectivep = do prefixedglob <- T.unpack <$> takeWhileP Nothing (/= '\n') -- don't consume newline yet parentoff <- getOffset parentpos <- getSourcePos - let (mprefix,glob) = splitReaderPrefix prefixedglob - paths <- getFilePaths parentoff parentpos glob + let (mprefix,glb) = splitReaderPrefix prefixedglob + paths <- getFilePaths parentoff parentpos glb let prefixedpaths = case mprefix of Nothing -> paths Just fmt -> map ((fmt++":")++) paths @@ -460,8 +460,8 @@ commoditydirectiveonelinep = do string "commodity" lift skipNonNewlineSpaces1 off <- getOffset - amount <- amountp - pure $ (off, amount) + amt <- amountp + pure $ (off, amt) lift skipNonNewlineSpaces _ <- lift followingcommentp let comm = Commodity{csymbol=acommodity, cformat=Just $ dbg6 "style from commodity directive" astyle} @@ -489,8 +489,8 @@ commoditydirectivemultilinep = do lift skipNonNewlineSpaces1 sym <- lift commoditysymbolp _ <- lift followingcommentp - mformat <- lastMay <$> many (indented $ formatdirectivep sym) - let comm = Commodity{csymbol=sym, cformat=mformat} + mfmt <- lastMay <$> many (indented $ formatdirectivep sym) + let comm = Commodity{csymbol=sym, cformat=mfmt} modify' (\j -> j{jcommodities=M.insert sym comm $ jcommodities j}) where indented = (lift skipNonNewlineSpaces1 >>) @@ -674,7 +674,7 @@ periodictransactionp = do -- first parsing with 'singlespacedtextp', then "re-parsing" with -- 'periodexprp' saves 'periodexprp' from having to respect the single- -- and double-space parsing rules - (interval, span) <- lift $ reparseExcerpt periodExcerpt $ do + (interval, spn) <- lift $ reparseExcerpt periodExcerpt $ do pexp <- periodexprp refdate (<|>) eof $ do offset1 <- getOffset @@ -687,7 +687,7 @@ periodictransactionp = do pure pexp -- In periodic transactions, the period expression has an additional constraint: - case checkPeriodicTransactionStartDate interval span periodtxt of + case checkPeriodicTransactionStartDate interval spn periodtxt of Just e -> customFailure $ parseErrorAt off e Nothing -> pure () @@ -701,7 +701,7 @@ periodictransactionp = do return $ nullperiodictransaction{ ptperiodexpr=periodtxt ,ptinterval=interval - ,ptspan=span + ,ptspan=spn ,ptstatus=status ,ptcode=code ,ptdescription=description @@ -767,7 +767,7 @@ postingphelper isPostingRule mTransactionYear = do let (ptype, account') = (accountNamePostingType account, textUnbracket account) lift skipNonNewlineSpaces mult <- if isPostingRule then multiplierp else pure False - amount <- optional $ amountpwithmultiplier mult + amt <- optional $ amountpwithmultiplier mult lift skipNonNewlineSpaces massertion <- optional balanceassertionp lift skipNonNewlineSpaces @@ -777,7 +777,7 @@ postingphelper isPostingRule mTransactionYear = do , pdate2=mdate2 , pstatus=status , paccount=account' - , pamount=maybe missingmixedamt mixedAmount amount + , pamount=maybe missingmixedamt mixedAmount amt , pcomment=comment , ptype=ptype , ptags=tags diff --git a/hledger-lib/Hledger/Read/TimedotReader.hs b/hledger-lib/Hledger/Read/TimedotReader.hs index aadf22775..68973fbf2 100644 --- a/hledger-lib/Hledger/Read/TimedotReader.hs +++ b/hledger-lib/Hledger/Read/TimedotReader.hs @@ -28,7 +28,6 @@ inc.client1 .... .... .. --- ** language {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE PackageImports #-} --- ** exports module Hledger.Read.TimedotReader ( @@ -173,7 +172,7 @@ entryp = do lift $ optional $ choice [orgheadingprefixp, skipNonNewlineSpaces1] a <- modifiedaccountnamep lift skipNonNewlineSpaces - hrs <- + hours <- try (lift followingcommentp >> return 0) <|> (lift durationp <* (try (lift followingcommentp) <|> (newline >> return ""))) @@ -187,7 +186,7 @@ entryp = do tstatus = Cleared, tpostings = [ nullposting{paccount=a - ,pamount=mixedAmount $ nullamt{acommodity=c, aquantity=hrs, astyle=s} + ,pamount=mixedAmount $ nullamt{acommodity=c, aquantity=hours, astyle=s} ,ptype=VirtualPosting ,ptransaction=Just t } diff --git a/hledger-lib/Hledger/Reports/AccountTransactionsReport.hs b/hledger-lib/Hledger/Reports/AccountTransactionsReport.hs index bd8900649..891554122 100644 --- a/hledger-lib/Hledger/Reports/AccountTransactionsReport.hs +++ b/hledger-lib/Hledger/Reports/AccountTransactionsReport.hs @@ -245,8 +245,8 @@ accountTransactionsReportByCommodity tr = -- balance amount) components that don't involve the specified -- commodity. Other item fields such as the transaction are left unchanged. filterAccountTransactionsReportByCommodity :: CommoditySymbol -> AccountTransactionsReport -> AccountTransactionsReport -filterAccountTransactionsReportByCommodity c = - fixTransactionsReportItemBalances . concatMap (filterTransactionsReportItemByCommodity c) +filterAccountTransactionsReportByCommodity comm = + fixTransactionsReportItemBalances . concatMap (filterTransactionsReportItemByCommodity comm) where filterTransactionsReportItemByCommodity c (t,t2,s,o,a,bal) | c `elem` cs = [item'] @@ -261,9 +261,9 @@ filterAccountTransactionsReportByCommodity c = fixTransactionsReportItemBalances items = reverse $ i:(go startbal is) where i:is = reverse items - startbal = filterMixedAmountByCommodity c $ triBalance i + startbal = filterMixedAmountByCommodity comm $ triBalance i go _ [] = [] - go bal ((t,t2,s,o,amt,_):is) = (t,t2,s,o,amt,bal'):go bal' is + go bal ((t,t2,s,o,amt,_):is') = (t,t2,s,o,amt,bal'):go bal' is' where bal' = bal `maPlus` amt -- tests diff --git a/hledger-lib/Hledger/Reports/BudgetReport.hs b/hledger-lib/Hledger/Reports/BudgetReport.hs index a6ddd9c55..cca06096a 100644 --- a/hledger-lib/Hledger/Reports/BudgetReport.hs +++ b/hledger-lib/Hledger/Reports/BudgetReport.hs @@ -133,17 +133,17 @@ journalAddBudgetGoalTransactions bopts ropts reportspan j = Just d -> Just d' where -- the interval and any date span of the periodic transaction with longest period - (interval, span) = + (intervl, spn) = case budgetpts of [] -> (Days 1, nulldatespan) pts -> (ptinterval pt, ptspan pt) where pt = maximumBy (comparing ptinterval) pts -- PARTIAL: maximumBy won't fail -- the natural start of this interval on or before the journal/report start - intervalstart = intervalStartBefore interval d + intervalstart = intervalStartBefore intervl d -- the natural interval start before the journal/report start, -- or the rule-specified start if later, -- but no later than the journal/report start. - d' = min d $ maybe intervalstart (max intervalstart) $ spanStart span + d' = min d $ maybe intervalstart (max intervalstart) $ spanStart spn -- select periodic transactions matching a pattern -- (the argument of the (final) --budget option). @@ -308,11 +308,11 @@ budgetReportAsTable | transpose_ = \(Tab.Table rh ch vals) -> Tab.Table ch rh (transpose vals) | otherwise = id - (accts, rows, totalrows) = (accts, prependcs itemscs (padcells texts), prependcs trcs (padtr trtexts)) + (accts, rows, totalrows) = (accts', prependcs itemscs (padcells texts), prependcs trcs (padtr trtexts)) where shownitems :: [[(AccountName, WideBuilder, BudgetDisplayRow)]] shownitems = (fmap (\i -> fmap (\(cs, cvals) -> (renderacct i, cs, cvals)) . showrow $ rowToBudgetCells i) items) - (accts, itemscs, texts) = unzip3 $ concat shownitems + (accts', itemscs, texts) = unzip3 $ concat shownitems showntr :: [[(WideBuilder, BudgetDisplayRow)]] showntr = [showrow $ rowToBudgetCells tr] @@ -381,10 +381,8 @@ budgetReportAsTable where actual' = fromMaybe nullmixedamt actual - budgetAndPerc b = uncurry zip - ( showmixed b - , fmap (wbFromText . T.pack . show . roundTo 0) <$> percbudget actual' b - ) + budgetAndPerc b = + zip (showmixed b) (fmap (wbFromText . T.pack . show . roundTo 0) <$> percbudget actual' b) full | Just b <- mbudget = Just <$> budgetAndPerc b @@ -397,9 +395,9 @@ budgetReportAsTable (TB.fromText . flip T.replicate " " $ actualwidth - w) <> b (totalpercentwidth, totalbudgetwidth) = - let totalpercentwidth = if percentwidth == 0 then 0 else percentwidth + 5 - in ( totalpercentwidth - , if budgetwidth == 0 then 0 else budgetwidth + totalpercentwidth + 3 + let totalpercentwidth' = if percentwidth == 0 then 0 else percentwidth + 5 + in ( totalpercentwidth' + , if budgetwidth == 0 then 0 else budgetwidth + totalpercentwidth' + 3 ) -- | Display a padded budget string @@ -446,14 +444,20 @@ budgetReportAsCsv (PeriodicReport colspans items tr) = (if transpose_ then transpose else id) $ + -- heading row + + -- heading row ("Account" : ["Commodity" | layout_ == LayoutBare ] - ++ concatMap (\span -> [showDateSpan span, "budget"]) colspans + ++ concatMap (\spn -> [showDateSpan spn, "budget"]) colspans ++ concat [["Total" ,"budget"] | row_total_] ++ concat [["Average","budget"] | average_] ) : + -- account rows + + -- account rows concatMap (rowAsTexts prrFullName) items @@ -461,23 +465,23 @@ budgetReportAsCsv ++ concat [ rowAsTexts (const "Total:") tr | not no_total_ ] where - flattentuples abs = concat [[a,b] | (a,b) <- abs] + flattentuples tups = concat [[a,b] | (a,b) <- tups] showNorm = maybe "" (wbToText . showMixedAmountB oneLine) rowAsTexts :: (PeriodicReportRow a BudgetCell -> Text) -> PeriodicReportRow a BudgetCell -> [[Text]] rowAsTexts render row@(PeriodicReportRow _ as (rowtot,budgettot) (rowavg, budgetavg)) - | layout_ /= LayoutBare = [render row : fmap showNorm all] + | layout_ /= LayoutBare = [render row : fmap showNorm vals] | otherwise = joinNames . zipWith (:) cs -- add symbols and names . transpose -- each row becomes a list of Text quantities . fmap (fmap wbToText . showMixedAmountLinesB oneLine{displayOrder=Just cs, displayMinWidth=Nothing} .fromMaybe nullmixedamt) - $ all + $ vals where - cs = S.toList . foldl' S.union mempty . fmap maCommodities $ catMaybes all - all = flattentuples as + cs = S.toList . foldl' S.union mempty . fmap maCommodities $ catMaybes vals + vals = flattentuples as ++ concat [[rowtot, budgettot] | row_total_] ++ concat [[rowavg, budgetavg] | average_] diff --git a/hledger-lib/Hledger/Reports/MultiBalanceReport.hs b/hledger-lib/Hledger/Reports/MultiBalanceReport.hs index 0a3a3795d..dd12201a5 100644 --- a/hledger-lib/Hledger/Reports/MultiBalanceReport.hs +++ b/hledger-lib/Hledger/Reports/MultiBalanceReport.hs @@ -343,7 +343,7 @@ calculateReportMatrix rspec@ReportSpec{_rsReportOpts=ropts} j priceoracle startb avalue = acctApplyBoth . mixedAmountApplyValuationAfterSumFromOptsWith ropts j priceoracle acctApplyBoth f a = a{aibalance = f $ aibalance a, aebalance = f $ aebalance a} historicalDate = minimumMay $ mapMaybe spanStart colspans - zeros = M.fromList [(span, nullacct) | span <- colspans] + zeros = M.fromList [(spn, nullacct) | spn <- colspans] colspans = map fst colps @@ -406,11 +406,11 @@ displayedAccounts :: ReportSpec -> HashMap AccountName (Map DateSpan Account) -> HashMap AccountName DisplayName displayedAccounts ReportSpec{_rsQuery=query,_rsReportOpts=ropts} unelidableaccts valuedaccts - | depth == 0 = HM.singleton "..." $ DisplayName "..." "..." 1 + | qdepth == 0 = HM.singleton "..." $ DisplayName "..." "..." 1 | otherwise = HM.mapWithKey (\a _ -> displayedName a) displayedAccts where -- Accounts which are to be displayed - displayedAccts = (if depth == 0 then id else HM.filterWithKey keep) valuedaccts + displayedAccts = (if qdepth == 0 then id else HM.filterWithKey keep) valuedaccts where keep name amts = isInteresting name amts || name `HM.member` interestingParents @@ -429,7 +429,7 @@ displayedAccounts ReportSpec{_rsQuery=query,_rsReportOpts=ropts} unelidableaccts -- Accounts interesting for their own sake isInteresting name amts = - d <= depth -- Throw out anything too deep + d <= qdepth -- Throw out anything too deep && ( name `Set.member` unelidableaccts -- Unelidable accounts should be kept unless too deep ||(empty_ ropts && keepWhenEmpty amts) -- Keep empty accounts when called with --empty || not (isZeroRow balance amts) -- Keep everything with a non-zero balance in the row @@ -440,8 +440,8 @@ displayedAccounts ReportSpec{_rsQuery=query,_rsReportOpts=ropts} unelidableaccts ALFlat -> const True -- Keep all empty accounts in flat mode ALTree -> all (null . asubs) -- Keep only empty leaves in tree mode balance = maybeStripPrices . case accountlistmode_ ropts of - ALTree | d == depth -> aibalance - _ -> aebalance + ALTree | d == qdepth -> aibalance + _ -> aebalance where maybeStripPrices = if conversionop_ ropts == Just NoConversionOp then id else mixedAmountStripPrices -- Accounts interesting because they are a fork for interesting subaccounts @@ -453,7 +453,7 @@ displayedAccounts ReportSpec{_rsQuery=query,_rsReportOpts=ropts} unelidableaccts minSubs = if no_elide_ ropts then 1 else 2 isZeroRow balance = all (mixedAmountLooksZero . balance) - depth = fromMaybe maxBound $ queryDepth query + qdepth = fromMaybe maxBound $ queryDepth query numSubs = subaccountTallies . HM.keys $ HM.filterWithKey isInteresting valuedaccts -- | Sort the rows by amount or by account declaration order. @@ -534,10 +534,10 @@ transposeMap :: [(DateSpan, HashMap AccountName a)] -> HashMap AccountName (Map DateSpan a) transposeMap = foldr (uncurry addSpan) mempty where - addSpan span acctmap seen = HM.foldrWithKey (addAcctSpan span) seen acctmap + addSpan spn acctmap seen = HM.foldrWithKey (addAcctSpan spn) seen acctmap - addAcctSpan span acct a = HM.alter f acct - where f = Just . M.insert span a . fromMaybe mempty + addAcctSpan spn acct a = HM.alter f acct + where f = Just . M.insert spn a . fromMaybe mempty -- | A sorting helper: sort a list of things (eg report rows) keyed by account name -- to match the provided ordering of those same account names. diff --git a/hledger-lib/Hledger/Reports/PostingsReport.hs b/hledger-lib/Hledger/Reports/PostingsReport.hs index 0e38b5bc6..f417098fc 100644 --- a/hledger-lib/Hledger/Reports/PostingsReport.hs +++ b/hledger-lib/Hledger/Reports/PostingsReport.hs @@ -73,8 +73,8 @@ postingsReport rspec@ReportSpec{_rsReportOpts=ropts@ReportOpts{..}} j = items -- Postings, or summary postings with their subperiod's end date, to be displayed. displayps :: [(Posting, Maybe Period)] - | multiperiod = [(p, Just period) | (p, period) <- summariseps reportps] - | otherwise = [(p, Nothing) | p <- reportps] + | multiperiod = [(p', Just period') | (p', period') <- summariseps reportps] + | otherwise = [(p', Nothing) | p' <- reportps] where summariseps = summarisePostingsByInterval whichdate mdepth showempty colspans showempty = empty_ || average_ @@ -189,9 +189,9 @@ summarisePostingsByInterval wd mdepth showempty colspans = -- with 0 amount. -- summarisePostingsInDateSpan :: DateSpan -> WhichDate -> Maybe Int -> Bool -> [Posting] -> [SummaryPosting] -summarisePostingsInDateSpan span@(DateSpan b e) wd mdepth showempty ps +summarisePostingsInDateSpan spn@(DateSpan b e) wd mdepth showempty ps | null ps && (isNothing b || isNothing e) = [] - | null ps && showempty = [(summaryp, dateSpanAsPeriod span)] + | null ps && showempty = [(summaryp, dateSpanAsPeriod spn)] | otherwise = summarypes where postingdate = if wd == PrimaryDate then postingDate else postingDate2 @@ -200,14 +200,14 @@ summarisePostingsInDateSpan span@(DateSpan b e) wd mdepth showempty ps clippedanames = nub $ map (clipAccountName mdepth) anames summaryps | mdepth == Just 0 = [summaryp{paccount="...",pamount=sumPostings ps}] | otherwise = [summaryp{paccount=a,pamount=balance a} | a <- clippedanames] - summarypes = map (, dateSpanAsPeriod span) $ (if showempty then id else filter (not . mixedAmountLooksZero . pamount)) summaryps + summarypes = map (, dateSpanAsPeriod spn) $ (if showempty then id else filter (not . mixedAmountLooksZero . pamount)) summaryps anames = nubSort $ map paccount ps -- aggregate balances by account, like ledgerFromJournal, then do depth-clipping accts = accountsFromPostings ps balance a = maybe nullmixedamt bal $ lookupAccount a accts where bal = if isclipped a then aibalance else aebalance - isclipped a = maybe False (accountNameLevel a >=) mdepth + isclipped a' = maybe False (accountNameLevel a' >=) mdepth negatePostingAmount :: Posting -> Posting negatePostingAmount = postingTransformAmount negate diff --git a/hledger-lib/Hledger/Reports/ReportOptions.hs b/hledger-lib/Hledger/Reports/ReportOptions.hs index b1994cc3d..cfd932585 100644 --- a/hledger-lib/Hledger/Reports/ReportOptions.hs +++ b/hledger-lib/Hledger/Reports/ReportOptions.hs @@ -292,8 +292,8 @@ defreportspec = ReportSpec -- | Set the default ConversionOp. setDefaultConversionOp :: ConversionOp -> ReportSpec -> ReportSpec -setDefaultConversionOp def rspec@ReportSpec{_rsReportOpts=ropts} = - rspec{_rsReportOpts=ropts{conversionop_=conversionop_ ropts <|> Just def}} +setDefaultConversionOp defop rspec@ReportSpec{_rsReportOpts=ropts} = + rspec{_rsReportOpts=ropts{conversionop_=conversionop_ ropts <|> Just defop}} accountlistmodeopt :: RawOpts -> AccountListMode accountlistmodeopt = @@ -360,7 +360,7 @@ layoutopt rawopts = fromMaybe (LayoutWide Nothing) $ layout <|> column (s,n) = break (==',') $ map toLower opt w = case drop 1 n of "" -> Nothing - c | Just w <- readMay c -> Just w + c | Just w' <- readMay c -> Just w' _ -> usageError "width in --layout=wide,WIDTH must be an integer" err = usageError "--layout's argument should be \"wide[,WIDTH]\", \"tall\", \"bare\", or \"tidy\"" @@ -390,14 +390,14 @@ periodFromRawOpts d rawopts = beginDatesFromRawOpts :: Day -> RawOpts -> [Day] beginDatesFromRawOpts d = collectopts (begindatefromrawopt d) where - begindatefromrawopt d (n,v) + begindatefromrawopt d' (n,v) | n == "begin" = either (\e -> usageError $ "could not parse "++n++" date: "++customErrorBundlePretty e) Just $ - fixSmartDateStrEither' d (T.pack v) + fixSmartDateStrEither' d' (T.pack v) | n == "period" = case either (\e -> usageError $ "could not parse period option: "++customErrorBundlePretty e) id $ - parsePeriodExpr d (stripquotes $ T.pack v) + parsePeriodExpr d' (stripquotes $ T.pack v) of (_, DateSpan (Just b) _) -> Just b _ -> Nothing @@ -408,14 +408,14 @@ beginDatesFromRawOpts d = collectopts (begindatefromrawopt d) endDatesFromRawOpts :: Day -> RawOpts -> [Day] endDatesFromRawOpts d = collectopts (enddatefromrawopt d) where - enddatefromrawopt d (n,v) + enddatefromrawopt d' (n,v) | n == "end" = either (\e -> usageError $ "could not parse "++n++" date: "++customErrorBundlePretty e) Just $ - fixSmartDateStrEither' d (T.pack v) + fixSmartDateStrEither' d' (T.pack v) | n == "period" = case either (\e -> usageError $ "could not parse period option: "++customErrorBundlePretty e) id $ - parsePeriodExpr d (stripquotes $ T.pack v) + parsePeriodExpr d' (stripquotes $ T.pack v) of (_, DateSpan _ (Just e)) -> Just e _ -> Nothing @@ -589,12 +589,12 @@ journalApplyValuationFromOptsWith rspec@ReportSpec{_rsReportOpts=ropts} j priceo CalcGain -> journalMapPostings (\p -> postingTransformAmount (gain p) p) j _ -> journalMapPostings (\p -> postingTransformAmount (valuation p) p) $ costing j where - valuation p = maybe id (mixedAmountApplyValuation priceoracle styles (periodEnd p) (_rsDay rspec) (postingDate p)) (value_ ropts) - gain p = maybe id (mixedAmountApplyGain priceoracle styles (periodEnd p) (_rsDay rspec) (postingDate p)) (value_ ropts) + valuation p = maybe id (mixedAmountApplyValuation priceoracle styles (postingperiodend p) (_rsDay rspec) (postingDate p)) (value_ ropts) + gain p = maybe id (mixedAmountApplyGain priceoracle styles (postingperiodend p) (_rsDay rspec) (postingDate p)) (value_ ropts) costing = journalToCost (fromMaybe NoConversionOp $ conversionop_ ropts) -- Find the end of the period containing this posting - periodEnd = addDays (-1) . fromMaybe err . mPeriodEnd . postingDateOrDate2 (whichDate ropts) + postingperiodend = addDays (-1) . fromMaybe err . mPeriodEnd . postingDateOrDate2 (whichDate ropts) mPeriodEnd = case interval_ ropts of NoInterval -> const . spanEnd . fst $ reportSpan j rspec _ -> spanEnd <=< latestSpanContaining (historical : spans) @@ -611,11 +611,11 @@ mixedAmountApplyValuationAfterSumFromOptsWith ropts j priceoracle = case valuationAfterSum ropts of Just mc -> case balancecalc_ ropts of CalcGain -> gain mc - _ -> \span -> valuation mc span . costing + _ -> \spn -> valuation mc spn . costing Nothing -> const id where - valuation mc span = mixedAmountValueAtDate priceoracle styles mc (maybe err (addDays (-1)) $ spanEnd span) - gain mc span = mixedAmountGainAtDate priceoracle styles mc (maybe err (addDays (-1)) $ spanEnd span) + valuation mc spn = mixedAmountValueAtDate priceoracle styles mc (maybe err (addDays (-1)) $ spanEnd spn) + gain mc spn = mixedAmountGainAtDate priceoracle styles mc (maybe err (addDays (-1)) $ spanEnd spn) costing = case fromMaybe NoConversionOp $ conversionop_ ropts of NoConversionOp -> id ToCost -> styleMixedAmount styles . mixedAmountCost @@ -809,6 +809,8 @@ class HasReportOptsNoUpdate a => HasReportOpts a where reportOpts = reportOptsNoUpdate {-# INLINE reportOpts #-} + -- XXX these names are a bit clashy + period :: ReportableLens' a Period period = reportOpts.periodNoUpdate {-# INLINE period #-} diff --git a/hledger-lib/Hledger/Utils.hs b/hledger-lib/Hledger/Utils.hs index 1f9a199ec..b77bdf818 100644 --- a/hledger-lib/Hledger/Utils.hs +++ b/hledger-lib/Hledger/Utils.hs @@ -183,7 +183,7 @@ readFileOrStdinPortably f = openFileOrStdin f ReadMode >>= readHandlePortably where openFileOrStdin :: String -> IOMode -> IO Handle openFileOrStdin "-" _ = return stdin - openFileOrStdin f m = openFile f m + openFileOrStdin f' m = openFile f' m readHandlePortably :: Handle -> IO Text readHandlePortably h = do @@ -225,9 +225,9 @@ sequence' ms = do return (h []) where go h [] = return h - go h (m:ms) = do + go h (m:ms') = do x <- m - go (h . (x :)) ms + go (h . (x :)) ms' -- | Like mapM but uses sequence'. {-# INLINABLE mapM' #-} @@ -339,7 +339,7 @@ makeHledgerClassyLenses x = flip makeLensesWith x $ classyRules -- HasReportOpts class with some special behaviour. We therefore give the -- basic lenses a special NoUpdate name to avoid conflicts. className "ReportOpts" = Just (mkName "HasReportOptsNoUpdate", mkName "reportOptsNoUpdate") - className (x:xs) = Just (mkName ("Has" ++ x:xs), mkName (toLower x : xs)) + className (x':xs) = Just (mkName ("Has" ++ x':xs), mkName (toLower x' : xs)) className [] = Nothing -- Fields of ReportOpts which need to update the Query when they are updated. diff --git a/hledger-lib/Hledger/Utils/Regex.hs b/hledger-lib/Hledger/Utils/Regex.hs index 27bb5431d..fd9658066 100644 --- a/hledger-lib/Hledger/Utils/Regex.hs +++ b/hledger-lib/Hledger/Utils/Regex.hs @@ -99,11 +99,11 @@ instance Show Regexp where RegexpCI _ _ -> showString "RegexpCI " instance Read Regexp where - readsPrec d r = readParen (d > app_prec) (\r -> [(toRegexCI' m,t) | - ("RegexCI",s) <- lex r, + readsPrec d r = readParen (d > app_prec) (\r' -> [(toRegexCI' m,t) | + ("RegexCI",s) <- lex r', (m,t) <- readsPrec (app_prec+1) s]) r - ++ readParen (d > app_prec) (\r -> [(toRegex' m, t) | - ("Regex",s) <- lex r, + ++ readParen (d > app_prec) (\r' -> [(toRegex' m, t) | + ("Regex",s) <- lex r', (m,t) <- readsPrec (app_prec+1) s]) r where app_prec = 10 @@ -186,7 +186,7 @@ regexReplace re repl = memo $ regexReplaceUnmemo re repl -- but there can still be a runtime error from the replacement -- pattern, eg a backreference referring to a nonexistent match group.) regexReplaceUnmemo :: Regexp -> Replacement -> String -> Either RegexError String -regexReplaceUnmemo re repl s = foldM (replaceMatch repl) s (reverse $ match (reCompiled re) s :: [MatchText String]) +regexReplaceUnmemo re repl str = foldM (replaceMatch repl) str (reverse $ match (reCompiled re) str :: [MatchText String]) where -- Replace one match within the string with the replacement text -- appropriate for this match. Or return an error message. @@ -195,22 +195,22 @@ regexReplaceUnmemo re repl s = foldM (replaceMatch repl) s (reverse $ match (reC case elems matchgroups of [] -> Right s ((_,(off,len)):_) -> -- groups should have 0-based indexes, and there should always be at least one, since this is a match - erepl >>= \repl -> Right $ pre ++ repl ++ post + erpl >>= \rpl -> Right $ pre ++ rpl ++ post where (pre, post') = splitAt off s post = drop len post' -- The replacement text: the replacement pattern with all -- numeric backreferences replaced by the appropriate groups -- from this match. Or an error message. - erepl = regexReplaceAllByM backrefRegex (lookupMatchGroup matchgroups) replpat + erpl = regexReplaceAllByM backrefRegex (lookupMatchGroup matchgroups) replpat where -- Given some match groups and a numeric backreference, -- return the referenced group text, or an error message. lookupMatchGroup :: MatchText String -> String -> Either RegexError String - lookupMatchGroup grps ('\\':s@(_:_)) | all isDigit s = - case read s of n | n `elem` indices grps -> Right $ fst (grps ! n) -- PARTIAL: should not fail, all digits - _ -> Left $ "no match group exists for backreference \"\\"++s++"\"" - lookupMatchGroup _ s = Left $ "lookupMatchGroup called on non-numeric-backreference \""++s++"\", shouldn't happen" + lookupMatchGroup grps ('\\':s2@(_:_)) | all isDigit s2 = + case read s2 of n | n `elem` indices grps -> Right $ fst (grps ! n) -- PARTIAL: should not fail, all digits + _ -> Left $ "no match group exists for backreference \"\\"++s++"\"" + lookupMatchGroup _ s2 = Left $ "lookupMatchGroup called on non-numeric-backreference \""++s2++"\", shouldn't happen" backrefRegex = toRegex' "\\\\[0-9]+" -- PARTIAL: should not fail -- regexReplace' :: Regexp -> Replacement -> String -> String @@ -249,8 +249,8 @@ regexReplaceAllBy re transform s = prependdone rest go :: (Int,String,String->String) -> (Int,Int) -> (Int,String,String->String) go (pos,todo,prepend) (off,len) = let (prematch, matchandrest) = splitAt (off - pos) todo - (matched, rest) = splitAt len matchandrest - in (off + len, rest, prepend . (prematch++) . (transform matched ++)) + (matched, rest2) = splitAt len matchandrest + in (off + len, rest2, prepend . (prematch++) . (transform matched ++)) -- Replace all occurrences of a regexp in a string, transforming each match -- with the given monadic function. Eg if the monad is Either, a Left result diff --git a/hledger-lib/Text/Megaparsec/Custom.hs b/hledger-lib/Text/Megaparsec/Custom.hs index 72cc88b18..c9e34276c 100644 --- a/hledger-lib/Text/Megaparsec/Custom.hs +++ b/hledger-lib/Text/Megaparsec/Custom.hs @@ -371,9 +371,9 @@ attachSource filePath sourceText finalParseError = case finalParseError of -- A parse error thrown directly with the 'FinalError' constructor -- requires both source and filepath. - FinalError parseError -> + FinalError err -> let bundle = ParseErrorBundle - { bundleErrors = parseError NE.:| [] + { bundleErrors = err NE.:| [] , bundlePosState = initialPosState filePath sourceText } in FinalParseErrorBundle' { finalErrorBundle = bundle diff --git a/hledger-lib/Text/Tabular/AsciiWide.hs b/hledger-lib/Text/Tabular/AsciiWide.hs index 4af4548df..7335149d3 100644 --- a/hledger-lib/Text/Tabular/AsciiWide.hs +++ b/hledger-lib/Text/Tabular/AsciiWide.hs @@ -211,11 +211,11 @@ renderHLine _ _ _ _ _ NoLine = [] renderHLine vpos borders pretty w h prop = [renderHLine' vpos borders pretty prop w h] renderHLine' :: VPos -> Bool -> Bool -> Properties -> [Int] -> Header a -> Builder -renderHLine' vpos borders pretty prop is h = addBorders $ sep <> coreLine <> sep +renderHLine' vpos borders pretty prop is hdr = addBorders $ sep <> coreLine <> sep where addBorders xs = if borders then edge HL <> xs <> edge HR else xs edge hpos = boxchar vpos hpos SingleLine prop pretty - coreLine = foldMap helper $ flattenHeader $ zipHeader 0 is h + coreLine = foldMap helper $ flattenHeader $ zipHeader 0 is hdr helper = either vsep dashes dashes (i,_) = stimesMonoid i sep sep = boxchar vpos HM NoLine prop pretty diff --git a/hledger-lib/package.yaml b/hledger-lib/package.yaml index 9430b03b6..93ec8e54b 100644 --- a/hledger-lib/package.yaml +++ b/hledger-lib/package.yaml @@ -83,7 +83,6 @@ ghc-options: - -Wall - -Wno-incomplete-uni-patterns - -Wno-missing-signatures -- -Wno-name-shadowing - -Wno-orphans - -Wno-type-defaults - -Wno-unused-do-bind diff --git a/hledger-ui/Hledger/UI/UIState.hs b/hledger-ui/Hledger/UI/UIState.hs index a19971fc9..a8dbd49ef 100644 --- a/hledger-ui/Hledger/UI/UIState.hs +++ b/hledger-ui/Hledger/UI/UIState.hs @@ -210,7 +210,7 @@ updateReportPeriod updatePeriod = fromRight err . overEither period updatePeriod -- | Apply a new filter query, or return the failing query. setFilter :: String -> UIState -> Either String UIState -setFilter s = first (const s) . setEither querystring (words'' prefixes $ T.pack s) +setFilter s = first (const s) . setEither querystring (words'' queryprefixes $ T.pack s) -- | Reset some filters & toggles. resetFilter :: UIState -> UIState diff --git a/hledger-web/Hledger/Web/Widget/Common.hs b/hledger-web/Hledger/Web/Widget/Common.hs index 4d3e20542..fe7054561 100644 --- a/hledger-web/Hledger/Web/Widget/Common.hs +++ b/hledger-web/Hledger/Web/Widget/Common.hs @@ -118,14 +118,14 @@ removeDates = map quoteIfSpaced . filter (\term -> not $ T.isPrefixOf "date:" term || T.isPrefixOf "date2:" term) . - Query.words'' Query.prefixes + Query.words'' queryprefixes removeInacct :: Text -> [Text] removeInacct = map quoteIfSpaced . filter (\term -> not $ T.isPrefixOf "inacct:" term || T.isPrefixOf "inacctonly:" term) . - Query.words'' Query.prefixes + Query.words'' queryprefixes replaceInacct :: Text -> Text -> Text replaceInacct q acct = T.unwords $ acct : removeInacct q diff --git a/hledger/Hledger/Cli/CliOptions.hs b/hledger/Hledger/Cli/CliOptions.hs index 230be5c72..e9abd52d2 100644 --- a/hledger/Hledger/Cli/CliOptions.hs +++ b/hledger/Hledger/Cli/CliOptions.hs @@ -323,7 +323,7 @@ defCommandMode names = defMode { -- given name, providing hledger's common input/reporting/help flags. -- Just used when invoking addons. addonCommandMode :: Name -> Mode RawOpts -addonCommandMode name = (defCommandMode [name]) { +addonCommandMode nam = (defCommandMode [nam]) { modeHelp = "" -- XXX not needed ? -- fromMaybe "" $ lookup (stripAddonExtension name) [ @@ -539,10 +539,10 @@ rawOptsToCliOpts rawopts = do -- add a space character to preserve them. -- getHledgerCliOpts' :: Mode RawOpts -> [String] -> IO CliOpts -getHledgerCliOpts' mode' args' = do - let rawopts = either usageError id $ process mode' args' +getHledgerCliOpts' mode' args0 = do + let rawopts = either usageError id $ process mode' args0 opts <- rawOptsToCliOpts rawopts - debugArgs args' opts + debugArgs args0 opts when ("help" `inRawOpts` rawopts_ opts) $ putStr shorthelp >> exitSuccess -- when ("help" `inRawOpts` rawopts_ opts) $ putStr longhelp >> exitSuccess return opts @@ -557,11 +557,11 @@ getHledgerCliOpts' mode' args' = do ] -- | Print debug info about arguments and options if --debug is present. debugArgs :: [String] -> CliOpts -> IO () - debugArgs args' opts = - when ("--debug" `elem` args') $ do + debugArgs args1 opts = + when ("--debug" `elem` args1) $ do progname' <- getProgName putStrLn $ "running: " ++ progname' - putStrLn $ "raw args: " ++ show args' + putStrLn $ "raw args: " ++ show args1 putStrLn $ "processed opts:\n" ++ show opts putStrLn $ "search query: " ++ show (_rsQuery $ reportspec_ opts) @@ -590,7 +590,7 @@ expandPathPreservingPrefix d prefixedf = do let (p,f) = splitReaderPrefix prefixedf f' <- expandPath d f return $ case p of - Just p -> p ++ ":" ++ f' + Just p' -> p' ++ ":" ++ f' Nothing -> f' -- | Get the expanded, absolute output file path specified by an diff --git a/hledger/Hledger/Cli/Commands/Accounts.hs b/hledger/Hledger/Cli/Commands/Accounts.hs index d427e74d8..99567458f 100644 --- a/hledger/Hledger/Cli/Commands/Accounts.hs +++ b/hledger/Hledger/Cli/Commands/Accounts.hs @@ -51,25 +51,25 @@ accounts CliOpts{rawopts_=rawopts, reportspec_=ReportSpec{_rsQuery=query,_rsRepo -- 1. identify the accounts we'll show let tree = tree_ ropts - declared = boolopt "declared" rawopts - used = boolopt "used" rawopts - types = boolopt "types" rawopts + decl = boolopt "declared" rawopts + used = boolopt "used" rawopts + types = boolopt "types" rawopts positions = boolopt "positions" rawopts directives = boolopt "directives" rawopts -- a depth limit will clip and exclude account names later, but we don't want to exclude accounts at this stage nodepthq = dbg4 "nodepthq" $ filterQuery (not . queryIsDepth) query -- just the acct: part of the query will be reapplied later, after clipping - acctq = dbg4 "acctq" $ filterQuery queryIsAcct query - depth = dbg4 "depth" $ queryDepth $ filterQuery queryIsDepth query + acctq = dbg4 "acctq" $ filterQuery queryIsAcct query + dep = dbg4 "depth" $ queryDepth $ filterQuery queryIsDepth query matcheddeclaredaccts = dbg4 "matcheddeclaredaccts" $ filter (matchesAccountExtra (journalAccountType j) (journalInheritedAccountTags j) nodepthq) $ map fst $ jdeclaredaccounts j - matchedusedaccts = dbg5 "matchedusedaccts" $ map paccount $ journalPostings $ filterJournalPostings nodepthq j - accts = dbg5 "accts to show" $ - if | declared && not used -> matcheddeclaredaccts - | not declared && used -> matchedusedaccts - | otherwise -> matcheddeclaredaccts ++ matchedusedaccts + matchedusedaccts = dbg5 "matchedusedaccts" $ map paccount $ journalPostings $ filterJournalPostings nodepthq j + accts = dbg5 "accts to show" $ + if | decl && not used -> matcheddeclaredaccts + | not decl && used -> matchedusedaccts + | otherwise -> matcheddeclaredaccts ++ matchedusedaccts -- 2. sort them by declaration order (then undeclared accounts alphabetically) -- within each group of siblings @@ -78,10 +78,10 @@ accounts CliOpts{rawopts_=rawopts, reportspec_=ReportSpec{_rsQuery=query,_rsRepo -- 3. if there's a depth limit, depth-clip and remove any no longer useful items clippedaccts = dbg4 "clippedaccts" $ - filter (matchesAccount acctq) $ -- clipping can leave accounts that no longer match the query, remove such - nub $ -- clipping can leave duplicates (adjacent, hopefully) - filter (not . T.null) $ -- depth:0 can leave nulls - map (clipAccountName depth) $ -- clip at depth if specified + filter (matchesAccount acctq) $ -- clipping can leave accounts that no longer match the query, remove such + nub $ -- clipping can leave duplicates (adjacent, hopefully) + filter (not . T.null) $ -- depth:0 can leave nulls + map (clipAccountName dep) $ -- clip at depth if specified sortedaccts -- 4. print what remains as a list or tree, maybe applying --drop in the former case. diff --git a/hledger/Hledger/Cli/Commands/Add.hs b/hledger/Hledger/Cli/Commands/Add.hs index 97f22f81a..96e5a60c3 100644 --- a/hledger/Hledger/Cli/Commands/Add.hs +++ b/hledger/Hledger/Cli/Commands/Add.hs @@ -189,7 +189,7 @@ confirmedTransactionWizard prevInput es@EntryState{..} stack@(currentStage : _) Nothing -> confirmedTransactionWizard prevInput es (drop 1 stack) - EnterNewPosting txnParams@TxnParams{..} posting -> case (esPostings, posting) of + EnterNewPosting txnParams@TxnParams{..} p -> case (esPostings, p) of ([], Nothing) -> confirmedTransactionWizard prevInput es (EnterAccount txnParams : stack) (_, Just _) -> @@ -230,15 +230,15 @@ confirmedTransactionWizard prevInput es@EntryState{..} stack@(currentStage : _) confirmedTransactionWizard prevInput es{esPostings=init esPostings} (dropWhile notPrevAmountAndNotEnterDesc stack) EnterAmountAndComment txnParams account -> amountAndCommentWizard prevInput es >>= \case - Just (amount, comment) -> do - let posting = nullposting{paccount=T.pack $ stripbrackets account - ,pamount=mixedAmount amount - ,pcomment=comment - ,ptype=accountNamePostingType $ T.pack account - } - amountAndCommentString = showAmount amount ++ T.unpack (if T.null comment then "" else " ;" <> comment) + Just (amt, comment) -> do + let p = nullposting{paccount=T.pack $ stripbrackets account + ,pamount=mixedAmount amt + ,pcomment=comment + ,ptype=accountNamePostingType $ T.pack account + } + amountAndCommentString = showAmount amt ++ T.unpack (if T.null comment then "" else " ;" <> comment) prevAmountAndCmnt' = replaceNthOrAppend (length esPostings) amountAndCommentString (prevAmountAndCmnt prevInput) - es' = es{esPostings=esPostings++[posting], esArgs=drop 2 esArgs} + es' = es{esPostings=esPostings++[p], esArgs=drop 2 esArgs} confirmedTransactionWizard prevInput{prevAmountAndCmnt=prevAmountAndCmnt'} es' (EnterNewPosting txnParams (Just posting) : stack) Nothing -> confirmedTransactionWizard prevInput es (drop 1 stack) @@ -310,18 +310,18 @@ accountWizard PrevInput{..} EntryState{..} = do where canfinish = not (null esPostings) && postingsBalanced esPostings parseAccountOrDotOrNull :: String -> Bool -> String -> Maybe (Maybe String) - parseAccountOrDotOrNull _ _ "<" = dbg1 $ Just Nothing - parseAccountOrDotOrNull _ _ "." = dbg1 $ Just $ Just "." -- . always signals end of txn - parseAccountOrDotOrNull "" True "" = dbg1 $ Just $ Just "" -- when there's no default and txn is balanced, "" also signals end of txn - parseAccountOrDotOrNull def@(_:_) _ "" = dbg1 $ Just $ Just def -- when there's a default, "" means use that - parseAccountOrDotOrNull _ _ s = dbg1 $ fmap (Just . T.unpack) $ + parseAccountOrDotOrNull _ _ "<" = dbg' $ Just Nothing + parseAccountOrDotOrNull _ _ "." = dbg' $ Just $ Just "." -- . always signals end of txn + parseAccountOrDotOrNull "" True "" = dbg' $ Just $ Just "" -- when there's no default and txn is balanced, "" also signals end of txn + parseAccountOrDotOrNull def@(_:_) _ "" = dbg' $ Just $ Just def -- when there's a default, "" means use that + parseAccountOrDotOrNull _ _ s = dbg' $ fmap (Just . T.unpack) $ either (const Nothing) validateAccount $ flip evalState esJournal $ runParserT (accountnamep <* eof) "" (T.pack s) -- otherwise, try to parse the input as an accountname where validateAccount :: Text -> Maybe Text validateAccount t | no_new_accounts_ esOpts && notElem t (journalAccountNamesDeclaredOrImplied esJournal) = Nothing | otherwise = Just t - dbg1 = id -- strace + dbg' = id -- strace amountAndCommentWizard PrevInput{..} EntryState{..} = do let pnum = length esPostings + 1 diff --git a/hledger/Hledger/Cli/Commands/Aregister.hs b/hledger/Hledger/Cli/Commands/Aregister.hs index 121fa3de9..ae85ccb15 100644 --- a/hledger/Hledger/Cli/Commands/Aregister.hs +++ b/hledger/Hledger/Cli/Commands/Aregister.hs @@ -31,7 +31,7 @@ import Hledger import Hledger.Read.CsvReader (CSV, CsvRecord, printCSV) import Hledger.Cli.CliOptions import Hledger.Cli.Utils -import Text.Tabular.AsciiWide +import Text.Tabular.AsciiWide hiding (render) aregistermode = hledgerCommandMode $(embedFileRelative "Hledger/Cli/Commands/Aregister.txt") @@ -71,7 +71,7 @@ aregister :: CliOpts -> Journal -> IO () aregister opts@CliOpts{rawopts_=rawopts,reportspec_=rspec} j = do -- the first argument specifies the account, any remaining arguments are a filter query let help = "aregister needs an ACCTPAT argument to select an account" - (apat,querystring) <- case listofstringopt "args" rawopts of + (apat,querystr) <- case listofstringopt "args" rawopts of [] -> error' $ help <> ".\nPlease provide an account name or a (case-insensitive, infix, regexp) pattern." (a:as) -> return (a, map T.pack as) let @@ -88,7 +88,7 @@ aregister opts@CliOpts{rawopts_=rawopts,reportspec_=rspec} j = do depth_=Nothing -- always show historical balance , balanceaccum_= Historical - , querystring_ = querystring + , querystring_ = querystr } wd = whichDate ropts' -- and regenerate the ReportSpec, making sure to use the above @@ -184,8 +184,8 @@ accountTransactionsReportItemAsText ] spacerCell = Cell BottomLeft [WideBuilder (TB.singleton ' ') 1] spacerCell2 = Cell BottomLeft [WideBuilder (TB.fromString " ") 2] - pad fullwidth amt = WideBuilder (TB.fromText $ T.replicate w " ") w <> amt - where w = fullwidth - wbWidth amt + pad fullwidth amt1 = WideBuilder (TB.fromText $ T.replicate w " ") w <> amt1 + where w = fullwidth - wbWidth amt1 -- calculate widths (totalwidth,mdescwidth) = registerWidthsFromOpts copts (datewidth, date) = (10, showDate $ transactionRegisterDate wd reportq thisacctq t) diff --git a/hledger/Hledger/Cli/Commands/Balance.hs b/hledger/Hledger/Cli/Commands/Balance.hs index 190016e56..0ae3ce4d6 100644 --- a/hledger/Hledger/Cli/Commands/Balance.hs +++ b/hledger/Hledger/Cli/Commands/Balance.hs @@ -267,7 +267,7 @@ import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.Builder as TB import Data.Time (addDays, fromGregorian) import System.Console.CmdArgs.Explicit as C -import Lucid as L +import Lucid as L hiding (value_) import Safe (headMay, maximumMay) import Text.Tabular.AsciiWide (Align(..), Cell(..), Table(..), TableOpts(..), cellWidth, concatTables, @@ -340,8 +340,8 @@ balancemode = hledgerCommandMode balance :: CliOpts -> Journal -> IO () balance opts@CliOpts{reportspec_=rspec} j = case balancecalc_ of CalcBudget -> do -- single or multi period budget report - let reportspan = fst $ reportSpan j rspec - budgetreport = budgetReport rspec (balancingopts_ $ inputopts_ opts) reportspan j + let rspan = fst $ reportSpan j rspec + budgetreport = budgetReport rspec (balancingopts_ $ inputopts_ opts) rspan j render = case fmt of "txt" -> budgetReportAsText ropts "json" -> (<>"\n") . toJsonText @@ -362,8 +362,8 @@ balance opts@CliOpts{reportspec_=rspec} j = case balancecalc_ of _ -> do -- single period simple balance report let report = balanceReport rspec j -- simple Ledger-style balance report render = case fmt of - "txt" -> \ropts -> TB.toLazyText . balanceReportAsText ropts - "csv" -> \ropts -> printCSV . balanceReportAsCsv ropts + "txt" -> \ropts1 -> TB.toLazyText . balanceReportAsText ropts1 + "csv" -> \ropts1 -> printCSV . balanceReportAsCsv ropts1 -- "html" -> \ropts -> (<>"\n") . L.renderText . multiBalanceReportAsHtml ropts . balanceReportAsMultiBalanceReport ropts "json" -> const $ (<>"\n") . toJsonText _ -> error' $ unsupportedOutputFormatError fmt -- PARTIAL: @@ -430,9 +430,9 @@ balanceReportAsText :: ReportOpts -> BalanceReport -> TB.Builder balanceReportAsText opts ((items, total)) = case layout_ opts of LayoutBare | iscustom -> error' "Custom format not supported with commodity columns" -- PARTIAL: LayoutBare -> balanceReportAsText' opts ((items, total)) - _ -> unlinesB lines <> unlinesB (if no_total_ opts then [] else [overline, totalLines]) + _ -> unlinesB ls <> unlinesB (if no_total_ opts then [] else [overline, totalLines]) where - (lines, sizes) = unzip $ map (balanceReportItemAsText opts) items + (ls, sizes) = unzip $ map (balanceReportItemAsText opts) items -- abuse renderBalanceReportItem to render the total with similar format (totalLines, _) = renderBalanceReportItem opts ("",0,total) -- with a custom format, extend the line to the full report width; @@ -449,20 +449,20 @@ balanceReportAsText opts ((items, total)) = case layout_ opts of balanceReportAsText' :: ReportOpts -> BalanceReport -> TB.Builder balanceReportAsText' opts ((items, total)) = unlinesB . fmap (renderColumns def{tableBorders=False} sizes . Tab.Group Tab.NoLine . fmap Tab.Header) $ - lines ++ concat [[[overline], totalline] | not (no_total_ opts)] + ls ++ concat [[[overline], totalline] | not (no_total_ opts)] where - render (_, acctname, depth, amt) = + render (_, acctname, dep, amt) = [ Cell TopRight damts , Cell TopLeft (fmap wbFromText cs) , Cell TopLeft (replicate (length damts - 1) mempty ++ [wbFromText dispname]) ] where dopts = oneLine{displayColour=color_ opts, displayOrder=Just cs} cs = if mixedAmountLooksZero amt then [""] else S.toList $ maCommodities amt - dispname = T.replicate ((depth - 1) * 2) " " <> acctname + dispname = T.replicate ((dep - 1) * 2) " " <> acctname damts = showMixedAmountLinesB dopts amt - lines = fmap render items + ls = fmap render items totalline = render ("", "", 0, total) sizes = fromMaybe 0 . maximumMay . map cellWidth <$> - transpose ([totalline | not (no_total_ opts)] ++ lines) + transpose ([totalline | not (no_total_ opts)] ++ ls) overline = Cell TopLeft . pure . wbFromText . flip T.replicate "-" . fromMaybe 0 $ headMay sizes {- @@ -481,12 +481,12 @@ This implementation turned out to be a bit convoluted but implements the followi -- differently-priced quantities of the same commodity will appear merged. -- The output will be one or more lines depending on the format and number of commodities. balanceReportItemAsText :: ReportOpts -> BalanceReportItem -> (TB.Builder, [Int]) -balanceReportItemAsText opts (_, accountName, depth, amt) = - renderBalanceReportItem opts (accountName, depth, amt) +balanceReportItemAsText opts (_, accountName, dep, amt) = + renderBalanceReportItem opts (accountName, dep, amt) -- | Render a balance report item using the given StringFormat, generating one or more lines of text. renderBalanceReportItem :: ReportOpts -> (AccountName, Int, MixedAmount) -> (TB.Builder, [Int]) -renderBalanceReportItem opts (acctname, depth, total) = +renderBalanceReportItem opts (acctname, dep, total) = case format_ opts of OneLine comps -> renderRow' $ render True True comps TopAligned comps -> renderRow' $ render True False comps @@ -496,14 +496,14 @@ renderBalanceReportItem opts (acctname, depth, total) = . Tab.Group Tab.NoLine $ map Tab.Header is , map cellWidth is ) - render topaligned oneline = map (renderComponent topaligned oneline opts (acctname, depth, total)) + render topaligned oneline = map (renderComponent topaligned oneline opts (acctname, dep, total)) -- | Render one StringFormat component for a balance report item. renderComponent :: Bool -> Bool -> ReportOpts -> (AccountName, Int, MixedAmount) -> StringFormatComponent -> Cell renderComponent _ _ _ _ (FormatLiteral s) = textCell TopLeft s -renderComponent topaligned oneline opts (acctname, depth, total) (FormatField ljust mmin mmax field) = case field of +renderComponent topaligned oneline opts (acctname, dep, total) (FormatField ljust mmin mmax field) = case field of DepthSpacerField -> Cell align [WideBuilder (TB.fromText $ T.replicate d " ") d] - where d = maybe id min mmax $ depth * fromMaybe 1 mmin + where d = maybe id min mmax $ dep * fromMaybe 1 mmin AccountField -> textCell align $ formatText ljust mmin mmax acctname TotalField -> Cell align . pure $ showMixedAmountB dopts total _ -> Cell align [mempty] @@ -721,13 +721,13 @@ multiBalanceRowAsWbs bopts ReportOpts{..} colspans (PeriodicReportRow _ as rowto totalscolumn = row_total_ && balanceaccum_ `notElem` [Cumulative, Historical] cs = if all mixedAmountLooksZero allamts then [""] else S.toList $ foldMap maCommodities allamts allamts = as ++ [rowtot | totalscolumn && not (null as)] ++ [rowavg | average_ && not (null as)] - addDateColumns span@(DateSpan s e) = (wbFromText (showDateSpan span) :) + addDateColumns spn@(DateSpan s e) = (wbFromText (showDateSpan spn) :) . (wbFromText (maybe "" showDate s) :) . (wbFromText (maybe "" (showDate . addDays (-1)) e) :) paddedTranspose :: a -> [[a]] -> [[a]] paddedTranspose _ [] = [[]] - paddedTranspose n as = take (maximum . map length $ as) . trans $ as + paddedTranspose n as1 = take (maximum . map length $ as1) . trans $ as1 where trans ([] : xss) = (n : map h xss) : trans ([n] : map t xss) trans ((x : xs) : xss) = (x : map h xss) : trans (m xs : map t xss) diff --git a/hledger/Hledger/Cli/Commands/Check.hs b/hledger/Hledger/Cli/Commands/Check.hs index 4725ae0cd..3304105bc 100644 --- a/hledger/Hledger/Cli/Commands/Check.hs +++ b/hledger/Hledger/Cli/Commands/Check.hs @@ -96,10 +96,10 @@ parseCheckArgument s = -- | Run the named error check, possibly with some arguments, -- on this journal with these options. runCheck :: CliOpts -> Journal -> (Check,[String]) -> IO () -runCheck CliOpts{reportspec_=ReportSpec{_rsReportOpts=ropts}} j (check,_) = do +runCheck CliOpts{reportspec_=ReportSpec{_rsReportOpts=ropts}} j (chck,_) = do d <- getCurrentDay let - results = case check of + results = case chck of Accounts -> journalCheckAccounts j Commodities -> journalCheckCommodities j Ordereddates -> journalCheckOrdereddates (whichDate ropts) j diff --git a/hledger/Hledger/Cli/Commands/Close.hs b/hledger/Hledger/Cli/Commands/Close.hs index ae9700a13..451876b7c 100755 --- a/hledger/Hledger/Cli/Commands/Close.hs +++ b/hledger/Hledger/Cli/Commands/Close.hs @@ -135,11 +135,11 @@ close copts@CliOpts{rawopts_=rawopts, reportspec_=rspec'} j = do | -- get the balances for each commodity and transaction price (a,mb) <- acctbals - , let bs = amounts mb + , let bs0 = amounts mb -- mark the last balance in each commodity with True - , let bs' = concat [reverse $ zip (reverse bs) (True : repeat False) - | bs <- groupBy ((==) `on` acommodity) bs] - , (b, islast) <- bs' + , let bs2 = concat [reverse $ zip (reverse bs1) (True : repeat False) + | bs1 <- groupBy ((==) `on` acommodity) bs0] + , (b, islast) <- bs2 ] -- or a final multicommodity posting transferring all balances to equity @@ -160,12 +160,12 @@ close copts@CliOpts{rawopts_=rawopts, reportspec_=rspec'} j = do : [posting{paccount=openingacct, pamount=mixedAmount . precise $ negate b} | interleaved] | (a,mb) <- acctbals - , let bs = amounts mb + , let bs0 = amounts mb -- mark the last balance in each commodity with the unpriced sum in that commodity (for a balance assertion) - , let bs' = concat [reverse $ zip (reverse bs) (Just commoditysum : repeat Nothing) - | bs <- groupBy ((==) `on` acommodity) bs - , let commoditysum = (sum bs)] - , (b, mcommoditysum) <- bs' + , let bs2 = concat [reverse $ zip (reverse bs1) (Just commoditysum : repeat Nothing) + | bs1 <- groupBy ((==) `on` acommodity) bs0 + , let commoditysum = (sum bs1)] + , (b, mcommoditysum) <- bs2 ] ++ [posting{paccount=openingacct, pamount=if explicit then mixedAmountSetFullPrecision (maNegate totalamt) else missingmixedamt} | not interleaved] diff --git a/hledger/Hledger/Cli/Commands/Codes.hs b/hledger/Hledger/Cli/Commands/Codes.hs index 93fd915a1..aba995269 100644 --- a/hledger/Hledger/Cli/Commands/Codes.hs +++ b/hledger/Hledger/Cli/Commands/Codes.hs @@ -34,6 +34,6 @@ codesmode = hledgerCommandMode codes :: CliOpts -> Journal -> IO () codes CliOpts{reportspec_=rspec} j = do let ts = entriesReport rspec j - codes = (if empty_ (_rsReportOpts rspec) then id else filter (not . T.null)) $ + codes' = (if empty_ (_rsReportOpts rspec) then id else filter (not . T.null)) $ map tcode ts - mapM_ T.putStrLn codes + mapM_ T.putStrLn codes' diff --git a/hledger/Hledger/Cli/Commands/Descriptions.hs b/hledger/Hledger/Cli/Commands/Descriptions.hs index 448f3d246..9a6f8a553 100644 --- a/hledger/Hledger/Cli/Commands/Descriptions.hs +++ b/hledger/Hledger/Cli/Commands/Descriptions.hs @@ -33,6 +33,6 @@ descriptionsmode = hledgerCommandMode descriptions :: CliOpts -> Journal -> IO () descriptions CliOpts{reportspec_=rspec} j = do let ts = entriesReport rspec j - descriptions = nubSort $ map tdescription ts + descs = nubSort $ map tdescription ts - mapM_ T.putStrLn descriptions + mapM_ T.putStrLn descs diff --git a/hledger/Hledger/Cli/Commands/Files.hs b/hledger/Hledger/Cli/Commands/Files.hs index 0337b90e2..7f778ccac 100644 --- a/hledger/Hledger/Cli/Commands/Files.hs +++ b/hledger/Hledger/Cli/Commands/Files.hs @@ -31,7 +31,7 @@ files :: CliOpts -> Journal -> IO () files CliOpts{rawopts_=rawopts} j = do let args = listofstringopt "args" rawopts regex <- mapM (either fail pure . toRegex . T.pack) $ headMay args - let files = maybe id (filter . regexMatch) regex + let fs = maybe id (filter . regexMatch) regex $ map fst $ jfiles j - mapM_ putStrLn files + mapM_ putStrLn fs diff --git a/hledger/Hledger/Cli/Commands/Notes.hs b/hledger/Hledger/Cli/Commands/Notes.hs index 26493cbdc..83e4a07a0 100644 --- a/hledger/Hledger/Cli/Commands/Notes.hs +++ b/hledger/Hledger/Cli/Commands/Notes.hs @@ -34,5 +34,5 @@ notesmode = hledgerCommandMode notes :: CliOpts -> Journal -> IO () notes CliOpts{reportspec_=rspec} j = do let ts = entriesReport rspec j - notes = nubSort $ map transactionNote ts - mapM_ T.putStrLn notes + notes' = nubSort $ map transactionNote ts + mapM_ T.putStrLn notes' diff --git a/hledger/Hledger/Cli/Commands/Payees.hs b/hledger/Hledger/Cli/Commands/Payees.hs index d72537794..2bd8358b2 100644 --- a/hledger/Hledger/Cli/Commands/Payees.hs +++ b/hledger/Hledger/Cli/Commands/Payees.hs @@ -36,13 +36,13 @@ payeesmode = hledgerCommandMode payees :: CliOpts -> Journal -> IO () payees CliOpts{rawopts_=rawopts, reportspec_=ReportSpec{_rsQuery=query}} j = do let - declared = boolopt "declared" rawopts + decl = boolopt "declared" rawopts used = boolopt "used" rawopts -- XXX matchesPayee is currently an alias for matchesDescription, not sure if it matters matcheddeclaredpayees = S.fromList . filter (matchesPayeeWIP query) $ journalPayeesDeclared j matchedusedpayees = S.fromList . map transactionPayee $ filter (matchesTransaction query) $ jtxns j - payees = - if | declared && not used -> matcheddeclaredpayees - | not declared && used -> matchedusedpayees - | otherwise -> matcheddeclaredpayees <> matchedusedpayees - mapM_ T.putStrLn payees + payees' = + if | decl && not used -> matcheddeclaredpayees + | not decl && used -> matchedusedpayees + | otherwise -> matcheddeclaredpayees <> matchedusedpayees + mapM_ T.putStrLn payees' diff --git a/hledger/Hledger/Cli/Commands/Print.hs b/hledger/Hledger/Cli/Commands/Print.hs index 1231a751b..e39c6dcb3 100644 --- a/hledger/Hledger/Cli/Commands/Print.hs +++ b/hledger/Hledger/Cli/Commands/Print.hs @@ -168,13 +168,13 @@ entriesReportAsCsv txns = -- The txnidx field (transaction index) allows postings to be grouped back into transactions. transactionToCSV :: Transaction -> CSV transactionToCSV t = - map (\p -> T.pack (show idx):date:date2:status:code:description:comment:p) + map (\p -> T.pack (show idx):d:d2:status:code:description:comment:p) (concatMap postingToCSV $ tpostings t) where idx = tindex t description = tdescription t - date = showDate (tdate t) - date2 = maybe "" showDate $ tdate2 t + d = showDate (tdate t) + d2 = maybe "" showDate $ tdate2 t status = T.pack . show $ tstatus t code = tcode t comment = T.strip $ tcomment t @@ -186,10 +186,10 @@ postingToCSV p = -- separators and prices let a_ = amountStripPrices a{acommodity=""} in let showamt = wbToText . showAmountB csvDisplay in - let amount = showamt a_ in + let amt = showamt a_ in let credit = if q < 0 then showamt $ negate a_ else "" in let debit = if q >= 0 then showamt a_ else "" in - [account, amount, c, credit, debit, status, comment]) + [account, amt, c, credit, debit, status, comment]) . amounts $ pamount p where status = T.pack . show $ pstatus p diff --git a/hledger/Hledger/Cli/Commands/Register.hs b/hledger/Hledger/Cli/Commands/Register.hs index 638d7fc5b..b5ee77c38 100644 --- a/hledger/Hledger/Cli/Commands/Register.hs +++ b/hledger/Hledger/Cli/Commands/Register.hs @@ -25,11 +25,11 @@ import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.Builder as TB import System.Console.CmdArgs.Explicit (flagNone, flagReq) -import Hledger +import Hledger hiding (per) import Hledger.Read.CsvReader (CSV, CsvRecord, printCSV) import Hledger.Cli.CliOptions import Hledger.Cli.Utils -import Text.Tabular.AsciiWide +import Text.Tabular.AsciiWide hiding (render) registermode = hledgerCommandMode $(embedFileRelative "Hledger/Cli/Commands/Register.txt") @@ -144,14 +144,14 @@ postingsReportItemAsText opts preferredamtwidth preferredbalwidth ((mdate, mperi ] spacerCell = Cell BottomLeft [WideBuilder (TB.singleton ' ') 1] spacerCell2 = Cell BottomLeft [WideBuilder (TB.fromString " ") 2] - pad fullwidth amt = WideBuilder (TB.fromText $ T.replicate w " ") w <> amt - where w = fullwidth - wbWidth amt + pad fullwidth amt' = WideBuilder (TB.fromText $ T.replicate w " ") w <> amt' + where w = fullwidth - wbWidth amt' -- calculate widths (totalwidth,mdescwidth) = registerWidthsFromOpts opts datewidth = maybe 10 periodTextWidth mperiod date = case mperiod of - Just period -> if isJust mdate then showPeriod period else "" - Nothing -> maybe "" showDate mdate + Just per -> if isJust mdate then showPeriod per else "" + Nothing -> maybe "" showDate mdate (amtwidth, balwidth) | shortfall <= 0 = (preferredamtwidth, preferredbalwidth) | otherwise = (adjustedamtwidth, adjustedbalwidth) diff --git a/hledger/Hledger/Cli/Commands/Rewrite.hs b/hledger/Hledger/Cli/Commands/Rewrite.hs index 45a1e5617..5fd77d462 100755 --- a/hledger/Hledger/Cli/Commands/Rewrite.hs +++ b/hledger/Hledger/Cli/Commands/Rewrite.hs @@ -20,7 +20,7 @@ import Hledger.Cli.CliOptions import Hledger.Cli.Commands.Print import System.Console.CmdArgs.Explicit import Text.Printf -import Text.Megaparsec +import Text.Megaparsec hiding (pos1) import qualified Data.Algorithm.Diff as D rewritemode = hledgerCommandMode @@ -101,11 +101,11 @@ renderPatch = go Nothing . sortOn fst where go _ [] = "" go Nothing cs@((SourcePos fp _ _, _):_) = fileHeader fp <> go (Just (fp, 0)) cs go (Just (fp, _)) cs@((SourcePos fp' _ _, _):_) | fp /= fp' = go Nothing cs - go (Just (fp, offs)) ((SourcePos _ lineno _, diffs):cs) = chunkHeader <> chunk <> go (Just (fp, offs + adds - dels)) cs + go (Just (fp, offs)) ((SourcePos _ lineno _, diffs):cs) = chunkHeader <> chnk <> go (Just (fp, offs + adds - dels)) cs where chunkHeader = T.pack $ printf "@@ -%d,%d +%d,%d @@\n" (unPos lineno) dels (unPos lineno+offs) adds (dels, adds) = foldl' countDiff (0, 0) diffs - chunk = foldMap renderLine diffs + chnk = foldMap renderLine diffs fileHeader fp = "--- " <> T.pack fp <> "\n+++ " <> T.pack fp <> "\n" countDiff (dels, adds) = \case diff --git a/hledger/Hledger/Cli/Commands/Roi.hs b/hledger/Hledger/Cli/Commands/Roi.hs index 374b3d712..d8fb3508b 100644 --- a/hledger/Hledger/Cli/Commands/Roi.hs +++ b/hledger/Hledger/Cli/Commands/Roi.hs @@ -92,45 +92,45 @@ roi CliOpts{rawopts_=rawopts, reportspec_=rspec@ReportSpec{_rsReportOpts=ReportO let priceDirectiveDates = dbg3 "priceDirectiveDates" $ map pddate $ jpricedirectives j - tableBody <- forM spans $ \span@(DateSpan (Just spanBegin) (Just spanEnd)) -> do - -- Spans are [spanBegin,spanEnd), and spanEnd is 1 day after then actual end date we are interested in + tableBody <- forM spans $ \spn@(DateSpan (Just begin) (Just end)) -> do + -- Spans are [begin,end), and end is 1 day after the actual end date we are interested in let - cashFlowApplyCostValue = map (\(d,amt) -> (d,mixedAmountValue spanEnd d amt)) + cashFlowApplyCostValue = map (\(d,amt) -> (d,mixedAmountValue end d amt)) valueBefore = - mixedAmountValue spanEnd spanBegin $ + mixedAmountValue end begin $ total trans (And [ investmentsQuery - , Date (DateSpan Nothing (Just spanBegin))]) + , Date (DateSpan Nothing (Just begin))]) valueAfter = - mixedAmountValue spanEnd spanEnd $ + mixedAmountValue end end $ total trans (And [investmentsQuery - , Date (DateSpan Nothing (Just spanEnd))]) + , Date (DateSpan Nothing (Just end))]) - priceDates = dbg3 "priceDates" $ nub $ filter (spanContainsDate span) priceDirectiveDates + priceDates = dbg3 "priceDates" $ nub $ filter (spanContainsDate spn) priceDirectiveDates cashFlow = ((map (,nullmixedamt) priceDates)++) $ cashFlowApplyCostValue $ calculateCashFlow wd trans (And [ Not investmentsQuery , Not pnlQuery - , Date span ] ) + , Date spn ] ) pnl = cashFlowApplyCostValue $ calculateCashFlow wd trans (And [ Not investmentsQuery , pnlQuery - , Date span ] ) + , Date spn ] ) thisSpan = dbg3 "processing span" $ - OneSpan spanBegin spanEnd valueBefore valueAfter cashFlow pnl + OneSpan begin end valueBefore valueAfter cashFlow pnl irr <- internalRateOfReturn showCashFlow prettyTables thisSpan twr <- timeWeightedReturn showCashFlow prettyTables investmentsQuery trans mixedAmountValue thisSpan let cashFlowAmt = maNegate . maSum $ map snd cashFlow let smallIsZero x = if abs x < 0.01 then 0.0 else x - return [ showDate spanBegin - , showDate (addDays (-1) spanEnd) + return [ showDate begin + , showDate (addDays (-1) end) , T.pack $ showMixedAmount valueBefore , T.pack $ showMixedAmount cashFlowAmt , T.pack $ showMixedAmount valueAfter @@ -148,7 +148,7 @@ roi CliOpts{rawopts_=rawopts, reportspec_=rspec@ReportSpec{_rsReportOpts=ReportO TL.putStrLn $ Tab.render prettyTables id id id table -timeWeightedReturn showCashFlow prettyTables investmentsQuery trans mixedAmountValue (OneSpan spanBegin spanEnd valueBeforeAmt valueAfter cashFlow pnl) = do +timeWeightedReturn showCashFlow prettyTables investmentsQuery trans mixedAmountValue (OneSpan begin end valueBeforeAmt valueAfter cashFlow pnl) = do let valueBefore = unMix valueBeforeAmt let initialUnitPrice = 100 :: Decimal let initialUnits = valueBefore / initialUnitPrice @@ -169,17 +169,17 @@ timeWeightedReturn showCashFlow prettyTables investmentsQuery trans mixedAmountV $ sort $ datedCashflows ++ datedPnls where - zeroUnitsNeedsCashflowAtTheFront changes = - if initialUnits > 0 then changes + zeroUnitsNeedsCashflowAtTheFront changes1 = + if initialUnits > 0 then changes1 else - let (leadingEmptyCashFlows, rest) = span isEmptyCashflow changes + let (leadingEmptyCashFlows, rest) = span isEmptyCashflow changes1 (leadingPnls, rest') = span (isLeft . snd) rest (firstCashflow, rest'') = splitAt 1 rest' in leadingEmptyCashFlows ++ firstCashflow ++ leadingPnls ++ rest'' isEmptyCashflow (_date, amt) = case amt of - Right amt -> mixedAmountIsZero amt - Left _ -> False + Right amt' -> mixedAmountIsZero amt' + Left _ -> False datedPnls = map (second Left) $ aggregateByDate pnl @@ -198,16 +198,16 @@ timeWeightedReturn showCashFlow prettyTables investmentsQuery trans mixedAmountV tail $ scanl (\(_, _, unitPrice, unitBalance) (date, amt) -> - let valueOnDate = unMix $ mixedAmountValue spanEnd date $ total trans (And [investmentsQuery, Date (DateSpan Nothing (Just date))]) + let valueOnDate = unMix $ mixedAmountValue end date $ total trans (And [investmentsQuery, Date (DateSpan Nothing (Just date))]) in case amt of - Right amt -> + Right amt' -> -- we are buying or selling - let unitsBoughtOrSold = unMix amt / unitPrice + let unitsBoughtOrSold = unMix amt' / unitPrice in (valueOnDate, unitsBoughtOrSold, unitPrice, unitBalance + unitsBoughtOrSold) - Left pnl -> + Left pnl' -> -- PnL change - let valueAfterDate = valueOnDate + unMix pnl + let valueAfterDate = valueOnDate + unMix pnl' unitPrice' = valueAfterDate/unitBalance in (valueOnDate, 0, unitPrice', unitBalance)) (0, 0, initialUnitPrice, initialUnits) @@ -220,17 +220,17 @@ timeWeightedReturn showCashFlow prettyTables investmentsQuery trans mixedAmountV else (unMix valueAfter) / finalUnitBalance -- Technically, totalTWR should be (100*(finalUnitPrice - initialUnitPrice) / initialUnitPrice), but initalUnitPrice is 100, so 100/100 == 1 totalTWR = roundTo 2 $ (finalUnitPrice - initialUnitPrice) - years = fromIntegral (diffDays spanEnd spanBegin) / 365 :: Double + years = fromIntegral (diffDays end begin) / 365 :: Double annualizedTWR = 100*((1+(realToFrac totalTWR/100))**(1/years)-1) :: Double when showCashFlow $ do - printf "\nTWR cash flow for %s - %s\n" (showDate spanBegin) (showDate (addDays (-1) spanEnd)) - let (dates', amounts) = unzip changes - cashflows' = map (fromRight nullmixedamt) amounts - pnls = map (fromLeft nullmixedamt) amounts + printf "\nTWR cash flow for %s - %s\n" (showDate begin) (showDate (addDays (-1) end)) + let (dates', amts) = unzip changes + cashflows' = map (fromRight nullmixedamt) amts + pnls = map (fromLeft nullmixedamt) amts (valuesOnDate,unitsBoughtOrSold', unitPrices', unitBalances') = unzip4 units add x lst = if valueBefore/=0 then x:lst else lst - dates = add spanBegin dates' + dates = add begin dates' cashflows = add valueBeforeAmt cashflows' unitsBoughtOrSold = add initialUnits unitsBoughtOrSold' unitPrices = add initialUnitPrice unitPrices' @@ -242,11 +242,11 @@ timeWeightedReturn showCashFlow prettyTables investmentsQuery trans mixedAmountV (Tab.Group DoubleLine [ Tab.Group Tab.SingleLine [Tab.Header "Portfolio value", Tab.Header "Unit balance"] , Tab.Group Tab.SingleLine [Tab.Header "Pnl", Tab.Header "Cashflow", Tab.Header "Unit price", Tab.Header "Units"] , Tab.Group Tab.SingleLine [Tab.Header "New Unit Balance"]]) - [ [value, oldBalance, pnl, cashflow, prc, udelta, balance] - | value <- map showDecimal valuesOnDate + [ [val, oldBalance, pnl', cashflow, prc, udelta, balance] + | val <- map showDecimal valuesOnDate | oldBalance <- map showDecimal (0:unitBalances) | balance <- map showDecimal unitBalances - | pnl <- map showMixedAmount pnls + | pnl' <- map showMixedAmount pnls | cashflow <- map showMixedAmount cashflows | prc <- map showDecimal unitPrices | udelta <- map showDecimal unitsBoughtOrSold ]) @@ -256,28 +256,28 @@ timeWeightedReturn showCashFlow prettyTables investmentsQuery trans mixedAmountV return annualizedTWR -internalRateOfReturn showCashFlow prettyTables (OneSpan spanBegin spanEnd valueBefore valueAfter cashFlow _pnl) = do - let prefix = (spanBegin, maNegate valueBefore) +internalRateOfReturn showCashFlow prettyTables (OneSpan begin end valueBefore valueAfter cashFlow _pnl) = do + let prefix = (begin, maNegate valueBefore) - postfix = (spanEnd, valueAfter) + postfix = (end, valueAfter) totalCF = filter (maIsNonZero . snd) $ prefix : (sortOn fst cashFlow) ++ [postfix] when showCashFlow $ do - printf "\nIRR cash flow for %s - %s\n" (showDate spanBegin) (showDate (addDays (-1) spanEnd)) - let (dates, amounts) = unzip totalCF + printf "\nIRR cash flow for %s - %s\n" (showDate begin) (showDate (addDays (-1) end)) + let (dates, amts) = unzip totalCF TL.putStrLn $ Tab.render prettyTables id id id (Table (Tab.Group Tab.NoLine (map (Header . showDate) dates)) (Tab.Group Tab.SingleLine [Header "Amount"]) - (map ((:[]) . T.pack . showMixedAmount) amounts)) + (map ((:[]) . T.pack . showMixedAmount) amts)) -- 0% is always a solution, so require at least something here case totalCF of [] -> return 0 _ -> case ridders (RiddersParam 100 (AbsTol 0.00001)) (0.000000000001,10000) - (interestSum spanEnd totalCF) of + (interestSum end totalCF) of Root rate -> return ((rate-1)*100) NotBracketed -> error' $ "Error (NotBracketed): No solution for Internal Rate of Return (IRR).\n" ++ " Possible causes: IRR is huge (>1000000%), balance of investment becomes negative at some point in time." @@ -301,7 +301,7 @@ total trans query = sumPostings . filter (matchesPosting query) $ concatMap real unMix :: MixedAmount -> Quantity unMix a = case (unifyMixedAmount $ mixedAmountCost a) of - Just a -> aquantity a + Just a' -> aquantity a' Nothing -> error' $ "Amounts could not be converted to a single cost basis: " ++ show (map showAmount $ amounts a) ++ "\nConsider using --value to force all costs to be in a single commodity." ++ "\nFor example, \"--cost --value=end, --infer-market-prices\", where commodity is the one that was used to pay for the investment." diff --git a/hledger/Hledger/Cli/Commands/Stats.hs b/hledger/Hledger/Cli/Commands/Stats.hs index 8549ea9b2..3bdca1d7c 100644 --- a/hledger/Hledger/Cli/Commands/Stats.hs +++ b/hledger/Hledger/Cli/Commands/Stats.hs @@ -60,17 +60,17 @@ stats opts@CliOpts{reportspec_=rspec, progstarttime_} j = do (realToFrac dt :: Float) (fromIntegral numtxns / realToFrac dt :: Float) showLedgerStats :: Ledger -> Day -> DateSpan -> (TB.Builder, Int) -showLedgerStats l today span = - (unlinesB $ map (renderRowB def{tableBorders=False, borderSpaces=False} . showRow) stats +showLedgerStats l today spn = + (unlinesB $ map (renderRowB def{tableBorders=False, borderSpaces=False} . showRow) stts ,tnum) where - showRow (label, value) = Group NoLine $ map (Header . textCell TopLeft) - [fitText (Just w1) (Just w1) False True label `T.append` ": ", T.pack value] - w1 = maximum $ map (T.length . fst) stats - (stats, tnum) = ([ + showRow (label, val) = Group NoLine $ map (Header . textCell TopLeft) + [fitText (Just w1) (Just w1) False True label `T.append` ": ", T.pack val] + w1 = maximum $ map (T.length . fst) stts + (stts, tnum) = ([ ("Main file", path) -- ++ " (from " ++ source ++ ")") ,("Included files", unlines $ drop 1 $ journalFilePaths j) - ,("Transactions span", printf "%s to %s (%d days)" (start span) (end span) days) + ,("Transactions span", printf "%s to %s (%d days)" (start spn) (end spn) days) ,("Last transaction", maybe "none" show lastdate ++ showelapsed lastelapsed) ,("Transactions", printf "%d (%0.1f per day)" tnum txnrate) ,("Transactions last 30 days", printf "%d (%0.1f per day)" tnum30 txnrate30) @@ -84,29 +84,29 @@ showLedgerStats l today span = -- Days since reconciliation : %(reconcileelapsed)s -- Days since last transaction : %(recentelapsed)s ] - ,tnum) + ,tnum1) where j = ljournal l path = journalFilePath j - ts = sortOn tdate $ filter (spanContainsDate span . tdate) $ jtxns j + ts = sortOn tdate $ filter (spanContainsDate spn . tdate) $ jtxns j as = nub $ map paccount $ concatMap tpostings ts cs = either error' Map.keys $ commodityStylesFromAmounts $ concatMap (amountsRaw . pamount) $ concatMap tpostings ts -- PARTIAL: lastdate | null ts = Nothing | otherwise = Just $ tdate $ last ts lastelapsed = fmap (diffDays today) lastdate showelapsed Nothing = "" - showelapsed (Just days) = printf " (%d %s)" days' direction - where days' = abs days - direction | days >= 0 = "days ago" :: String + showelapsed (Just dys) = printf " (%d %s)" dys' direction + where dys' = abs dys + direction | dys >= 0 = "days ago" :: String | otherwise = "days from now" - tnum = length ts -- Integer would be better + tnum1 = length ts -- Integer would be better start (DateSpan (Just d) _) = show d start _ = "" end (DateSpan _ (Just d)) = show d end _ = "" - days = fromMaybe 0 $ daysInSpan span + days = fromMaybe 0 $ daysInSpan spn txnrate | days==0 = 0 - | otherwise = fromIntegral tnum / fromIntegral days :: Double + | otherwise = fromIntegral tnum1 / fromIntegral days :: Double tnum30 = length $ filter withinlast30 ts withinlast30 t = d >= addDays (-30) today && (d<=today) where d = tdate t txnrate30 = fromIntegral tnum30 / 30 :: Double diff --git a/hledger/Hledger/Cli/CompoundBalanceCommand.hs b/hledger/Hledger/Cli/CompoundBalanceCommand.hs index 6fb68110f..440a44eb1 100644 --- a/hledger/Hledger/Cli/CompoundBalanceCommand.hs +++ b/hledger/Hledger/Cli/CompoundBalanceCommand.hs @@ -22,7 +22,7 @@ import Data.Time.Calendar (Day, addDays) import System.Console.CmdArgs.Explicit as C import Hledger.Read.CsvReader (CSV, printCSV) import Lucid as L hiding (value_) -import Text.Tabular.AsciiWide as Tab +import Text.Tabular.AsciiWide as Tab hiding (render) import Hledger import Hledger.Cli.Commands.Balance @@ -174,11 +174,11 @@ compoundBalanceCommand CompoundBalanceCommandSpec{..} opts@CliOpts{reportspec_=r -- render appropriately render = case outputFormatFromOpts opts of - "txt" -> compoundBalanceReportAsText ropts' - "csv" -> printCSV . compoundBalanceReportAsCsv ropts' - "html" -> L.renderText . compoundBalanceReportAsHtml ropts' - "json" -> toJsonText - x -> error' $ unsupportedOutputFormatError x + "txt" -> compoundBalanceReportAsText ropts' + "csv" -> printCSV . compoundBalanceReportAsCsv ropts' + "html" -> L.renderText . compoundBalanceReportAsHtml ropts' + "json" -> toJsonText + x -> error' $ unsupportedOutputFormatError x -- | Summarise one or more (inclusive) end dates, in a way that's -- visually different from showDateSpan, suggesting discrete end dates @@ -232,12 +232,12 @@ compoundBalanceReportAsText ropts -- | Convert a named multi balance report to a table suitable for -- concatenating with others to make a compound balance report table. - subreportAsTable ropts (title, r, _) = t + subreportAsTable ropts1 (title1, r, _) = t where -- convert to table - Table lefthdrs tophdrs cells = balanceReportAsTable ropts r + Table lefthdrs tophdrs cells = balanceReportAsTable ropts1 r -- tweak the layout - t = Table (Tab.Group Tab.SingleLine [Tab.Header title, lefthdrs]) tophdrs ([]:cells) + t = Table (Tab.Group Tab.SingleLine [Tab.Header title1, lefthdrs]) tophdrs ([]:cells) -- | Render a compound balance report as CSV. -- Subreports' CSV is concatenated, with the headings rows replaced by a @@ -256,9 +256,9 @@ compoundBalanceReportAsCsv ropts (CompoundPeriodicReport title colspans subrepor : concatMap (subreportAsCsv ropts) subreports where -- | Add a subreport title row and drop the heading row. - subreportAsCsv ropts (subreporttitle, multibalreport, _) = + subreportAsCsv ropts1 (subreporttitle, multibalreport, _) = padRow subreporttitle : - tail (multiBalanceReportAsCsv ropts multibalreport) + tail (multiBalanceReportAsCsv ropts1 multibalreport) padRow s = take numcols $ s : repeat "" where numcols diff --git a/hledger/Hledger/Cli/Main.hs b/hledger/Hledger/Cli/Main.hs index 51fb15cc7..c8fe5d6ac 100644 --- a/hledger/Hledger/Cli/Main.hs +++ b/hledger/Hledger/Cli/Main.hs @@ -97,7 +97,7 @@ mainmode addons = defMode { -- | Let's go! main :: IO () main = do - progstarttime <- getPOSIXTime + starttime <- getPOSIXTime -- Choose and run the appropriate internal or external command based -- on the raw command-line arguments, cmdarg's interpretation of @@ -132,7 +132,7 @@ main = do -- parse arguments with cmdargs opts' <- argsToCliOpts args addons - let opts = opts'{progstarttime_=progstarttime} + let opts = opts'{progstarttime_=starttime} -- select an action and run it. let @@ -143,13 +143,13 @@ main = do hasVersion = ("--version" `elem`) printUsage = putStr $ showModeUsage $ mainmode addons badCommandError = error' ("command "++rawcmd++" is not recognized, run with no command to see a list") >> exitFailure -- PARTIAL: - hasHelpFlag args = any (`elem` args) ["-h","--help"] - hasManFlag args = (`elem` args) "--man" - hasInfoFlag args = (`elem` args) "--info" - f `orShowHelp` mode - | hasHelpFlag args = putStr $ showModeUsage mode - | hasInfoFlag args = runInfoForTopic "hledger" (headMay $ modeNames mode) - | hasManFlag args = runManForTopic "hledger" (headMay $ modeNames mode) + hasHelpFlag args1 = any (`elem` args1) ["-h","--help"] + hasManFlag args1 = (`elem` args1) "--man" + hasInfoFlag args1 = (`elem` args1) "--info" + f `orShowHelp` mode1 + | hasHelpFlag args = putStr $ showModeUsage mode1 + | hasInfoFlag args = runInfoForTopic "hledger" (headMay $ modeNames mode1) + | hasManFlag args = runManForTopic "hledger" (headMay $ modeNames mode1) | otherwise = f -- where -- lastdocflag @@ -237,7 +237,7 @@ moveFlagsAfterCommand args = moveArgs $ ensureDebugHasArg args (bs,["--debug"]) -> bs++["--debug=1"] _ -> as - moveArgs args = insertFlagsAfterCommand $ moveArgs' (args, []) + moveArgs args1 = insertFlagsAfterCommand $ moveArgs' (args1, []) where -- -f FILE ..., --alias ALIAS ... moveArgs' ((f:v:a:as), flags) | isMovableReqArgFlag f, isValue v = moveArgs' (a:as, flags ++ [f,v]) @@ -251,7 +251,7 @@ moveFlagsAfterCommand args = moveArgs $ ensureDebugHasArg args moveArgs' (as, flags) = (as, flags) insertFlagsAfterCommand ([], flags) = flags - insertFlagsAfterCommand (command:args, flags) = [command] ++ flags ++ args + insertFlagsAfterCommand (command1:args2, flags) = [command1] ++ flags ++ args2 isMovableNoArgFlag a = "-" `isPrefixOf` a && dropWhile (=='-') a `elem` optargflagstomove ++ noargflagstomove diff --git a/hledger/Hledger/Cli/Utils.hs b/hledger/Hledger/Cli/Utils.hs index d9f458959..9954a8115 100644 --- a/hledger/Hledger/Cli/Utils.hs +++ b/hledger/Hledger/Cli/Utils.hs @@ -181,16 +181,16 @@ maybeFileModificationTime f = do -- | Attempt to open a web browser on the given url, all platforms. openBrowserOn :: String -> IO ExitCode -openBrowserOn u = trybrowsers browsers u +openBrowserOn = trybrowsers browsers where - trybrowsers (b:bs) u = do - (e,_,_) <- readProcessWithExitCode b [u] "" + trybrowsers (b:bs) u1 = do + (e,_,_) <- readProcessWithExitCode b [u1] "" case e of ExitSuccess -> return ExitSuccess - ExitFailure _ -> trybrowsers bs u - trybrowsers [] u = do + ExitFailure _ -> trybrowsers bs u1 + trybrowsers [] u1 = do putStrLn $ printf "Could not start a web browser (tried: %s)" $ intercalate ", " browsers - putStrLn $ printf "Please open your browser and visit %s" u + putStrLn $ printf "Please open your browser and visit %s" u1 return $ ExitFailure 127 browsers | os=="darwin" = ["open"] | os=="mingw32" = ["c:/Program Files/Mozilla Firefox/firefox.exe"] @@ -270,11 +270,11 @@ postingsOrTransactionsReportAsText alignAll opts itemAsText itemamt itembal repo minWidth = 12 chunkSize = 1000 - renderItem (amtWidth, balWidth) item@(_, amt, bal) = ((amtWidth', balWidth'), itemBuilder) + renderItem (amtWidth, balWidth) item@(_, amt1, bal1) = ((amtWidth', balWidth'), itemBuilder) where itemBuilder = itemAsText amtWidth' balWidth' item - amtWidth' = if alignAll then amtWidth else maximumStrict $ amtWidth : map wbWidth amt - balWidth' = if alignAll then balWidth else maximumStrict $ balWidth : map wbWidth bal + amtWidth' = if alignAll then amtWidth else maximumStrict $ amtWidth : map wbWidth amt1 + balWidth' = if alignAll then balWidth else maximumStrict $ balWidth : map wbWidth bal1 startWidth f = maximum $ minWidth : map wbWidth (concatMap f startAlign) where diff --git a/hledger/Hledger/Cli/Version.hs b/hledger/Hledger/Cli/Version.hs index 8c65c4d09..17dac1531 100644 --- a/hledger/Hledger/Cli/Version.hs +++ b/hledger/Hledger/Cli/Version.hs @@ -57,19 +57,19 @@ progname = "hledger" -- so that must not be overridden by a log.date git config variable. -- versionStringWith :: Either String GitInfo -> ProgramName -> PackageVersion -> VersionString -versionStringWith egitinfo progname packageversion = - concat [ progname , " " , version , ", " , os' , "-" , arch ] +versionStringWith egitinfo prognam packagever = + concat [ prognam , " " , version , ", " , os' , "-" , arch ] where os' | os == "darwin" = "mac" | os == "mingw32" = "windows" | otherwise = os version = case egitinfo of - Left _err -> packageversion + Left _err -> packagever Right gitinfo -> case words $ giCommitDate gitinfo of -- git log's date format is normally --date=default ("similar to --date=rfc2822") _weekday:mon:day:_localtime:year:_offset:_ -> - intercalate "-" [packageversion , hash, date] + intercalate "-" [packagever , hash, date] where hash = 'g' : take 9 (giHash gitinfo) -- like git describe date = concat [year,mm,dd] diff --git a/hledger/package.yaml b/hledger/package.yaml index 798cb1e35..2700b77f8 100644 --- a/hledger/package.yaml +++ b/hledger/package.yaml @@ -89,7 +89,6 @@ ghc-options: - -Wall - -Wno-incomplete-uni-patterns - -Wno-missing-signatures -- -Wno-name-shadowing - -Wno-orphans - -Wno-type-defaults - -Wno-unused-do-bind