{-|

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,
  vpost,
  post',
  vpost',
  nullsourcepos,
  nullassertion,
  balassert,
  balassertTot,
  balassertParInc,
  balassertTotInc,
  -- * operations
  originalPosting,
  postingStatus,
  isReal,
  isVirtual,
  isBalancedVirtual,
  isEmptyPosting,
  hasBalanceAssignment,
  hasAmount,
  postingAllTags,
  transactionAllTags,
  relatedPostings,
  removePrices,
  -- * date operations
  postingDate,
  postingDate2,
  isPostingInDateSpan,
  isPostingInDateSpan',
  -- * account name operations
  accountNamesFromPostings,
  accountNamePostingType,
  accountNameWithoutPostingType,
  accountNameWithPostingType,
  joinAccountNames,
  concatAccountNames,
  accountNameApplyAliases,
  accountNameApplyAliasesMemo,
  -- * comment/tag operations
  commentJoin,
  commentAddTag,
  commentAddTagNextLine,
  -- * arithmetic
  sumPostings,
  -- * rendering
  showPosting,
  -- * misc.
  showComment,
  postingTransformAmount,
  postingApplyValuation,
  postingToCost,
  tests_Posting
)
where

import Control.Monad (foldM)
import Data.Foldable (asum)
import Data.List.Extra (nubSort)
import qualified Data.Map as M
import Data.Maybe
import Data.MemoUgly (memo)
#if !(MIN_VERSION_base(4,11,0))
import Data.Monoid
#endif
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)
import Hledger.Data.Valuation



nullposting, posting :: Posting
nullposting :: Posting
nullposting = Posting :: Maybe Day
-> Maybe Day
-> Status
-> AccountName
-> MixedAmount
-> AccountName
-> PostingType
-> [Tag]
-> Maybe BalanceAssertion
-> Maybe Transaction
-> Maybe Posting
-> Posting
Posting
                {pdate :: Maybe Day
pdate=Maybe Day
forall a. Maybe a
Nothing
                ,pdate2 :: Maybe Day
pdate2=Maybe Day
forall a. Maybe a
Nothing
                ,pstatus :: Status
pstatus=Status
Unmarked
                ,paccount :: AccountName
paccount=""
                ,pamount :: MixedAmount
pamount=MixedAmount
nullmixedamt
                ,pcomment :: AccountName
pcomment=""
                ,ptype :: PostingType
ptype=PostingType
RegularPosting
                ,ptags :: [Tag]
ptags=[]
                ,pbalanceassertion :: Maybe BalanceAssertion
pbalanceassertion=Maybe BalanceAssertion
forall a. Maybe a
Nothing
                ,ptransaction :: Maybe Transaction
ptransaction=Maybe Transaction
forall a. Maybe a
Nothing
                ,poriginal :: Maybe Posting
poriginal=Maybe Posting
forall a. Maybe a
Nothing
                }
posting :: Posting
posting = Posting
nullposting

-- constructors

-- | Make a posting to an account.
post :: AccountName -> Amount -> Posting
post :: AccountName -> Amount -> Posting
post acc :: AccountName
acc amt :: Amount
amt = Posting
posting {paccount :: AccountName
paccount=AccountName
acc, pamount :: MixedAmount
pamount=[Amount] -> MixedAmount
Mixed [Amount
amt]}

-- | Make a virtual (unbalanced) posting to an account.
vpost :: AccountName -> Amount -> Posting
vpost :: AccountName -> Amount -> Posting
vpost acc :: AccountName
acc amt :: Amount
amt = (AccountName -> Amount -> Posting
post AccountName
acc Amount
amt){ptype :: PostingType
ptype=PostingType
VirtualPosting}

-- | Make a posting to an account, maybe with a balance assertion.
post' :: AccountName -> Amount -> Maybe BalanceAssertion -> Posting
post' :: AccountName -> Amount -> Maybe BalanceAssertion -> Posting
post' acc :: AccountName
acc amt :: Amount
amt ass :: Maybe BalanceAssertion
ass = Posting
posting {paccount :: AccountName
paccount=AccountName
acc, pamount :: MixedAmount
pamount=[Amount] -> MixedAmount
Mixed [Amount
amt], pbalanceassertion :: Maybe BalanceAssertion
pbalanceassertion=Maybe BalanceAssertion
ass}

-- | Make a virtual (unbalanced) posting to an account, maybe with a balance assertion.
vpost' :: AccountName -> Amount -> Maybe BalanceAssertion -> Posting
vpost' :: AccountName -> Amount -> Maybe BalanceAssertion -> Posting
vpost' acc :: AccountName
acc amt :: Amount
amt ass :: Maybe BalanceAssertion
ass = (AccountName -> Amount -> Maybe BalanceAssertion -> Posting
post' AccountName
acc Amount
amt Maybe BalanceAssertion
ass){ptype :: PostingType
ptype=PostingType
VirtualPosting, pbalanceassertion :: Maybe BalanceAssertion
pbalanceassertion=Maybe BalanceAssertion
ass}

nullsourcepos :: GenericSourcePos
nullsourcepos :: GenericSourcePos
nullsourcepos = FilePath -> (Int, Int) -> GenericSourcePos
JournalSourcePos "" (1,1)

