]> Git — Sourcephile - comptalang.git/blob - jcc/Hcompta/JCC/Transaction.hs
Simplify hcompta-lib.
[comptalang.git] / jcc / Hcompta / JCC / Transaction.hs
1 {-# LANGUAGE DeriveDataTypeable #-}
2 {-# LANGUAGE FlexibleInstances #-}
3 {-# LANGUAGE OverloadedStrings #-}
4 {-# LANGUAGE NamedFieldPuns #-}
5 {-# LANGUAGE RecordWildCards #-}
6 {-# LANGUAGE TypeFamilies #-}
7 module Hcompta.JCC.Transaction where
8
9 import Control.DeepSeq (NFData(..))
10 import Data.Data (Data(..))
11 import Data.Eq (Eq(..))
12 import Data.Function (($), (.), id)
13 -- import Data.Functor (Functor(..), (<$>))
14 import Data.Functor.Compose (Compose(..))
15 import qualified Data.List as List
16 import Data.Map.Strict (Map)
17 import qualified Data.Map.Strict as 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 (flip, seq)
24 import Text.Parsec.Pos (SourcePos, initialPos)
25 import Text.Show (Show)
26 -- import qualified Data.MonoTraversable as MT
27
28 import qualified Hcompta as H
29
30 import Hcompta.JCC.Account
31 import Hcompta.JCC.Posting
32 import Hcompta.JCC.Chart
33
34 -- * Type 'Transaction'
35
36 data Transaction
37 = Transaction
38 { transaction_anchors :: H.Transaction_Anchors
39 , transaction_comments :: [Comment]
40 , transaction_dates :: (H.Date, [H.Date])
41 , transaction_postings :: Map Account [Posting]
42 , transaction_sourcepos :: SourcePos
43 , transaction_tags :: H.Transaction_Tags
44 , transaction_wording :: Wording
45 } deriving (Data, Eq, Show, Typeable)
46
47 transaction :: Transaction
48 transaction =
49 Transaction
50 { transaction_anchors = mempty
51 , transaction_comments = []
52 , transaction_dates = (H.date_epoch, [])
53 , transaction_postings = mempty
54 , transaction_sourcepos = initialPos ""
55 , transaction_tags = mempty
56 , transaction_wording = ""
57 }
58
59 instance NFData Transaction where
60 rnf Transaction{..} =
61 rnf transaction_anchors `seq`
62 rnf transaction_comments `seq`
63 rnf transaction_dates `seq`
64 rnf transaction_postings `seq`
65 -- rnf transaction_sourcepos `seq`
66 rnf transaction_tags `seq`
67 rnf transaction_wording
68
69 -- Transaction
70 instance H.Transaction Transaction where
71 type Transaction_Posting Transaction = Posting
72 type Transaction_Postings Transaction = Compose (Map Account) [] Posting
73 transaction_date = fst . transaction_dates
74 transaction_description = transaction_wording
75 transaction_postings = Compose . transaction_postings
76 transaction_tags = transaction_tags
77 instance H.Transaction (Charted Transaction) where
78 type Transaction_Posting (Charted Transaction) = H.Transaction_Posting Transaction
79 type Transaction_Postings (Charted Transaction) = H.Transaction_Postings Transaction
80 transaction_date = H.transaction_date . charted
81 transaction_description = H.transaction_description . charted
82 transaction_postings = H.transaction_postings . charted
83 transaction_tags = H.transaction_tags . charted
84
85 -- Journal
86 instance H.Journal_Transaction Transaction
87 instance H.Journal_Transaction (Charted Transaction)
88
89 -- Stats
90 instance H.Stats_Transaction Transaction where
91 stats_transaction_postings_count = Map.size . transaction_postings
92 instance H.Stats_Transaction (Charted Transaction) where
93 stats_transaction_postings_count = H.stats_transaction_postings_count . charted
94
95 -- GL
96 instance H.GL_Transaction Transaction where
97 type GL_Transaction_Line Transaction = Transaction
98 gl_transaction_line = id
99 {-
100 gl_transaction_postings_filter f t =
101 t{ transaction_postings =
102 Map.mapMaybe
103 (\post -> case List.filter f post of
104 [] -> Nothing
105 posts -> Just posts)
106 (transaction_postings t)
107 }
108 -}
109 instance H.GL_Transaction (Charted Transaction) where
110 type GL_Transaction_Line (Charted Transaction) = H.GL_Transaction_Line Transaction
111 gl_transaction_line = H.gl_transaction_line . charted
112 {-
113 gl_transaction_postings_filter f (Charted c t) =
114 Charted c
115 t{ transaction_postings =
116 Map.mapMaybe
117 (\post -> case List.filter f $ ({-Charted c <$>-} post) of
118 [] -> Nothing
119 posts -> Just $ {-charted <$>-} posts)
120 (transaction_postings t)
121 }
122 -}
123
124 {-
125 instance Filter.Transaction (Charted Transaction) where
126 type Transaction_Posting (Charted Transaction) = Charted Posting
127 type Transaction_Postings (Charted Transaction) = Compose (Map Account) []
128 transaction_date = fst . transaction_dates . Chart.charted
129 transaction_wording = transaction_wording . Chart.charted
130 transaction_postings (Chart.Charted c t) =
131 fmap (Chart.Charted c) $
132 Compose $ transaction_postings t
133 {-
134 transaction_postings_virtual (Chart.Charted c t) =
135 fmap (Chart.Charted c) $
136 Compose
137 [ Compose $ transaction_virtual_postings t
138 , Compose $ transaction_balanced_virtual_postings t
139 ]
140 -}
141 transaction_tags = transaction_tags . Chart.charted
142 -}
143
144 -- | Return a 'Map' associating
145 -- the given 'Transaction's with their respective 'Date'.
146 transaction_by_date :: [Transaction] -> (Compose (Map H.Date) []) Transaction
147 transaction_by_date =
148 Compose .
149 Map.fromListWith (flip mappend) .
150 List.map (\t -> (fst $ transaction_dates t, [t]))
151
152 -- ** Type 'Wording'
153
154 type Wording = Text
155
156 -- ** Type 'Date'
157
158 type Date = H.Date