module Hledger.Data.Posting (
nullposting,
posting,
post,
postingCleared,
isReal,
isVirtual,
isBalancedVirtual,
isEmptyPosting,
hasAmount,
postingAllTags,
transactionAllTags,
relatedPostings,
postingDate,
postingDate2,
isPostingInDateSpan,
isPostingInDateSpan',
postingsDateSpan,
postingsDateSpan',
accountNamesFromPostings,
accountNamePostingType,
accountNameWithoutPostingType,
accountNameWithPostingType,
joinAccountNames,
concatAccountNames,
accountNameApplyAliases,
sumPostings,
showPosting,
showComment,
tests_Hledger_Data_Posting
)
where
import Data.List
import Data.Maybe
import Data.Ord
import Data.Time.Calendar
import Safe
import Test.HUnit
import Text.Printf
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=False
,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 [showaccountname a ++ " ", showamount amt, showComment (pcomment p)]]
where
ledger3ishlayout = False
acctnamewidth = if ledger3ishlayout then 25 else 22
showaccountname = printf ("%-"++(show acctnamewidth)++"s") . bracket . elideAccountName width
(bracket,width) = case t of
BalancedVirtualPosting -> (\s -> "["++s++"]", acctnamewidth2)
VirtualPosting -> (\s -> "("++s++")", acctnamewidth2)
_ -> (id,acctnamewidth)
showamount = padleft 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
]
postingCleared :: Posting -> Bool
postingCleared p = if pstatus p
then True
else maybe False tstatus $ ptransaction p
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 :: [(AccountName,AccountName)] -> AccountName -> AccountName
accountNameApplyAliases aliases a = withorigtype
where
(a',t) = (accountNameWithoutPostingType a, accountNamePostingType a)
firstmatchingalias = headDef Nothing $ map Just $ filter (\(orig,_) -> orig == a' || orig `isAccountNamePrefixOf` a') aliases
rewritten = maybe a' (\(orig,alias) -> alias++drop (length orig) a') firstmatchingalias
withorigtype = accountNameWithPostingType t rewritten
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)"
]