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

refactor: lib: hlint cleanups

Browse Source
This commit is contained in:
Simon Michael 2019-02-14 05:14:52 -08:00
parent 03877057fb
commit bc7a1476ed
14 changed files with 579 additions and 472 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
.hlint.yaml
View File

@ -47,10 +47,11 @@
# - ignore: {name: Use let} # - ignore: {name: Use let}
# - ignore: {name: Use const, within: SpecialModule} # Only within certain modules # - ignore: {name: Use const, within: SpecialModule} # Only within certain modules
- ignore: {name: Use camelCase} - ignore: {name: Reduce duplication}
- ignore: {name: Redundant $} - ignore: {name: Redundant $}
- ignore: {name: Redundant bracket} - ignore: {name: Redundant bracket}
- ignore: {name: Redundant do} - ignore: {name: Redundant do}
- ignore: {name: Use camelCase}
# Define some custom infix operators # Define some custom infix operators

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

@ -242,7 +242,7 @@ sortAccountTreeByDeclaration :: Account -> Account
sortAccountTreeByDeclaration a sortAccountTreeByDeclaration a
| null $ asubs a = a | null $ asubs a = a
| otherwise = a{asubs= | otherwise = a{asubs=
sortBy (comparing accountDeclarationOrderAndName) $ sortOn accountDeclarationOrderAndName $
map sortAccountTreeByDeclaration $ asubs a map sortAccountTreeByDeclaration $ asubs a
} }

3
hledger-lib/Hledger/Data/Amount.hs
View File

@ -132,7 +132,6 @@ import Data.List
import Data.Map (findWithDefault) import Data.Map (findWithDefault)
import Data.Maybe import Data.Maybe
import Data.Time.Calendar (Day) import Data.Time.Calendar (Day)
import Data.Ord (comparing)
-- import Data.Text (Text) -- import Data.Text (Text)
import qualified Data.Text as T import qualified Data.Text as T
import Safe (maximumDef) import Safe (maximumDef)
@ -469,7 +468,7 @@ commodityValue j valuationdate c
where where
dbg = dbg8 ("using market price for "++T.unpack c) dbg = dbg8 ("using market price for "++T.unpack c)
applicableprices = applicableprices =
[p | p <- sortBy (comparing mpdate) $ jmarketprices j [p | p <- sortOn mpdate $ jmarketprices j
, mpcommodity p == c , mpcommodity p == c
, mpdate p <= valuationdate , mpdate p <= valuationdate
] ]

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

@ -26,7 +26,7 @@ import Hledger.Utils
-- characters that may not be used in a non-quoted commodity symbol -- characters that may not be used in a non-quoted commodity symbol
nonsimplecommoditychars = "0123456789-+.@*;\n \"{}=" :: [Char] nonsimplecommoditychars = "0123456789-+.@*;\n \"{}=" :: String
isNonsimpleCommodityChar :: Char -> Bool isNonsimpleCommodityChar :: Char -> Bool
isNonsimpleCommodityChar c = isDigit c || c `textElem` otherChars isNonsimpleCommodityChar c = isDigit c || c `textElem` otherChars

93
hledger-lib/Hledger/Data/Dates.hs
View File

