{-| A 'Posting' represents a change (by some 'MixedAmount') of the balance in some 'Account'. Each 'Transaction' contains two or more postings which should add up to 0. Postings reference their parent transaction, so we can look up the date or description there. -} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE CPP #-} module Hledger.Data.Posting ( -- * Posting nullposting, posting, post, nullsourcepos, nullassertion, assertion, -- * operations originalPosting, postingStatus, isReal, isVirtual, isBalancedVirtual, isEmptyPosting, isAssignment, hasAmount, postingAllTags, transactionAllTags, relatedPostings, removePrices, -- * date operations postingDate, postingDate2, isPostingInDateSpan, isPostingInDateSpan', postingsDateSpan, postingsDateSpan', -- * account name operations accountNamesFromPostings, accountNamePostingType, accountNameWithoutPostingType, accountNameWithPostingType, joinAccountNames, concatAccountNames, accountNameApplyAliases, accountNameApplyAliasesMemo, -- * transaction description operations transactionPayee, transactionNote, payeeAndNoteFromDescription, -- * arithmetic sumPostings, -- * rendering showPosting, -- * misc. showComment, tests_Posting ) where import Data.List import Data.Maybe 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 import Safe import Hledger.Utils import Hledger.Data.Types import Hledger.Data.Amount import Hledger.Data.AccountName import Hledger.Data.Dates (nulldate, spanContainsDate) nullposting, posting :: Posting nullposting = Posting {pdate=Nothing ,pdate2=Nothing ,pstatus=Unmarked ,paccount="" ,pamount=nullmixedamt ,pcomment="" ,ptype=RegularPosting ,ptags=[] ,pbalanceassertion=Nothing ,ptransaction=Nothing ,porigin=Nothing } posting = nullposting post :: AccountName -> Amount -> Posting post acct amt = posting {paccount=acct, pamount=Mixed [amt]} nullsourcepos :: GenericSourcePos nullsourcepos = JournalSourcePos "" (1,1) nullassertion, assertion :: BalanceAssertion nullassertion = BalanceAssertion {baamount=nullamt ,baexact=False ,baposition=nullsourcepos } assertion = nullassertion -- Get the original posting, if any. originalPosting :: Posting -> Posting originalPosting p = fromMaybe p $ porigin p -- XXX once rendered user output, but just for debugging now; clean up 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 . T.unpack . elideAccountName width (bracket,width) = case t of BalancedVirtualPosting -> (\s -> "["++s++"]", acctnamewidth-2) VirtualPosting -> (\s -> "("++s++")", acctnamewidth-2) _ -> (id,acctnamewidth) showamount = padLeftWide 12 . showMixedAmount showComment :: Text -> String showComment t = if T.null t then "" else " ;" ++ T.unpack t 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 isAssignment :: Posting -> Bool isAssignment p = not (hasAmount p) && isJust (pbalanceassertion p) -- | Sorted unique account names referenced by these postings. accountNamesFromPostings :: [Posting] -> [AccountName] accountNamesFromPostings = nub . sort . map paccount sumPostings :: [Posting] -> MixedAmount sumPostings = sumStrict . map pamount -- | Remove all prices of a posting removePrices :: Posting -> Posting removePrices p = p{ pamount = Mixed $ remove <$> amounts (pamount p) } where remove a = a { aprice = NoPrice } -- | Get a posting's (primary) date - it's own primary date if specified, -- otherwise the parent transaction's primary date, or the null date if -- there is no parent transaction. postingDate :: Posting -> Day postingDate p = fromMaybe txndate $ pdate p where txndate = maybe nulldate tdate $ ptransaction p -- | Get a posting's secondary (secondary) date, which is the first of: -- posting's secondary date, transaction's secondary date, posting's -- primary date, transaction's primary date, or the null date if there is -- no parent transaction. 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 ] -- | Get a posting's status. This is cleared or pending if those are -- explicitly set on the posting, otherwise the status of its parent -- transaction, or unmarked if there is no parent transaction. (Note -- the ambiguity, unmarked can mean "posting and transaction are both -- unmarked" or "posting is unmarked and don't know about the transaction". postingStatus :: Posting -> Status postingStatus Posting{pstatus=s, ptransaction=mt} | s == Unmarked = case mt of Just t -> tstatus t Nothing -> Unmarked | otherwise = s transactionPayee :: Transaction -> Text transactionPayee = fst . payeeAndNoteFromDescription . tdescription transactionNote :: Transaction -> Text transactionNote = snd . payeeAndNoteFromDescription . tdescription -- | Parse a transaction's description into payee and note (aka narration) fields, -- assuming a convention of separating these with | (like Beancount). -- Ie, everything up to the first | is the payee, everything after it is the note. -- When there's no |, payee == note == description. payeeAndNoteFromDescription :: Text -> (Text,Text) payeeAndNoteFromDescription t | T.null n = (t, t) | otherwise = (textstrip p, textstrip $ T.drop 1 n) where (p, n) = T.span (/= '|') t -- | Tags for this posting including any inherited from its parent transaction. postingAllTags :: Posting -> [Tag] postingAllTags p = ptags p ++ maybe [] ttags (ptransaction p) -- | Tags for this transaction including any from its postings. transactionAllTags :: Transaction -> [Tag] transactionAllTags t = ttags t ++ concatMap ptags (tpostings t) -- Get the other postings from this posting's transaction. relatedPostings :: Posting -> [Posting] relatedPostings p@Posting{ptransaction=Just t} = filter (/= p) $ tpostings t relatedPostings _ = [] -- | Does this posting fall within the given date span ? isPostingInDateSpan :: DateSpan -> Posting -> Bool isPostingInDateSpan s = spanContainsDate s . postingDate -- --date2-sensitive version, separate for now to avoid disturbing multiBalanceReport. isPostingInDateSpan' :: WhichDate -> DateSpan -> Posting -> Bool isPostingInDateSpan' PrimaryDate s = spanContainsDate s . postingDate isPostingInDateSpan' SecondaryDate s = spanContainsDate s . postingDate2 isEmptyPosting :: Posting -> Bool isEmptyPosting = isZeroMixedAmount . pamount -- | Get the minimal date span which contains all the postings, or the -- null date span if there are none. 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 -- --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 postingdate = if wd == PrimaryDate then postingDate else postingDate2 -- AccountName stuff that depends on PostingType accountNamePostingType :: AccountName -> PostingType accountNamePostingType a | T.null a = RegularPosting | T.head a == '[' && T.last a == ']' = BalancedVirtualPosting | T.head a == '(' && T.last a == ')' = VirtualPosting | otherwise = RegularPosting accountNameWithoutPostingType :: AccountName -> AccountName accountNameWithoutPostingType a = case accountNamePostingType a of BalancedVirtualPosting -> T.init $ T.tail a VirtualPosting -> T.init $ T.tail a RegularPosting -> a accountNameWithPostingType :: PostingType -> AccountName -> AccountName accountNameWithPostingType BalancedVirtualPosting a = "["<>accountNameWithoutPostingType a<>"]" accountNameWithPostingType VirtualPosting a = "("<>accountNameWithoutPostingType a<>")" accountNameWithPostingType RegularPosting a = accountNameWithoutPostingType a -- | Prefix one account name to another, preserving posting type -- indicators like concatAccountNames. joinAccountNames :: AccountName -> AccountName -> AccountName joinAccountNames a b = concatAccountNames $ filter (not . T.null) [a,b] -- | Join account names into one. If any of them has () or [] posting type -- indicators, these (the first type encountered) will also be applied to -- the resulting account name. concatAccountNames :: [AccountName] -> AccountName concatAccountNames as = accountNameWithPostingType t $ T.intercalate ":" $ map accountNameWithoutPostingType as where t = headDef RegularPosting $ filter (/= RegularPosting) $ map accountNamePostingType as -- | Rewrite an account name using all matching aliases from the given list, in sequence. -- Each alias sees the result of applying the previous aliases. 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 -- | Memoising version of accountNameApplyAliases, maybe overkill. accountNameApplyAliasesMemo :: [AccountAlias] -> AccountName -> AccountName accountNameApplyAliasesMemo aliases = memo (accountNameApplyAliases aliases) -- aliasMatches :: AccountAlias -> AccountName -> Bool -- aliasMatches (BasicAlias old _) a = old `isAccountNamePrefixOf` a -- aliasMatches (RegexAlias re _) a = regexMatchesCI re a aliasReplace :: AccountAlias -> AccountName -> AccountName aliasReplace (BasicAlias old new) a | old `isAccountNamePrefixOf` a || old == a = new <> T.drop (T.length old) a | otherwise = a aliasReplace (RegexAlias re repl) a = T.pack $ regexReplaceCIMemo re repl $ T.unpack a -- XXX -- tests tests_Posting = tests "Posting" [ tests "accountNamePostingType" [ accountNamePostingType "a" `is` RegularPosting ,accountNamePostingType "(a)" `is` VirtualPosting ,accountNamePostingType "[a]" `is` BalancedVirtualPosting ] ,tests "accountNameWithoutPostingType" [ accountNameWithoutPostingType "(a)" `is` "a" ] ,tests "accountNameWithPostingType" [ accountNameWithPostingType VirtualPosting "[a]" `is` "(a)" ] ,tests "joinAccountNames" [ "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" ] ,tests "concatAccountNames" [ concatAccountNames [] `is` "" ,concatAccountNames ["a","(b)","[c:d]"] `is` "(a:b:c:d)" ] ]