]> Git — Sourcephile - comptalang.git/blob - ledger/Hcompta/Ledger/Transaction.hs
Remove cli/
[comptalang.git] / ledger / Hcompta / Ledger / Transaction.hs
1 {-# LANGUAGE DeriveDataTypeable #-}
2 {-# LANGUAGE FlexibleInstances #-}
3 {-# LANGUAGE OverloadedStrings #-}
4 {-# LANGUAGE NamedFieldPuns #-}
5 {-# LANGUAGE RecordWildCards #-}
6 {-# LANGUAGE TypeFamilies #-}
7 module Hcompta.Ledger.Transaction where
8
9 import Control.DeepSeq (NFData(..))
10 import Data.Bool
11 import Data.Data (Data(..))
12 import Data.Eq (Eq(..))
13 import Data.Function (($), (.), id)
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.Monoid (Monoid(..))
19 import Data.Text (Text)
20 import Data.Tuple (fst)
21 import Data.Typeable (Typeable)
22 import Prelude (flip, seq)
23 import Text.Parsec.Pos (SourcePos, initialPos)
24 import Text.Show (Show)
25
26 import qualified Hcompta as H
27
28 import Hcompta.Ledger.Account
29 import Hcompta.Ledger.Posting
30 import Hcompta.Ledger.Chart
31
32 -- * Type 'Transaction'
33
34 data Transaction
35 = Transaction
36 { transaction_code :: Code
37 , transaction_comments_before :: [Comment]
38 , transaction_comments_after :: [Comment]
39 , transaction_dates :: (H.Date, [H.Date])
40 , transaction_postings :: Map Account [Posting]
41 , transaction_sourcepos :: SourcePos
42 , transaction_status :: Status
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_code = ""
51 , transaction_comments_after = []
52 , transaction_comments_before = []
53 , transaction_dates = (H.date_epoch, [])
54 , transaction_postings = mempty
55 , transaction_sourcepos = initialPos ""
56 , transaction_status = False
57 , transaction_tags = mempty
58 , transaction_wording = ""
59 }
60
61 instance NFData Transaction where
62 rnf Transaction{..} =
63 rnf transaction_code `seq`
64 rnf transaction_comments_before `seq`
65 rnf transaction_comments_after `seq`
66 rnf transaction_dates `seq`
67 rnf transaction_postings `seq`
68 -- rnf transaction_sourcepos `seq`
69 rnf transaction_status `seq`
70 rnf transaction_tags `seq`
71 rnf transaction_wording
72
73 -- Transaction
74 instance H.Transaction Transaction where
75 type Transaction_Posting Transaction = Posting
76 type Transaction_Postings Transaction = Compose (Map Account) [] Posting
77 transaction_date = fst . transaction_dates
78 transaction_description = transaction_wording
79 transaction_postings = Compose . transaction_postings
80 transaction_tags = transaction_tags
81 instance H.Transaction (Charted Transaction) where
82 type Transaction_Posting (Charted Transaction) = H.Transaction_Posting Transaction
83 type Transaction_Postings (Charted Transaction) = H.Transaction_Postings Transaction
84 transaction_date = H.transaction_date . charted
85 transaction_description = H.transaction_description . charted
86 transaction_postings = H.transaction_postings . charted
87 transaction_tags = H.transaction_tags . charted
88
89 -- Journal
90 instance H.Journal_Transaction Transaction
91 instance H.Journal_Transaction (Charted Transaction)
92
93 -- Stats
94 instance H.Stats_Transaction Transaction where
95 stats_transaction_postings_count = Map.size . transaction_postings
96 instance H.Stats_Transaction (Charted Transaction) where
97 stats_transaction_postings_count = H.stats_transaction_postings_count . charted
98
99 -- GL
100 instance H.GL_Transaction Transaction where
101 type GL_Transaction_Line Transaction = Transaction
102 gl_transaction_line = id
103 instance H.GL_Transaction (Charted Transaction) where
104 type GL_Transaction_Line (Charted Transaction) = H.GL_Transaction_Line Transaction
105 gl_transaction_line = H.gl_transaction_line . charted
106
107 -- | Return a 'Map' associating
108 -- the given 'Transaction's with their respective 'Date'.
109 transaction_by_date :: [Transaction] -> (Compose (Map H.Date) []) Transaction
110 transaction_by_date =
111 Compose .
112 Map.fromListWith (flip mappend) .
113 List.map (\t -> (fst $ transaction_dates t, [t]))
114
115 -- ** Type 'Wording'
116
117 type Wording = Text
118
119 -- ** Type 'Date'
120
121 type Date = H.Date
122
123 -- ** Type 'Code'
124
125 type Code = Text
126
127 -- ** Type 'Status'
128 type Status = Bool