{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE ScopedTypeVariables #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Hcompta.Model.Transaction.Posting where import Data.Data import qualified Data.Foldable import qualified Data.List import qualified Data.Map.Strict as Data.Map import Data.Text (Text) import Data.Typeable () import Text.Parsec.Pos (SourcePos, initialPos) import qualified Hcompta.Model.Account as Account () import Hcompta.Model.Account (Account) import qualified Hcompta.Model.Amount as Amount import Hcompta.Model.Date (Date) import qualified Hcompta.Model.Transaction.Tag as Tag -- * The 'Posting' type data Posting = Posting { account :: Account , amounts :: Amount.By_Unit , comments :: [Comment] , dates :: [Date] , sourcepos :: SourcePos , status :: Bool , tags :: Tag.By_Name } deriving (Data, Eq, Read, Show, Typeable) type Comment = Text instance Read SourcePos where readsPrec _ s = [(initialPos s, "")] data Type = Type_Regular | Type_Virtual | Type_Virtual_Balanced deriving (Data, Eq, Read, Show, Typeable) -- ** Convenient constructors nil :: Account -> Posting nil acct = Posting { account = acct , amounts = Data.Map.empty , comments = [] , dates = [] , status = False , sourcepos = initialPos "" , tags = Data.Map.empty } -- * The 'By_Account' mapping type By_Account = Data.Map.Map Account [Posting] type By_Amount_and_Account = Data.Map.Map Amount.By_Unit By_Account type By_Signs_and_Account = Data.Map.Map Amount.Signs By_Account by_amount_and_account :: By_Account -> By_Amount_and_Account by_amount_and_account = Data.Map.foldlWithKey (flip (\acct -> Data.List.foldl (flip (\p -> Data.Map.insertWith (Data.Map.unionWith (++)) (amounts p) (Data.Map.singleton acct [p]))))) Data.Map.empty by_signs_and_account :: By_Account -> By_Signs_and_Account by_signs_and_account = Data.Map.foldlWithKey (flip (\acct -> Data.List.foldl (flip (\p -> Data.Map.insertWith (Data.Map.unionWith (++)) (Amount.signs $ amounts p) (Data.Map.singleton acct [p]))))) Data.Map.empty -- ** Convenient constructors -- | Return a tuple associating the given 'Posting' with its 'Account'. by_account :: Posting -> (Account, Posting) by_account posting = (account posting, posting) -- | Return a Data.'Data.Map.Map' associating the given 'Posting's with their respective 'Account'. from_List :: [Posting] -> By_Account from_List postings = Data.Map.fromListWith (flip (++)) $ Data.List.map (\posting -> (account posting, [posting])) postings -- * Collectors -- | Return the 'Unit's in use within the given 'Posting's units :: Data.Foldable.Foldable m => m [Posting] -> [Amount.Unit] units = Data.Foldable.foldl' (\acc -> Data.List.union acc . Data.List.concatMap (Data.Map.keys . amounts)) []