]> Git — Sourcephile - comptalang.git/blob - ledger/Hcompta/Ledger/Write/Test.hs
Remove cli/
[comptalang.git] / ledger / Hcompta / Ledger / Write / Test.hs
1 {-# LANGUAGE OverloadedStrings #-}
2 {-# LANGUAGE ScopedTypeVariables #-}
3
4 module Write.Test where
5
6 import Control.Applicative (Applicative(..), (<*))
7 import Control.Monad (Monad(..))
8 import Data.Bool
9 import Data.Data ()
10 import Data.Decimal (DecimalRaw(..))
11 import Data.Either (either, rights)
12 import Data.Function (($), (.), const, id)
13 import Data.Functor ((<$>))
14 import Data.Maybe (Maybe(..))
15 import Data.Monoid (Monoid(..))
16 import Data.Text (Text)
17 import qualified Data.Text as Text
18 import qualified Data.Text.Lazy as TL
19 import Test.Tasty
20 import Test.Tasty.HUnit
21 import qualified Text.Parsec as R hiding
22 ( char
23 , anyChar
24 , crlf
25 , newline
26 , noneOf
27 , oneOf
28 , satisfy
29 , space
30 , spaces
31 , string
32 , tab
33 )
34 import qualified Text.Parsec.Combinator.CorrectSourcePosWithTab as R
35 import qualified Text.Parsec.Error.Custom as R
36 -- import Text.Show (Show(..))
37
38 import qualified Hcompta as H
39 import qualified Hcompta.Ledger as Ledger
40 import qualified Hcompta.Ledger.Lib.Parsec as R
41
42 tests :: TestTree
43 tests = testGroup "Write"
44 [ testGroup "write_date" $
45 let (==>) (txt::Text) e =
46 testCase (Text.unpack txt) $
47 (@?=)
48 (Ledger.write
49 Ledger.write_style
50 { Ledger.write_style_color = False
51 , Ledger.write_style_align = True } .
52 Ledger.write_date <$>
53 rights [R.runParserWithError
54 (Ledger.read_date id Nothing <* R.eof) () "" txt])
55 [e] in
56 [ testCase "date_epoch" $
57 Ledger.write
58 Ledger.write_style
59 { Ledger.write_style_color = False
60 , Ledger.write_style_align = True }
61 (Ledger.write_date H.date_epoch)
62 @?= "1970-01-01"
63 , "2000-01-01" ==> "2000-01-01"
64 , "2000-01-01_12:34:51_CET" ==> "2000-01-01_11:34:51"
65 , "2000-01-01_12:34:51+01:10" ==> "2000-01-01_11:24:51"
66 , "2000-01-01_12:34:51-01:10" ==> "2000-01-01_13:44:51"
67 , "2000-01-01_01:02:03" ==> "2000-01-01_01:02:03"
68 , "2000-01-01_01:02" ==> "2000-01-01_01:02"
69 , "2000-01-01_01:00" ==> "2000-01-01_01:00"
70 ]
71 , testGroup "write_amount" $
72 let (<==) (txt::Text) e =
73 testCase (Text.unpack txt) $
74 (@?=)
75 (Ledger.write
76 Ledger.write_style
77 { Ledger.write_style_color = False
78 , Ledger.write_style_align = True } $
79 Ledger.write_amount e)
80 (TL.fromStrict txt) in
81 [ "0" <==
82 ( mempty
83 , Ledger.amount )
84 , "0.00" <==
85 ( mempty
86 , Ledger.amount { Ledger.amount_quantity = Decimal 2 0 } )
87 , "123" <==
88 ( mempty
89 , Ledger.amount { Ledger.amount_quantity = Decimal 0 123 } )
90 , "-123" <==
91 ( mempty
92 , Ledger.amount { Ledger.amount_quantity = Decimal 0 (- 123) } )
93 , "12.3" <==
94 ( mempty { Ledger.amount_style_fractioning = Just '.' }
95 , Ledger.amount { Ledger.amount_quantity = Decimal 1 123 } )
96 , "1,234.56" <==
97 ( mempty
98 { Ledger.amount_style_fractioning = Just '.'
99 , Ledger.amount_style_grouping_integral = Just $ Ledger.Amount_Style_Grouping ',' [3]
100 }
101 , Ledger.amount { Ledger.amount_quantity = Decimal 2 123456 })
102 , "123,456,789,01,2.3456789" <==
103 ( mempty
104 { Ledger.amount_style_fractioning = Just '.'
105 , Ledger.amount_style_grouping_integral = Just $ Ledger.Amount_Style_Grouping ',' [1, 2, 3]
106 }
107 , Ledger.amount { Ledger.amount_quantity = Decimal 7 1234567890123456789 } )
108 , "1234567.8_90_123_456_789" <==
109 ( mempty
110 { Ledger.amount_style_fractioning = Just '.'
111 , Ledger.amount_style_grouping_fractional = Just $ Ledger.Amount_Style_Grouping '_' [1, 2, 3]
112 }
113 , Ledger.amount { Ledger.amount_quantity = Decimal 12 1234567890123456789 })
114 , "1,2,3,4,5,6,7,89,012.3456789" <==
115 ( mempty
116 { Ledger.amount_style_fractioning = Just '.'
117 , Ledger.amount_style_grouping_integral = Just $ Ledger.Amount_Style_Grouping ',' [3, 2, 1]
118 }
119 , Ledger.amount { Ledger.amount_quantity = Decimal 7 1234567890123456789 })
120 , "1234567.890_12_3_4_5_6_7_8_9" <==
121 ( mempty
122 { Ledger.amount_style_fractioning = Just '.'
123 , Ledger.amount_style_grouping_fractional = Just $ Ledger.Amount_Style_Grouping '_' [3, 2, 1]
124 }
125 , Ledger.amount { Ledger.amount_quantity = Decimal 12 1234567890123456789 })
126 ]
127 , testGroup "write_amount_length" $
128 let (==>) (txt::Text) =
129 testCase (Text.unpack txt) $
130 (@?=)
131 (Ledger.write_amount_length <$>
132 rights [R.runParser (Ledger.read_amount <* R.eof) () "" txt])
133 [Text.length txt] in
134 (==>) <$>
135 [ "0.00"
136 , "123"
137 , "-123"
138 , "12.3"
139 , "12.5"
140 , "12.3"
141 , "1,234.56"
142 , "123,456,789,01,2.3456789"
143 , "1234567.8_90_123_456_789"
144 , "1,2,3,4,5,6,7,89,012.3456789"
145 , "1234567.890_12_3_4_5_6_7_8_9"
146 , "1000000.000_00_0_0_0_0_0_0_0"
147 , "999"
148 , "1000"
149 , "10,00€"
150 , "10,00 €"
151 , "€10,00"
152 , "€ 10,00"
153 , "EUR 10,00"
154 , "10,00 EUR"
155 , "\"4 2\" 10,00"
156 ]
157 , testGroup "write_account" $
158 let (==>) txt =
159 testCase (Text.unpack txt) $
160 (@?=)
161 (let read (t::Text) =
162 rights [R.runParser
163 (Ledger.read_account <* R.eof)
164 () "" t] in
165 Ledger.write
166 Ledger.write_style
167 { Ledger.write_style_color = False
168 , Ledger.write_style_align = True } <$>
169 (read txt >>= \a ->
170 let Ledger.Posting_Typed ty ac = Ledger.read_posting_type a in
171 return $ Ledger.write_account ty ac)
172 )
173 [TL.fromStrict txt] in
174 (==>) <$>
175 [ "A"
176 , "(A:B:C)"
177 , "[A:B:C]"
178 ]
179 , testGroup "write_transaction" $
180 let (==>) (txt::Text) =
181 testCase (Text.unpack txt) .
182 (@?=) (
183 let write (txn, ctx) =
184 Ledger.write
185 Ledger.write_style
186 { Ledger.write_style_color = False
187 , Ledger.write_style_align = True } $
188 let jnl = Ledger.context_read_journal ctx in
189 let sty = Ledger.journal_amount_styles jnl in
190 Ledger.write_transaction sty txn in
191 either
192 (const []) {-(pure . TL.pack . show)-}
193 (pure . write) $
194 R.runParserWithError
195 (R.and_state (Ledger.read_transaction <* R.newline <* R.eof))
196 ( Ledger.context_read Ledger.charted Ledger.journal
197 ::Ledger.Context_Read Ledger.Transaction [Ledger.Transaction] )
198 "" txt) in
199 [ Text.unlines
200 [ "2000-01-01 some wording"
201 , " A:B:C $1"
202 , " a:b:c"
203 ] ==> [TL.unlines
204 [ "2000-01-01 some wording"
205 , " A:B:C $1"
206 , " a:b:c $-1"
207 ]]
208 , Text.unlines
209 [ "2000-01-01 some wording"
210 , " A:B:C $1"
211 , " a:b:c"
212 , " ; first comment"
213 , " ; second comment"
214 , " ; third comment"
215 ] ==> [TL.unlines
216 [ "2000-01-01 some wording"
217 , " A:B:C $1"
218 , " a:b:c $-1"
219 , " ; first comment"
220 , " ; second comment"
221 , " ; third comment"
222 ]]
223 , Text.unlines
224 [ "2000-01-01 some wording"
225 , " A:B:C $1"
226 , " AA:BB:CC $123"
227 ] ==> []
228 , testCase "empty" $
229 Ledger.write
230 Ledger.write_style
231 { Ledger.write_style_color = False
232 , Ledger.write_style_align = True }
233 (Ledger.write_transaction
234 Ledger.amount_styles
235 Ledger.transaction)
236 @?= "1970-01-01\n\n"
237 ]
238 ]