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