lib/Hcompta/Format/Ledger.hs

   1 {-# LANGUAGE BangPatterns #-}
   2 {-# LANGUAGE DeriveDataTypeable #-}
   3 {-# LANGUAGE FlexibleInstances #-}
   4 {-# LANGUAGE MultiParamTypeClasses #-}
   5 {-# LANGUAGE NamedFieldPuns #-}
   6 {-# LANGUAGE OverloadedStrings #-}
   7 {-# LANGUAGE TupleSections #-}
   8 {-# LANGUAGE TypeFamilies #-}
   9 {-# OPTIONS_GHC -fno-warn-orphans #-}
  10 module Hcompta.Format.Ledger where
  11
  12 -- import           Control.Applicative (Const(..))
  13 import           Data.Bool
  14 import           Data.Data (Data(..))
  15 import           Data.Eq (Eq(..))
  16 import           Data.Functor (Functor(..))
  17 import           Data.Functor.Compose (Compose(..))
  18 import           Data.List
  19 import           Data.Map.Strict (Map)
  20 import qualified Data.Map.Strict as Data.Map
  21 import           Data.Maybe (Maybe(..))
  22 import           Data.Monoid (Monoid(..))
  23 import           Data.Text (Text)
  24 import           Data.Tuple (fst, snd)
  25 import           Data.Typeable (Typeable)
  26 import           Prelude (($), (.), FilePath, Num(..), flip, undefined)
  27 import           Text.Parsec.Pos (SourcePos, initialPos)
  28 import           Text.Show (Show)
  29
  30 import qualified Hcompta.Account as Account
  31 import           Hcompta.Amount (Amount)
  32 import qualified Hcompta.Amount as Amount
  33 -- import           Hcompta.Balance (Balance(..))
  34 import qualified Hcompta.Balance as Balance
  35 import           Hcompta.Chart (Chart)
  36 import qualified Hcompta.Chart as Chart
  37 import           Hcompta.Date (Date)
  38 import qualified Hcompta.Date as Date
  39 import qualified Hcompta.Filter as Filter
  40 -- import           Hcompta.GL (GL(..))
  41 import qualified Hcompta.GL as GL
  42 import qualified Hcompta.Journal as Journal
  43 -- import           Hcompta.Lib.Consable
  44 import           Hcompta.Lib.Parsec ()
  45 import qualified Hcompta.Stats as Stats
  46 import qualified Hcompta.Tag as Tag
  47
  48 type Code = Text
  49 type Description = Text
  50 type Status = Bool
  51 type Comment = Text
  52
  53 -- * Type 'Account'
  54
  55 {-
  56 data Account
  57  =   Account
  58  { account_path :: Account.Account_Path
  59  , account_tags :: Tag.Tags
  60  }
  61
  62 -}
  63
  64 -- * Type 'Journal'
  65
  66 data Monoid ts => Journal ts
  67  =  Journal
  68  { journal_file           :: FilePath
  69  , journal_includes       :: [Journal ts]
  70  , journal_last_read_time :: Date
  71  , journal_sections       :: !ts
  72  , journal_unit_styles    :: Map Amount.Unit Amount.Style
  73  , journal_chart          :: Chart
  74  } deriving (Data, Eq, Show, Typeable)
  75
  76 journal :: Monoid ts => Journal ts
  77 journal =
  78         Journal
  79          { journal_file = mempty
  80          , journal_includes = mempty
  81          , journal_last_read_time = Date.nil
  82          , journal_sections = mempty
  83          , journal_unit_styles = mempty
  84          , journal_chart = mempty
  85          }
  86
  87 -- * Type 'Transaction'
  88
  89 data Transaction
  90  =   Transaction
  91  { transaction_code                      :: Code
  92  , transaction_comments_before           :: [Comment]
  93  , transaction_comments_after            :: [Comment]
  94  , transaction_dates                     :: (Date, [Date])
  95  , transaction_description               :: Description
  96  , transaction_postings                  :: Map Account.Account_Path [Posting]
  97  , transaction_virtual_postings          :: Map Account.Account_Path [Posting]
  98  , transaction_balanced_virtual_postings :: Map Account.Account_Path [Posting]
  99  , transaction_sourcepos                 :: SourcePos
 100  , transaction_status                    :: Status
 101  , transaction_tags                      :: Tag.Tags
 102  } deriving (Data, Eq, Show, Typeable)
 103
 104 transaction :: Transaction
 105 transaction =
 106         Transaction
 107          { transaction_code = ""
 108          , transaction_comments_before = []
 109          , transaction_comments_after = []
 110          , transaction_dates = (Date.nil, [])
 111          , transaction_description = ""
 112          , transaction_postings = mempty
 113          , transaction_virtual_postings = mempty
 114          , transaction_balanced_virtual_postings = mempty
 115          , transaction_sourcepos = initialPos ""
 116          , transaction_status = False
 117          , transaction_tags = mempty
 118          }
 119
 120 instance Filter.Transaction (Chart, Transaction) where
 121         type Transaction_Posting  (Chart, Transaction) = (Chart, Posting)
 122         type Transaction_Postings (Chart, Transaction) = Compose [] (Compose (Map Account.Account_Path) [])
 123         transaction_date        = fst . transaction_dates . snd
 124         transaction_description = transaction_description . snd
 125         transaction_postings (c, t)  =
 126                 fmap (c,) $
 127                 Compose
 128                  [ Compose $ transaction_postings t
 129                  ]
 130         transaction_postings_virtual (c, t) =
 131                 fmap (c,) $
 132                 Compose
 133                  [ Compose $ transaction_virtual_postings t
 134                  , Compose $ transaction_balanced_virtual_postings t
 135                  ]
 136         transaction_tags = transaction_tags . snd
 137
 138 --instance Journal.Transaction Transaction where
 139 --      transaction_date = fst . transaction_dates
 140 instance Journal.Transaction (Chart, Transaction) where
 141         transaction_date = fst . transaction_dates . snd
 142
 143 instance Stats.Transaction  Transaction where
 144         type Transaction_Posting  Transaction = Posting
 145         type Transaction_Postings Transaction = Compose [] (Compose (Map Account.Account_Path) [])
 146         transaction_date = fst . transaction_dates
 147         transaction_postings t =
 148                 Compose
 149                  [ Compose $ transaction_postings t
 150                  , Compose $ transaction_virtual_postings t
 151                  , Compose $ transaction_balanced_virtual_postings t
 152                  ]
 153         transaction_postings_size t =
 154                 Data.Map.size (transaction_postings t) +
 155                 Data.Map.size (transaction_virtual_postings t) +
 156                 Data.Map.size (transaction_balanced_virtual_postings t)
 157         transaction_tags = transaction_tags
 158 instance Stats.Transaction  (Chart, Transaction) where
 159         type Transaction_Posting  (Chart, Transaction) = Stats.Transaction_Posting  Transaction
 160         type Transaction_Postings (Chart, Transaction) = Stats.Transaction_Postings Transaction
 161         transaction_date = Stats.transaction_date . snd
 162         transaction_postings = Stats.transaction_postings . snd
 163         transaction_postings_size = Stats.transaction_postings_size . snd
 164         transaction_tags = Stats.transaction_tags . snd
 165
 166 instance GL.Transaction     Transaction where
 167         type Transaction_Posting  Transaction = Posting
 168         type Transaction_Postings Transaction = Compose [] (Compose (Map Account.Account_Path) [])
 169         transaction_date = fst . transaction_dates
 170         transaction_postings t =
 171                 Compose
 172                  [ Compose $ transaction_postings t
 173                  , Compose $ transaction_virtual_postings t
 174                  , Compose $ transaction_balanced_virtual_postings t
 175                  ]
 176         transaction_postings_filter f t =
 177                 t{ transaction_postings =
 178                         Data.Map.mapMaybe
 179                          (\p -> case filter f p of
 180                                  [] -> Nothing
 181                                  ps -> Just ps)
 182                          (transaction_postings t)
 183                  , transaction_virtual_postings =
 184                         Data.Map.mapMaybe
 185                          (\p -> case filter f p of
 186                                  [] -> Nothing
 187                                  ps -> Just ps)
 188                          (transaction_virtual_postings t)
 189                  , transaction_balanced_virtual_postings =
 190                         Data.Map.mapMaybe
 191                          (\p -> case filter f p of
 192                                  [] -> Nothing
 193                                  ps -> Just ps)
 194                          (transaction_balanced_virtual_postings t)
 195                  }
 196 instance GL.Transaction     (Chart, Transaction) where
 197         type Transaction_Posting  (Chart, Transaction) = (Chart, GL.Transaction_Posting  Transaction)
 198         type Transaction_Postings (Chart, Transaction) = GL.Transaction_Postings Transaction
 199         transaction_date = GL.transaction_date . snd
 200         transaction_postings (c, t) = fmap (c,) $ GL.transaction_postings t
 201         transaction_postings_filter f (c, t) =
 202                 (c, t{ transaction_postings =
 203                         Data.Map.mapMaybe
 204                          (\p -> case filter f $ fmap (c,) p of
 205                                  [] -> Nothing
 206                                  ps -> Just $ fmap snd ps)
 207                          (transaction_postings t)
 208                  , transaction_virtual_postings =
 209                         Data.Map.mapMaybe
 210                          (\p -> case filter f $ fmap (c,) p of
 211                                  [] -> Nothing
 212                                  ps -> Just $ fmap snd ps)
 213                          (transaction_virtual_postings t)
 214                  , transaction_balanced_virtual_postings =
 215                         Data.Map.mapMaybe
 216                          (\p -> case filter f $ fmap (c,) p of
 217                                  [] -> Nothing
 218                                  ps -> Just $ fmap snd ps)
 219                          (transaction_balanced_virtual_postings t)
 220                  })
 221
 222 -- | Return a 'Data.Map.Map' associating
 223 --   the given 'Transaction's with their respective 'Date'.
 224 transaction_by_Date :: [Transaction] -> (Compose (Map Date) []) Transaction
 225 transaction_by_Date =
 226         Compose .
 227         Data.Map.fromListWith (flip (++)) .
 228         Data.List.map (\t -> (fst $ transaction_dates t, [t]))
 229
 230 -- * Type 'Posting'
 231
 232 data Posting
 233  =   Posting
 234  { posting_account   :: Account.Account_Path
 235  , posting_amounts   :: Map Amount.Unit Amount
 236  , posting_comments  :: [Comment]
 237  , posting_dates     :: [Date]
 238  , posting_sourcepos :: SourcePos
 239  , posting_status    :: Bool
 240  , posting_tags      :: Tag.Tags
 241  } deriving (Data, Eq, Show, Typeable)
 242
 243 instance Filter.Account (Chart, Account.Account_Path) where
 244         account_path = snd
 245         account_tags (c, a) = Chart.account_tags a c
 246
 247 posting :: Account.Account_Path -> Posting
 248 posting acct =
 249         Posting
 250          { posting_account = acct
 251          , posting_amounts = mempty
 252          , posting_comments = mempty
 253          , posting_dates = mempty
 254          , posting_status = False
 255          , posting_sourcepos = initialPos ""
 256          , posting_tags = mempty
 257          }
 258
 259 instance Balance.Posting Posting where
 260         type Posting_Amount    Posting = Amount.Sum Amount
 261         posting_account = posting_account
 262         posting_amounts = Data.Map.map Amount.sum . posting_amounts
 263         posting_set_amounts amounts p =
 264                 p { posting_amounts=Data.Map.map Amount.sum_balance amounts }
 265
 266 instance Balance.Posting (Chart, Posting) where
 267         type Posting_Amount    (Chart, Posting) = Amount.Sum Amount
 268         posting_account = posting_account . snd
 269         posting_amounts = Data.Map.map Amount.sum . posting_amounts . snd
 270         posting_set_amounts amounts (c, p) =
 271                 (c, p { posting_amounts=Data.Map.map Amount.sum_balance amounts })
 272
 273 instance Filter.Posting (Chart, Posting) where
 274         type Posting_Account  (Chart, Posting) = (Chart, Account.Account_Path)
 275         type Posting_Amount   (Chart, Posting) = Amount
 276         posting_account (c, p) = (c, posting_account p)
 277         posting_amounts = posting_amounts . snd
 278         posting_type    = undefined
 279          -- NOTE: the posting_type will be given to Filter.test
 280          --       through instance Posting p => Posting (Posting_Type, p)
 281          --       by Filter.transaction_postings
 282          --       and Filter.transaction_postings_virtual
 283
 284 instance GL.Posting   Posting where
 285         type Posting_Amount Posting = Amount.Sum (Map Amount.Unit Amount)
 286         posting_account = posting_account
 287         posting_amount  = Amount.sum . posting_amounts
 288
 289 instance GL.Posting   (Chart, Posting) where
 290         type Posting_Amount (Chart, Posting) = GL.Posting_Amount Posting
 291         posting_account = posting_account . snd
 292         posting_amount  = Amount.sum . posting_amounts . snd
 293
 294 instance Stats.Posting Posting where
 295         type Posting_Amount  Posting = Amount
 296         posting_account = posting_account
 297         posting_amounts = posting_amounts
 298
 299 -- ** 'Posting' mappings
 300
 301 type Posting_by_Account
 302  = Map Account.Account_Path [Posting]
 303
 304 type Posting_by_Amount_and_Account
 305  = Map Amount.By_Unit Posting_by_Account
 306
 307 type Posting_by_Signs_and_Account
 308  = Map Amount.Signs Posting_by_Account
 309
 310 -- | Return a Data.'Data.Map.Map' associating the given 'Posting's with their respective 'Account'.
 311 posting_by_Account :: [Posting] -> Posting_by_Account
 312 posting_by_Account =
 313         Data.Map.fromListWith (flip (++)) .
 314         Data.List.map
 315          (\p -> (posting_account p, [p]))
 316
 317 posting_by_Amount_and_Account :: Posting_by_Account -> Posting_by_Amount_and_Account
 318 posting_by_Amount_and_Account =
 319         Data.Map.foldlWithKey
 320          (flip (\acct ->
 321                 Data.List.foldl'
 322                  (flip (\p ->
 323                         Data.Map.insertWith
 324                          (Data.Map.unionWith (++))
 325                          (posting_amounts p)
 326                          (Data.Map.singleton acct [p])))))
 327          mempty
 328
 329 posting_by_Signs_and_Account :: Posting_by_Account -> Posting_by_Signs_and_Account
 330 posting_by_Signs_and_Account =
 331         Data.Map.foldlWithKey
 332          (flip (\acct ->
 333                 Data.List.foldl'
 334                  (flip (\p ->
 335                         Data.Map.insertWith
 336                          (Data.Map.unionWith (++))
 337                          (Amount.signs $ posting_amounts p)
 338                          (Data.Map.singleton acct [p])))))
 339          mempty