lib/Hcompta/Format/Ledger.hs

   1 {-# LANGUAGE DeriveDataTypeable #-}
   2 {-# LANGUAGE FlexibleInstances #-}
   3 {-# LANGUAGE NamedFieldPuns #-}
   4 {-# LANGUAGE OverloadedStrings #-}
   5 {-# LANGUAGE TypeFamilies #-}
   6 module Hcompta.Format.Ledger where
   7
   8 import           Data.Data (Data(..))
   9 import           Data.Functor.Compose (Compose(..))
  10 import qualified Data.List as Data.List
  11 import           Data.Map.Strict (Map)
  12 import qualified Data.Map.Strict as Data.Map
  13 import           Data.Text (Text)
  14 import qualified Data.Time.Clock       as Time
  15 import qualified Data.Time.Clock.POSIX as Time
  16 import           Data.Typeable (Typeable)
  17 import           Text.Parsec.Pos (SourcePos, initialPos)
  18
  19 import           Hcompta.Account (Account)
  20 import           Hcompta.Amount (Amount)
  21 import qualified Hcompta.Amount as Amount
  22 import qualified Hcompta.Balance as Balance
  23 import           Hcompta.Date (Date)
  24 import qualified Hcompta.Date as Date
  25 import qualified Hcompta.Filter as Filter
  26 import           Hcompta.Lib.Parsec ()
  27 import qualified Hcompta.GL as GL
  28
  29 type Code = Text
  30 type Description = Text
  31 type Status = Bool
  32 type Comment = Text
  33
  34 -- * The 'Journal' type
  35
  36 data Journal
  37  =   Journal
  38  { journal_file           :: FilePath
  39  , journal_includes       :: [Journal]
  40  , journal_last_read_time :: Time.UTCTime
  41  , journal_transactions   :: Map Date [Transaction]
  42  , journal_unit_styles    :: Map Amount.Unit Amount.Style
  43  } deriving (Data, Eq, Show, Typeable)
  44
  45 journal :: Journal
  46 journal =
  47         Journal
  48          { journal_file = ""
  49          , journal_includes = []
  50          , journal_last_read_time = Time.posixSecondsToUTCTime 0
  51          , journal_transactions = Data.Map.empty
  52          , journal_unit_styles = Data.Map.empty
  53          }
  54
  55 -- * The 'Transaction' type
  56
  57 data Transaction
  58  =   Transaction
  59  { transaction_code                      :: Code
  60  , transaction_comments_before           :: [Comment]
  61  , transaction_comments_after            :: [Comment]
  62  , transaction_dates                     :: (Date, [Date])
  63  , transaction_description               :: Description
  64  , transaction_postings                  :: Posting_by_Account
  65  , transaction_virtual_postings          :: Posting_by_Account
  66  , transaction_balanced_virtual_postings :: Posting_by_Account
  67  , transaction_sourcepos                 :: SourcePos
  68  , transaction_status                    :: Status
  69  , transaction_tags                      :: Tag_by_Name
  70  } deriving (Data, Eq, Show, Typeable)
  71
  72 transaction :: Transaction
  73 transaction =
  74         Transaction
  75          { transaction_code = ""
  76          , transaction_comments_before = []
  77          , transaction_comments_after = []
  78          , transaction_dates = (Date.nil, [])
  79          , transaction_description = ""
  80          , transaction_postings = Data.Map.empty
  81          , transaction_virtual_postings = Data.Map.empty
  82          , transaction_balanced_virtual_postings = Data.Map.empty
  83          , transaction_sourcepos = initialPos ""
  84          , transaction_status = False
  85          , transaction_tags = Data.Map.empty
  86          }
  87
  88 instance Filter.Transaction Transaction where
  89         type Transaction_Posting Transaction = Posting
  90         transaction_date        = fst . transaction_dates
  91         transaction_description = transaction_description
  92         transaction_postings    = transaction_postings
  93         transaction_tags        = transaction_tags
  94
  95 {-
  96 instance Filter.GL (GL.GL_Line Transaction) where
  97         type GL_Amount (GL.GL_Line Transaction) = Amount
  98         register_account         = GL.posting_account  . GL.register_line_posting
  99         register_date            = GL.transaction_date . GL.register_line_transaction
 100         register_amount_positive = Amount.sum_positive . GL.posting_amount . GL.register_line_posting
 101         register_amount_negative = Amount.sum_negative . GL.posting_amount . GL.register_line_posting
 102         register_amount_balance  = Amount.sum_balance  . GL.posting_amount . GL.register_line_posting
 103         register_sum_positive    = Amount.sum_positive . GL.register_line_sum
 104         register_sum_negative    = Amount.sum_negative . GL.register_line_sum
 105         register_sum_balance     = Amount.sum_balance  . GL.register_line_sum
 106 -}
 107
 108 instance GL.Transaction Transaction where
 109         type Transaction_Posting  Transaction = Posting
 110         type Transaction_Postings Transaction = Compose (Map Account) []
 111         transaction_date     = fst . transaction_dates
 112         transaction_postings = Compose . transaction_postings
 113
 114 -- | Return a 'Data.Map.Map' associating
 115 --   the given 'Transaction's with their respective 'Date'.
 116 transaction_by_Date :: [Transaction] -> Map Date [Transaction]
 117 transaction_by_Date =
 118         Data.Map.fromListWith (flip (++)) .
 119         Data.List.map (\t -> (fst $ transaction_dates t, [t]))
 120
 121 -- * The 'Posting' type
 122
 123 data Posting
 124  =   Posting
 125  { posting_account   :: Account
 126  , posting_amounts   :: Map Amount.Unit Amount
 127  , posting_comments  :: [Comment]
 128  , posting_dates     :: [Date]
 129  , posting_sourcepos :: SourcePos
 130  , posting_status    :: Bool
 131  , posting_tags      :: Tag_by_Name
 132  } deriving (Data, Eq, Show, Typeable)
 133
 134 data Posting_Type
 135  =   Posting_Type_Regular
 136  |   Posting_Type_Virtual
 137  |   Posting_Type_Virtual_Balanced
 138  deriving (Data, Eq, Read, Show, Typeable)
 139
 140 posting :: Account -> Posting
 141 posting acct =
 142         Posting
 143          { posting_account = acct
 144          , posting_amounts = Data.Map.empty
 145          , posting_comments = []
 146          , posting_dates = []
 147          , posting_status = False
 148          , posting_sourcepos = initialPos ""
 149          , posting_tags = Data.Map.empty
 150          }
 151
 152 instance
 153  Balance.Posting Posting where
 154         type Posting_Amount Posting = Amount.Sum Amount
 155         posting_account = posting_account
 156         posting_amounts = Data.Map.map Amount.sum . posting_amounts
 157         posting_set_amounts amounts p =
 158                 p { posting_amounts=Data.Map.map Amount.sum_balance amounts }
 159
 160 instance Filter.Posting Posting where
 161         type Posting_Amount Posting = Amount
 162         posting_account = posting_account
 163         posting_amounts = posting_amounts
 164
 165 instance GL.Posting Posting where
 166         type Posting_Amount Posting = Amount.Sum (Map Amount.Unit Amount)
 167         posting_account = posting_account
 168         posting_amount  = Amount.sum . posting_amounts
 169
 170 -- ** The 'Posting' mappings
 171
 172 type Posting_by_Account
 173  = Map Account [Posting]
 174
 175 type Posting_by_Amount_and_Account
 176  = Map Amount.By_Unit Posting_by_Account
 177
 178 type Posting_by_Signs_and_Account
 179  = Map Amount.Signs Posting_by_Account
 180
 181 -- | Return a Data.'Data.Map.Map' associating the given 'Posting's with their respective 'Account'.
 182 posting_by_Account :: [Posting] -> Posting_by_Account
 183 posting_by_Account =
 184         Data.Map.fromListWith (flip (++)) .
 185         Data.List.map
 186          (\p -> (posting_account p, [p]))
 187
 188 posting_by_Amount_and_Account :: Posting_by_Account -> Posting_by_Amount_and_Account
 189 posting_by_Amount_and_Account =
 190         Data.Map.foldlWithKey
 191          (flip (\acct ->
 192                 Data.List.foldl
 193                  (flip (\p ->
 194                         Data.Map.insertWith
 195                          (Data.Map.unionWith (++))
 196                          (posting_amounts p)
 197                          (Data.Map.singleton acct [p])))))
 198          Data.Map.empty
 199
 200 posting_by_Signs_and_Account :: Posting_by_Account -> Posting_by_Signs_and_Account
 201 posting_by_Signs_and_Account =
 202         Data.Map.foldlWithKey
 203          (flip (\acct ->
 204                 Data.List.foldl
 205                  (flip (\p ->
 206                         Data.Map.insertWith
 207                          (Data.Map.unionWith (++))
 208                          (Amount.signs $ posting_amounts p)
 209                          (Data.Map.singleton acct [p])))))
 210          Data.Map.empty
 211
 212 -- * The 'Tag' type
 213
 214 type Tag = (Tag_Name, Tag_Value)
 215 type Tag_Name = Text
 216 type Tag_Value = Text
 217
 218 type Tag_by_Name = Map Tag_Name [Tag_Value]
 219
 220 -- | Return a 'Data.Map.Map' associating the 'Value's of the given 'Tag's with their respective 'Name'.
 221 tag_by_Name :: [Tag] -> Tag_by_Name
 222 tag_by_Name =
 223         Data.Map.fromListWith (flip (++)) .
 224         Data.List.map (\(n, v) -> (n, [v]))