@ -126,21 +126,15 @@ showDateSpanMonthAbbrev = showPeriodMonthAbbrev . dateSpanAsPeriod
-- | Get the current local date. -- | Get the current local date.
getCurrentDay :: IO Day getCurrentDay :: IO Day
getCurrentDay = do getCurrentDay = localDay . zonedTimeToLocalTime <$> getZonedTime
t <- getZonedTime
return $ localDay (zonedTimeToLocalTime t)
-- | Get the current local month number. -- | Get the current local month number.
getCurrentMonth :: IO Int getCurrentMonth :: IO Int
getCurrentMonth = do getCurrentMonth = second3 . toGregorian <$> getCurrentDay
(_,m,_) <- toGregorian `fmap` getCurrentDay
return m
-- | Get the current local year. -- | Get the current local year.
getCurrentYear :: IO Integer getCurrentYear :: IO Integer
getCurrentYear = do getCurrentYear = first3 . toGregorian <$> getCurrentDay
(y,_,_) <- toGregorian `fmap` getCurrentDay
return y
elapsedSeconds :: Fractional a => UTCTime -> UTCTime -> a elapsedSeconds :: Fractional a => UTCTime -> UTCTime -> a
elapsedSeconds t1 = realToFrac . diffUTCTime t1 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 -- | Convert a smart date string to an explicit yyyy\/mm\/dd string using
-- the provided reference date, or raise an error. -- the provided reference date, or raise an error.
fixSmartDateStr :: Day -> Text -> String fixSmartDateStr :: Day -> Text -> String
fixSmartDateStr d s = either fixSmartDateStr d s =
(\e->error' $ printf "could not parse date %s %s" (show s) (show e)) either (error' . printf "could not parse date %s %s" (show s) . show) id $
id (fixSmartDateStrEither d s :: Either (ParseErrorBundle Text CustomErr) String)
$ (fixSmartDateStrEither d s :: Either (ParseErrorBundle Text CustomErr) String)
-- | A safe version of fixSmartDateStr. -- | A safe version of fixSmartDateStr.
fixSmartDateStrEither :: Day -> Text -> Either (ParseErrorBundle Text CustomErr) String fixSmartDateStrEither :: Day -> Text -> Either (ParseErrorBundle Text CustomErr) String
fixSmartDateStrEither d = either Left (Right . showDate) . fixSmartDateStrEither' d fixSmartDateStrEither d = fmap showDate . fixSmartDateStrEither' d
fixSmartDateStrEither' fixSmartDateStrEither'
:: Day -> Text -> Either (ParseErrorBundle Text CustomErr) Day :: Day -> Text -> Either (ParseErrorBundle Text CustomErr) Day
@ -469,34 +462,34 @@ fixSmartDateStrEither' d s = case parsewith smartdateonly (T.toLower s) of
-- "2009/01/01" -- "2009/01/01"
-- --
fixSmartDate :: Day -> SmartDate -> Day fixSmartDate :: Day -> SmartDate -> Day
fixSmartDate refdate sdate = fix sdate fixSmartDate refdate = fix
where where
fix :: SmartDate -> Day fix :: SmartDate -> Day
fix ("","","today") = fromGregorian ry rm rd fix ("", "", "today") = fromGregorian ry rm rd
fix ("","this","day") = fromGregorian ry rm rd fix ("", "this", "day") = fromGregorian ry rm rd
fix ("","","yesterday") = prevday refdate fix ("", "", "yesterday") = prevday refdate
fix ("","last","day") = prevday refdate fix ("", "last", "day") = prevday refdate
fix ("","","tomorrow") = nextday refdate fix ("", "", "tomorrow") = nextday refdate
fix ("","next","day") = nextday refdate fix ("", "next", "day") = nextday refdate
fix ("","last","week") = prevweek refdate fix ("", "last", "week") = prevweek refdate
fix ("","this","week") = thisweek refdate fix ("", "this", "week") = thisweek refdate
fix ("","next","week") = nextweek refdate fix ("", "next", "week") = nextweek refdate
fix ("","last","month") = prevmonth refdate fix ("", "last", "month") = prevmonth refdate
fix ("","this","month") = thismonth refdate fix ("", "this", "month") = thismonth refdate
fix ("","next","month") = nextmonth refdate fix ("", "next", "month") = nextmonth refdate
fix ("","last","quarter") = prevquarter refdate fix ("", "last", "quarter") = prevquarter refdate
fix ("","this","quarter") = thisquarter refdate fix ("", "this", "quarter") = thisquarter refdate
fix ("","next","quarter") = nextquarter refdate fix ("", "next", "quarter") = nextquarter refdate
fix ("","last","year") = prevyear refdate fix ("", "last", "year") = prevyear refdate
fix ("","this","year") = thisyear refdate fix ("", "this", "year") = thisyear refdate
fix ("","next","year") = nextyear refdate fix ("", "next", "year") = nextyear refdate
fix ("","",d) = fromGregorian ry rm (read d) fix ("", "", d) = fromGregorian ry rm (read d)
fix ("",m,"") = fromGregorian ry (read m) 1 fix ("", m, "") = fromGregorian ry (read m) 1
fix ("",m,d) = fromGregorian ry (read m) (read d) fix ("", m, d) = fromGregorian ry (read m) (read d)
fix (y,"","") = fromGregorian (read y) 1 1 fix (y, "", "") = fromGregorian (read y) 1 1
fix (y,m,"") = fromGregorian (read y) (read m) 1 fix (y, m, "") = fromGregorian (read y) (read m) 1
fix (y,m,d) = fromGregorian (read y) (read m) (read d) fix (y, m, d) = fromGregorian (read y) (read m) (read d)
(ry,rm,rd) = toGregorian refdate (ry, rm, rd) = toGregorian refdate
prevday :: Day -> Day prevday :: Day -> Day
prevday = addDays (-1) prevday = addDays (-1)
@ -764,7 +757,7 @@ smartdateonly = do
eof eof
return d return d
datesepchars :: [Char] datesepchars :: String
datesepchars = "/-." datesepchars = "/-."
datesepchar :: TextParser m Char datesepchar :: TextParser m Char
@ -980,8 +973,7 @@ reportingintervalp = choice' [
return $ DayOfWeek n, return $ DayOfWeek n,
do string' "every" do string' "every"
skipMany spacenonewline skipMany spacenonewline
n <- weekday DayOfWeek <$> weekday,
return $ DayOfWeek n,
do string' "every" do string' "every"
skipMany spacenonewline skipMany spacenonewline
n <- nth n <- nth
@ -1034,7 +1026,7 @@ reportingintervalp = choice' [
return $ intcons 1, return $ intcons 1,
do string' "every" do string' "every"
skipMany spacenonewline skipMany spacenonewline
n <- fmap read $ some digitChar n <- read <$> some digitChar
skipMany spacenonewline skipMany spacenonewline
string' plural' string' plural'
return $ intcons n return $ intcons n
@ -1061,8 +1053,7 @@ doubledatespanp rdate = do
b <- smartdate b <- smartdate
skipMany spacenonewline skipMany spacenonewline
optional (choice [string' "to", string' "-"] >> skipMany spacenonewline) optional (choice [string' "to", string' "-"] >> skipMany spacenonewline)
e <- smartdate DateSpan (Just $ fixSmartDate rdate b) . Just . fixSmartDate rdate <$> smartdate
return $ DateSpan (Just $ fixSmartDate rdate b) (Just $ fixSmartDate rdate e)
fromdatespanp :: Day -> TextParser m DateSpan fromdatespanp :: Day -> TextParser m DateSpan
fromdatespanp rdate = do fromdatespanp rdate = do
@ -1081,14 +1072,12 @@ fromdatespanp rdate = do
todatespanp :: Day -> TextParser m DateSpan todatespanp :: Day -> TextParser m DateSpan
todatespanp rdate = do todatespanp rdate = do
choice [string' "to", string' "-"] >> skipMany spacenonewline choice [string' "to", string' "-"] >> skipMany spacenonewline
e <- smartdate DateSpan Nothing . Just . fixSmartDate rdate <$> smartdate
return $ DateSpan Nothing (Just $ fixSmartDate rdate e)
justdatespanp :: Day -> TextParser m DateSpan justdatespanp :: Day -> TextParser m DateSpan
justdatespanp rdate = do justdatespanp rdate = do
optional (string' "in" >> skipMany spacenonewline) optional (string' "in" >> skipMany spacenonewline)
d <- smartdate spanFromSmartDate rdate <$> smartdate
return $ spanFromSmartDate rdate d
-- | Make a datespan from two valid date strings parseable by parsedate -- | Make a datespan from two valid date strings parseable by parsedate
-- (or raise an error). Eg: mkdatespan \"2011/1/1\" \"2011/12/31\". -- (or raise an error). Eg: mkdatespan \"2011/1/1\" \"2011/12/31\".

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

