lib/Hcompta/Model/Transaction/Posting.hs

   1 {-# LANGUAGE DeriveDataTypeable #-}
   2 {-# LANGUAGE ScopedTypeVariables #-}
   3 {-# OPTIONS_GHC -fno-warn-orphans #-}
   4 module Hcompta.Model.Transaction.Posting where
   5
   6 import           Data.Data
   7 import qualified Data.Foldable
   8 import qualified Data.List
   9 import qualified Data.Map.Strict as Data.Map
  10 import           Data.Text (Text)
  11 import           Data.Typeable ()
  12 import           Text.Parsec.Pos (SourcePos, initialPos)
  13
  14 import qualified Hcompta.Model.Account as Account ()
  15 import           Hcompta.Model.Account (Account)
  16 import qualified Hcompta.Model.Amount as Amount
  17 import           Hcompta.Model.Date (Date)
  18 import qualified Hcompta.Model.Transaction.Tag as Tag
  19
  20 -- * The 'Posting' type
  21
  22 data Posting
  23  =   Posting
  24  { account   :: Account
  25  , amounts   :: Amount.By_Unit
  26  , comments  :: [Comment]
  27  , dates     :: [Date]
  28  , sourcepos :: SourcePos
  29  , status    :: Bool
  30  , tags      :: Tag.By_Name
  31  } deriving (Data, Eq, Read, Show, Typeable)
  32
  33 type Comment = Text
  34
  35 instance Read SourcePos where
  36         readsPrec _ s = [(initialPos s, "")]
  37
  38 data Type
  39  =   Type_Regular
  40  |   Type_Virtual
  41  |   Type_Virtual_Balanced
  42  deriving (Data, Eq, Read, Show, Typeable)
  43
  44 -- ** Convenient constructors
  45
  46 nil :: Account -> Posting
  47 nil acct =
  48         Posting
  49          { account = acct
  50          , amounts = Data.Map.empty
  51          , comments = []
  52          , dates = []
  53          , status = False
  54          , sourcepos = initialPos ""
  55          , tags = Data.Map.empty
  56          }
  57
  58 -- * The 'By_Account' mapping
  59
  60 type By_Account
  61  = Data.Map.Map Account [Posting]
  62
  63 type By_Amount_and_Account
  64  = Data.Map.Map Amount.By_Unit By_Account
  65
  66 type By_Signs_and_Account
  67  = Data.Map.Map Amount.Signs By_Account
  68
  69 by_amount_and_account :: By_Account -> By_Amount_and_Account
  70 by_amount_and_account =
  71         Data.Map.foldlWithKey
  72          (flip (\acct ->
  73                 Data.List.foldl
  74                  (flip (\p ->
  75                         Data.Map.insertWith
  76                          (Data.Map.unionWith (++))
  77                          (amounts p)
  78                          (Data.Map.singleton acct [p])))))
  79          Data.Map.empty
  80
  81 by_signs_and_account :: By_Account -> By_Signs_and_Account
  82 by_signs_and_account =
  83         Data.Map.foldlWithKey
  84          (flip (\acct ->
  85                 Data.List.foldl
  86                  (flip (\p ->
  87                         Data.Map.insertWith
  88                          (Data.Map.unionWith (++))
  89                          (Amount.signs $ amounts p)
  90                          (Data.Map.singleton acct [p])))))
  91          Data.Map.empty
  92
  93 -- ** Convenient constructors
  94
  95 -- | Return a tuple associating the given 'Posting' with its 'Account'.
  96 by_account :: Posting -> (Account, Posting)
  97 by_account posting = (account posting, posting)
  98
  99 -- | Return a Data.'Data.Map.Map' associating the given 'Posting's with their respective 'Account'.
 100 from_List :: [Posting] -> By_Account
 101 from_List postings =
 102         Data.Map.fromListWith (flip (++)) $
 103         Data.List.map
 104          (\posting -> (account posting, [posting]))
 105          postings
 106
 107 -- * Collectors
 108
 109 -- | Return the 'Unit's in use within the given 'Posting's
 110 units
 111  :: Data.Foldable.Foldable m
 112  => m [Posting]
 113  -> [Amount.Unit]
 114 units =
 115         Data.Foldable.foldl'
 116          (\acc ->
 117                 Data.List.union acc .
 118                 Data.List.concatMap
 119                  (Data.Map.keys . amounts))
 120          []