{-# LANGUAGE NamedFieldPuns #-}
{-|

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 #-}

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,
  postingStripPrices,
  postingApplyAliases,
  postingApplyCommodityStyles,
  -- * 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 qualified Data.Map as M
import Data.Maybe (fromMaybe, isJust)
import Data.MemoUgly (memo)
import Data.List (foldl')
import qualified Data.Set as S
import Data.Text (Text)
import qualified Data.Text as T
import Data.Time.Calendar (Day)
import Safe (headDef)

import Hledger.Utils
import Hledger.Data.Types
import Hledger.Data.Amount
import Hledger.Data.AccountName
import Hledger.Data.Dates (nulldate, showDate, spanContainsDate)
import Hledger.Data.Valuation



nullposting, posting :: Posting
nullposting :: Posting
nullposting = Posting :: Maybe Day
-> Maybe Day
-> Status
-> Text
-> MixedAmount
-> Text
-> 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 :: Text
paccount=Text
""
                ,pamount :: MixedAmount
pamount=MixedAmount
nullmixedamt
                ,pcomment :: Text
pcomment=Text
""
                ,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 :: Text -> Amount -> Posting
post Text
acc Amount
amt = Posting
posting {paccount :: Text
paccount=Text
acc, pamount :: MixedAmount
pamount=Amount -> MixedAmount
mixedAmount Amount
amt}

-- | Make a virtual (unbalanced) posting to an account.
vpost :: AccountName -> Amount -> Posting
vpost :: Text -> Amount -> Posting
vpost Text
acc Amount
amt = (Text -> Amount -> Posting
post Text
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' :: Text -> Amount -> Maybe BalanceAssertion -> Posting
post' Text
acc Amount
amt Maybe BalanceAssertion
ass = Posting
posting {paccount :: Text
paccount=Text
acc, pamount :: MixedAmount
pamount=Amount -> MixedAmount
mixedAmount 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' :: Text -> Amount -> Maybe BalanceAssertion -> Posting
vpost' Text
acc Amount
amt Maybe BalanceAssertion
ass = (Text -> Amount -> Maybe BalanceAssertion -> Posting
post' Text
acc Amount
amt Maybe BalanceAssertion
ass){ptype :: PostingType
ptype=PostingType
VirtualPosting, pbalanceassertion :: Maybe BalanceAssertion
pbalanceassertion=Maybe BalanceAssertion
ass}

nullsourcepos :: (SourcePos, SourcePos)
nullsourcepos :: (SourcePos, SourcePos)
nullsourcepos = (RegexError -> Pos -> Pos -> SourcePos
SourcePos RegexError
"" (Int -> Pos
mkPos Int
1) (Int -> Pos
mkPos Int
1), RegexError -> Pos -> Pos -> SourcePos
SourcePos RegexError
"" (Int -> Pos
mkPos Int
2) (Int -> Pos
mkPos Int
1))

nullassertion :: BalanceAssertion
nullassertion :: BalanceAssertion
nullassertion = BalanceAssertion :: Amount -> Bool -> Bool -> SourcePos -> BalanceAssertion
BalanceAssertion
                  {baamount :: Amount
baamount=Amount
nullamt
                  ,batotal :: Bool
batotal=Bool
False
                  ,bainclusive :: Bool
bainclusive=Bool
False
                  ,baposition :: SourcePos
baposition=RegexError -> SourcePos
initialPos RegexError
""
                  }

-- | Make a partial, exclusive balance assertion.
balassert :: Amount -> Maybe BalanceAssertion
balassert :: Amount -> Maybe BalanceAssertion
balassert 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 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 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 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 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 -> RegexError
showPosting p :: Posting
p@Posting{paccount :: Posting -> Text
paccount=Text
a,pamount :: Posting -> MixedAmount
pamount=MixedAmount
amt,ptype :: Posting -> PostingType
ptype=PostingType
t} =
    Text -> RegexError
T.unpack (Text -> RegexError) -> Text -> RegexError
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
textConcatTopPadded [Day -> Text
showDate (Posting -> Day
postingDate Posting
p) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" ", Text -> Text
showaccountname Text
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" ", Text
showamt, Text -> Text
showComment (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Posting -> Text
pcomment Posting
p]
  where
    ledger3ishlayout :: Bool
ledger3ishlayout = Bool
False
    acctnamewidth :: Int
acctnamewidth = if Bool
ledger3ishlayout then Int
25 else Int
22
    showaccountname :: Text -> Text
showaccountname = Maybe Int -> Maybe Int -> Bool -> Bool -> Text -> Text
fitText (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
acctnamewidth) Maybe Int
forall a. Maybe a
Nothing Bool
False Bool
False (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
bracket (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text -> Text
elideAccountName Int
width
    (Text -> Text
bracket,Int
width) = case PostingType
t of
                        PostingType
BalancedVirtualPosting -> (Text -> Text -> Text -> Text
wrap Text
"[" Text
"]", Int
acctnamewidthInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
2)
                        PostingType
VirtualPosting         -> (Text -> Text -> Text -> Text
wrap Text
"(" Text
")", Int
acctnamewidthInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
2)
                        PostingType
_                      -> (Text -> Text
forall a. a -> a
id,Int
acctnamewidth)
    showamt :: Text
showamt = WideBuilder -> Text
wbToText (WideBuilder -> Text) -> WideBuilder -> Text
forall a b. (a -> b) -> a -> b
$ AmountDisplayOpts -> MixedAmount -> WideBuilder
showMixedAmountB AmountDisplayOpts
noColour{displayMinWidth :: Maybe Int
displayMinWidth=Int -> Maybe Int
forall a. a -> Maybe a
Just Int
12} MixedAmount
amt


showComment :: Text -> Text
showComment :: Text -> Text
showComment Text
t = if Text -> Bool
T.null Text
t then Text
"" else Text
"  ;" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t

isReal :: Posting -> Bool
isReal :: Posting -> Bool
isReal 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 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 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 = Bool -> Bool
not (Bool -> Bool) -> (Posting -> Bool) -> Posting -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MixedAmount -> Bool
isMissingMixedAmount (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 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] -> [Text]
accountNamesFromPostings = Set Text -> [Text]
forall a. Set a -> [a]
S.toList (Set Text -> [Text])
-> ([Posting] -> Set Text) -> [Posting] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Set Text
forall a. Ord a => [a] -> Set a
S.fromList ([Text] -> Set Text)
-> ([Posting] -> [Text]) -> [Posting] -> Set Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Posting -> Text) -> [Posting] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Posting -> Text
paccount

-- | Sum all amounts from a list of postings.
sumPostings :: [Posting] -> MixedAmount
sumPostings :: [Posting] -> MixedAmount
sumPostings = (MixedAmount -> Posting -> MixedAmount)
-> MixedAmount -> [Posting] -> MixedAmount
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\MixedAmount
amt Posting
p -> MixedAmount -> MixedAmount -> MixedAmount
maPlus MixedAmount
amt (MixedAmount -> MixedAmount) -> MixedAmount -> MixedAmount
forall a b. (a -> b) -> a -> b
$ Posting -> MixedAmount
pamount Posting
p) MixedAmount
nullmixedamt

-- | Strip all prices from a Posting.
postingStripPrices :: Posting -> Posting
postingStripPrices :: Posting -> Posting
postingStripPrices = (MixedAmount -> MixedAmount) -> Posting -> Posting
postingTransformAmount MixedAmount -> MixedAmount
mixedAmountStripPrices

-- | 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 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 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} = case Status
s of
    Status
Unmarked -> Status -> (Transaction -> Status) -> Maybe Transaction -> Status
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Status
Unmarked Transaction -> Status
tstatus Maybe Transaction
mt
    Status
_ -> Status
s

-- | Tags for this posting including any inherited from its parent transaction.
postingAllTags :: Posting -> [Tag]
postingAllTags :: Posting -> [Tag]
postingAllTags 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 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 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 Posting
_ = []

-- | 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' WhichDate
PrimaryDate   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' WhichDate
SecondaryDate 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 :: Text -> PostingType
accountNamePostingType Text
a
    | Text -> Bool
T.null Text
a = PostingType
RegularPosting
    | Text -> Char
T.head Text
a Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'[' Bool -> Bool -> Bool
&& Text -> Char
T.last Text
a Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
']' = PostingType
BalancedVirtualPosting
    | Text -> Char
T.head Text
a Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'(' Bool -> Bool -> Bool
&& Text -> Char
T.last Text
a Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
')' = PostingType
VirtualPosting
    | Bool
otherwise = PostingType
RegularPosting

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

accountNameWithPostingType :: PostingType -> AccountName -> AccountName
accountNameWithPostingType :: PostingType -> Text -> Text
accountNameWithPostingType PostingType
BalancedVirtualPosting = Text -> Text -> Text -> Text
wrap Text
"[" Text
"]" (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
accountNameWithoutPostingType
accountNameWithPostingType PostingType
VirtualPosting         = Text -> Text -> Text -> Text
wrap Text
"(" Text
")" (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
accountNameWithoutPostingType
accountNameWithPostingType PostingType
RegularPosting         = Text -> Text
accountNameWithoutPostingType

-- | Prefix one account name to another, preserving posting type
-- indicators like concatAccountNames.
joinAccountNames :: AccountName -> AccountName -> AccountName
joinAccountNames :: Text -> Text -> Text
joinAccountNames Text
a Text
b = [Text] -> Text
concatAccountNames ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
T.null) [Text
a,Text
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 :: [Text] -> Text
concatAccountNames [Text]
as = PostingType -> Text -> Text
accountNameWithPostingType PostingType
t (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
T.intercalate Text
":" ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
accountNameWithoutPostingType [Text]
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
$ (Text -> PostingType) -> [Text] -> [PostingType]
forall a b. (a -> b) -> [a] -> [b]
map Text -> PostingType
accountNamePostingType [Text]
as

-- | Apply some account aliases to the posting's account name, as described by accountNameApplyAliases.
-- This can fail due to a bad replacement pattern in a regular expression alias.
postingApplyAliases :: [AccountAlias] -> Posting -> Either RegexError Posting
postingApplyAliases :: [AccountAlias] -> Posting -> Either RegexError Posting
postingApplyAliases [AccountAlias]
aliases p :: Posting
p@Posting{Text
paccount :: Text
paccount :: Posting -> Text
paccount} =
  case [AccountAlias] -> Text -> Either RegexError Text
accountNameApplyAliases [AccountAlias]
aliases Text
paccount of
    Right Text
a -> Posting -> Either RegexError Posting
forall a b. b -> Either a b
Right Posting
p{paccount :: Text
paccount=Text
a}
    Left RegexError
e  -> RegexError -> Either RegexError Posting
forall a b. a -> Either a b
Left RegexError
err
      where
        err :: RegexError
err = RegexError
"problem while applying account aliases:\n" RegexError -> RegexError -> RegexError
forall a. [a] -> [a] -> [a]
++ [AccountAlias] -> RegexError
forall a. Show a => a -> RegexError
pshow [AccountAlias]
aliases 
          RegexError -> RegexError -> RegexError
forall a. [a] -> [a] -> [a]
++ RegexError
"\n to account name: "RegexError -> RegexError -> RegexError
forall a. [a] -> [a] -> [a]
++Text -> RegexError
T.unpack Text
paccountRegexError -> RegexError -> RegexError
forall a. [a] -> [a] -> [a]
++RegexError
"\n "RegexError -> RegexError -> RegexError
forall a. [a] -> [a] -> [a]
++RegexError
e

-- | Choose and apply a consistent display style to the posting
-- amounts in each commodity (see journalCommodityStyles).
postingApplyCommodityStyles :: M.Map CommoditySymbol AmountStyle -> Posting -> Posting
postingApplyCommodityStyles :: Map Text AmountStyle -> Posting -> Posting
postingApplyCommodityStyles Map Text AmountStyle
styles Posting
p = Posting
p{pamount :: MixedAmount
pamount=Map Text AmountStyle -> MixedAmount -> MixedAmount
styleMixedAmount Map Text AmountStyle
styles (MixedAmount -> MixedAmount) -> MixedAmount -> MixedAmount
forall a b. (a -> b) -> a -> b
$ Posting -> MixedAmount
pamount Posting
p
                                        ,pbalanceassertion :: Maybe BalanceAssertion
pbalanceassertion=BalanceAssertion -> BalanceAssertion
fixbalanceassertion (BalanceAssertion -> BalanceAssertion)
-> Maybe BalanceAssertion -> Maybe BalanceAssertion
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Posting -> Maybe BalanceAssertion
pbalanceassertion Posting
p}
  where
    fixbalanceassertion :: BalanceAssertion -> BalanceAssertion
fixbalanceassertion BalanceAssertion
ba = BalanceAssertion
ba{baamount :: Amount
baamount=Map Text AmountStyle -> Amount -> Amount
styleAmountExceptPrecision Map Text AmountStyle
styles (Amount -> Amount) -> Amount -> Amount
forall a b. (a -> b) -> a -> b
$ BalanceAssertion -> Amount
baamount BalanceAssertion
ba}

-- | 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] -> Text -> Either RegexError Text
accountNameApplyAliases [AccountAlias]
aliases Text
a =
  let (Text
aname,PostingType
atype) = (Text -> Text
accountNameWithoutPostingType Text
a, Text -> PostingType
accountNamePostingType Text
a)
  in (Text -> AccountAlias -> Either RegexError Text)
-> Text -> [AccountAlias] -> Either RegexError Text
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM
     (\Text
acct AccountAlias
alias -> RegexError -> Either RegexError Text -> Either RegexError Text
forall a. Show a => RegexError -> a -> a
dbg6 RegexError
"result" (Either RegexError Text -> Either RegexError Text)
-> Either RegexError Text -> Either RegexError Text
forall a b. (a -> b) -> a -> b
$ AccountAlias -> Text -> Either RegexError Text
aliasReplace (RegexError -> AccountAlias -> AccountAlias
forall a. Show a => RegexError -> a -> a
dbg6 RegexError
"alias" AccountAlias
alias) (RegexError -> Text -> Text
forall a. Show a => RegexError -> a -> a
dbg6 RegexError
"account" Text
acct))
     Text
aname
     [AccountAlias]
aliases
     Either RegexError Text
-> (Text -> Either RegexError Text) -> Either RegexError Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Either RegexError Text
forall a b. b -> Either a b
Right (Text -> Either RegexError Text)
-> (Text -> Text) -> Text -> Either RegexError Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PostingType -> Text -> Text
accountNameWithPostingType PostingType
atype

-- | Memoising version of accountNameApplyAliases, maybe overkill.
accountNameApplyAliasesMemo :: [AccountAlias] -> AccountName -> Either RegexError AccountName
accountNameApplyAliasesMemo :: [AccountAlias] -> Text -> Either RegexError Text
accountNameApplyAliasesMemo [AccountAlias]
aliases = (Text -> Either RegexError Text) -> Text -> Either RegexError Text
forall a b. Ord a => (a -> b) -> a -> b
memo ([AccountAlias] -> Text -> Either RegexError Text
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 -> Text -> Either RegexError Text
aliasReplace (BasicAlias Text
old Text
new) Text
a
  | Text
old Text -> Text -> Bool
`isAccountNamePrefixOf` Text
a Bool -> Bool -> Bool
|| Text
old Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
a =
      Text -> Either RegexError Text
forall a b. b -> Either a b
Right (Text -> Either RegexError Text) -> Text -> Either RegexError Text
forall a b. (a -> b) -> a -> b
$ Text
new Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
T.drop (Text -> Int
T.length Text
old) Text
a
  | Bool
otherwise = Text -> Either RegexError Text
forall a b. b -> Either a b
Right Text
a
aliasReplace (RegexAlias Regexp
re RegexError
repl) Text
a =
  (RegexError -> Text)
-> Either RegexError RegexError -> Either RegexError Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RegexError -> Text
T.pack (Either RegexError RegexError -> Either RegexError Text)
-> (RegexError -> Either RegexError RegexError)
-> RegexError
-> Either RegexError Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Regexp -> RegexError -> RegexError -> Either RegexError RegexError
regexReplace Regexp
re RegexError
repl (RegexError -> Either RegexError Text)
-> RegexError -> Either RegexError Text
forall a b. (a -> b) -> a -> b
$ Text -> RegexError
T.unpack Text
a -- XXX

-- | Apply a specified valuation to this posting's amount, using the
-- provided price oracle, commodity styles, and reference dates.
-- See amountApplyValuation.
postingApplyValuation :: PriceOracle -> M.Map CommoditySymbol AmountStyle -> Day -> Day -> ValuationType -> Posting -> Posting
postingApplyValuation :: PriceOracle
-> Map Text AmountStyle
-> Day
-> Day
-> ValuationType
-> Posting
-> Posting
postingApplyValuation PriceOracle
priceoracle Map Text AmountStyle
styles Day
periodlast Day
today ValuationType
v Posting
p =
    (MixedAmount -> MixedAmount) -> Posting -> Posting
postingTransformAmount (PriceOracle
-> Map Text AmountStyle
-> Day
-> Day
-> Day
-> ValuationType
-> MixedAmount
-> MixedAmount
mixedAmountApplyValuation PriceOracle
priceoracle Map Text AmountStyle
styles Day
periodlast Day
today (Posting -> Day
postingDate Posting
p) ValuationType
v) Posting
p

-- | Convert this posting's amount to cost, and apply the appropriate amount styles.
postingToCost :: M.Map CommoditySymbol AmountStyle -> Posting -> Posting
postingToCost :: Map Text AmountStyle -> Posting -> Posting
postingToCost Map Text AmountStyle
styles = (MixedAmount -> MixedAmount) -> Posting -> Posting
postingTransformAmount (Map Text AmountStyle -> MixedAmount -> MixedAmount
styleMixedAmount Map Text AmountStyle
styles (MixedAmount -> MixedAmount)
-> (MixedAmount -> MixedAmount) -> MixedAmount -> MixedAmount
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MixedAmount -> MixedAmount
mixedAmountCost)

-- | Apply a transform function to this posting's amount.
postingTransformAmount :: (MixedAmount -> MixedAmount) -> Posting -> Posting
postingTransformAmount :: (MixedAmount -> MixedAmount) -> Posting -> Posting
postingTransformAmount 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 :: Text -> Text -> Text
commentJoin Text
c1 Text
c2
  | Text -> Bool
T.null Text
c1 = Text
c2
  | Text -> Bool
T.null Text
c2 = Text
c1
  | Bool
otherwise = Text
c1 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
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 :: Text -> Tag -> Text
commentAddTag Text
c (Text
t,Text
v)
  | Text -> Bool
T.null Text
c' = Text
tag
  | Bool
otherwise = Text
c' Text -> Text -> Text
`commentJoin` Text
tag
  where
    c' :: Text
c'  = Text -> Text
T.stripEnd Text
c
    tag :: Text
tag = Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
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 :: Text -> Tag -> Text
commentAddTagNextLine Text
cmt (Text
t,Text
v) =
  Text
cmt Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (if Text
"\n" Text -> Text -> Bool
`T.isSuffixOf` Text
cmt then Text
"" else Text
"\n") Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
v 


-- tests

tests_Posting :: TestTree
tests_Posting = RegexError -> [TestTree] -> TestTree
testGroup RegexError
"Posting" [

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

 ,RegexError -> Assertion -> TestTree
testCase RegexError
"accountNameWithoutPostingType" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
    Text -> Text
accountNameWithoutPostingType Text
"(a)" Text -> Text -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Text
"a"

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

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

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

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

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

 ]