lib/Hcompta/Format/Ledger.hs

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