nullassertion :: BalanceAssertion
nullassertion :: BalanceAssertion
nullassertion = BalanceAssertion :: Amount -> Bool -> Bool -> GenericSourcePos -> BalanceAssertion
BalanceAssertion
                  {baamount :: Amount
baamount=Amount
nullamt
                  ,batotal :: Bool
batotal=Bool
False
                  ,bainclusive :: Bool
bainclusive=Bool
False
                  ,baposition :: GenericSourcePos
baposition=GenericSourcePos
nullsourcepos
                  }

-- | Make a partial, exclusive balance assertion.
balassert :: Amount -> Maybe BalanceAssertion
balassert :: Amount -> Maybe BalanceAssertion
balassert amt :: Amount
amt = BalanceAssertion -> Maybe BalanceAssertion
forall a. a -> Maybe a
Just (BalanceAssertion -> Maybe BalanceAssertion)
-> BalanceAssertion -> Maybe BalanceAssertion
forall a b. (a -> b) -> a -> b
$ BalanceAssertion
nullassertion{baamount :: Amount
baamount=Amount
amt}

-- | Make a total, exclusive balance assertion.
balassertTot :: Amount -> Maybe BalanceAssertion
balassertTot :: Amount -> Maybe BalanceAssertion
balassertTot amt :: Amount
amt = BalanceAssertion -> Maybe BalanceAssertion
forall a. a -> Maybe a
Just (BalanceAssertion -> Maybe BalanceAssertion)
-> BalanceAssertion -> Maybe BalanceAssertion
forall a b. (a -> b) -> a -> b
$ BalanceAssertion
nullassertion{baamount :: Amount
baamount=Amount
amt, batotal :: Bool
batotal=Bool
True}

-- | Make a partial, inclusive balance assertion.
balassertParInc :: Amount -> Maybe BalanceAssertion
balassertParInc :: Amount -> Maybe BalanceAssertion
balassertParInc amt :: Amount
amt = BalanceAssertion -> Maybe BalanceAssertion
forall a. a -> Maybe a
Just (BalanceAssertion -> Maybe BalanceAssertion)
-> BalanceAssertion -> Maybe BalanceAssertion
forall a b. (a -> b) -> a -> b
$ BalanceAssertion
nullassertion{baamount :: Amount
baamount=Amount
amt, bainclusive :: Bool
bainclusive=Bool
True}

-- | Make a total, inclusive balance assertion.
balassertTotInc :: Amount -> Maybe BalanceAssertion
balassertTotInc :: Amount -> Maybe BalanceAssertion
balassertTotInc amt :: Amount
amt = BalanceAssertion -> Maybe BalanceAssertion
forall a. a -> Maybe a
Just (BalanceAssertion -> Maybe BalanceAssertion)
-> BalanceAssertion -> Maybe BalanceAssertion
forall a b. (a -> b) -> a -> b
$ BalanceAssertion
nullassertion{baamount :: Amount
baamount=Amount
amt, batotal :: Bool
batotal=Bool
True, bainclusive :: Bool
bainclusive=Bool
True}

-- Get the original posting, if any.
originalPosting :: Posting -> Posting
originalPosting :: Posting -> Posting
originalPosting p :: Posting
p = Posting -> Maybe Posting -> Posting
forall a. a -> Maybe a -> a
fromMaybe Posting
p (Maybe Posting -> Posting) -> Maybe Posting -> Posting
forall a b. (a -> b) -> a -> b
$ Posting -> Maybe Posting
poriginal Posting
p

-- XXX once rendered user output, but just for debugging now; clean up
showPosting :: Posting -> String
showPosting :: Posting -> FilePath
showPosting p :: Posting
p@Posting{paccount :: Posting -> AccountName
paccount=AccountName
a,pamount :: Posting -> MixedAmount
pamount=MixedAmount
amt,ptype :: Posting -> PostingType
ptype=PostingType
t} =
    [FilePath] -> FilePath
unlines ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall a b. (a -> b) -> a -> b
$ [[FilePath] -> FilePath
concatTopPadded [Day -> FilePath
forall a. Show a => a -> FilePath
show (Posting -> Day
postingDate Posting
p) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ " ", AccountName -> FilePath
showaccountname AccountName
a FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ " ", MixedAmount -> FilePath
showamount MixedAmount
amt, AccountName -> FilePath
showComment (Posting -> AccountName
pcomment Posting
p)]]
    where
      ledger3ishlayout :: Bool
ledger3ishlayout = Bool
False
      acctnamewidth :: Int
acctnamewidth = if Bool
ledger3ishlayout then 25 else 22
      showaccountname :: AccountName -> FilePath
