]> Git — Sourcephile - comptalang.git/blob - jcc/Hcompta/JCC/Posting.hs
Simplify hcompta-lib.
[comptalang.git] / 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