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
  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 import qualified Hcompta.Stats as Stats
  35 import qualified Hcompta.Tag as Tag
  36
  37 type Code = Text
  38 type Description = Text
  39 type Status = Bool
  40 type Comment = Text
  41
  42 -- * The 'Journal' type
  43
  44 data Monoid ts => Journal ts
  45  =  Journal
  46  { journal_file           :: FilePath
  47  , journal_includes       :: [Journal ts]
  48  , journal_last_read_time :: Date
  49  , journal_transactions   :: !ts
  50  , journal_unit_styles    :: Map Amount.Unit Amount.Style
  51  } deriving (Data, Eq, Show, Typeable)
  52
  53 journal :: Monoid ts => Journal ts
  54 journal =
  55         Journal
  56          { journal_file = mempty
  57          , journal_includes = mempty
  58          , journal_last_read_time = Date.nil
  59          , journal_transactions = mempty
  60          , journal_unit_styles = mempty
  61          }
  62
  63 -- * The 'Transaction' type
  64
  65 data Transaction
  66  =   Transaction
  67  { transaction_code                      :: Code
  68  , transaction_comments_before           :: [Comment]
  69  , transaction_comments_after            :: [Comment]
  70  , transaction_dates                     :: (Date, [Date])
  71  , transaction_description               :: Description
  72  , transaction_postings                  :: Map Account [Posting]
  73  , transaction_virtual_postings          :: Map Account [Posting]
  74  , transaction_balanced_virtual_postings :: Map Account [Posting]
  75  , transaction_sourcepos                 :: SourcePos
  76  , transaction_status                    :: Status
  77  , transaction_tags                      :: Map Tag.Path [Tag.Value]
  78  } deriving (Data, Eq, Show, Typeable)
  79
  80 transaction :: Transaction
  81 transaction =
  82         Transaction
  83          { transaction_code = ""
  84          , transaction_comments_before = []
  85          , transaction_comments_after = []
  86          , transaction_dates = (Date.nil, [])
  87          , transaction_description = ""
  88          , transaction_postings = mempty
  89          , transaction_virtual_postings = mempty
  90          , transaction_balanced_virtual_postings = mempty
  91          , transaction_sourcepos = initialPos ""
  92          , transaction_status = False
  93          , transaction_tags = mempty
  94          }
  95
  96 instance Filter.Transaction Transaction where
  97         type Transaction_Posting  Transaction = Posting
  98         type Transaction_Postings Transaction = Compose [] (Compose (Map Account) [])
  99         transaction_date        = fst . transaction_dates
 100         transaction_description = transaction_description
 101         transaction_postings t  =
 102                 Compose
 103                  [ Compose $ transaction_postings t
 104                  ]
 105         transaction_postings_virtual t  =
 106                 Compose
 107                  [ Compose $ transaction_virtual_postings t
 108                  , Compose $ transaction_balanced_virtual_postings t
 109                  ]
 110         transaction_tags        = transaction_tags
 111
 112 instance Journal.Transaction Transaction where
 113         transaction_date = fst . transaction_dates
 114
 115 instance Stats.Transaction  Transaction where
 116         type Transaction_Posting  Transaction = Posting
 117         type Transaction_Postings Transaction = Compose [] (Compose (Map Account) [])
 118         transaction_date = fst . transaction_dates
 119         transaction_postings t =
 120                 Compose
 121                  [ Compose $ transaction_postings t
 122                  , Compose $ transaction_virtual_postings t
 123                  , Compose $ transaction_balanced_virtual_postings t
 124                  ]
 125         transaction_postings_size t =
 126                 Data.Map.size (transaction_postings t) +
 127                 Data.Map.size (transaction_virtual_postings t) +
 128                 Data.Map.size (transaction_balanced_virtual_postings t)
 129         transaction_tags =
 130                 transaction_tags
 131
 132 instance GL.Transaction     Transaction where
 133         type Transaction_Posting  Transaction = Posting
 134         type Transaction_Postings Transaction = Compose [] (Compose (Map Account) [])
 135         transaction_date = fst . transaction_dates
 136         transaction_postings t =
 137                 Compose
 138                  [ Compose $ transaction_postings t
 139                  , Compose $ transaction_virtual_postings t
 140                  , Compose $ transaction_balanced_virtual_postings t
 141                  ]
 142         transaction_postings_filter f t =
 143                 t{ transaction_postings =
 144                         Data.Map.mapMaybe
 145                          (\p -> case filter f p of
 146                                  [] -> Nothing
 147                                  ps -> Just ps)
 148                          (transaction_postings t)
 149                  , transaction_virtual_postings =
 150                         Data.Map.mapMaybe
 151                          (\p -> case filter f p of
 152                                  [] -> Nothing
 153                                  ps -> Just ps)
 154                          (transaction_virtual_postings t)
 155                  , transaction_balanced_virtual_postings =
 156                         Data.Map.mapMaybe
 157                          (\p -> case filter f p of
 158                                  [] -> Nothing
 159                                  ps -> Just ps)
 160                          (transaction_balanced_virtual_postings t)
 161                  }
 162
 163 -- | Return a 'Data.Map.Map' associating
 164 --   the given 'Transaction's with their respective 'Date'.
 165 transaction_by_Date :: [Transaction] -> (Compose (Map Date) []) Transaction
 166 transaction_by_Date =
 167         Compose .
 168         Data.Map.fromListWith (flip (++)) .
 169         Data.List.map (\t -> (fst $ transaction_dates t, [t]))
 170
 171 -- * The 'Posting' type
 172
 173 data Posting
 174  =   Posting
 175  { posting_account   :: Account
 176  , posting_amounts   :: Map Amount.Unit Amount
 177  , posting_comments  :: [Comment]
 178  , posting_dates     :: [Date]
 179  , posting_sourcepos :: SourcePos
 180  , posting_status    :: Bool
 181  , posting_tags      :: Map Tag.Path [Tag.Value]
 182  } deriving (Data, Eq, Show, Typeable)
 183
 184 posting :: Account -> Posting
 185 posting acct =
 186         Posting
 187          { posting_account = acct
 188          , posting_amounts = mempty
 189          , posting_comments = mempty
 190          , posting_dates = mempty
 191          , posting_status = False
 192          , posting_sourcepos = initialPos ""
 193          , posting_tags = mempty
 194          }
 195
 196 instance Balance.Posting Posting where
 197         type Posting_Amount    Posting = Amount.Sum Amount
 198         posting_account = posting_account
 199         posting_amounts = Data.Map.map Amount.sum . posting_amounts
 200         posting_set_amounts amounts p =
 201                 p { posting_amounts=Data.Map.map Amount.sum_balance amounts }
 202
 203 instance Filter.Posting Posting where
 204         type Posting_Amount   Posting = Amount
 205         posting_account = posting_account
 206         posting_amounts = posting_amounts
 207         posting_type    = undefined
 208          -- NOTE: the posting_type will be given to Filter.test
 209          --       through instance Posting p => Posting (Posting_Type, p)
 210          --       by Filter.transaction_postings
 211          --       and Filter.transaction_postings_virtual
 212
 213 instance GL.Posting   Posting where
 214         type Posting_Amount Posting = Amount.Sum (Map Amount.Unit Amount)
 215         posting_account = posting_account
 216         posting_amount  = Amount.sum . posting_amounts
 217
 218 instance Stats.Posting Posting where
 219         type Posting_Amount  Posting = Amount
 220         posting_account = posting_account
 221         posting_amounts = posting_amounts
 222
 223 -- ** The 'Posting' mappings
 224
 225 type Posting_by_Account
 226  = Map Account [Posting]
 227
 228 type Posting_by_Amount_and_Account
 229  = Map Amount.By_Unit Posting_by_Account
 230
 231 type Posting_by_Signs_and_Account
 232  = Map Amount.Signs Posting_by_Account
 233
 234 -- | Return a Data.'Data.Map.Map' associating the given 'Posting's with their respective 'Account'.
 235 posting_by_Account :: [Posting] -> Posting_by_Account
 236 posting_by_Account =
 237         Data.Map.fromListWith (flip (++)) .
 238         Data.List.map
 239          (\p -> (posting_account p, [p]))
 240
 241 posting_by_Amount_and_Account :: Posting_by_Account -> Posting_by_Amount_and_Account
 242 posting_by_Amount_and_Account =
 243         Data.Map.foldlWithKey
 244          (flip (\acct ->
 245                 Data.List.foldl'
 246                  (flip (\p ->
 247                         Data.Map.insertWith
 248                          (Data.Map.unionWith (++))
 249                          (posting_amounts p)
 250                          (Data.Map.singleton acct [p])))))
 251          mempty
 252
 253 posting_by_Signs_and_Account :: Posting_by_Account -> Posting_by_Signs_and_Account
 254 posting_by_Signs_and_Account =
 255         Data.Map.foldlWithKey
 256          (flip (\acct ->
 257                 Data.List.foldl'
 258                  (flip (\p ->
 259                         Data.Map.insertWith
 260                          (Data.Map.unionWith (++))
 261                          (Amount.signs $ posting_amounts p)
 262                          (Data.Map.singleton acct [p])))))
 263          mempty