lib/Hcompta/Model/Transaction.hs

   1 {-# LANGUAGE DeriveDataTypeable #-}
   2 {-# LANGUAGE OverloadedStrings #-}
   3 {-# OPTIONS_GHC -fno-warn-orphans #-}
   4 module Hcompta.Model.Transaction where
   5
   6 import           Data.Data
   7 import qualified Data.List
   8 import qualified Data.Map.Strict as Data.Map
   9 import           Data.Text (Text)
  10 import           Data.Typeable ()
  11 import           Text.Parsec.Pos (SourcePos, initialPos)
  12
  13 import qualified Hcompta.Model.Date as Date
  14 import           Hcompta.Model.Date (Date)
  15 import qualified Hcompta.Model.Transaction.Posting as Posting
  16 import qualified Hcompta.Model.Transaction.Tag as Tag
  17
  18 -- * The 'Transaction' type
  19
  20 data Transaction
  21  =   Transaction
  22  { code                      :: Code
  23  , comments_before           :: [Comment]
  24  , comments_after            :: [Comment]
  25  , dates                     :: (Date, [Date])
  26  , description               :: Description
  27  , postings                  :: Posting.By_Account
  28  , virtual_postings          :: Posting.By_Account
  29  , balanced_virtual_postings :: Posting.By_Account
  30  , sourcepos                 :: SourcePos
  31  , status                    :: Status
  32  , tags                      :: Tag.By_Name
  33  } deriving (Data, Eq, Read, Show, Typeable)
  34
  35 type Code = Text
  36 type Comment = Posting.Comment
  37 type Description = Text
  38 type Status = Bool
  39
  40 nil :: Transaction
  41 nil =
  42         Transaction
  43          { code = ""
  44          , comments_before = []
  45          , comments_after = []
  46          , dates = (Date.nil, [])
  47          , description = ""
  48          , postings = Data.Map.empty
  49          , virtual_postings = Data.Map.empty
  50          , balanced_virtual_postings = Data.Map.empty
  51          , sourcepos = initialPos ""
  52          , status = False
  53          , tags = Data.Map.empty
  54          }
  55
  56 -- * Types to submodules
  57
  58 type Posting = Posting.Posting
  59 type Tag     = Tag.Tag
  60
  61 -- * The 'By_Date' mapping
  62
  63 type By_Date
  64  = Data.Map.Map Date.UTC [Transaction]
  65
  66 -- ** Convenient constructors
  67
  68 -- | Return a tuple associating the given 'Transaction' with its 'Date'.
  69 by_date :: Transaction -> (Date.UTC, Transaction)
  70 by_date t = (Date.to_UTC $ fst $ dates t, t)
  71
  72 -- | Return a Data.'Data.Map.Map' associating the given 'Transaction's with their respective 'Date'.
  73 from_List :: [Transaction] -> By_Date
  74 from_List =
  75         Data.Map.fromListWith (++) . -- TODO: check order is preserved on equality, or flip (++)
  76         Data.List.map (\t -> (Date.to_UTC $ fst $ dates t, [t]))