@ -90,7 +90,6 @@ import Data.Maybe
#if !(MIN_VERSION_base(4,11,0)) #if !(MIN_VERSION_base(4,11,0))
import Data.Monoid import Data.Monoid
#endif #endif
import Data.Ord
import qualified Data.Semigroup as Sem import qualified Data.Semigroup as Sem
import Data.Text (Text) import Data.Text (Text)
import qualified Data.Text as T import qualified Data.Text as T
@ -672,7 +671,7 @@ journalBalanceTransactionsST assrt j createStore storeIn extract =
(Just $ journalCommodityStyles j) (Just $ journalCommodityStyles j)
(getModifierAccountNames j) (getModifierAccountNames j)
flip R.runReaderT env $ do flip R.runReaderT env $ do
dated <- fmap snd . sortBy (comparing fst) . concat dated <- fmap snd . sortOn fst . concat
<$> mapM' discriminateByDate (jtxns j) <$> mapM' discriminateByDate (jtxns j)
mapM' checkInferAndRegisterAmounts dated mapM' checkInferAndRegisterAmounts dated
lift $ extract txStore lift $ extract txStore
@ -714,33 +713,33 @@ discriminateByDate :: Transaction
-> CurrentBalancesModifier s [(Day, Either Posting Transaction)] -> CurrentBalancesModifier s [(Day, Either Posting Transaction)]
discriminateByDate tx discriminateByDate tx
| null (assignmentPostings tx) = do | null (assignmentPostings tx) = do
styles <- R.reader $ eStyles styles <- R.reader $ eStyles
balanced <- lift $ ExceptT $ return $ balanceTransaction styles tx balanced <- lift $ ExceptT $ return $ balanceTransaction styles tx
storeTransaction balanced storeTransaction balanced
return $ return $ fmap (postingDate &&& (Left . removePrices)) $ tpostings $ balanced
fmap (postingDate &&& (Left . removePrices)) $ tpostings $ balanced | otherwise = do
| True = do when (any (isJust . pdate) $ tpostings tx) $
when (any (isJust . pdate) $ tpostings tx) $ throwError $
throwError $ unlines $ unlines $
["postings may not have both a custom date and a balance assignment." [ "postings may not have both a custom date and a balance assignment."
,"Write the posting amount explicitly, or remove the posting date:\n" , "Write the posting amount explicitly, or remove the posting date:\n"
, showTransaction tx] , showTransaction tx
return ]
[(tdate tx, Right $ tx { tpostings = removePrices <$> tpostings tx })] return [(tdate tx, Right $ tx {tpostings = removePrices <$> tpostings tx})]
-- | Throw an error if a posting is in the unassignable set. -- | Throw an error if a posting is in the unassignable set.
checkUnassignablePosting :: Posting -> CurrentBalancesModifier s () checkUnassignablePosting :: Posting -> CurrentBalancesModifier s ()
checkUnassignablePosting p = do checkUnassignablePosting p = do
unassignable <- R.asks eUnassignable unassignable <- R.asks eUnassignable
if (isAssignment p && paccount p `S.member` unassignable) when (isAssignment p && paccount p `S.member` unassignable) $
then throwError $ unlines $ throwError $
[ "cannot assign amount to account " unlines $
, "" [ "cannot assign amount to account "
, " " ++ (T.unpack $ paccount p) , ""
, "" , " " ++ T.unpack (paccount p)
, "because it is also included in transaction modifiers." , ""
] , "because it is also included in transaction modifiers."
else return () ]
-- | This function takes an object describing changes to -- | This function takes an object describing changes to
@ -789,7 +788,7 @@ checkInferAndRegisterAmounts (Right oldTx) = do
Just ba | baexact ba -> do Just ba | baexact ba -> do
diff <- setMixedBalance acc $ Mixed [baamount ba] diff <- setMixedBalance acc $ Mixed [baamount ba]
fullPosting diff p fullPosting diff p
Just ba | otherwise -> do Just ba -> do
old <- liftModifier $ \Env{ eBalances = bals } -> HT.lookup bals acc old <- liftModifier $ \Env{ eBalances = bals } -> HT.lookup bals acc
let amt = baamount ba let amt = baamount ba
assertedcomm = acommodity amt 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. -- That is: the style of the first, and the maximum precision of all.
canonicalStyleFrom :: [AmountStyle] -> AmountStyle canonicalStyleFrom :: [AmountStyle] -> AmountStyle
canonicalStyleFrom [] = amountstyle canonicalStyleFrom [] = amountstyle
canonicalStyleFrom ss@(first:_) = canonicalStyleFrom ss@(first:_) = first {asprecision = prec, asdecimalpoint = mdec, asdigitgroups = mgrps}
first{asprecision=prec, asdecimalpoint=mdec, asdigitgroups=mgrps}
where where
mgrps = maybe Nothing Just $ headMay $ catMaybes $ map asdigitgroups ss mgrps = headMay $ mapMaybe asdigitgroups ss
-- precision is maximum of all precisions -- precision is maximum of all precisions
prec = maximumStrict $ map asprecision ss 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 -- precision is that of first amount with a decimal point
-- (mdec, prec) = -- (mdec, prec) =
-- case filter (isJust . asdecimalpoint) ss of -- case filter (isJust . asdecimalpoint) ss of
@ -993,7 +991,7 @@ journalDateSpan secondary j
latest = maximumStrict dates latest = maximumStrict dates
dates = pdates ++ tdates dates = pdates ++ tdates
tdates = map (if secondary then transactionDate2 else tdate) ts 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 ts = jtxns j
-- | Apply the pivot transformation to all postings in a journal, -- | Apply the pivot transformation to all postings in a journal,

