From bc7a1476ed99dd309b1ee3ef68d2f456dccd613f Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Thu, 14 Feb 2019 05:14:52 -0800 Subject: [PATCH] refactor: lib: hlint cleanups --- .hlint.yaml | 3 +- hledger-lib/Hledger/Data/Account.hs | 2 +- hledger-lib/Hledger/Data/Amount.hs | 3 +- hledger-lib/Hledger/Data/Commodity.hs | 2 +- hledger-lib/Hledger/Data/Dates.hs | 93 +- hledger-lib/Hledger/Data/Journal.hs | 58 +- hledger-lib/Hledger/Data/Ledger.hs | 19 +- hledger-lib/Hledger/Data/MarketPrice.hs | 2 - .../Hledger/Data/PeriodicTransaction.hs | 1 - hledger-lib/Hledger/Data/Posting.hs | 7 +- hledger-lib/Hledger/Data/RawOptions.hs | 2 +- hledger-lib/Hledger/Data/StringFormat.hs | 4 +- hledger-lib/Hledger/Data/Timeclock.hs | 1 + hledger-lib/Hledger/Data/Transaction.hs | 854 ++++++++++-------- 14 files changed, 579 insertions(+), 472 deletions(-) diff --git a/.hlint.yaml b/.hlint.yaml index 96201e5cefb..c442cb29bc1 100644 --- a/.hlint.yaml +++ b/.hlint.yaml @@ -47,10 +47,11 @@ # - ignore: {name: Use let} # - ignore: {name: Use const, within: SpecialModule} # Only within certain modules -- ignore: {name: Use camelCase} +- ignore: {name: Reduce duplication} - ignore: {name: Redundant $} - ignore: {name: Redundant bracket} - ignore: {name: Redundant do} +- ignore: {name: Use camelCase} # Define some custom infix operators diff --git a/hledger-lib/Hledger/Data/Account.hs b/hledger-lib/Hledger/Data/Account.hs index ca362533fb0..316d928bed7 100644 --- a/hledger-lib/Hledger/Data/Account.hs +++ b/hledger-lib/Hledger/Data/Account.hs @@ -242,7 +242,7 @@ sortAccountTreeByDeclaration :: Account -> Account sortAccountTreeByDeclaration a | null $ asubs a = a | otherwise = a{asubs= - sortBy (comparing accountDeclarationOrderAndName) $ + sortOn accountDeclarationOrderAndName $ map sortAccountTreeByDeclaration $ asubs a } diff --git a/hledger-lib/Hledger/Data/Amount.hs b/hledger-lib/Hledger/Data/Amount.hs index 2906c8549b8..370b538226d 100644 --- a/hledger-lib/Hledger/Data/Amount.hs +++ b/hledger-lib/Hledger/Data/Amount.hs @@ -132,7 +132,6 @@ import Data.List import Data.Map (findWithDefault) import Data.Maybe import Data.Time.Calendar (Day) -import Data.Ord (comparing) -- import Data.Text (Text) import qualified Data.Text as T import Safe (maximumDef) @@ -469,7 +468,7 @@ commodityValue j valuationdate c where dbg = dbg8 ("using market price for "++T.unpack c) applicableprices = - [p | p <- sortBy (comparing mpdate) $ jmarketprices j + [p | p <- sortOn mpdate $ jmarketprices j , mpcommodity p == c , mpdate p <= valuationdate ] diff --git a/hledger-lib/Hledger/Data/Commodity.hs b/hledger-lib/Hledger/Data/Commodity.hs index 4e095c708c0..1cd892c777e 100644 --- a/hledger-lib/Hledger/Data/Commodity.hs +++ b/hledger-lib/Hledger/Data/Commodity.hs @@ -26,7 +26,7 @@ import Hledger.Utils -- characters that may not be used in a non-quoted commodity symbol -nonsimplecommoditychars = "0123456789-+.@*;\n \"{}=" :: [Char] +nonsimplecommoditychars = "0123456789-+.@*;\n \"{}=" :: String isNonsimpleCommodityChar :: Char -> Bool isNonsimpleCommodityChar c = isDigit c || c `textElem` otherChars diff --git a/hledger-lib/Hledger/Data/Dates.hs b/hledger-lib/Hledger/Data/Dates.hs index ef31f4c6ad5..d827431dac8 100644 --- a/hledger-lib/Hledger/Data/Dates.hs +++ b/hledger-lib/Hledger/Data/Dates.hs @@ -126,21 +126,15 @@ showDateSpanMonthAbbrev = showPeriodMonthAbbrev . dateSpanAsPeriod -- | Get the current local date. getCurrentDay :: IO Day -getCurrentDay = do - t <- getZonedTime - return $ localDay (zonedTimeToLocalTime t) +getCurrentDay = localDay . zonedTimeToLocalTime <$> getZonedTime -- | Get the current local month number. getCurrentMonth :: IO Int -getCurrentMonth = do - (_,m,_) <- toGregorian `fmap` getCurrentDay - return m +getCurrentMonth = second3 . toGregorian <$> getCurrentDay -- | Get the current local year. getCurrentYear :: IO Integer -getCurrentYear = do - (y,_,_) <- toGregorian `fmap` getCurrentDay - return y +getCurrentYear = first3 . toGregorian <$> getCurrentDay elapsedSeconds :: Fractional a => UTCTime -> UTCTime -> a elapsedSeconds t1 = realToFrac . diffUTCTime t1 @@ -380,14 +374,13 @@ spanFromSmartDate refdate sdate = DateSpan (Just b) (Just e) -- | Convert a smart date string to an explicit yyyy\/mm\/dd string using -- the provided reference date, or raise an error. fixSmartDateStr :: Day -> Text -> String -fixSmartDateStr d s = either - (\e->error' $ printf "could not parse date %s %s" (show s) (show e)) - id - $ (fixSmartDateStrEither d s :: Either (ParseErrorBundle Text CustomErr) String) +fixSmartDateStr d s = + either (error' . printf "could not parse date %s %s" (show s) . show) id $ + (fixSmartDateStrEither d s :: Either (ParseErrorBundle Text CustomErr) String) -- | A safe version of fixSmartDateStr. fixSmartDateStrEither :: Day -> Text -> Either (ParseErrorBundle Text CustomErr) String -fixSmartDateStrEither d = either Left (Right . showDate) . fixSmartDateStrEither' d +fixSmartDateStrEither d = fmap showDate . fixSmartDateStrEither' d fixSmartDateStrEither' :: Day -> Text -> Either (ParseErrorBundle Text CustomErr) Day @@ -469,34 +462,34 @@ fixSmartDateStrEither' d s = case parsewith smartdateonly (T.toLower s) of -- "2009/01/01" -- fixSmartDate :: Day -> SmartDate -> Day -fixSmartDate refdate sdate = fix sdate - where - fix :: SmartDate -> Day - fix ("","","today") = fromGregorian ry rm rd - fix ("","this","day") = fromGregorian ry rm rd - fix ("","","yesterday") = prevday refdate - fix ("","last","day") = prevday refdate - fix ("","","tomorrow") = nextday refdate - fix ("","next","day") = nextday refdate - fix ("","last","week") = prevweek refdate - fix ("","this","week") = thisweek refdate - fix ("","next","week") = nextweek refdate - fix ("","last","month") = prevmonth refdate - fix ("","this","month") = thismonth refdate - fix ("","next","month") = nextmonth refdate - fix ("","last","quarter") = prevquarter refdate - fix ("","this","quarter") = thisquarter refdate - fix ("","next","quarter") = nextquarter refdate - fix ("","last","year") = prevyear refdate - fix ("","this","year") = thisyear refdate - fix ("","next","year") = nextyear refdate - fix ("","",d) = fromGregorian ry rm (read d) - fix ("",m,"") = fromGregorian ry (read m) 1 - fix ("",m,d) = fromGregorian ry (read m) (read d) - fix (y,"","") = fromGregorian (read y) 1 1 - fix (y,m,"") = fromGregorian (read y) (read m) 1 - fix (y,m,d) = fromGregorian (read y) (read m) (read d) - (ry,rm,rd) = toGregorian refdate +fixSmartDate refdate = fix + where + fix :: SmartDate -> Day + fix ("", "", "today") = fromGregorian ry rm rd + fix ("", "this", "day") = fromGregorian ry rm rd + fix ("", "", "yesterday") = prevday refdate + fix ("", "last", "day") = prevday refdate + fix ("", "", "tomorrow") = nextday refdate + fix ("", "next", "day") = nextday refdate + fix ("", "last", "week") = prevweek refdate + fix ("", "this", "week") = thisweek refdate + fix ("", "next", "week") = nextweek refdate + fix ("", "last", "month") = prevmonth refdate + fix ("", "this", "month") = thismonth refdate + fix ("", "next", "month") = nextmonth refdate + fix ("", "last", "quarter") = prevquarter refdate + fix ("", "this", "quarter") = thisquarter refdate + fix ("", "next", "quarter") = nextquarter refdate + fix ("", "last", "year") = prevyear refdate + fix ("", "this", "year") = thisyear refdate + fix ("", "next", "year") = nextyear refdate + fix ("", "", d) = fromGregorian ry rm (read d) + fix ("", m, "") = fromGregorian ry (read m) 1 + fix ("", m, d) = fromGregorian ry (read m) (read d) + fix (y, "", "") = fromGregorian (read y) 1 1 + fix (y, m, "") = fromGregorian (read y) (read m) 1 + fix (y, m, d) = fromGregorian (read y) (read m) (read d) + (ry, rm, rd) = toGregorian refdate prevday :: Day -> Day prevday = addDays (-1) @@ -764,7 +757,7 @@ smartdateonly = do eof return d -datesepchars :: [Char] +datesepchars :: String datesepchars = "/-." datesepchar :: TextParser m Char @@ -980,8 +973,7 @@ reportingintervalp = choice' [ return $ DayOfWeek n, do string' "every" skipMany spacenonewline - n <- weekday - return $ DayOfWeek n, + DayOfWeek <$> weekday, do string' "every" skipMany spacenonewline n <- nth @@ -1034,7 +1026,7 @@ reportingintervalp = choice' [ return $ intcons 1, do string' "every" skipMany spacenonewline - n <- fmap read $ some digitChar + n <- read <$> some digitChar skipMany spacenonewline string' plural' return $ intcons n @@ -1061,8 +1053,7 @@ doubledatespanp rdate = do b <- smartdate skipMany spacenonewline optional (choice [string' "to", string' "-"] >> skipMany spacenonewline) - e <- smartdate - return $ DateSpan (Just $ fixSmartDate rdate b) (Just $ fixSmartDate rdate e) + DateSpan (Just $ fixSmartDate rdate b) . Just . fixSmartDate rdate <$> smartdate fromdatespanp :: Day -> TextParser m DateSpan fromdatespanp rdate = do @@ -1081,14 +1072,12 @@ fromdatespanp rdate = do todatespanp :: Day -> TextParser m DateSpan todatespanp rdate = do choice [string' "to", string' "-"] >> skipMany spacenonewline - e <- smartdate - return $ DateSpan Nothing (Just $ fixSmartDate rdate e) + DateSpan Nothing . Just . fixSmartDate rdate <$> smartdate justdatespanp :: Day -> TextParser m DateSpan justdatespanp rdate = do optional (string' "in" >> skipMany spacenonewline) - d <- smartdate - return $ spanFromSmartDate rdate d + spanFromSmartDate rdate <$> smartdate -- | Make a datespan from two valid date strings parseable by parsedate -- (or raise an error). Eg: mkdatespan \"2011/1/1\" \"2011/12/31\". diff --git a/hledger-lib/Hledger/Data/Journal.hs b/hledger-lib/Hledger/Data/Journal.hs index df436ef214f..0976a83c16d 100644 --- a/hledger-lib/Hledger/Data/Journal.hs +++ b/hledger-lib/Hledger/Data/Journal.hs @@ -90,7 +90,6 @@ import Data.Maybe #if !(MIN_VERSION_base(4,11,0)) import Data.Monoid #endif -import Data.Ord import qualified Data.Semigroup as Sem import Data.Text (Text) import qualified Data.Text as T @@ -672,7 +671,7 @@ journalBalanceTransactionsST assrt j createStore storeIn extract = (Just $ journalCommodityStyles j) (getModifierAccountNames j) flip R.runReaderT env $ do - dated <- fmap snd . sortBy (comparing fst) . concat + dated <- fmap snd . sortOn fst . concat <$> mapM' discriminateByDate (jtxns j) mapM' checkInferAndRegisterAmounts dated lift $ extract txStore @@ -714,33 +713,33 @@ discriminateByDate :: Transaction -> CurrentBalancesModifier s [(Day, Either Posting Transaction)] discriminateByDate tx | null (assignmentPostings tx) = do - styles <- R.reader $ eStyles - balanced <- lift $ ExceptT $ return $ balanceTransaction styles tx - storeTransaction balanced - return $ - fmap (postingDate &&& (Left . removePrices)) $ tpostings $ balanced - | True = do - when (any (isJust . pdate) $ tpostings tx) $ - throwError $ unlines $ - ["postings may not have both a custom date and a balance assignment." - ,"Write the posting amount explicitly, or remove the posting date:\n" - , showTransaction tx] - return - [(tdate tx, Right $ tx { tpostings = removePrices <$> tpostings tx })] + styles <- R.reader $ eStyles + balanced <- lift $ ExceptT $ return $ balanceTransaction styles tx + storeTransaction balanced + return $ fmap (postingDate &&& (Left . removePrices)) $ tpostings $ balanced + | otherwise = do + when (any (isJust . pdate) $ tpostings tx) $ + throwError $ + unlines $ + [ "postings may not have both a custom date and a balance assignment." + , "Write the posting amount explicitly, or remove the posting date:\n" + , showTransaction tx + ] + return [(tdate tx, Right $ tx {tpostings = removePrices <$> tpostings tx})] -- | Throw an error if a posting is in the unassignable set. checkUnassignablePosting :: Posting -> CurrentBalancesModifier s () checkUnassignablePosting p = do unassignable <- R.asks eUnassignable - if (isAssignment p && paccount p `S.member` unassignable) - then throwError $ unlines $ - [ "cannot assign amount to account " - , "" - , " " ++ (T.unpack $ paccount p) - , "" - , "because it is also included in transaction modifiers." - ] - else return () + when (isAssignment p && paccount p `S.member` unassignable) $ + throwError $ + unlines $ + [ "cannot assign amount to account " + , "" + , " " ++ T.unpack (paccount p) + , "" + , "because it is also included in transaction modifiers." + ] -- | This function takes an object describing changes to @@ -789,7 +788,7 @@ checkInferAndRegisterAmounts (Right oldTx) = do Just ba | baexact ba -> do diff <- setMixedBalance acc $ Mixed [baamount ba] fullPosting diff p - Just ba | otherwise -> do + Just ba -> do old <- liftModifier $ \Env{ eBalances = bals } -> HT.lookup bals acc let amt = baamount ba assertedcomm = acommodity amt @@ -884,13 +883,12 @@ commodityStylesFromAmounts amts = M.fromList commstyles -- That is: the style of the first, and the maximum precision of all. canonicalStyleFrom :: [AmountStyle] -> AmountStyle canonicalStyleFrom [] = amountstyle -canonicalStyleFrom ss@(first:_) = - first{asprecision=prec, asdecimalpoint=mdec, asdigitgroups=mgrps} +canonicalStyleFrom ss@(first:_) = first {asprecision = prec, asdecimalpoint = mdec, asdigitgroups = mgrps} where - mgrps = maybe Nothing Just $ headMay $ catMaybes $ map asdigitgroups ss + mgrps = headMay $ mapMaybe asdigitgroups ss -- precision is maximum of all precisions prec = maximumStrict $ map asprecision ss - mdec = Just $ headDef '.' $ catMaybes $ map asdecimalpoint ss + mdec = Just $ headDef '.' $ mapMaybe asdecimalpoint ss -- precision is that of first amount with a decimal point -- (mdec, prec) = -- case filter (isJust . asdecimalpoint) ss of @@ -993,7 +991,7 @@ journalDateSpan secondary j latest = maximumStrict dates dates = pdates ++ tdates tdates = map (if secondary then transactionDate2 else tdate) ts - pdates = concatMap (catMaybes . map (if secondary then (Just . postingDate2) else pdate) . tpostings) ts + pdates = concatMap (mapMaybe (if secondary then (Just . postingDate2) else pdate) . tpostings) ts ts = jtxns j -- | Apply the pivot transformation to all postings in a journal, diff --git a/hledger-lib/Hledger/Data/Ledger.hs b/hledger-lib/Hledger/Data/Ledger.hs index b6d963a7776..08345545904 100644 --- a/hledger-lib/Hledger/Data/Ledger.hs +++ b/hledger-lib/Hledger/Data/Ledger.hs @@ -107,12 +107,13 @@ ledgerCommodities = M.keys . jinferredcommodities . ljournal -- tests -tests_Ledger = tests "Ledger" [ - - tests "ledgerFromJournal" [ - (length $ ledgerPostings $ ledgerFromJournal Any nulljournal) `is` 0 - ,(length $ ledgerPostings $ ledgerFromJournal Any samplejournal) `is` 13 - ,(length $ ledgerPostings $ ledgerFromJournal (Depth 2) samplejournal) `is` 7 - ] - - ] +tests_Ledger = + tests + "Ledger" + [ tests + "ledgerFromJournal" + [ length (ledgerPostings $ ledgerFromJournal Any nulljournal) `is` 0 + , length (ledgerPostings $ ledgerFromJournal Any samplejournal) `is` 13 + , length (ledgerPostings $ ledgerFromJournal (Depth 2) samplejournal) `is` 7 + ] + ] diff --git a/hledger-lib/Hledger/Data/MarketPrice.hs b/hledger-lib/Hledger/Data/MarketPrice.hs index a06a1612e1c..cf99446fc73 100644 --- a/hledger-lib/Hledger/Data/MarketPrice.hs +++ b/hledger-lib/Hledger/Data/MarketPrice.hs @@ -8,8 +8,6 @@ value of things at a given date. -} -{-# LANGUAGE OverloadedStrings, LambdaCase #-} - module Hledger.Data.MarketPrice where import qualified Data.Text as T diff --git a/hledger-lib/Hledger/Data/PeriodicTransaction.hs b/hledger-lib/Hledger/Data/PeriodicTransaction.hs index ec788c1825f..a2b71ee3ada 100644 --- a/hledger-lib/Hledger/Data/PeriodicTransaction.hs +++ b/hledger-lib/Hledger/Data/PeriodicTransaction.hs @@ -1,7 +1,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE StandaloneDeriving #-} {-| A 'PeriodicTransaction' is a rule describing recurring transactions. diff --git a/hledger-lib/Hledger/Data/Posting.hs b/hledger-lib/Hledger/Data/Posting.hs index 48921c8da59..ec5b2d4663f 100644 --- a/hledger-lib/Hledger/Data/Posting.hs +++ b/hledger-lib/Hledger/Data/Posting.hs @@ -66,7 +66,6 @@ import Data.MemoUgly (memo) #if !(MIN_VERSION_base(4,11,0)) import Data.Monoid #endif -import Data.Ord import Data.Text (Text) import qualified Data.Text as T import Data.Time.Calendar @@ -176,7 +175,7 @@ postingDate2 p = headDef nulldate $ catMaybes dates where dates = [pdate2 p ,maybe Nothing tdate2 $ ptransaction p ,pdate p - ,maybe Nothing (Just . tdate) $ ptransaction p + ,fmap tdate (ptransaction p) ] -- | Get a posting's status. This is cleared or pending if those are @@ -237,14 +236,14 @@ isEmptyPosting = isZeroMixedAmount . pamount postingsDateSpan :: [Posting] -> DateSpan postingsDateSpan [] = DateSpan Nothing Nothing postingsDateSpan ps = DateSpan (Just $ postingDate $ head ps') (Just $ addDays 1 $ postingDate $ last ps') - where ps' = sortBy (comparing postingDate) ps + where ps' = sortOn postingDate ps -- --date2-sensitive version, as above. postingsDateSpan' :: WhichDate -> [Posting] -> DateSpan postingsDateSpan' _ [] = DateSpan Nothing Nothing postingsDateSpan' wd ps = DateSpan (Just $ postingdate $ head ps') (Just $ addDays 1 $ postingdate $ last ps') where - ps' = sortBy (comparing postingdate) ps + ps' = sortOn postingdate ps postingdate = if wd == PrimaryDate then postingDate else postingDate2 -- AccountName stuff that depends on PostingType diff --git a/hledger-lib/Hledger/Data/RawOptions.hs b/hledger-lib/Hledger/Data/RawOptions.hs index 412c595b4e1..fbc47be13f6 100644 --- a/hledger-lib/Hledger/Data/RawOptions.hs +++ b/hledger-lib/Hledger/Data/RawOptions.hs @@ -46,7 +46,7 @@ boolopt :: String -> RawOpts -> Bool boolopt = inRawOpts maybestringopt :: String -> RawOpts -> Maybe String -maybestringopt name = maybe Nothing (Just . T.unpack . stripquotes . T.pack) . lookup name . reverse +maybestringopt name = fmap (T.unpack . stripquotes . T.pack) . lookup name . reverse stringopt :: String -> RawOpts -> String stringopt name = fromMaybe "" . maybestringopt name diff --git a/hledger-lib/Hledger/Data/StringFormat.hs b/hledger-lib/Hledger/Data/StringFormat.hs index 815af005beb..ede3b0b7c63 100644 --- a/hledger-lib/Hledger/Data/StringFormat.hs +++ b/hledger-lib/Hledger/Data/StringFormat.hs @@ -107,7 +107,7 @@ formatliteralp = do s <- some c return $ FormatLiteral s where - isPrintableButNotPercentage x = isPrint x && (not $ x == '%') + isPrintableButNotPercentage x = isPrint x && x /= '%' c = (satisfy isPrintableButNotPercentage "printable character") <|> try (string "%%" >> return '%') @@ -133,7 +133,7 @@ fieldp = do <|> try (string "date" >> return DescriptionField) <|> try (string "description" >> return DescriptionField) <|> try (string "total" >> return TotalField) - <|> try (some digitChar >>= (\s -> return $ FieldNo $ read s)) + <|> try ((FieldNo . read) <$> some digitChar) ---------------------------------------------------------------------- diff --git a/hledger-lib/Hledger/Data/Timeclock.hs b/hledger-lib/Hledger/Data/Timeclock.hs index d9f287c81f0..7f220082bd8 100644 --- a/hledger-lib/Hledger/Data/Timeclock.hs +++ b/hledger-lib/Hledger/Data/Timeclock.hs @@ -74,6 +74,7 @@ timeclockEntriesToTransactions now (i:o:rest) (idate,odate) = (localDay itime,localDay otime) o' = o{tldatetime=itime{localDay=idate, localTimeOfDay=TimeOfDay 23 59 59}} i' = i{tldatetime=itime{localDay=addDays 1 idate, localTimeOfDay=midnight}} +{- HLINT ignore timeclockEntriesToTransactions -} -- | Convert a timeclock clockin and clockout entry to an equivalent journal -- transaction, representing the time expenditure. Note this entry is not balanced, diff --git a/hledger-lib/Hledger/Data/Transaction.hs b/hledger-lib/Hledger/Data/Transaction.hs index 7a1fa7e0d49..dca178afedd 100644 --- a/hledger-lib/Hledger/Data/Transaction.hs +++ b/hledger-lib/Hledger/Data/Transaction.hs @@ -192,9 +192,9 @@ renderCommentLines t = case lines $ T.unpack t of ("":ls) -> "":map commentpref -- postingsAsLines :: Bool -> Bool -> Transaction -> [Posting] -> [String] postingsAsLines elide onelineamounts t ps - | elide && length ps > 1 && all hasAmount ps && isTransactionBalanced Nothing t -- imprecise balanced check - = (concatMap (postingAsLines False onelineamounts ps) $ init ps) ++ postingAsLines True onelineamounts ps (last ps) - | otherwise = concatMap (postingAsLines False onelineamounts ps) ps + | elide && length ps > 1 && all hasAmount ps && isTransactionBalanced Nothing t -- imprecise balanced check + = concatMap (postingAsLines False onelineamounts ps) (init ps) ++ postingAsLines True onelineamounts ps (last ps) + | otherwise = concatMap (postingAsLines False onelineamounts ps) ps -- | Render one posting, on one or more lines, suitable for `print` output. -- There will be an indented account name, plus one or more of status flag, @@ -300,7 +300,7 @@ balancedVirtualPostings :: Transaction -> [Posting] balancedVirtualPostings = filter isBalancedVirtual . tpostings transactionsPostings :: [Transaction] -> [Posting] -transactionsPostings = concat . map tpostings +transactionsPostings = concatMap tpostings -- | Get the sums of a transaction's real, virtual, and balanced virtual postings. transactionPostingBalances :: Transaction -> (MixedAmount,MixedAmount,MixedAmount) @@ -445,9 +445,7 @@ inferBalancingAmount update styles t@Transaction{tpostings=ps} inferBalancingPrices :: Transaction -> Transaction inferBalancingPrices t@Transaction{tpostings=ps} = t{tpostings=ps'} where - ps' = map (priceInferrerFor t BalancedVirtualPosting) $ - map (priceInferrerFor t RegularPosting) $ - ps + ps' = map (priceInferrerFor t BalancedVirtualPosting . priceInferrerFor t RegularPosting) ps -- | Generate a posting update function which assigns a suitable balancing -- price to the posting, if and as appropriate for the given transaction and @@ -478,7 +476,7 @@ priceInferrerFor t pt = inferprice tocommodity = head $ filter (/=fromcommodity) sumcommodities toamount = head $ filter ((==tocommodity).acommodity) sumamounts unitprice = (aquantity fromamount) `divideAmount` toamount - unitprecision = max 2 ((asprecision $ astyle $ toamount) + (asprecision $ astyle $ fromamount)) + unitprecision = max 2 (asprecision (astyle toamount) + asprecision (astyle fromamount)) inferprice p = p -- Get a transaction's secondary date, defaulting to the primary date. @@ -502,371 +500,495 @@ postingSetTransaction t p = p{ptransaction=Just t} -- tests -tests_Transaction = tests "Transaction" [ - - tests "showTransactionUnelided" [ - showTransactionUnelided nulltransaction `is` "0000/01/01\n\n" - ,showTransactionUnelided nulltransaction{ - tdate=parsedate "2012/05/14", - tdate2=Just $ parsedate "2012/05/15", - tstatus=Unmarked, - tcode="code", - tdescription="desc", - tcomment="tcomment1\ntcomment2\n", - ttags=[("ttag1","val1")], - tpostings=[ - nullposting{ - pstatus=Cleared, - paccount="a", - pamount=Mixed [usd 1, hrs 2], - pcomment="\npcomment2\n", - ptype=RegularPosting, - ptags=[("ptag1","val1"),("ptag2","val2")] - } - ] - } - `is` unlines [ - "2012/05/14=2012/05/15 (code) desc ; tcomment1", - " ; tcomment2", - " * a $1.00", - " ; pcomment2", - " * a 2.00h", - " ; pcomment2", - "" - ] - ] - - ,tests "postingAsLines" [ - postingAsLines False False [posting] posting `is` [""] - ,let p = posting{ - pstatus=Cleared, - paccount="a", - pamount=Mixed [usd 1, hrs 2], - pcomment="pcomment1\npcomment2\n tag3: val3 \n", - ptype=RegularPosting, - ptags=[("ptag1","val1"),("ptag2","val2")] - } - in postingAsLines False False [p] p `is` - [ - " * a $1.00 ; pcomment1", - " ; pcomment2", - " ; tag3: val3 ", - " * a 2.00h ; pcomment1", - " ; pcomment2", - " ; tag3: val3 " - ] - ] - +tests_Transaction = + tests + "Transaction" + [ tests + "showTransactionUnelided" + [ showTransactionUnelided nulltransaction `is` "0000/01/01\n\n" + , showTransactionUnelided + nulltransaction + { tdate = parsedate "2012/05/14" + , tdate2 = Just $ parsedate "2012/05/15" + , tstatus = Unmarked + , tcode = "code" + , tdescription = "desc" + , tcomment = "tcomment1\ntcomment2\n" + , ttags = [("ttag1", "val1")] + , tpostings = + [ nullposting + { pstatus = Cleared + , paccount = "a" + , pamount = Mixed [usd 1, hrs 2] + , pcomment = "\npcomment2\n" + , ptype = RegularPosting + , ptags = [("ptag1", "val1"), ("ptag2", "val2")] + } + ] + } `is` + unlines + [ "2012/05/14=2012/05/15 (code) desc ; tcomment1" + , " ; tcomment2" + , " * a $1.00" + , " ; pcomment2" + , " * a 2.00h" + , " ; pcomment2" + , "" + ] + ] + , tests + "postingAsLines" + [ postingAsLines False False [posting] posting `is` [""] + , let p = + posting + { pstatus = Cleared + , paccount = "a" + , pamount = Mixed [usd 1, hrs 2] + , pcomment = "pcomment1\npcomment2\n tag3: val3 \n" + , ptype = RegularPosting + , ptags = [("ptag1", "val1"), ("ptag2", "val2")] + } + in postingAsLines False False [p] p `is` + [ " * a $1.00 ; pcomment1" + , " ; pcomment2" + , " ; tag3: val3 " + , " * a 2.00h ; pcomment1" + , " ; pcomment2" + , " ; tag3: val3 " + ] + ] -- postingsAsLines - ,let -- one implicit amount - timp = nulltransaction{tpostings=[ - "a" `post` usd 1, - "b" `post` missingamt - ]} + , let timp = nulltransaction {tpostings = ["a" `post` usd 1, "b" `post` missingamt]} -- explicit amounts, balanced - texp = nulltransaction{tpostings=[ - "a" `post` usd 1, - "b" `post` usd (-1) - ]} + texp = nulltransaction {tpostings = ["a" `post` usd 1, "b" `post` usd (-1)]} -- explicit amount, only one posting - texp1 = nulltransaction{tpostings=[ - "(a)" `post` usd 1 - ]} + texp1 = nulltransaction {tpostings = ["(a)" `post` usd 1]} -- explicit amounts, two commodities, explicit balancing price - texp2 = nulltransaction{tpostings=[ - "a" `post` usd 1, - "b" `post` (hrs (-1) `at` usd 1) - ]} + texp2 = nulltransaction {tpostings = ["a" `post` usd 1, "b" `post` (hrs (-1) `at` usd 1)]} -- explicit amounts, two commodities, implicit balancing price - texp2b = nulltransaction{tpostings=[ - "a" `post` usd 1, - "b" `post` hrs (-1) - ]} + texp2b = nulltransaction {tpostings = ["a" `post` usd 1, "b" `post` hrs (-1)]} -- one missing amount, not the last one - t3 = nulltransaction{tpostings=[ - "a" `post` usd 1 - ,"b" `post` missingamt - ,"c" `post` usd (-1) - ]} + t3 = nulltransaction {tpostings = ["a" `post` usd 1, "b" `post` missingamt, "c" `post` usd (-1)]} -- unbalanced amounts when precision is limited (#931) - t4 = nulltransaction{tpostings=[ - "a" `post` usd (-0.01) - ,"b" `post` usd (0.005) - ,"c" `post` usd (0.005) - ]} - in - tests "postingsAsLines" [ - - test "null-transaction" $ - let t = nulltransaction - in postingsAsLines True False t (tpostings t) `is` [] - - ,test "implicit-amount-elide-false" $ - let t = timp in postingsAsLines False False t (tpostings t) `is` [ - " a $1.00" - ," b" -- implicit amount remains implicit - ] - - ,test "implicit-amount-elide-true" $ - let t = timp in postingsAsLines True False t (tpostings t) `is` [ - " a $1.00" - ," b" -- implicit amount remains implicit - ] - - ,test "explicit-amounts-elide-false" $ - let t = texp in postingsAsLines False False t (tpostings t) `is` [ - " a $1.00" - ," b $-1.00" -- both amounts remain explicit - ] - - ,test "explicit-amounts-elide-true" $ - let t = texp in postingsAsLines True False t (tpostings t) `is` [ - " a $1.00" - ," b" -- explicit amount is made implicit - ] - - ,test "one-explicit-amount-elide-true" $ - let t = texp1 in postingsAsLines True False t (tpostings t) `is` [ - " (a) $1.00" -- explicit amount remains explicit since only one posting - ] - - ,test "explicit-amounts-two-commodities-elide-true" $ - let t = texp2 in postingsAsLines True False t (tpostings t) `is` [ - " a $1.00" - ," b" -- explicit amount is made implicit since txn is explicitly balanced - ] - - ,test "explicit-amounts-not-explicitly-balanced-elide-true" $ - let t = texp2b in postingsAsLines True False t (tpostings t) `is` [ - " a $1.00" - ," b -1.00h" -- explicit amount remains explicit since a conversion price would have be inferred to balance - ] - - ,test "implicit-amount-not-last" $ - let t = t3 in postingsAsLines True False t (tpostings t) `is` [ - " a $1.00" - ," b" - ," c $-1.00" - ] - - ,_test "ensure-visibly-balanced" $ - let t = t4 in postingsAsLines False False t (tpostings t) `is` [ - " a $-0.01" - ," b $0.005" - ," c $0.005" - ] - - ] - - ,do - let inferTransaction :: Transaction -> Either String Transaction - inferTransaction = runIdentity . runExceptT . inferBalancingAmount (\_ _ -> return ()) Map.empty - tests "inferBalancingAmount" [ - inferTransaction nulltransaction `is` Right nulltransaction - ,inferTransaction nulltransaction{ - tpostings=[ - "a" `post` usd (-5), - "b" `post` missingamt - ]} - `is` Right - nulltransaction{ - tpostings=[ - "a" `post` usd (-5), - "b" `post` usd 5 - ]} - ,inferTransaction nulltransaction{ - tpostings=[ - "a" `post` usd (-5), - "b" `post` (eur 3 @@ usd 4), - "c" `post` missingamt - ]} - `is` Right - nulltransaction{ - tpostings=[ - "a" `post` usd (-5), - "b" `post` (eur 3 @@ usd 4), - "c" `post` usd 1 - ]} - ] - - ,tests "showTransaction" [ - test "show a balanced transaction, eliding last amount" $ - let t = Transaction 0 "" nullsourcepos (parsedate "2007/01/28") Nothing Unmarked "" "coopportunity" "" [] - [posting{paccount="expenses:food:groceries", pamount=Mixed [usd 47.18], ptransaction=Just t} - ,posting{paccount="assets:checking", pamount=Mixed [usd (-47.18)], ptransaction=Just t} - ] - in - showTransaction t - `is` - unlines - ["2007/01/28 coopportunity" - ," expenses:food:groceries $47.18" - ," assets:checking" - ,"" - ] - - ,test "show a balanced transaction, no eliding" $ - (let t = Transaction 0 "" nullsourcepos (parsedate "2007/01/28") Nothing Unmarked "" "coopportunity" "" [] - [posting{paccount="expenses:food:groceries", pamount=Mixed [usd 47.18], ptransaction=Just t} - ,posting{paccount="assets:checking", pamount=Mixed [usd (-47.18)], ptransaction=Just t} - ] - in showTransactionUnelided t) - `is` - (unlines - ["2007/01/28 coopportunity" - ," expenses:food:groceries $47.18" - ," assets:checking $-47.18" - ,"" - ]) - + t4 = nulltransaction {tpostings = ["a" `post` usd (-0.01), "b" `post` usd (0.005), "c" `post` usd (0.005)]} + in tests + "postingsAsLines" + [ test "null-transaction" $ + let t = nulltransaction + in postingsAsLines True False t (tpostings t) `is` [] + , test "implicit-amount-elide-false" $ + let t = timp + in postingsAsLines False False t (tpostings t) `is` + [ " a $1.00" + , " b" -- implicit amount remains implicit + ] + , test "implicit-amount-elide-true" $ + let t = timp + in postingsAsLines True False t (tpostings t) `is` + [ " a $1.00" + , " b" -- implicit amount remains implicit + ] + , test "explicit-amounts-elide-false" $ + let t = texp + in postingsAsLines False False t (tpostings t) `is` + [ " a $1.00" + , " b $-1.00" -- both amounts remain explicit + ] + , test "explicit-amounts-elide-true" $ + let t = texp + in postingsAsLines True False t (tpostings t) `is` + [ " a $1.00" + , " b" -- explicit amount is made implicit + ] + , test "one-explicit-amount-elide-true" $ + let t = texp1 + in postingsAsLines True False t (tpostings t) `is` + [ " (a) $1.00" -- explicit amount remains explicit since only one posting + ] + , test "explicit-amounts-two-commodities-elide-true" $ + let t = texp2 + in postingsAsLines True False t (tpostings t) `is` + [ " a $1.00" + , " b" -- explicit amount is made implicit since txn is explicitly balanced + ] + , test "explicit-amounts-not-explicitly-balanced-elide-true" $ + let t = texp2b + in postingsAsLines True False t (tpostings t) `is` + [ " a $1.00" + , " b -1.00h" -- explicit amount remains explicit since a conversion price would have be inferred to balance + ] + , test "implicit-amount-not-last" $ + let t = t3 + in postingsAsLines True False t (tpostings t) `is` + [" a $1.00", " b", " c $-1.00"] + , _test "ensure-visibly-balanced" $ + let t = t4 + in postingsAsLines False False t (tpostings t) `is` + [" a $-0.01", " b $0.005", " c $0.005"] + ] + , do let inferTransaction :: Transaction -> Either String Transaction + inferTransaction = runIdentity . runExceptT . inferBalancingAmount (\_ _ -> return ()) Map.empty + tests + "inferBalancingAmount" + [ inferTransaction nulltransaction `is` Right nulltransaction + , inferTransaction nulltransaction {tpostings = ["a" `post` usd (-5), "b" `post` missingamt]} `is` + Right nulltransaction {tpostings = ["a" `post` usd (-5), "b" `post` usd 5]} + , inferTransaction + nulltransaction {tpostings = ["a" `post` usd (-5), "b" `post` (eur 3 @@ usd 4), "c" `post` missingamt]} `is` + Right nulltransaction {tpostings = ["a" `post` usd (-5), "b" `post` (eur 3 @@ usd 4), "c" `post` usd 1]} + ] + , tests + "showTransaction" + [ test "show a balanced transaction, eliding last amount" $ + let t = + Transaction + 0 + "" + nullsourcepos + (parsedate "2007/01/28") + Nothing + Unmarked + "" + "coopportunity" + "" + [] + [ posting {paccount = "expenses:food:groceries", pamount = Mixed [usd 47.18], ptransaction = Just t} + , posting {paccount = "assets:checking", pamount = Mixed [usd (-47.18)], ptransaction = Just t} + ] + in showTransaction t `is` + unlines + ["2007/01/28 coopportunity", " expenses:food:groceries $47.18", " assets:checking", ""] + , test "show a balanced transaction, no eliding" $ + (let t = + Transaction + 0 + "" + nullsourcepos + (parsedate "2007/01/28") + Nothing + Unmarked + "" + "coopportunity" + "" + [] + [ posting {paccount = "expenses:food:groceries", pamount = Mixed [usd 47.18], ptransaction = Just t} + , posting {paccount = "assets:checking", pamount = Mixed [usd (-47.18)], ptransaction = Just t} + ] + in showTransactionUnelided t) `is` + (unlines + [ "2007/01/28 coopportunity" + , " expenses:food:groceries $47.18" + , " assets:checking $-47.18" + , "" + ]) -- document some cases that arise in debug/testing: - ,test "show an unbalanced transaction, should not elide" $ - (showTransaction - (txnTieKnot $ Transaction 0 "" nullsourcepos (parsedate "2007/01/28") Nothing Unmarked "" "coopportunity" "" [] - [posting{paccount="expenses:food:groceries", pamount=Mixed [usd 47.18]} - ,posting{paccount="assets:checking", pamount=Mixed [usd (-47.19)]} - ])) - `is` - (unlines - ["2007/01/28 coopportunity" - ," expenses:food:groceries $47.18" - ," assets:checking $-47.19" - ,"" - ]) - - ,test "show an unbalanced transaction with one posting, should not elide" $ - (showTransaction - (txnTieKnot $ Transaction 0 "" nullsourcepos (parsedate "2007/01/28") Nothing Unmarked "" "coopportunity" "" [] - [posting{paccount="expenses:food:groceries", pamount=Mixed [usd 47.18]} - ])) - `is` - (unlines - ["2007/01/28 coopportunity" - ," expenses:food:groceries $47.18" - ,"" - ]) - - ,test "show a transaction with one posting and a missing amount" $ - (showTransaction - (txnTieKnot $ Transaction 0 "" nullsourcepos (parsedate "2007/01/28") Nothing Unmarked "" "coopportunity" "" [] - [posting{paccount="expenses:food:groceries", pamount=missingmixedamt} - ])) - `is` - (unlines - ["2007/01/28 coopportunity" - ," expenses:food:groceries" - ,"" - ]) - - ,test "show a transaction with a priced commodityless amount" $ - (showTransaction - (txnTieKnot $ Transaction 0 "" nullsourcepos (parsedate "2010/01/01") Nothing Unmarked "" "x" "" [] - [posting{paccount="a", pamount=Mixed [num 1 `at` (usd 2 `withPrecision` 0)]} - ,posting{paccount="b", pamount= missingmixedamt} - ])) - `is` - (unlines - ["2010/01/01 x" - ," a 1 @ $2" - ," b" - ,"" - ]) + , test "show an unbalanced transaction, should not elide" $ + (showTransaction + (txnTieKnot $ + Transaction + 0 + "" + nullsourcepos + (parsedate "2007/01/28") + Nothing + Unmarked + "" + "coopportunity" + "" + [] + [ posting {paccount = "expenses:food:groceries", pamount = Mixed [usd 47.18]} + , posting {paccount = "assets:checking", pamount = Mixed [usd (-47.19)]} + ])) `is` + (unlines + [ "2007/01/28 coopportunity" + , " expenses:food:groceries $47.18" + , " assets:checking $-47.19" + , "" + ]) + , test "show an unbalanced transaction with one posting, should not elide" $ + (showTransaction + (txnTieKnot $ + Transaction + 0 + "" + nullsourcepos + (parsedate "2007/01/28") + Nothing + Unmarked + "" + "coopportunity" + "" + [] + [posting {paccount = "expenses:food:groceries", pamount = Mixed [usd 47.18]}])) `is` + (unlines ["2007/01/28 coopportunity", " expenses:food:groceries $47.18", ""]) + , test "show a transaction with one posting and a missing amount" $ + (showTransaction + (txnTieKnot $ + Transaction + 0 + "" + nullsourcepos + (parsedate "2007/01/28") + Nothing + Unmarked + "" + "coopportunity" + "" + [] + [posting {paccount = "expenses:food:groceries", pamount = missingmixedamt}])) `is` + (unlines ["2007/01/28 coopportunity", " expenses:food:groceries", ""]) + , test "show a transaction with a priced commodityless amount" $ + (showTransaction + (txnTieKnot $ + Transaction + 0 + "" + nullsourcepos + (parsedate "2010/01/01") + Nothing + Unmarked + "" + "x" + "" + [] + [ posting {paccount = "a", pamount = Mixed [num 1 `at` (usd 2 `withPrecision` 0)]} + , posting {paccount = "b", pamount = missingmixedamt} + ])) `is` + (unlines ["2010/01/01 x", " a 1 @ $2", " b", ""]) + ] + , tests + "balanceTransaction" + [ test "detect unbalanced entry, sign error" $ + expectLeft + (balanceTransaction + Nothing + (Transaction + 0 + "" + nullsourcepos + (parsedate "2007/01/28") + Nothing + Unmarked + "" + "test" + "" + [] + [posting {paccount = "a", pamount = Mixed [usd 1]}, posting {paccount = "b", pamount = Mixed [usd 1]}])) + , test "detect unbalanced entry, multiple missing amounts" $ + expectLeft $ + balanceTransaction + Nothing + (Transaction + 0 + "" + nullsourcepos + (parsedate "2007/01/28") + Nothing + Unmarked + "" + "test" + "" + [] + [ posting {paccount = "a", pamount = missingmixedamt} + , posting {paccount = "b", pamount = missingmixedamt} + ]) + , test "one missing amount is inferred" $ + (pamount . last . tpostings <$> + balanceTransaction + Nothing + (Transaction + 0 + "" + nullsourcepos + (parsedate "2007/01/28") + Nothing + Unmarked + "" + "" + "" + [] + [posting {paccount = "a", pamount = Mixed [usd 1]}, posting {paccount = "b", pamount = missingmixedamt}])) `is` + Right (Mixed [usd (-1)]) + , test "conversion price is inferred" $ + (pamount . head . tpostings <$> + balanceTransaction + Nothing + (Transaction + 0 + "" + nullsourcepos + (parsedate "2007/01/28") + Nothing + Unmarked + "" + "" + "" + [] + [ posting {paccount = "a", pamount = Mixed [usd 1.35]} + , posting {paccount = "b", pamount = Mixed [eur (-1)]} + ])) `is` + Right (Mixed [usd 1.35 @@ (eur 1 `withPrecision` maxprecision)]) + , test "balanceTransaction balances based on cost if there are unit prices" $ + expectRight $ + balanceTransaction + Nothing + (Transaction + 0 + "" + nullsourcepos + (parsedate "2011/01/01") + Nothing + Unmarked + "" + "" + "" + [] + [ posting {paccount = "a", pamount = Mixed [usd 1 `at` eur 2]} + , posting {paccount = "a", pamount = Mixed [usd (-2) `at` eur 1]} + ]) + , test "balanceTransaction balances based on cost if there are total prices" $ + expectRight $ + balanceTransaction + Nothing + (Transaction + 0 + "" + nullsourcepos + (parsedate "2011/01/01") + Nothing + Unmarked + "" + "" + "" + [] + [ posting {paccount = "a", pamount = Mixed [usd 1 @@ eur 1]} + , posting {paccount = "a", pamount = Mixed [usd (-2) @@ eur 1]} + ]) + ] + , tests + "isTransactionBalanced" + [ test "detect balanced" $ + expect $ + isTransactionBalanced Nothing $ + Transaction + 0 + "" + nullsourcepos + (parsedate "2009/01/01") + Nothing + Unmarked + "" + "a" + "" + [] + [ posting {paccount = "b", pamount = Mixed [usd 1.00]} + , posting {paccount = "c", pamount = Mixed [usd (-1.00)]} + ] + , test "detect unbalanced" $ + expect $ + not $ + isTransactionBalanced Nothing $ + Transaction + 0 + "" + nullsourcepos + (parsedate "2009/01/01") + Nothing + Unmarked + "" + "a" + "" + [] + [ posting {paccount = "b", pamount = Mixed [usd 1.00]} + , posting {paccount = "c", pamount = Mixed [usd (-1.01)]} + ] + , test "detect unbalanced, one posting" $ + expect $ + not $ + isTransactionBalanced Nothing $ + Transaction + 0 + "" + nullsourcepos + (parsedate "2009/01/01") + Nothing + Unmarked + "" + "a" + "" + [] + [posting {paccount = "b", pamount = Mixed [usd 1.00]}] + , test "one zero posting is considered balanced for now" $ + expect $ + isTransactionBalanced Nothing $ + Transaction + 0 + "" + nullsourcepos + (parsedate "2009/01/01") + Nothing + Unmarked + "" + "a" + "" + [] + [posting {paccount = "b", pamount = Mixed [usd 0]}] + , test "virtual postings don't need to balance" $ + expect $ + isTransactionBalanced Nothing $ + Transaction + 0 + "" + nullsourcepos + (parsedate "2009/01/01") + Nothing + Unmarked + "" + "a" + "" + [] + [ posting {paccount = "b", pamount = Mixed [usd 1.00]} + , posting {paccount = "c", pamount = Mixed [usd (-1.00)]} + , posting {paccount = "d", pamount = Mixed [usd 100], ptype = VirtualPosting} + ] + , test "balanced virtual postings need to balance among themselves" $ + expect $ + not $ + isTransactionBalanced Nothing $ + Transaction + 0 + "" + nullsourcepos + (parsedate "2009/01/01") + Nothing + Unmarked + "" + "a" + "" + [] + [ posting {paccount = "b", pamount = Mixed [usd 1.00]} + , posting {paccount = "c", pamount = Mixed [usd (-1.00)]} + , posting {paccount = "d", pamount = Mixed [usd 100], ptype = BalancedVirtualPosting} + ] + , test "balanced virtual postings need to balance among themselves (2)" $ + expect $ + isTransactionBalanced Nothing $ + Transaction + 0 + "" + nullsourcepos + (parsedate "2009/01/01") + Nothing + Unmarked + "" + "a" + "" + [] + [ posting {paccount = "b", pamount = Mixed [usd 1.00]} + , posting {paccount = "c", pamount = Mixed [usd (-1.00)]} + , posting {paccount = "d", pamount = Mixed [usd 100], ptype = BalancedVirtualPosting} + , posting {paccount = "3", pamount = Mixed [usd (-100)], ptype = BalancedVirtualPosting} + ] + ] ] - - ,tests "balanceTransaction" [ - test "detect unbalanced entry, sign error" $ - (expectLeft $ balanceTransaction Nothing - (Transaction 0 "" nullsourcepos (parsedate "2007/01/28") Nothing Unmarked "" "test" "" [] - [posting{paccount="a", pamount=Mixed [usd 1]} - ,posting{paccount="b", pamount=Mixed [usd 1]} - ])) - - ,test "detect unbalanced entry, multiple missing amounts" $ - (expectLeft $ balanceTransaction Nothing - (Transaction 0 "" nullsourcepos (parsedate "2007/01/28") Nothing Unmarked "" "test" "" [] - [posting{paccount="a", pamount=missingmixedamt} - ,posting{paccount="b", pamount=missingmixedamt} - ])) - - ,test "one missing amount is inferred" $ - (pamount . last . tpostings <$> balanceTransaction - Nothing - (Transaction 0 "" nullsourcepos (parsedate "2007/01/28") Nothing Unmarked "" "" "" [] - [posting{paccount="a", pamount=Mixed [usd 1]} - ,posting{paccount="b", pamount=missingmixedamt} - ])) - `is` Right (Mixed [usd (-1)]) - - ,test "conversion price is inferred" $ - (pamount . head . tpostings <$> balanceTransaction - Nothing - (Transaction 0 "" nullsourcepos (parsedate "2007/01/28") Nothing Unmarked "" "" "" [] - [posting{paccount="a", pamount=Mixed [usd 1.35]} - ,posting{paccount="b", pamount=Mixed [eur (-1)]} - ])) - `is` Right (Mixed [usd 1.35 @@ (eur 1 `withPrecision` maxprecision)]) - - ,test "balanceTransaction balances based on cost if there are unit prices" $ - expectRight $ - balanceTransaction Nothing (Transaction 0 "" nullsourcepos (parsedate "2011/01/01") Nothing Unmarked "" "" "" [] - [posting{paccount="a", pamount=Mixed [usd 1 `at` eur 2]} - ,posting{paccount="a", pamount=Mixed [usd (-2) `at` eur 1]} - ]) - - ,test "balanceTransaction balances based on cost if there are total prices" $ - expectRight $ - balanceTransaction Nothing (Transaction 0 "" nullsourcepos (parsedate "2011/01/01") Nothing Unmarked "" "" "" [] - [posting{paccount="a", pamount=Mixed [usd 1 @@ eur 1]} - ,posting{paccount="a", pamount=Mixed [usd (-2) @@ eur 1]} - ]) - ] - - ,tests "isTransactionBalanced" [ - test "detect balanced" $ expect $ - isTransactionBalanced Nothing $ Transaction 0 "" nullsourcepos (parsedate "2009/01/01") Nothing Unmarked "" "a" "" [] - [posting{paccount="b", pamount=Mixed [usd 1.00]} - ,posting{paccount="c", pamount=Mixed [usd (-1.00)]} - ] - - ,test "detect unbalanced" $ expect $ - not $ isTransactionBalanced Nothing $ Transaction 0 "" nullsourcepos (parsedate "2009/01/01") Nothing Unmarked "" "a" "" [] - [posting{paccount="b", pamount=Mixed [usd 1.00]} - ,posting{paccount="c", pamount=Mixed [usd (-1.01)]} - ] - - ,test "detect unbalanced, one posting" $ expect $ - not $ isTransactionBalanced Nothing $ Transaction 0 "" nullsourcepos (parsedate "2009/01/01") Nothing Unmarked "" "a" "" [] - [posting{paccount="b", pamount=Mixed [usd 1.00]} - ] - - ,test "one zero posting is considered balanced for now" $ expect $ - isTransactionBalanced Nothing $ Transaction 0 "" nullsourcepos (parsedate "2009/01/01") Nothing Unmarked "" "a" "" [] - [posting{paccount="b", pamount=Mixed [usd 0]} - ] - - ,test "virtual postings don't need to balance" $ expect $ - isTransactionBalanced Nothing $ Transaction 0 "" nullsourcepos (parsedate "2009/01/01") Nothing Unmarked "" "a" "" [] - [posting{paccount="b", pamount=Mixed [usd 1.00]} - ,posting{paccount="c", pamount=Mixed [usd (-1.00)]} - ,posting{paccount="d", pamount=Mixed [usd 100], ptype=VirtualPosting} - ] - - ,test "balanced virtual postings need to balance among themselves" $ expect $ - not $ isTransactionBalanced Nothing $ Transaction 0 "" nullsourcepos (parsedate "2009/01/01") Nothing Unmarked "" "a" "" [] - [posting{paccount="b", pamount=Mixed [usd 1.00]} - ,posting{paccount="c", pamount=Mixed [usd (-1.00)]} - ,posting{paccount="d", pamount=Mixed [usd 100], ptype=BalancedVirtualPosting} - ] - - ,test "balanced virtual postings need to balance among themselves (2)" $ expect $ - isTransactionBalanced Nothing $ Transaction 0 "" nullsourcepos (parsedate "2009/01/01") Nothing Unmarked "" "a" "" [] - [posting{paccount="b", pamount=Mixed [usd 1.00]} - ,posting{paccount="c", pamount=Mixed [usd (-1.00)]} - ,posting{paccount="d", pamount=Mixed [usd 100], ptype=BalancedVirtualPosting} - ,posting{paccount="3", pamount=Mixed [usd (-100)], ptype=BalancedVirtualPosting} - ] - - ] - - ]