lib/Hcompta/Model/Transaction/Posting.hs

   1 {-# LANGUAGE DeriveDataTypeable #-}
   2 {-# LANGUAGE ScopedTypeVariables #-}
   3 module Hcompta.Model.Transaction.Posting where
   4
   5 import           Data.Data
   6 import qualified Data.Foldable
   7 import qualified Data.List
   8 import qualified Data.Map
   9 import           Data.Map (Map)
  10 import           Data.Typeable ()
  11 import           Text.Parsec.Pos (SourcePos, initialPos)
  12
  13 import qualified Hcompta.Model.Account as Account
  14 import           Hcompta.Model.Account (Account)
  15 import qualified Hcompta.Model.Amount as Amount
  16 import           Hcompta.Model.Amount (Amount)
  17 import qualified Hcompta.Model.Date as Date
  18 import           Hcompta.Model.Date (Date)
  19 import qualified Hcompta.Model.Transaction.Tag as Tag
  20 import           Hcompta.Model.Transaction.Tag (Tag)
  21
  22 -- * The 'Posting' type
  23
  24 data Posting
  25  =   Posting
  26  { account   :: Account
  27  , amounts   :: Amount.By_Unit
  28  , comment   :: String
  29  , date      :: Date
  30  , date2     :: Maybe Date
  31  , status    :: Bool
  32  , sourcepos :: SourcePos
  33  , tags      :: Tag.By_Name
  34  , type_     :: Type
  35  } deriving (Data, Eq, Read, Show, Typeable)
  36
  37 instance Read SourcePos where
  38         readsPrec _ s = [(initialPos s, "")]
  39
  40 data Type
  41  =   Type_Regular
  42  |   Type_Virtual
  43  |   Type_Virtual_Balanced
  44  deriving (Data, Eq, Read, Show, Typeable)
  45
  46 -- ** Convenient constructors
  47
  48 nil :: Posting
  49 nil =
  50         Posting
  51          { account = []
  52          , amounts = Data.Map.empty
  53          , comment = ""
  54          , date = Date.nil
  55          , date2 = Nothing
  56          , status = False
  57          , sourcepos = initialPos ""
  58          , tags = Data.Map.empty
  59          , type_ = Type_Regular
  60          }
  61
  62 -- * The 'By_Account' mapping
  63
  64 type By_Account
  65  = Map Account [Posting]
  66
  67 -- ** Convenient constructors
  68
  69 -- | Return a tuple associating the given posting with its account.
  70 by_account :: Posting -> (Account, Posting)
  71 by_account posting = (account posting, posting)
  72
  73 -- | Return a 'Data.Map.Map' associating the given 'Posting's with their respective 'Unit'.
  74 from_List :: [Posting] -> By_Account
  75 from_List postings =
  76         Data.Map.fromListWith (++) $
  77         Data.List.map
  78          (\posting -> (account posting, [posting]))
  79          postings
  80
  81 -- * Collectors
  82
  83 -- | Return the units in use within the given postings
  84 units
  85  :: Data.Foldable.Foldable m
  86  => m [Posting]
  87  -> [Amount.Unit]
  88 units =
  89         Data.Foldable.foldl
  90          (\acc ->
  91                 Data.List.union acc .
  92                 Data.List.concatMap
  93                  (Data.Map.keys . amounts))
  94          []