showaccountname = Maybe Int -> Maybe Int -> Bool -> Bool -> FilePath -> FilePath
fitString (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
acctnamewidth) Maybe Int
forall a. Maybe a
Nothing Bool
False Bool
False (FilePath -> FilePath)
-> (AccountName -> FilePath) -> AccountName -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
bracket (FilePath -> FilePath)
-> (AccountName -> FilePath) -> AccountName -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AccountName -> FilePath
T.unpack (AccountName -> FilePath)
-> (AccountName -> AccountName) -> AccountName -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> AccountName -> AccountName
elideAccountName Int
width
      (bracket :: FilePath -> FilePath
bracket,width :: Int
width) = case PostingType
t of
                          BalancedVirtualPosting -> (\s :: FilePath
s -> "["FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++FilePath
sFilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++"]", Int
acctnamewidthInt -> Int -> Int
forall a. Num a => a -> a -> a
-2)
                          VirtualPosting -> (\s :: FilePath
s -> "("FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++FilePath
sFilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++")", Int
acctnamewidthInt -> Int -> Int
forall a. Num a => a -> a -> a
-2)
                          _ -> (FilePath -> FilePath
forall a. a -> a
id,Int
acctnamewidth)
      showamount :: MixedAmount -> FilePath
showamount = Int -> FilePath -> FilePath
padLeftWide 12 (FilePath -> FilePath)
-> (MixedAmount -> FilePath) -> MixedAmount -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MixedAmount -> FilePath
showMixedAmount


showComment :: Text -> String
showComment :: AccountName -> FilePath
showComment t :: AccountName
t = if AccountName -> Bool
T.null AccountName
t then "" else "  ;" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ AccountName -> FilePath
T.unpack AccountName
t

isReal :: Posting -> Bool
isReal :: Posting -> Bool
isReal p :: Posting
p = Posting -> PostingType
ptype Posting
p PostingType -> PostingType -> Bool
forall a. Eq a => a -> a -> Bool
== PostingType
RegularPosting

isVirtual :: Posting -> Bool
isVirtual :: Posting -> Bool
isVirtual p :: Posting
p = Posting -> PostingType
ptype Posting
p PostingType -> PostingType -> Bool
forall a. Eq a => a -> a -> Bool
== PostingType
VirtualPosting

isBalancedVirtual :: Posting -> Bool
isBalancedVirtual :: Posting -> Bool
isBalancedVirtual p :: Posting
p = Posting -> PostingType
ptype Posting
p PostingType -> PostingType -> Bool
forall a. Eq a => a -> a -> Bool
== PostingType
BalancedVirtualPosting

hasAmount :: Posting -> Bool
hasAmount :: Posting -> Bool
hasAmount = (MixedAmount -> MixedAmount -> Bool
forall a. Eq a => a -> a -> Bool
/= MixedAmount
missingmixedamt) (MixedAmount -> Bool)
-> (Posting -> MixedAmount) -> Posting -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Posting -> MixedAmount
pamount

hasBalanceAssignment :: Posting -> Bool
hasBalanceAssignment :: Posting -> Bool
hasBalanceAssignment p :: Posting
p = Bool -> Bool
not (Posting -> Bool
hasAmount Posting
p) Bool -> Bool -> Bool
&& Maybe BalanceAssertion -> Bool
forall a. Maybe a -> Bool
isJust (Posting -> Maybe BalanceAssertion
pbalanceassertion Posting
p)

-- | Sorted unique account names referenced by these postings.
accountNamesFromPostings :: [Posting] -> [AccountName]
accountNamesFromPostings :: [Posting] -> [AccountName]
accountNamesFromPostings = [AccountName] -> [AccountName]
forall a. Ord a => [a] -> [a]
nubSort ([AccountName] -> [AccountName])
-> ([Posting] -> [AccountName]) -> [Posting] -> [AccountName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Posting -> AccountName) -> [Posting] -> [AccountName]
forall a b. (a -> b) -> [a] -> [b]
map Posting -> AccountName
paccount

sumPostings :: [Posting] -> MixedAmount
sumPostings :: [Posting] -> MixedAmount
sumPostings = [MixedAmount] -> MixedAmount
forall a. Num a => [a] -> a
sumStrict ([MixedAmount] -> MixedAmount)
-> ([Posting] -> [MixedAmount]) -> [Posting] -> MixedAmount
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Posting -> MixedAmount) -> [Posting] -> [MixedAmount]
forall a b. (a -> b) -> [a] -> [b]
map Posting -> MixedAmount
pamount

-- | Remove all prices of a posting
removePrices :: Posting -> Posting
removePrices :: Posting -> Posting
removePrices p :: Posting
p = Posting
p{ pamount :: MixedAmount
pamount = [Amount] -> MixedAmount
Mixed ([Amount] -> MixedAmount) -> [Amount] -> MixedAmount
forall a b. (a -> b) -> a -> b
$ Amount -> Amount
remove (Amount -> Amount) -> [Amount] -> [Amount]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MixedAmount -> [Amount]
amounts (Posting -> MixedAmount
pamount Posting
p) }
  where remove :: Amount -> Amount
remove a :: Amount
a = Amount
a { aprice :: Maybe AmountPrice
aprice = Maybe AmountPrice
forall a. Maybe a
Nothing }

-- | 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 :: Posting -> Day
postingDate p :: Posting
p = Day -> Maybe Day -> Day
forall a. a -> Maybe a -> a
fromMaybe Day
nulldate (Maybe Day -> Day) -> Maybe Day -> Day
forall a b. (a -> b) -> a -> b
$ [Maybe Day] -> Maybe Day
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum [Maybe Day]
dates
    where dates :: [Maybe Day]
