module Hledger.Data.Posting (
nullposting,
posting,
post,
postingStatus,
isReal,
isVirtual,
isBalancedVirtual,
isEmptyPosting,
hasAmount,
postingAllTags,
transactionAllTags,
relatedPostings,
postingDate,
postingDate2,
isPostingInDateSpan,
isPostingInDateSpan',
postingsDateSpan,
postingsDateSpan',
accountNamesFromPostings,
accountNamePostingType,
accountNameWithoutPostingType,
accountNameWithPostingType,
joinAccountNames,
concatAccountNames,
accountNameApplyAliases,
accountNameApplyAliasesMemo,
sumPostings,
showPosting,
showComment,
tests_Hledger_Data_Posting
)
where
import Data.List
import Data.Maybe
import Data.MemoUgly (memo)
import Data.Ord
import Data.Time.Calendar
import Safe
import Test.HUnit
import Hledger.Utils
import Hledger.Data.Types
import Hledger.Data.Amount
import Hledger.Data.AccountName
import Hledger.Data.Dates (nulldate, spanContainsDate)
instance Show Posting where show = showPosting
nullposting, posting :: Posting
nullposting = Posting
{pdate=Nothing
,pdate2=Nothing
,pstatus=Uncleared
,paccount=""
,pamount=nullmixedamt
,pcomment=""
,ptype=RegularPosting
,ptags=[]
,pbalanceassertion=Nothing
,ptransaction=Nothing
}
posting = nullposting
post :: AccountName -> Amount -> Posting
post acct amt = posting {paccount=acct, pamount=Mixed [amt]}
showPosting :: Posting -> String
showPosting p@Posting{paccount=a,pamount=amt,ptype=t} =
unlines $ [concatTopPadded [show (postingDate p) ++ " ", showaccountname a ++ " ", showamount amt, showComment (pcomment p)]]
where
ledger3ishlayout = False
acctnamewidth = if ledger3ishlayout then 25 else 22
showaccountname = fitString (Just acctnamewidth) Nothing False False . bracket . elideAccountName width
(bracket,width) = case t of
BalancedVirtualPosting -> (\s -> "["++s++"]", acctnamewidth2)
VirtualPosting -> (\s -> "("++s++")", acctnamewidth2)
_ -> (id,acctnamewidth)
showamount = padLeftWide 12 . showMixedAmount
showComment :: String -> String
showComment s = if null s then "" else " ;" ++ s
isReal :: Posting -> Bool
isReal p = ptype p == RegularPosting
isVirtual :: Posting -> Bool
isVirtual p = ptype p == VirtualPosting
isBalancedVirtual :: Posting -> Bool
isBalancedVirtual p = ptype p == BalancedVirtualPosting
hasAmount :: Posting -> Bool
hasAmount = (/= missingmixedamt) . pamount
accountNamesFromPostings :: [Posting] -> [AccountName]
accountNamesFromPostings = nub . map paccount
sumPostings :: [Posting] -> MixedAmount
sumPostings = sum . map pamount
postingDate :: Posting -> Day
postingDate p = fromMaybe txndate $ pdate p
where
txndate = maybe nulldate tdate $ ptransaction p
postingDate2 :: Posting -> Day
postingDate2 p = headDef nulldate $ catMaybes dates
where dates = [pdate2 p
,maybe Nothing tdate2 $ ptransaction p
,pdate p
,maybe Nothing (Just . tdate) $ ptransaction p
]
postingStatus :: Posting -> ClearedStatus
postingStatus Posting{pstatus=s, ptransaction=mt}
| s == Uncleared = case mt of Just t -> tstatus t
Nothing -> Uncleared
| otherwise = s
postingAllTags :: Posting -> [Tag]
postingAllTags p = ptags p ++ maybe [] ttags (ptransaction p)
transactionAllTags :: Transaction -> [Tag]
transactionAllTags t = ttags t ++ concatMap ptags (tpostings t)
relatedPostings :: Posting -> [Posting]
relatedPostings p@Posting{ptransaction=Just t} = filter (/= p) $ tpostings t
relatedPostings _ = []
isPostingInDateSpan :: DateSpan -> Posting -> Bool
isPostingInDateSpan s = spanContainsDate s . postingDate
isPostingInDateSpan' :: WhichDate -> DateSpan -> Posting -> Bool
isPostingInDateSpan' PrimaryDate s = spanContainsDate s . postingDate
isPostingInDateSpan' SecondaryDate s = spanContainsDate s . postingDate2
isEmptyPosting :: Posting -> Bool
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
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
postingdate = if wd == PrimaryDate then postingDate else postingDate2
accountNamePostingType :: AccountName -> PostingType
accountNamePostingType a
| null a = RegularPosting
| head a == '[' && last a == ']' = BalancedVirtualPosting
| head a == '(' && last a == ')' = VirtualPosting
| otherwise = RegularPosting
accountNameWithoutPostingType :: AccountName -> AccountName
accountNameWithoutPostingType a = case accountNamePostingType a of
BalancedVirtualPosting -> init $ tail a
VirtualPosting -> init $ tail a
RegularPosting -> a
accountNameWithPostingType :: PostingType -> AccountName -> AccountName
accountNameWithPostingType BalancedVirtualPosting a = "["++accountNameWithoutPostingType a++"]"
accountNameWithPostingType VirtualPosting a = "("++accountNameWithoutPostingType a++")"
accountNameWithPostingType RegularPosting a = accountNameWithoutPostingType a
joinAccountNames :: AccountName -> AccountName -> AccountName
joinAccountNames a b = concatAccountNames $ filter (not . null) [a,b]
concatAccountNames :: [AccountName] -> AccountName
concatAccountNames as = accountNameWithPostingType t $ intercalate ":" $ map accountNameWithoutPostingType as
where t = headDef RegularPosting $ filter (/= RegularPosting) $ map accountNamePostingType as
accountNameApplyAliases :: [AccountAlias] -> AccountName -> AccountName
accountNameApplyAliases aliases a = accountNameWithPostingType atype aname'
where
(aname,atype) = (accountNameWithoutPostingType a, accountNamePostingType a)
aname' = foldl
(\acct alias -> dbg6 "result" $ aliasReplace (dbg6 "alias" alias) (dbg6 "account" acct))
aname
aliases
accountNameApplyAliasesMemo :: [AccountAlias] -> AccountName -> AccountName
accountNameApplyAliasesMemo aliases = memo (accountNameApplyAliases aliases)
aliasReplace :: AccountAlias -> AccountName -> AccountName
aliasReplace (BasicAlias old new) a
| old `isAccountNamePrefixOf` a || old == a = new ++ drop (length old) a
| otherwise = a
aliasReplace (RegexAlias re repl) a = regexReplaceCIMemo re repl a
tests_Hledger_Data_Posting = TestList [
"accountNamePostingType" ~: do
accountNamePostingType "a" `is` RegularPosting
accountNamePostingType "(a)" `is` VirtualPosting
accountNamePostingType "[a]" `is` BalancedVirtualPosting
,"accountNameWithoutPostingType" ~: do
accountNameWithoutPostingType "(a)" `is` "a"
,"accountNameWithPostingType" ~: do
accountNameWithPostingType VirtualPosting "[a]" `is` "(a)"
,"joinAccountNames" ~: do
"a" `joinAccountNames` "b:c" `is` "a:b:c"
"a" `joinAccountNames` "(b:c)" `is` "(a:b:c)"
"[a]" `joinAccountNames` "(b:c)" `is` "[a:b:c]"
"" `joinAccountNames` "a" `is` "a"
,"concatAccountNames" ~: do
concatAccountNames [] `is` ""
concatAccountNames ["a","(b)","[c:d]"] `is` "(a:b:c:d)"
]