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