19
hledger-lib/Hledger/Data/Ledger.hs
View File

@ -107,12 +107,13 @@ ledgerCommodities = M.keys . jinferredcommodities . ljournal
-- tests -- tests
tests_Ledger = tests "Ledger" [ tests_Ledger =
tests
tests "ledgerFromJournal" [ "Ledger"
(length $ ledgerPostings $ ledgerFromJournal Any nulljournal) `is` 0 [ tests
,(length $ ledgerPostings $ ledgerFromJournal Any samplejournal) `is` 13 "ledgerFromJournal"
,(length $ ledgerPostings $ ledgerFromJournal (Depth 2) samplejournal) `is` 7 [ length (ledgerPostings $ ledgerFromJournal Any nulljournal) `is` 0
] , length (ledgerPostings $ ledgerFromJournal Any samplejournal) `is` 13
, length (ledgerPostings $ ledgerFromJournal (Depth 2) samplejournal) `is` 7
] ]
]

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

@ -8,8 +8,6 @@ value of things at a given date.
-} -}
{-# LANGUAGE OverloadedStrings, LambdaCase #-}
module Hledger.Data.MarketPrice module Hledger.Data.MarketPrice
where where
import qualified Data.Text as T import qualified Data.Text as T

1
hledger-lib/Hledger/Data/PeriodicTransaction.hs
View File

@ -1,7 +1,6 @@
{-# LANGUAGE CPP #-} {-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StandaloneDeriving #-}
{-| {-|
A 'PeriodicTransaction' is a rule describing recurring transactions. A 'PeriodicTransaction' is a rule describing recurring transactions.

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

@ -66,7 +66,6 @@ import Data.MemoUgly (memo)
#if !(MIN_VERSION_base(4,11,0)) #if !(MIN_VERSION_base(4,11,0))
import Data.Monoid import Data.Monoid
#endif #endif
import Data.Ord
import Data.Text (Text) import Data.Text (Text)
import qualified Data.Text as T import qualified Data.Text as T
import Data.Time.Calendar import Data.Time.Calendar
@ -176,7 +175,7 @@ postingDate2 p = headDef nulldate $ catMaybes dates
where dates = [pdate2 p where dates = [pdate2 p
,maybe Nothing tdate2 $ ptransaction p ,maybe Nothing tdate2 $ ptransaction p
,pdate 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 -- | Get a posting's status. This is cleared or pending if those are
@ -237,14 +236,14 @@ isEmptyPosting = isZeroMixedAmount . pamount
postingsDateSpan :: [Posting] -> DateSpan postingsDateSpan :: [Posting] -> DateSpan
postingsDateSpan [] = DateSpan Nothing Nothing postingsDateSpan [] = DateSpan Nothing Nothing
postingsDateSpan ps = DateSpan (Just $ postingDate $ head ps') (Just $ addDays 1 $ postingDate $ last ps') 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. -- --date2-sensitive version, as above.
postingsDateSpan' :: WhichDate -> [Posting] -> DateSpan postingsDateSpan' :: WhichDate -> [Posting] -> DateSpan
postingsDateSpan' _ [] = DateSpan Nothing Nothing postingsDateSpan' _ [] = DateSpan Nothing Nothing
postingsDateSpan' wd ps = DateSpan (Just $ postingdate $ head ps') (Just $ addDays 1 $ postingdate $ last ps') postingsDateSpan' wd ps = DateSpan (Just $ postingdate $ head ps') (Just $ addDays 1 $ postingdate $ last ps')
where where
ps' = sortBy (comparing postingdate) ps ps' = sortOn postingdate ps
postingdate = if wd == PrimaryDate then postingDate else postingDate2 postingdate = if wd == PrimaryDate then postingDate else postingDate2
-- AccountName stuff that depends on PostingType -- AccountName stuff that depends on PostingType

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

@ -46,7 +46,7 @@ boolopt :: String -> RawOpts -> Bool
boolopt = inRawOpts boolopt = inRawOpts
maybestringopt :: String -> RawOpts -> Maybe String 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 :: String -> RawOpts -> String
stringopt name = fromMaybe "" . maybestringopt name stringopt name = fromMaybe "" . maybestringopt name

4
hledger-lib/Hledger/Data/StringFormat.hs
View File

@ -107,7 +107,7 @@ formatliteralp = do
s <- some c s <- some c
return $ FormatLiteral s return $ FormatLiteral s
where where
isPrintableButNotPercentage x = isPrint x && (not $ x == '%') isPrintableButNotPercentage x = isPrint x && x /= '%'
c = (satisfy isPrintableButNotPercentage <?> "printable character") c = (satisfy isPrintableButNotPercentage <?> "printable character")
<|> try (string "%%" >> return '%') <|> try (string "%%" >> return '%')
@ -133,7 +133,7 @@ fieldp = do
<|> try (string "date" >> return DescriptionField) <|> try (string "date" >> return DescriptionField)
<|> try (string "description" >> return DescriptionField) <|> try (string "description" >> return DescriptionField)
<|> try (string "total" >> return TotalField) <|> try (string "total" >> return TotalField)
<|> try (some digitChar >>= (\s -> return $ FieldNo $ read s)) <|> try ((FieldNo . read) <$> some digitChar)
---------------------------------------------------------------------- ----------------------------------------------------------------------

1
hledger-lib/Hledger/Data/Timeclock.hs
View File

@ -74,6 +74,7 @@ timeclockEntriesToTransactions now (i:o:rest)
(idate,odate) = (localDay itime,localDay otime) (idate,odate) = (localDay itime,localDay otime)
o' = o{tldatetime=itime{localDay=idate, localTimeOfDay=TimeOfDay 23 59 59}} o' = o{tldatetime=itime{localDay=idate, localTimeOfDay=TimeOfDay 23 59 59}}
i' = i{tldatetime=itime{localDay=addDays 1 idate, localTimeOfDay=midnight}} i' = i{tldatetime=itime{localDay=addDays 1 idate, localTimeOfDay=midnight}}
{- HLINT ignore timeclockEntriesToTransactions -}
-- | Convert a timeclock clockin and clockout entry to an equivalent journal -- | Convert a timeclock clockin and clockout entry to an equivalent journal
-- transaction, representing the time expenditure. Note this entry is not balanced, -- transaction, representing the time expenditure. Note this entry is not balanced,

854
hledger-lib/Hledger/Data/Transaction.hs
View File

@ -192,9 +192,9 @@ renderCommentLines t = case lines $ T.unpack t of ("":ls) -> "":map commentpref
-- --
postingsAsLines :: Bool -> Bool -> Transaction -> [Posting] -> [String] postingsAsLines :: Bool -> Bool -> Transaction -> [Posting] -> [String]
postingsAsLines elide onelineamounts t ps postingsAsLines elide onelineamounts t ps
| elide && length ps > 1 && all hasAmount ps && isTransactionBalanced Nothing t -- imprecise balanced check | 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) = concatMap (postingAsLines False onelineamounts ps) (init ps) ++ postingAsLines True onelineamounts ps (last ps)
| otherwise = concatMap (postingAsLines False onelineamounts ps) ps | otherwise = concatMap (postingAsLines False onelineamounts ps) ps
-- | Render one posting, on one or more lines, suitable for `print` output. -- | 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, -- 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 balancedVirtualPostings = filter isBalancedVirtual . tpostings
transactionsPostings :: [Transaction] -> [Posting] transactionsPostings :: [Transaction] -> [Posting]
transactionsPostings = concat . map tpostings transactionsPostings = concatMap tpostings
-- | Get the sums of a transaction's real, virtual, and balanced virtual postings. -- | Get the sums of a transaction's real, virtual, and balanced virtual postings.
transactionPostingBalances :: Transaction -> (MixedAmount,MixedAmount,MixedAmount) transactionPostingBalances :: Transaction -> (MixedAmount,MixedAmount,MixedAmount)
@ -445,9 +445,7 @@ inferBalancingAmount update styles t@Transaction{tpostings=ps}
inferBalancingPrices :: Transaction -> Transaction inferBalancingPrices :: Transaction -> Transaction
inferBalancingPrices t@Transaction{tpostings=ps} = t{tpostings=ps'} inferBalancingPrices t@Transaction{tpostings=ps} = t{tpostings=ps'}
where where
ps' = map (priceInferrerFor t BalancedVirtualPosting) $ ps' = map (priceInferrerFor t BalancedVirtualPosting . priceInferrerFor t RegularPosting) ps
map (priceInferrerFor t RegularPosting) $
ps
-- | Generate a posting update function which assigns a suitable balancing -- | Generate a posting update function which assigns a suitable balancing
-- price to the posting, if and as appropriate for the given transaction and -- 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 tocommodity = head $ filter (/=fromcommodity) sumcommodities
toamount = head $ filter ((==tocommodity).acommodity) sumamounts toamount = head $ filter ((==tocommodity).acommodity) sumamounts
unitprice = (aquantity fromamount) `divideAmount` toamount 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 inferprice p = p
-- Get a transaction's secondary date, defaulting to the primary date. -- Get a transaction's secondary date, defaulting to the primary date.
@ -502,371 +500,495 @@ postingSetTransaction t p = p{ptransaction=Just t}
-- tests -- tests
tests_Transaction = tests "Transaction" [ tests_Transaction =
tests
tests "showTransactionUnelided" [ "Transaction"
showTransactionUnelided nulltransaction `is` "0000/01/01\n\n" [ tests
,showTransactionUnelided nulltransaction{ "showTransactionUnelided"
tdate=parsedate "2012/05/14", [ showTransactionUnelided nulltransaction `is` "0000/01/01\n\n"
tdate2=Just $ parsedate "2012/05/15", , showTransactionUnelided
tstatus=Unmarked, nulltransaction
tcode="code", { tdate = parsedate "2012/05/14"
tdescription="desc", , tdate2 = Just $ parsedate "2012/05/15"
tcomment="tcomment1\ntcomment2\n", , tstatus = Unmarked
ttags=[("ttag1","val1")], , tcode = "code"
tpostings=[ , tdescription = "desc"
nullposting{ , tcomment = "tcomment1\ntcomment2\n"
pstatus=Cleared, , ttags = [("ttag1", "val1")]
paccount="a", , tpostings =
pamount=Mixed [usd 1, hrs 2], [ nullposting
pcomment="\npcomment2\n", { pstatus = Cleared
ptype=RegularPosting, , paccount = "a"
ptags=[("ptag1","val1"),("ptag2","val2")] , 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", } `is`
" * a $1.00", unlines
" ; pcomment2", [ "2012/05/14=2012/05/15 (code) desc ; tcomment1"
" * a 2.00h", , " ; tcomment2"
" ; pcomment2", , " * a $1.00"
"" , " ; pcomment2"
] , " * a 2.00h"
] , " ; pcomment2"
, ""
,tests "postingAsLines" [ ]
postingAsLines False False [posting] posting `is` [""] ]
,let p = posting{ , tests
pstatus=Cleared, "postingAsLines"
paccount="a", [ postingAsLines False False [posting] posting `is` [""]
pamount=Mixed [usd 1, hrs 2], , let p =
pcomment="pcomment1\npcomment2\n tag3: val3 \n", posting
ptype=RegularPosting, { pstatus = Cleared
ptags=[("ptag1","val1"),("ptag2","val2")] , paccount = "a"
} , pamount = Mixed [usd 1, hrs 2]
in postingAsLines False False [p] p `is` , pcomment = "pcomment1\npcomment2\n tag3: val3 \n"
[ , ptype = RegularPosting
" * a $1.00 ; pcomment1", , ptags = [("ptag1", "val1"), ("ptag2", "val2")]
" ; pcomment2", }
" ; tag3: val3 ", in postingAsLines False False [p] p `is`
" * a 2.00h ; pcomment1", [ " * a $1.00 ; pcomment1"
" ; pcomment2", , " ; pcomment2"
" ; tag3: val3 " , " ; tag3: val3 "
] , " * a 2.00h ; pcomment1"
] , " ; pcomment2"
, " ; tag3: val3 "
]
]
-- postingsAsLines -- postingsAsLines
,let
-- one implicit amount -- one implicit amount
timp = nulltransaction{tpostings=[ , let timp = nulltransaction {tpostings = ["a" `post` usd 1, "b" `post` missingamt]}
"a" `post` usd 1,
"b" `post` missingamt
]}
-- explicit amounts, balanced -- explicit amounts, balanced
texp = nulltransaction{tpostings=[ texp = nulltransaction {tpostings = ["a" `post` usd 1, "b" `post` usd (-1)]}
"a" `post` usd 1,
"b" `post` usd (-1)
]}
-- explicit amount, only one posting -- explicit amount, only one posting
texp1 = nulltransaction{tpostings=[ texp1 = nulltransaction {tpostings = ["(a)" `post` usd 1]}
"(a)" `post` usd 1
]}
-- explicit amounts, two commodities, explicit balancing price -- explicit amounts, two commodities, explicit balancing price
texp2 = nulltransaction{tpostings=[ texp2 = nulltransaction {tpostings = ["a" `post` usd 1, "b" `post` (hrs (-1) `at` usd 1)]}
"a" `post` usd 1,
"b" `post` (hrs (-1) `at` usd 1)
]}
-- explicit amounts, two commodities, implicit balancing price -- explicit amounts, two commodities, implicit balancing price
texp2b = nulltransaction{tpostings=[ texp2b = nulltransaction {tpostings = ["a" `post` usd 1, "b" `post` hrs (-1)]}
"a" `post` usd 1,
"b" `post` hrs (-1)
]}
-- one missing amount, not the last one -- one missing amount, not the last one
t3 = nulltransaction{tpostings=[ t3 = nulltransaction {tpostings = ["a" `post` usd 1, "b" `post` missingamt, "c" `post` usd (-1)]}
"a" `post` usd 1
,"b" `post` missingamt
,"c" `post` usd (-1)
]}
-- unbalanced amounts when precision is limited (#931) -- unbalanced amounts when precision is limited (#931)
t4 = nulltransaction{tpostings=[ t4 = nulltransaction {tpostings = ["a" `post` usd (-0.01), "b" `post` usd (0.005), "c" `post` usd (0.005)]}
"a" `post` usd (-0.01) in tests
,"b" `post` usd (0.005) "postingsAsLines"
,"c" `post` usd (0.005) [ test "null-transaction" $
]} let t = nulltransaction
in in postingsAsLines True False t (tpostings t) `is` []
tests "postingsAsLines" [ , test "implicit-amount-elide-false" $
let t = timp
test "null-transaction" $ in postingsAsLines False False t (tpostings t) `is`
let t = nulltransaction [ " a $1.00"
in postingsAsLines True False t (tpostings t) `is` [] , " b" -- implicit amount remains implicit
]
,test "implicit-amount-elide-false" $ , test "implicit-amount-elide-true" $
let t = timp in postingsAsLines False False t (tpostings t) `is` [ let t = timp
" a $1.00" in postingsAsLines True False t (tpostings t) `is`
," b" -- implicit amount remains implicit [ " a $1.00"
] , " b" -- implicit amount remains implicit
]
,test "implicit-amount-elide-true" $ , test "explicit-amounts-elide-false" $
let t = timp in postingsAsLines True False t (tpostings t) `is` [ let t = texp
" a $1.00" in postingsAsLines False False t (tpostings t) `is`
," b" -- implicit amount remains implicit [ " a $1.00"
] , " b $-1.00" -- both amounts remain explicit
]
,test "explicit-amounts-elide-false" $ , test "explicit-amounts-elide-true" $
let t = texp in postingsAsLines False False t (tpostings t) `is` [ let t = texp
" a $1.00" in postingsAsLines True False t (tpostings t) `is`
," b $-1.00" -- both amounts remain explicit [ " a $1.00"
] , " b" -- explicit amount is made implicit
]
,test "explicit-amounts-elide-true" $ , test "one-explicit-amount-elide-true" $
let t = texp in postingsAsLines True False t (tpostings t) `is` [ let t = texp1
" a $1.00" in postingsAsLines True False t (tpostings t) `is`
," b" -- explicit amount is made implicit [ " (a) $1.00" -- explicit amount remains explicit since only one posting
] ]
, test "explicit-amounts-two-commodities-elide-true" $
,test "one-explicit-amount-elide-true" $ let t = texp2
let t = texp1 in postingsAsLines True False t (tpostings t) `is` [ in postingsAsLines True False t (tpostings t) `is`
" (a) $1.00" -- explicit amount remains explicit since only one posting [ " a $1.00"
] , " b" -- explicit amount is made implicit since txn is explicitly balanced
]
,test "explicit-amounts-two-commodities-elide-true" $ , test "explicit-amounts-not-explicitly-balanced-elide-true" $
let t = texp2 in postingsAsLines True False t (tpostings t) `is` [ let t = texp2b
" a $1.00" in postingsAsLines True False t (tpostings t) `is`
," b" -- explicit amount is made implicit since txn is explicitly balanced [ " a $1.00"
] , " b -1.00h" -- explicit amount remains explicit since a conversion price would have be inferred to balance
]
,test "explicit-amounts-not-explicitly-balanced-elide-true" $ , test "implicit-amount-not-last" $
let t = texp2b in postingsAsLines True False t (tpostings t) `is` [ let t = t3
" a $1.00" in postingsAsLines True False t (tpostings t) `is`
," b -1.00h" -- explicit amount remains explicit since a conversion price would have be inferred to balance [" a $1.00", " b", " c $-1.00"]
] , _test "ensure-visibly-balanced" $
let t = t4
,test "implicit-amount-not-last" $ in postingsAsLines False False t (tpostings t) `is`
let t = t3 in postingsAsLines True False t (tpostings t) `is` [ [" a $-0.01", " b $0.005", " c $0.005"]
" a $1.00" ]
," b" , do let inferTransaction :: Transaction -> Either String Transaction
," c $-1.00" inferTransaction = runIdentity . runExceptT . inferBalancingAmount (\_ _ -> return ()) Map.empty
] tests
"inferBalancingAmount"
,_test "ensure-visibly-balanced" $ [ inferTransaction nulltransaction `is` Right nulltransaction
let t = t4 in postingsAsLines False False t (tpostings t) `is` [ , inferTransaction nulltransaction {tpostings = ["a" `post` usd (-5), "b" `post` missingamt]} `is`
" a $-0.01" Right nulltransaction {tpostings = ["a" `post` usd (-5), "b" `post` usd 5]}
," b $0.005" , inferTransaction
," c $0.005" 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"
,do [ test "show a balanced transaction, eliding last amount" $
let inferTransaction :: Transaction -> Either String Transaction let t =
inferTransaction = runIdentity . runExceptT . inferBalancingAmount (\_ _ -> return ()) Map.empty Transaction
tests "inferBalancingAmount" [ 0
inferTransaction nulltransaction `is` Right nulltransaction ""
,inferTransaction nulltransaction{ nullsourcepos
tpostings=[ (parsedate "2007/01/28")
"a" `post` usd (-5), Nothing
"b" `post` missingamt Unmarked
]} ""
`is` Right "coopportunity"
nulltransaction{ ""
tpostings=[ []
"a" `post` usd (-5), [ posting {paccount = "expenses:food:groceries", pamount = Mixed [usd 47.18], ptransaction = Just t}
"b" `post` usd 5 , posting {paccount = "assets:checking", pamount = Mixed [usd (-47.18)], ptransaction = Just t}
]} ]
,inferTransaction nulltransaction{ in showTransaction t `is`
tpostings=[ unlines
"a" `post` usd (-5), ["2007/01/28 coopportunity", " expenses:food:groceries $47.18", " assets:checking", ""]
"b" `post` (eur 3 @@ usd 4), , test "show a balanced transaction, no eliding" $
"c" `post` missingamt (let t =
]} Transaction
`is` Right 0
nulltransaction{ ""
tpostings=[ nullsourcepos
"a" `post` usd (-5), (parsedate "2007/01/28")
"b" `post` (eur 3 @@ usd 4), Nothing
"c" `post` usd 1 Unmarked
]} ""
] "coopportunity"
""
,tests "showTransaction" [ []
test "show a balanced transaction, eliding last amount" $ [ posting {paccount = "expenses:food:groceries", pamount = Mixed [usd 47.18], ptransaction = Just t}
let t = Transaction 0 "" nullsourcepos (parsedate "2007/01/28") Nothing Unmarked "" "coopportunity" "" [] , posting {paccount = "assets:checking", pamount = Mixed [usd (-47.18)], ptransaction = Just t}
[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
in [ "2007/01/28 coopportunity"
showTransaction t , " expenses:food:groceries $47.18"
`is` , " assets:checking $-47.18"
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: -- document some cases that arise in debug/testing:
,test "show an unbalanced transaction, should not elide" $ , test "show an unbalanced transaction, should not elide" $
(showTransaction (showTransaction
(txnTieKnot $ Transaction 0 "" nullsourcepos (parsedate "2007/01/28") Nothing Unmarked "" "coopportunity" "" [] (txnTieKnot $
[posting{paccount="expenses:food:groceries", pamount=Mixed [usd 47.18]} Transaction
,posting{paccount="assets:checking", pamount=Mixed [usd (-47.19)]} 0
])) ""
`is` nullsourcepos
(unlines (parsedate "2007/01/28")
["2007/01/28 coopportunity" Nothing
," expenses:food:groceries $47.18" Unmarked
," assets:checking $-47.19" ""
,"" "coopportunity"
]) ""
[]
,test "show an unbalanced transaction with one posting, should not elide" $ [ posting {paccount = "expenses:food:groceries", pamount = Mixed [usd 47.18]}
(showTransaction , posting {paccount = "assets:checking", pamount = Mixed [usd (-47.19)]}
(txnTieKnot $ Transaction 0 "" nullsourcepos (parsedate "2007/01/28") Nothing Unmarked "" "coopportunity" "" [] ])) `is`
[posting{paccount="expenses:food:groceries", pamount=Mixed [usd 47.18]} (unlines
])) [ "2007/01/28 coopportunity"
`is` , " expenses:food:groceries $47.18"
(unlines , " assets:checking $-47.19"
["2007/01/28 coopportunity" , ""
," expenses:food:groceries $47.18" ])
,"" , test "show an unbalanced transaction with one posting, should not elide" $
]) (showTransaction
(txnTieKnot $
,test "show a transaction with one posting and a missing amount" $ Transaction
(showTransaction 0
(txnTieKnot $ Transaction 0 "" nullsourcepos (parsedate "2007/01/28") Nothing Unmarked "" "coopportunity" "" [] ""
[posting{paccount="expenses:food:groceries", pamount=missingmixedamt} nullsourcepos
])) (parsedate "2007/01/28")
`is` Nothing
(unlines Unmarked
["2007/01/28 coopportunity" ""
," expenses:food:groceries" "coopportunity"
,"" ""
]) []
[posting {paccount = "expenses:food:groceries", pamount = Mixed [usd 47.18]}])) `is`
,test "show a transaction with a priced commodityless amount" $ (unlines ["2007/01/28 coopportunity", " expenses:food:groceries $47.18", ""])
(showTransaction , test "show a transaction with one posting and a missing amount" $
(txnTieKnot $ Transaction 0 "" nullsourcepos (parsedate "2010/01/01") Nothing Unmarked "" "x" "" [] (showTransaction
[posting{paccount="a", pamount=Mixed [num 1 `at` (usd 2 `withPrecision` 0)]} (txnTieKnot $
,posting{paccount="b", pamount= missingmixedamt} Transaction
])) 0
`is` ""
(unlines nullsourcepos
["2010/01/01 x" (parsedate "2007/01/28")
," a 1 @ $2" Nothing
," b" 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}
]
]
]