dates = [ Posting -> Maybe Day
pdate Posting
p, Transaction -> Day
tdate (Transaction -> Day) -> Maybe Transaction -> Maybe Day
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Posting -> Maybe Transaction
ptransaction Posting
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 :: Posting -> Day
postingDate2 p :: Posting
p = Day -> Maybe Day -> Day
forall a. a -> Maybe a -> a
fromMaybe Day
nulldate (Maybe Day -> Day) -> Maybe Day -> Day
forall a b. (a -> b) -> a -> b
$ [Maybe Day] -> Maybe Day
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum [Maybe Day]
dates
  where dates :: [Maybe Day]
dates = [ Posting -> Maybe Day
pdate2 Posting
p
                , Transaction -> Maybe Day
tdate2 (Transaction -> Maybe Day) -> Maybe Transaction -> Maybe Day
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Posting -> Maybe Transaction
ptransaction Posting
p
                , Posting -> Maybe Day
pdate Posting
p
                , Transaction -> Day
tdate (Transaction -> Day) -> Maybe Transaction -> Maybe Day
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Posting -> Maybe Transaction
ptransaction Posting
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 -> Status
postingStatus Posting{pstatus :: Posting -> Status
pstatus=Status
s, ptransaction :: Posting -> Maybe Transaction
ptransaction=Maybe Transaction
mt}
  | Status
s Status -> Status -> Bool
forall a. Eq a => a -> a -> Bool
== Status
Unmarked = case Maybe Transaction
mt of Just t :: Transaction
t  -> Transaction -> Status
tstatus Transaction
t
                               Nothing -> Status
Unmarked
  | Bool
otherwise = Status
s

-- | Tags for this posting including any inherited from its parent transaction.
postingAllTags :: Posting -> [Tag]
postingAllTags :: Posting -> [Tag]
postingAllTags p :: Posting
p = Posting -> [Tag]
ptags Posting
p [Tag] -> [Tag] -> [Tag]
forall a. [a] -> [a] -> [a]
++ [Tag] -> (Transaction -> [Tag]) -> Maybe Transaction -> [Tag]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] Transaction -> [Tag]
ttags (Posting -> Maybe Transaction
ptransaction Posting
p)

-- | Tags for this transaction including any from its postings.
transactionAllTags :: Transaction -> [Tag]
transactionAllTags :: Transaction -> [Tag]
transactionAllTags t :: Transaction
t = Transaction -> [Tag]
ttags Transaction
t [Tag] -> [Tag] -> [Tag]
forall a. [a] -> [a] -> [a]
++ (Posting -> [Tag]) -> [Posting] -> [Tag]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Posting -> [Tag]
ptags (Transaction -> [Posting]
tpostings Transaction
t)

-- Get the other postings from this posting's transaction.
relatedPostings :: Posting -> [Posting]
relatedPostings :: Posting -> [Posting]
relatedPostings p :: Posting
p@Posting{ptransaction :: Posting -> Maybe Transaction
ptransaction=Just t :: Transaction
t} = (Posting -> Bool) -> [Posting] -> [Posting]
forall a. (a -> Bool) -> [a] -> [a]
filter (Posting -> Posting -> Bool
forall a. Eq a => a -> a -> Bool
/= Posting
p) ([Posting] -> [Posting]) -> [Posting] -> [Posting]
forall a b. (a -> b) -> a -> b
$ Transaction -> [Posting]
tpostings Transaction
t
relatedPostings _ = []

-- | Does this posting fall within the given date span ?
isPostingInDateSpan :: DateSpan -> Posting -> Bool
isPostingInDateSpan :: DateSpan -> Posting -> Bool
isPostingInDateSpan = WhichDate -> DateSpan -> Posting -> Bool
isPostingInDateSpan' WhichDate
PrimaryDate

-- --date2-sensitive version, separate for now to avoid disturbing multiBalanceReport.
isPostingInDateSpan' :: WhichDate -> DateSpan -> Posting -> Bool
isPostingInDateSpan' :: WhichDate -> DateSpan -> Posting -> Bool
isPostingInDateSpan' PrimaryDate   s :: DateSpan
s = DateSpan -> Day -> Bool
spanContainsDate DateSpan
s (Day -> Bool) -> (Posting -> Day) -> Posting -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Posting -> Day
postingDate
isPostingInDateSpan' SecondaryDate s :: DateSpan
s = DateSpan -> Day -> Bool
spanContainsDate DateSpan
s (Day -> Bool) -> (Posting -> Day) -> Posting -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Posting -> Day
postingDate2

isEmptyPosting :: Posting -> Bool
isEmptyPosting :: Posting -> Bool
isEmptyPosting = MixedAmount -> Bool
mixedAmountLooksZero (MixedAmount -> Bool)
-> (Posting -> MixedAmount) -> Posting -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Posting -> MixedAmount
pamount

-- AccountName stuff that depends on PostingType

accountNamePostingType :: AccountName -> PostingType
accountNamePostingType :: AccountName -> PostingType
accountNamePostingType a :: AccountName
a
    | AccountName -> Bool
T.null AccountName
a = PostingType
RegularPosting
    | AccountName -> Char
T.head AccountName
a Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '[' Bool -> Bool -> Bool
&& AccountName -> Char
T.last AccountName
a Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== ']' = PostingType
BalancedVirtualPosting
    | AccountName -> Char
T.head AccountName
a Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '(' Bool -> Bool -> Bool
&& AccountName -> Char
T.last AccountName
a Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== ')' = PostingType
VirtualPosting
    | Bool
otherwise = PostingType
RegularPosting

accountNameWithoutPostingType :: AccountName -> AccountName
accountNameWithoutPostingType :: AccountName -> AccountName
accountNameWithoutPostingType a :: AccountName
a = case AccountName -> PostingType
accountNamePostingType AccountName
a of
                                    BalancedVirtualPosting -> AccountName -> AccountName
T.init (AccountName -> AccountName) -> AccountName -> AccountName
forall a b. (a -> b) -> a -> b
$ AccountName -> AccountName
T.tail AccountName
a
                                    VirtualPosting -> AccountName -> AccountName
T.init (AccountName -> AccountName) -> AccountName -> AccountName
forall a b. (a -> b) -> a -> b
$ AccountName -> AccountName
T.tail AccountName
a
                                    RegularPosting -> AccountName
a

accountNameWithPostingType :: PostingType -> AccountName -> AccountName
accountNameWithPostingType :: PostingType -> AccountName -> AccountName
accountNameWithPostingType BalancedVirtualPosting a :: AccountName
a = "["AccountName -> AccountName -> AccountName
forall a. Semigroup a => a -> a -> a
<>AccountName -> AccountName
accountNameWithoutPostingType AccountName
aAccountName -> AccountName -> AccountName
forall a. Semigroup a => a -> a -> a
<>"]"
accountNameWithPostingType VirtualPosting a :: AccountName
a = "("AccountName -> AccountName -> AccountName
forall a. Semigroup a => a -> a -> a
<>AccountName -> AccountName
accountNameWithoutPostingType AccountName
aAccountName -> AccountName -> AccountName
forall a. Semigroup a => a -> a -> a
<>")"
accountNameWithPostingType RegularPosting a :: AccountName
a = AccountName -> AccountName
accountNameWithoutPostingType AccountName
a

-- | Prefix one account name to another, preserving posting type
-- indicators like concatAccountNames.
joinAccountNames :: AccountName -> AccountName -> AccountName
joinAccountNames :: AccountName -> AccountName -> AccountName
joinAccountNames a :: AccountName
a b :: AccountName
b = [AccountName] -> AccountName
concatAccountNames ([AccountName] -> AccountName) -> [AccountName] -> AccountName
forall a b. (a -> b) -> a -> b
$ (AccountName -> Bool) -> [AccountName] -> [AccountName]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (AccountName -> Bool) -> AccountName -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AccountName -> Bool
T.null) [AccountName
a,AccountName
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 :: [AccountName] -> AccountName
concatAccountNames as :: [AccountName]
as = PostingType -> AccountName -> AccountName
accountNameWithPostingType PostingType
t (AccountName -> AccountName) -> AccountName -> AccountName
forall a b. (a -> b) -> a -> b
$ AccountName -> [AccountName] -> AccountName
T.intercalate ":" ([AccountName] -> AccountName) -> [AccountName] -> AccountName
forall a b. (a -> b) -> a -> b
$ (AccountName -> AccountName) -> [AccountName] -> [AccountName]
forall a b. (a -> b) -> [a] -> [b]
map AccountName -> AccountName
accountNameWithoutPostingType [AccountName]
as
    where t :: PostingType
t = PostingType -> [PostingType] -> PostingType
forall a. a -> [a] -> a
headDef PostingType
RegularPosting ([PostingType] -> PostingType) -> [PostingType] -> PostingType
forall a b. (a -> b) -> a -> b
$ (PostingType -> Bool) -> [PostingType] -> [PostingType]
forall a. (a -> Bool) -> [a] -> [a]
filter (PostingType -> PostingType -> Bool
forall a. Eq a => a -> a -> Bool
/= PostingType
RegularPosting) ([PostingType] -> [PostingType]) -> [PostingType] -> [PostingType]
forall a b. (a -> b) -> a -> b
$ (AccountName -> PostingType) -> [AccountName] -> [PostingType]
forall a b. (a -> b) -> [a] -> [b]
map AccountName -> PostingType
accountNamePostingType [AccountName]
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.
-- Or, return any error arising from a bad regular expression in the aliases.
accountNameApplyAliases :: [AccountAlias] -> AccountName -> Either RegexError AccountName
accountNameApplyAliases :: [AccountAlias] -> AccountName -> Either FilePath AccountName
accountNameApplyAliases aliases :: [AccountAlias]
aliases a :: AccountName
a =
  let (aname :: AccountName
aname,atype :: PostingType
atype) = (AccountName -> AccountName
accountNameWithoutPostingType AccountName
a, AccountName -> PostingType
accountNamePostingType AccountName
a)
  in (AccountName -> AccountAlias -> Either FilePath AccountName)
-> AccountName -> [AccountAlias] -> Either FilePath AccountName
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM
     (\acct :: AccountName
acct alias :: AccountAlias
alias -> FilePath
-> Either FilePath AccountName -> Either FilePath AccountName
forall a. Show a => FilePath -> a -> a
dbg6 "result" (Either FilePath AccountName -> Either FilePath AccountName)
-> Either FilePath AccountName -> Either FilePath AccountName
forall a b. (a -> b) -> a -> b
$ AccountAlias -> AccountName -> Either FilePath AccountName
aliasReplace (FilePath -> AccountAlias -> AccountAlias
forall a. Show a => FilePath -> a -> a
dbg6 "alias" AccountAlias
alias) (FilePath -> AccountName -> AccountName
forall a. Show a => FilePath -> a -> a
dbg6 "account" AccountName
acct))
     AccountName
aname
     [AccountAlias]
aliases
     Either FilePath AccountName
-> (AccountName -> Either FilePath AccountName)
-> Either FilePath AccountName
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= AccountName -> Either FilePath AccountName
forall a b. b -> Either a b
Right (AccountName -> Either FilePath AccountName)
-> (AccountName -> AccountName)
-> AccountName
-> Either FilePath AccountName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PostingType -> AccountName -> AccountName
accountNameWithPostingType PostingType
atype

-- | Memoising version of accountNameApplyAliases, maybe overkill.
accountNameApplyAliasesMemo :: [AccountAlias] -> AccountName -> Either RegexError AccountName
accountNameApplyAliasesMemo :: [AccountAlias] -> AccountName -> Either FilePath AccountName
accountNameApplyAliasesMemo aliases :: [AccountAlias]
aliases = (AccountName -> Either FilePath AccountName)
-> AccountName -> Either FilePath AccountName
forall a b. Ord a => (a -> b) -> a -> b
memo ([AccountAlias] -> AccountName -> Either FilePath AccountName
accountNameApplyAliases [AccountAlias]
aliases)
  -- XXX re-test this memoisation

-- aliasMatches :: AccountAlias -> AccountName -> Bool
-- aliasMatches (BasicAlias old _) a = old `isAccountNamePrefixOf` a
-- aliasMatches (RegexAlias re  _) a = regexMatchesCI re a

aliasReplace :: AccountAlias -> AccountName -> Either RegexError AccountName
aliasReplace :: AccountAlias -> AccountName -> Either FilePath AccountName
aliasReplace (BasicAlias old :: AccountName
old new :: AccountName
new) a :: AccountName
a
  | AccountName
old AccountName -> AccountName -> Bool
`isAccountNamePrefixOf` AccountName
a Bool -> Bool -> Bool
|| AccountName
old AccountName -> AccountName -> Bool
forall a. Eq a => a -> a -> Bool
== AccountName
a =
      AccountName -> Either FilePath AccountName
forall a b. b -> Either a b
Right (AccountName -> Either FilePath AccountName)
-> AccountName -> Either FilePath AccountName
forall a b. (a -> b) -> a -> b
$ AccountName
new AccountName -> AccountName -> AccountName
forall a. Semigroup a => a -> a -> a
<> Int -> AccountName -> AccountName
T.drop (AccountName -> Int
T.length AccountName
old) AccountName
a
  | Bool
otherwise = AccountName -> Either FilePath AccountName
forall a b. b -> Either a b
Right AccountName
a
aliasReplace (RegexAlias re :: Regexp
re repl :: FilePath
repl) a :: AccountName
a =
  (FilePath -> AccountName)
-> Either FilePath FilePath -> Either FilePath AccountName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> AccountName
T.pack (Either FilePath FilePath -> Either FilePath AccountName)
-> (FilePath -> Either FilePath FilePath)
-> FilePath
-> Either FilePath AccountName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Regexp -> FilePath -> FilePath -> Either FilePath FilePath
regexReplace Regexp
re FilePath
repl (FilePath -> Either FilePath AccountName)
-> FilePath -> Either FilePath AccountName
forall a b. (a -> b) -> a -> b
$ AccountName -> FilePath
T.unpack AccountName
a -- XXX

-- | Apply a specified valuation to this posting's amount, using the
-- provided price oracle, commodity styles, reference dates, and
-- whether this is for a multiperiod report or not. See
-- amountApplyValuation.
postingApplyValuation :: PriceOracle -> M.Map CommoditySymbol AmountStyle -> Day -> Maybe Day -> Day -> Bool -> Posting -> ValuationType -> Posting
postingApplyValuation :: PriceOracle
-> Map AccountName AmountStyle
-> Day
-> Maybe Day
-> Day
-> Bool
-> Posting
-> ValuationType
-> Posting
postingApplyValuation priceoracle :: PriceOracle
priceoracle styles :: Map AccountName AmountStyle
styles periodlast :: Day
periodlast mreportlast :: Maybe Day
mreportlast today :: Day
today ismultiperiod :: Bool
ismultiperiod p :: Posting
p v :: ValuationType
v =
  case ValuationType
v of
    AtCost    Nothing            -> Map AccountName AmountStyle -> Posting -> Posting
postingToCost Map AccountName AmountStyle
styles Posting
p
    AtCost    mc :: Maybe AccountName
mc                 -> PriceOracle
-> Map AccountName AmountStyle
-> Maybe AccountName
-> Day
-> Posting
-> Posting
postingValueAtDate PriceOracle
priceoracle Map AccountName AmountStyle
styles Maybe AccountName
mc Day
periodlast (Posting -> Posting) -> Posting -> Posting
forall a b. (a -> b) -> a -> b
$ Map AccountName AmountStyle -> Posting -> Posting
postingToCost Map AccountName AmountStyle
styles Posting
p
    AtThen    mc :: Maybe AccountName
mc                 -> PriceOracle
-> Map AccountName AmountStyle
-> Maybe AccountName
-> Day
-> Posting
-> Posting
postingValueAtDate PriceOracle
priceoracle Map AccountName AmountStyle
styles Maybe AccountName
mc (Posting -> Day
postingDate Posting
p) Posting
p
    AtEnd     mc :: Maybe AccountName
mc                 -> PriceOracle
-> Map AccountName AmountStyle
-> Maybe AccountName
-> Day
-> Posting
-> Posting
postingValueAtDate PriceOracle
priceoracle Map AccountName AmountStyle
styles Maybe AccountName
mc Day
periodlast Posting
p
    AtNow     mc :: Maybe AccountName
mc                 -> PriceOracle
-> Map AccountName AmountStyle
-> Maybe AccountName
-> Day
-> Posting
-> Posting
postingValueAtDate PriceOracle
priceoracle Map AccountName AmountStyle
styles Maybe AccountName
mc Day
today Posting
p
    AtDefault mc :: Maybe AccountName
mc | Bool
ismultiperiod -> PriceOracle
-> Map AccountName AmountStyle
-> Maybe AccountName
-> Day
-> Posting
-> Posting
postingValueAtDate PriceOracle
priceoracle Map AccountName AmountStyle
styles Maybe AccountName
mc Day
periodlast Posting
p
    AtDefault mc :: Maybe AccountName
mc                 -> PriceOracle
-> Map AccountName AmountStyle
-> Maybe AccountName
-> Day
-> Posting
-> Posting
postingValueAtDate PriceOracle
priceoracle Map AccountName AmountStyle
styles Maybe AccountName
mc (Day -> Maybe Day -> Day
forall a. a -> Maybe a -> a
fromMaybe Day
today Maybe Day
mreportlast) Posting
p
    AtDate d :: Day
d  mc :: Maybe AccountName
mc                 -> PriceOracle
-> Map AccountName AmountStyle
-> Maybe AccountName
-> Day
-> Posting
-> Posting
postingValueAtDate PriceOracle
priceoracle Map AccountName AmountStyle
styles Maybe AccountName
mc Day
d Posting
p

-- | Convert this posting's amount to cost, and apply the appropriate amount styles.
postingToCost :: M.Map CommoditySymbol AmountStyle -> Posting -> Posting
postingToCost :: Map AccountName AmountStyle -> Posting -> Posting
postingToCost styles :: Map AccountName AmountStyle
styles p :: Posting
p@Posting{pamount :: Posting -> MixedAmount
pamount=MixedAmount
a} = Posting
p{pamount :: MixedAmount
pamount=Map AccountName AmountStyle -> MixedAmount -> MixedAmount
styleMixedAmount Map AccountName AmountStyle
styles (MixedAmount -> MixedAmount) -> MixedAmount -> MixedAmount
forall a b. (a -> b) -> a -> b
$ MixedAmount -> MixedAmount
mixedAmountCost MixedAmount
a}

-- | Convert this posting's amount to market value in the given commodity,
-- or the default valuation commodity, at the given valuation date,
-- using the given market price oracle.
-- When market prices available on that date are not sufficient to
-- calculate the value, amounts are left unchanged.
postingValueAtDate :: PriceOracle -> M.Map CommoditySymbol AmountStyle -> Maybe CommoditySymbol -> Day -> Posting -> Posting
postingValueAtDate :: PriceOracle
-> Map AccountName AmountStyle
-> Maybe AccountName
-> Day
-> Posting
-> Posting
postingValueAtDate priceoracle :: PriceOracle
priceoracle styles :: Map AccountName AmountStyle
styles mc :: Maybe AccountName
mc d :: Day
d p :: Posting
p = (MixedAmount -> MixedAmount) -> Posting -> Posting
postingTransformAmount (PriceOracle
-> Map AccountName AmountStyle
-> Maybe AccountName
-> Day
-> MixedAmount
-> MixedAmount
mixedAmountValueAtDate PriceOracle
priceoracle Map AccountName AmountStyle
styles Maybe AccountName
mc Day
d) Posting
p

-- | Apply a transform function to this posting's amount.
postingTransformAmount :: (MixedAmount -> MixedAmount) -> Posting -> Posting
postingTransformAmount :: (MixedAmount -> MixedAmount) -> Posting -> Posting
postingTransformAmount f :: MixedAmount -> MixedAmount
f p :: Posting
p@Posting{pamount :: Posting -> MixedAmount
pamount=MixedAmount
a} = Posting
p{pamount :: MixedAmount
pamount=MixedAmount -> MixedAmount
f MixedAmount
a}

-- | Join two parts of a comment, eg a tag and another tag, or a tag
-- and a non-tag, on a single line. Interpolates a comma and space
-- unless one of the parts is empty.
commentJoin :: Text -> Text -> Text
commentJoin :: AccountName -> AccountName -> AccountName
commentJoin c1 :: AccountName
c1 c2 :: AccountName
c2
  | AccountName -> Bool
T.null AccountName
c1 = AccountName
c2
  | AccountName -> Bool
T.null AccountName
c2 = AccountName
c1
  | Bool
otherwise = AccountName
c1 AccountName -> AccountName -> AccountName
forall a. Semigroup a => a -> a -> a
<> ", " AccountName -> AccountName -> AccountName
forall a. Semigroup a => a -> a -> a
<> AccountName
c2

-- | Add a tag to a comment, comma-separated from any prior content.
-- A space is inserted following the colon, before the value.
commentAddTag :: Text -> Tag -> Text
commentAddTag :: AccountName -> Tag -> AccountName
commentAddTag c :: AccountName
c (t :: AccountName
t,v :: AccountName
v)
  | AccountName -> Bool
T.null AccountName
c' = AccountName
tag
  | Bool
otherwise = AccountName
c' AccountName -> AccountName -> AccountName
`commentJoin` AccountName
tag
  where
    c' :: AccountName
c'  = AccountName -> AccountName
T.stripEnd AccountName
c
    tag :: AccountName
tag = AccountName
t AccountName -> AccountName -> AccountName
forall a. Semigroup a => a -> a -> a
<> ": " AccountName -> AccountName -> AccountName
forall a. Semigroup a => a -> a -> a
<> AccountName
v

-- | Add a tag on its own line to a comment, preserving any prior content.
-- A space is inserted following the colon, before the value.
commentAddTagNextLine :: Text -> Tag -> Text
commentAddTagNextLine :: AccountName -> Tag -> AccountName
commentAddTagNextLine cmt :: AccountName
cmt (t :: AccountName
t,v :: AccountName
v) =
  AccountName
cmt AccountName -> AccountName -> AccountName
forall a. Semigroup a => a -> a -> a
<> if "\n" AccountName -> AccountName -> Bool
`T.isSuffixOf` AccountName
cmt then "" else "\n" AccountName -> AccountName -> AccountName
forall a. Semigroup a => a -> a -> a
<> AccountName
t AccountName -> AccountName -> AccountName
forall a. Semigroup a => a -> a -> a
<> ": " AccountName -> AccountName -> AccountName
forall a. Semigroup a => a -> a -> a
<> AccountName
v 


-- tests

tests_Posting :: TestTree
tests_Posting = FilePath -> [TestTree] -> TestTree
tests "Posting" [

  FilePath -> Assertion -> TestTree
test "accountNamePostingType" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
    AccountName -> PostingType
accountNamePostingType "a" PostingType -> PostingType -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= PostingType
RegularPosting
    AccountName -> PostingType
accountNamePostingType "(a)" PostingType -> PostingType -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= PostingType
VirtualPosting
    AccountName -> PostingType
accountNamePostingType "[a]" PostingType -> PostingType -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= PostingType
BalancedVirtualPosting

 ,FilePath -> Assertion -> TestTree
test "accountNameWithoutPostingType" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
    AccountName -> AccountName
accountNameWithoutPostingType "(a)" AccountName -> AccountName -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= "a"

 ,FilePath -> Assertion -> TestTree
test "accountNameWithPostingType" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
    PostingType -> AccountName -> AccountName
accountNameWithPostingType PostingType
VirtualPosting "[a]" AccountName -> AccountName -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= "(a)"

 ,FilePath -> Assertion -> TestTree
test "joinAccountNames" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
    "a" AccountName -> AccountName -> AccountName
`joinAccountNames` "b:c" AccountName -> AccountName -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= "a:b:c"
    "a" AccountName -> AccountName -> AccountName
`joinAccountNames` "(b:c)" AccountName -> AccountName -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= "(a:b:c)"
    "[a]" AccountName -> AccountName -> AccountName
`joinAccountNames` "(b:c)" AccountName -> AccountName -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= "[a:b:c]"
    "" AccountName -> AccountName -> AccountName
`joinAccountNames` "a" AccountName -> AccountName -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= "a"

 ,FilePath -> Assertion -> TestTree
test "concatAccountNames" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
    [AccountName] -> AccountName
concatAccountNames [] AccountName -> AccountName -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= ""
    [AccountName] -> AccountName
concatAccountNames ["a","(b)","[c:d]"] AccountName -> AccountName -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= "(a:b:c:d)"

 ,FilePath -> Assertion -> TestTree
test "commentAddTag" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
    AccountName -> Tag -> AccountName
commentAddTag "" ("a","") AccountName -> AccountName -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= "a: "
    AccountName -> Tag -> AccountName
commentAddTag "[1/2]" ("a","") AccountName -> AccountName -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= "[1/2], a: "

 ,FilePath -> Assertion -> TestTree
test "commentAddTagNextLine" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
    AccountName -> Tag -> AccountName
commentAddTagNextLine "" ("a","") AccountName -> AccountName -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= "\na: "
    AccountName -> Tag -> AccountName
commentAddTagNextLine "[1/2]" ("a","") AccountName -> AccountName -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= "[1/2]\na: "

 ]