]> Git — Sourcephile - comptalang.git/blob - ledger/Hcompta/Format/Ledger/Transaction.hs
.gitignore
[comptalang.git] / ledger / Hcompta / Format / Ledger / Transaction.hs
1 {-# LANGUAGE DeriveDataTypeable #-}
2 {-# LANGUAGE FlexibleInstances #-}
3 {-# LANGUAGE OverloadedStrings #-}
4 {-# LANGUAGE NamedFieldPuns #-}
5 {-# LANGUAGE TypeFamilies #-}
6 module Hcompta.Format.Ledger.Transaction where
7
8 import Control.DeepSeq (NFData(..))
9 import Data.Bool
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
27 import qualified Hcompta.Chart as Chart
28 import Hcompta.Date (Date)
29 import qualified Hcompta.Date as Date
30 import qualified Hcompta.Filter as Filter
31 import qualified Hcompta.GL as GL
32 import qualified Hcompta.Journal as Journal
33 import Hcompta.Lib.Parsec ()
34 import qualified Hcompta.Stats as Stats
35 import Hcompta.Transaction (Transaction_Tags(..))
36
37 import Hcompta.Format.Ledger.Account
38 import Hcompta.Format.Ledger.Posting
39 import Hcompta.Format.Ledger.Chart
40
41 type Code = Text
42 type Status = Bool
43 type Wording = Text
44
45 -- * Type 'Transaction'
46
47 data Transaction
48 = Transaction
49 { transaction_code :: Code
50 , transaction_comments_before :: [Comment]
51 , transaction_comments_after :: [Comment]
52 , transaction_dates :: (Date, [Date])
53 , transaction_postings :: Map Account [Posting]
54 , transaction_sourcepos :: SourcePos
55 , transaction_status :: Status
56 , transaction_tags :: Transaction_Tags
57 , transaction_wording :: Wording
58 } deriving (Data, Eq, Show, Typeable)
59 instance NFData Transaction where
60 rnf
61 Transaction
62 { transaction_code
63 , transaction_comments_before
64 , transaction_comments_after
65 , transaction_dates
66 , transaction_postings
67 -- , transaction_sourcepos
68 , transaction_status
69 , transaction_tags
70 , transaction_wording
71 } =
72 rnf transaction_code `seq`
73 rnf transaction_comments_before `seq`
74 rnf transaction_comments_after `seq`
75 rnf transaction_dates `seq`
76 rnf transaction_postings `seq`
77 -- rnf transaction_sourcepos `seq`
78 rnf transaction_status `seq`
79 rnf transaction_tags `seq`
80 rnf transaction_wording
81
82 transaction :: Transaction
83 transaction =
84 Transaction
85 { transaction_code = ""
86 , transaction_comments_after = []
87 , transaction_comments_before = []
88 , transaction_dates = (Date.nil, [])
89 , transaction_postings = mempty
90 , transaction_sourcepos = initialPos ""
91 , transaction_status = False
92 , transaction_tags = mempty
93 , transaction_wording = ""
94 }
95
96 instance Filter.Transaction (Charted Transaction) where
97 type Transaction_Posting (Charted Transaction) = Charted Posting
98 type Transaction_Postings (Charted Transaction) = Compose (Map Account) []
99 transaction_date = fst . transaction_dates . Chart.charted
100 transaction_wording = transaction_wording . Chart.charted
101 transaction_postings (Chart.Charted c t) =
102 fmap (Chart.Charted c) $
103 Compose $ transaction_postings t
104 {-
105 transaction_postings_virtual (Chart.Charted c t) =
106 fmap (Chart.Charted c) $
107 Compose
108 [ Compose $ transaction_virtual_postings t
109 , Compose $ transaction_balanced_virtual_postings t
110 ]
111 -}
112 transaction_tags = transaction_tags . Chart.charted
113
114 instance Journal.Transaction Transaction where
115 transaction_date = fst . transaction_dates
116 instance Journal.Transaction (Charted Transaction) where
117 transaction_date = Journal.transaction_date . Chart.charted
118
119 instance Stats.Transaction Transaction where
120 type Transaction_Posting Transaction = Posting
121 type Transaction_Postings Transaction = Compose (Map Account) []
122 transaction_date = fst . transaction_dates
123 transaction_postings = Compose . transaction_postings
124 transaction_postings_size = Map.size . transaction_postings
125 transaction_tags = transaction_tags
126 instance Stats.Transaction (Charted Transaction) where
127 type Transaction_Posting (Charted Transaction) = Stats.Transaction_Posting Transaction
128 type Transaction_Postings (Charted Transaction) = Stats.Transaction_Postings Transaction
129 transaction_date = Stats.transaction_date . Chart.charted
130 transaction_postings = Stats.transaction_postings . Chart.charted
131 transaction_postings_size = Stats.transaction_postings_size . Chart.charted
132 transaction_tags = Stats.transaction_tags . Chart.charted
133
134 instance GL.Transaction Transaction where
135 type Transaction_Line Transaction = Transaction
136 type Transaction_Posting Transaction = Posting
137 type Transaction_Postings Transaction = Compose (Map Account) []
138 transaction_line = id
139 transaction_date = fst . transaction_dates
140 transaction_postings = Compose . transaction_postings
141 transaction_postings_filter f t =
142 t{ transaction_postings =
143 Map.mapMaybe
144 (\p -> case List.filter f p of
145 [] -> Nothing
146 ps -> Just ps)
147 (transaction_postings t)
148 }
149 instance GL.Transaction (Charted Transaction) where
150 type Transaction_Line (Charted Transaction) = Transaction
151 type Transaction_Posting (Charted Transaction) = (Charted (GL.Transaction_Posting Transaction))
152 type Transaction_Postings (Charted Transaction) = GL.Transaction_Postings Transaction
153 transaction_line = Chart.charted
154 transaction_date = GL.transaction_date . Chart.charted
155 transaction_postings (Chart.Charted c t) =
156 fmap (Chart.Charted c) $
157 GL.transaction_postings t
158 transaction_postings_filter f (Chart.Charted c t) =
159 Chart.Charted c
160 t{ transaction_postings =
161 Map.mapMaybe
162 (\p -> case List.filter f $ fmap (Chart.Charted c) p of
163 [] -> Nothing
164 ps -> Just $ fmap Chart.charted ps)
165 (transaction_postings t)
166 }
167
168 -- | Return a 'Map' associating
169 -- the given 'Transaction's with their respective 'Date'.
170 transaction_by_date :: [Transaction] -> (Compose (Map Date) []) Transaction
171 transaction_by_date =
172 Compose .
173 Map.fromListWith (flip mappend) .
174 List.map (\t -> (fst $ transaction_dates t, [t]))