jcc/Hcompta/Format/JCC/Posting.hs

   1 {-# LANGUAGE DeriveDataTypeable #-}
   2 {-# LANGUAGE FlexibleInstances #-}
   3 {-# LANGUAGE OverloadedStrings #-}
   4 {-# LANGUAGE NamedFieldPuns #-}
   5 {-# LANGUAGE TypeFamilies #-}
   6 module Hcompta.Format.JCC.Posting where
   7
   8 import           Control.DeepSeq (NFData(..))
   9 import           Data.Data (Data(..))
  10 import           Data.Eq (Eq(..))
  11 import           Data.Function (($), (.), flip)
  12 import qualified Data.List as List
  13 import           Data.Map.Strict (Map)
  14 import qualified Data.Map.Strict as Map
  15 import           Data.Maybe (Maybe(..))
  16 import           Data.Monoid (Monoid(..))
  17 import           Data.Text (Text)
  18 import           Data.Tuple (uncurry)
  19 import           Data.Typeable (Typeable)
  20 import           Prelude (seq, undefined)
  21 import           Text.Parsec.Pos (SourcePos, initialPos)
  22 import           Text.Show (Show)
  23
  24 import           Hcompta.Account (Account_Anchor(..))
  25 import qualified Hcompta.Balance as Balance
  26 import qualified Hcompta.Chart as Chart
  27 import           Hcompta.Date (Date)
  28 import qualified Hcompta.Filter as Filter
  29 import qualified Hcompta.GL as GL
  30 import           Hcompta.Lib.Parsec ()
  31 import qualified Hcompta.Polarize as Polarize
  32 import           Hcompta.Posting (Posting_Tags(..), Posting_Anchors(..))
  33 import qualified Hcompta.Posting as Posting
  34 import qualified Hcompta.Stats as Stats
  35
  36 import           Hcompta.Format.JCC.Account
  37 import           Hcompta.Format.JCC.Amount
  38 import           Hcompta.Format.JCC.Chart
  39
  40 -- * Type 'Comment'
  41
  42 type Comment = Text
  43
  44 -- * Type 'Posting'
  45
  46 data Posting
  47  =   Posting
  48  { posting_account        :: Account
  49  , posting_account_anchor :: Maybe (Account_Anchor, Maybe Account)
  50  , posting_amounts        :: Map Unit Quantity
  51  , posting_anchors        :: Posting_Anchors
  52  , posting_comments       :: [Comment]
  53  , posting_dates          :: [Date]
  54  , posting_sourcepos      :: SourcePos
  55  , posting_tags           :: Posting_Tags
  56  } deriving (Data, Eq, Show, Typeable)
  57 instance NFData Posting where
  58         rnf
  59          Posting
  60          { posting_account
  61          , posting_account_anchor
  62          , posting_amounts
  63          , posting_anchors
  64          , posting_comments
  65          , posting_dates
  66          -- , posting_sourcepos
  67          , posting_tags
  68          } =
  69                 rnf posting_account `seq`
  70                 rnf posting_account_anchor `seq`
  71                 rnf posting_amounts `seq`
  72                 rnf posting_anchors `seq`
  73                 rnf posting_comments `seq`
  74                 rnf posting_dates `seq`
  75                 -- rnf posting_sourcepos `seq`
  76                 rnf posting_tags
  77
  78 posting :: Account -> Posting
  79 posting acct =
  80         Posting
  81          { posting_account        = acct
  82          , posting_account_anchor = Nothing
  83          , posting_amounts        = mempty
  84          , posting_anchors        = mempty
  85          , posting_comments       = mempty
  86          , posting_dates          = mempty
  87          , posting_sourcepos      = initialPos ""
  88          , posting_tags           = mempty
  89          }
  90
  91 postings_by_account :: [Posting] -> Map Account [Posting]
  92 postings_by_account =
  93         Map.fromListWith (flip mappend) .
  94         List.map (\p -> (posting_account p, [p]))
  95
  96 instance Posting.Posting Posting where
  97         type Posting_Account   Posting = Account
  98         type Posting_Amount    Posting = Amount
  99         type Posting_Amounts   Posting = []
 100         posting_account = posting_account
 101         posting_amounts = List.map (uncurry Amount) . Map.toList . posting_amounts
 102
 103 instance Posting.Posting (Charted Posting) where
 104         type Posting_Account   (Charted Posting) = Charted Account
 105         type Posting_Amount    (Charted Posting) = Posting.Posting_Amount  Posting
 106         type Posting_Amounts   (Charted Posting) = Posting.Posting_Amounts Posting
 107         posting_account (Chart.Charted c p) = Chart.Charted c $ Posting.posting_account p
 108         posting_amounts = Posting.posting_amounts . Chart.charted
 109
 110 instance Balance.Posting Posting where
 111         type Posting_Account   Posting = Account
 112         type Posting_Quantity  Posting = Polarize.Polarized Quantity
 113         type Posting_Unit      Posting = Unit
 114         posting_account = posting_account
 115         posting_amounts = Map.map Polarize.polarize . posting_amounts
 116         posting_set_amounts amounts p =
 117                 p { posting_amounts=Map.map Polarize.depolarize amounts }
 118
 119 instance Balance.Posting (Charted Posting) where
 120         type Posting_Account   (Charted Posting) = Account
 121         type Posting_Quantity  (Charted Posting) = Balance.Posting_Quantity Posting
 122         type Posting_Unit      (Charted Posting) = Balance.Posting_Unit     Posting
 123         posting_account = posting_account . Chart.charted
 124         posting_amounts = Map.map Polarize.polarize . posting_amounts . Chart.charted
 125         posting_set_amounts amounts (Chart.Charted c p) =
 126                 Chart.Charted c p{ posting_amounts=Map.map Polarize.depolarize amounts }
 127
 128 instance Filter.Posting (Charted Posting) where
 129         posting_type = undefined
 130          -- NOTE: the posting_type will be given to Filter.test
 131          --       through instance Posting p => Posting (Posting_Typed p)
 132          --       by Filter.transaction_postings
 133          --       and Filter.transaction_postings_virtual
 134
 135 instance GL.Posting     Posting where
 136         type Posting_Account  Posting = Account
 137         type Posting_Quantity Posting = Map Unit (Polarize.Polarized Quantity)
 138         posting_account  = posting_account
 139         posting_quantity = Map.map Polarize.polarize . posting_amounts
 140
 141 instance GL.Posting     (Charted Posting) where
 142         type Posting_Account  (Charted Posting) = Account
 143         type Posting_Quantity (Charted Posting) = GL.Posting_Quantity Posting
 144         posting_account  = GL.posting_account  . Chart.charted
 145         posting_quantity = GL.posting_quantity . Chart.charted
 146
 147 instance Stats.Posting  Posting where
 148         type Posting_Account  Posting = Account
 149         type Posting_Quantity Posting = Quantity
 150         type Posting_Unit     Posting = Unit
 151         posting_account = posting_account
 152         posting_amounts = posting_amounts
 153
 154 {-
 155 -- ** 'Posting' mappings
 156
 157 type Posting_by_Account
 158  = Map Account [Posting]
 159
 160 type Posting_by_Amount_and_Account
 161  = Map (Map Unit Amount) Posting_by_Account
 162
 163 type Posting_by_Signs_and_Account
 164  = Map Signs Posting_by_Account
 165
 166 -- | Return a Data.'Map.Map' associating the given 'Posting's with their respective 'Account'.
 167 posting_by_Account :: [Posting] -> Posting_by_Account
 168 posting_by_Account =
 169         Map.fromListWith (flip mappend) .
 170         Data.List.map
 171          (\p -> (posting_account p, [p]))
 172
 173 posting_by_Amount_and_Account :: Posting_by_Account -> Posting_by_Amount_and_Account
 174 posting_by_Amount_and_Account =
 175         Map.foldlWithKey
 176          (flip (\acct ->
 177                 Data.List.foldl'
 178                  (flip (\p ->
 179                         Map.insertWith
 180                          (Map.unionWith mappend)
 181                          (posting_amounts p)
 182                          (Map.singleton acct [p])))))
 183          mempty
 184
 185 posting_by_Signs_and_Account :: Posting_by_Account -> Posting_by_Signs_and_Account
 186 posting_by_Signs_and_Account =
 187         Map.foldlWithKey
 188          (flip (\acct ->
 189                 Data.List.foldl'
 190                  (flip (\p ->
 191                         Map.insertWith
 192                          (Map.unionWith mappend)
 193                          (signs $ posting_amounts p)
 194                          (Map.singleton acct [p])))))
 195          mempty
 196 -}