jcc/Hcompta/JCC/Posting.hs

   1 {-# LANGUAGE DeriveDataTypeable #-}
   2 {-# LANGUAGE FlexibleInstances #-}
   3 {-# LANGUAGE OverloadedStrings #-}
   4 {-# LANGUAGE NamedFieldPuns #-}
   5 {-# LANGUAGE RecordWildCards #-}
   6 {-# LANGUAGE TypeFamilies #-}
   7 module Hcompta.JCC.Posting where
   8
   9 import           Control.DeepSeq (NFData(..))
  10 import           Data.Data (Data(..))
  11 import           Data.Eq (Eq(..))
  12 import           Data.Function ((.), flip)
  13 import           Data.Functor ((<$>))
  14 import qualified Data.List as List
  15 import           Data.Map.Strict (Map)
  16 import qualified Data.Map.Strict as Map
  17 import           Data.Maybe (Maybe(..))
  18 import           Data.Monoid (Monoid(..))
  19 import           Data.Text (Text)
  20 import           Data.Tuple (uncurry)
  21 import           Data.Typeable (Typeable)
  22 import           Prelude (seq)
  23 import           Text.Parsec.Pos (SourcePos, initialPos)
  24 import           Text.Show (Show)
  25
  26 import qualified Hcompta as H
  27
  28 import           Hcompta.JCC.Account
  29 import           Hcompta.JCC.Amount
  30 import           Hcompta.JCC.Chart
  31
  32 -- * Type 'Posting'
  33
  34 data Posting
  35  =   Posting
  36  {   posting_account        :: Account
  37  ,   posting_account_anchor :: Maybe (H.Account_Anchor, Maybe Account)
  38  ,   posting_amounts        :: Map Unit Quantity
  39  ,   posting_anchors        :: H.Posting_Anchors
  40  ,   posting_comments       :: [Comment]
  41  ,   posting_dates          :: [H.Date]
  42  ,   posting_sourcepos      :: SourcePos
  43  ,   posting_tags           :: H.Posting_Tags
  44  } deriving (Data, Eq, Show, Typeable)
  45 instance NFData Posting where
  46         rnf Posting{..} =
  47                 rnf posting_account `seq`
  48                 rnf posting_account_anchor `seq`
  49                 rnf posting_amounts `seq`
  50                 rnf posting_anchors `seq`
  51                 rnf posting_comments `seq`
  52                 rnf posting_dates `seq`
  53                 -- rnf posting_sourcepos `seq`
  54                 rnf posting_tags
  55
  56 posting :: Account -> Posting
  57 posting acct =
  58         Posting
  59          { posting_account        = acct
  60          , posting_account_anchor = Nothing
  61          , posting_amounts        = mempty
  62          , posting_anchors        = mempty
  63          , posting_comments       = mempty
  64          , posting_dates          = mempty
  65          , posting_sourcepos      = initialPos ""
  66          , posting_tags           = mempty
  67          }
  68
  69 postings_by_account :: [Posting] -> Map Account [Posting]
  70 postings_by_account =
  71         Map.fromListWith (flip mappend) .
  72         List.map (\p -> (posting_account p, [p]))
  73
  74 -- Posting
  75 instance H.Posting Posting where
  76         type Posting_Account Posting = Account
  77         type Posting_Amount  Posting = Amount
  78         type Posting_Amounts Posting = [Amount]
  79         posting_account = posting_account
  80         posting_amounts = (uncurry Amount <$>) . Map.toList . posting_amounts
  81 instance H.Posting (Charted Posting) where
  82         type Posting_Account (Charted Posting) = Charted Account
  83         type Posting_Amount  (Charted Posting) = H.Posting_Amount  Posting
  84         type Posting_Amounts (Charted Posting) = H.Posting_Amounts Posting
  85         posting_account = (H.posting_account <$>)
  86         posting_amounts = H.posting_amounts . charted
  87
  88 -- Balance
  89 instance H.Balance_Posting Posting where
  90         type Balance_Posting_Quantity Posting = H.Polarized Quantity
  91         balance_posting_amounts = (H.polarize <$>) . posting_amounts
  92         balance_posting_amounts_set amounts p =
  93                 p { posting_amounts = H.depolarize <$> amounts }
  94 instance H.Balance_Posting (Charted Posting) where
  95         type Balance_Posting_Quantity (Charted Posting) = H.Balance_Posting_Quantity Posting
  96         balance_posting_amounts = H.balance_posting_amounts . charted
  97         balance_posting_amounts_set amounts (Charted c p) =
  98                 Charted c p{ posting_amounts = H.depolarize <$> amounts }
  99
 100 -- GL
 101 instance H.GL_Posting Posting where
 102         type GL_Posting_Quantity Posting = Map Unit (H.Polarized Quantity)
 103         gl_posting_quantity = (H.polarize <$>) . posting_amounts
 104 instance H.GL_Posting (Charted Posting) where
 105         type GL_Posting_Quantity (Charted Posting) = H.GL_Posting_Quantity Posting
 106         gl_posting_quantity = H.gl_posting_quantity . charted
 107
 108 -- ** Type 'Comment'
 109
 110 type Comment = Text