module Hledger.Data.Posting (
nullposting,
postingCleared,
isReal,
isVirtual,
isBalancedVirtual,
isEmptyPosting,
hasAmount,
postingAllTags,
transactionAllTags,
postingDate,
isPostingInDateSpan,
postingsDateSpan,
accountNamesFromPostings,
accountNamePostingType,
accountNameWithoutPostingType,
accountNameWithPostingType,
joinAccountNames,
concatAccountNames,
accountNameApplyAliases,
sumPostings,
showPosting,
showPostingForRegister,
postingTagsAsLines,
tagsAsLines,
showComment,
tests_Hledger_Data_Posting
)
where
import Data.List
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
nullposting = Posting False "" nullmixedamt "" RegularPosting [] Nothing
showPosting :: Posting -> String
showPosting p@Posting{paccount=a,pamount=amt,ptype=t} =
unlines $ [concatTopPadded [showaccountname a ++ " ", showamount amt, showComment (pcomment p)]] ++ postingTagsAsLines 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
postingTagsAsLines :: Posting -> [String]
postingTagsAsLines = tagsAsLines . ptags
tagsAsLines :: [(String, String)] -> [String]
tagsAsLines mds = map (\(k,v) -> " ; " ++ k++": "++v) mds
showComment :: String -> String
showComment s = if null s then "" else " ; " ++ s
showPostingForRegister :: Posting -> String
showPostingForRegister (Posting{paccount=a,pamount=amt,ptype=t}) =
concatTopPadded [showaccountname a ++ " ", showamount amt]
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 . showMixedAmountWithoutPrice
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 = maybe nulldate 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 [] transactionAllTags (ptransaction p)
transactionAllTags :: Transaction -> [Tag]
transactionAllTags t = ttags t
isPostingInDateSpan :: DateSpan -> Posting -> Bool
isPostingInDateSpan s = spanContainsDate s . postingDate
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
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)"
]