]> Git — Sourcephile - comptalang.git/blob - jcc/Test/Main.hs
sourcephile / git / comptalang.git / blob
? search:
summary | shortlog | log | commit | commitdiff | tree
history | raw | HEAD
Épure hcompta-lib.
[comptalang.git] / jcc / Test / Main.hs
1 {-# LANGUAGE OverloadedStrings #-}
2 {-# LANGUAGE ScopedTypeVariables #-}
3 {-# LANGUAGE StandaloneDeriving #-}
4
5 import Test.HUnit hiding (test)
6 import Test.Framework.Providers.HUnit (hUnitTestToTests)
7 import Test.Framework.Runners.Console (defaultMain)
8
9 import Control.Applicative (Applicative(..))
10 import Control.Arrow (ArrowChoice(..))
11 import Control.Monad (liftM)
12 import Control.Monad.IO.Class (liftIO)
13 import Data.Bool (Bool(..))
14 import Data.Decimal (DecimalRaw(..))
15 import Data.Either (rights, either)
16 import Data.Eq (Eq(..))
17 import Data.Function (($), (.), id, const)
18 import Data.Functor (Functor(..), (<$>))
19 import Data.List ((++))
20 import Data.List.NonEmpty (NonEmpty(..))
21 import qualified Data.Map.Strict as Map
22 import Data.Maybe (Maybe(..))
23 import Data.Monoid (Monoid(..))
24 import Data.Text (Text)
25 import qualified Data.Text as Text
26 import qualified Data.Text.Lazy as TL
27 import qualified Data.Time.Calendar as Time
28 import qualified Data.Time.LocalTime as Time
29 import System.IO (IO)
30 import qualified Text.Parsec as R hiding (char, space, spaces, string)
31 import qualified Text.Parsec.Pos as R
32 import Text.Show
33
34 import qualified Hcompta.Chart as Chart
35 import qualified Hcompta.Date as Date
36 import qualified Hcompta.Lib.Parsec as R
37 import qualified Hcompta.Posting as Posting
38 import qualified Hcompta.Tag as Tag
39 import qualified Hcompta.Transaction as Transaction
40
41 import qualified Hcompta.Format.JCC as F
42 import qualified Hcompta.Format.JCC.Read as F
43 import qualified Hcompta.Format.JCC.Write as F
44 import Prelude (error)
45 deriving instance Eq F.Amount
46
47 main :: IO ()
48 main = defaultMain $ hUnitTestToTests test
49
50 test :: Test
51 test = TestList
52 [ "Read" ~: TestList
53 [ {- "read_date" ~:
54 let (==>) (txt::Text) =
55 (~:) (Text.unpack txt) .
56 (~?=)
57 (rights [R.runParser_with_Error
58 (F.read_date id Nothing <* R.eof) () "" txt])
59 in TestList $
60 [ "2000-01-01" ==>
61 [ Time.zonedTimeToUTC $
62 Time.ZonedTime
63 (Time.LocalTime
64 (Time.fromGregorian 2000 01 01)
65 (Time.TimeOfDay 0 0 0))
66 (Time.utc) ]
67 , "2000/01/01" ==> []
68 , "2000-01-01_12:34" ==>
69 [ Time.zonedTimeToUTC $
70 Time.ZonedTime
71 (Time.LocalTime
72 (Time.fromGregorian 2000 01 01)
73 (Time.TimeOfDay 12 34 0))
74 (Time.utc) ]
75 , "2000-01-01_12:34:56" ==>
76 [ Time.zonedTimeToUTC $
77 Time.ZonedTime
78 (Time.LocalTime
79 (Time.fromGregorian 2000 01 01)
80 (Time.TimeOfDay 12 34 56))
81 (Time.utc) ]
82 , "2000-01-01_12:34_CET" ==>
83 [ Time.zonedTimeToUTC $
84 Time.ZonedTime
85 (Time.LocalTime
86 (Time.fromGregorian 2000 01 01)
87 (Time.TimeOfDay 12 34 0))
88 (Time.TimeZone 60 True "CET") ]
89 , "2000-01-01_12:34+01:30" ==>
90 [ Time.zonedTimeToUTC $
91 Time.ZonedTime
92 (Time.LocalTime
93 (Time.fromGregorian 2000 01 01)
94 (Time.TimeOfDay 12 34 0))
95 (Time.TimeZone 90 False "+01:30") ]
96 , "2000-01-01_12:34:56_CET" ==>
97 [ Time.zonedTimeToUTC $
98 Time.ZonedTime
99 (Time.LocalTime
100 (Time.fromGregorian 2000 01 01)
101 (Time.TimeOfDay 12 34 56))
102 (Time.TimeZone 60 True "CET") ]
103 , "2001-02-29" ==> []
104 ] ++
105 let (==>) (txt::Text, def) =
106 (~:) (Text.unpack txt) .
107 (~?=) (rights [R.runParser_with_Error
108 (F.read_date id (Just def) <* R.eof) () "" txt])
109 in
110 [ ("01-01", 2000) ==>
111 [ Time.zonedTimeToUTC $
112 Time.ZonedTime
113 (Time.LocalTime
114 (Time.fromGregorian 2000 01 01)
115 (Time.TimeOfDay 0 0 0))
116 (Time.utc)]
117 ]
118 , "read_account_section" ~:
119 let (==>) (txt::Text) b =
120 (~:) (Text.unpack txt) $
121 (~?=)
122 (rights [R.runParser (F.read_account_section <* R.eof) () "" txt])
123 (if b then [txt] else [])
124 in TestList
125 [ "" ==> False
126 , "A" ==> True
127 , "AA" ==> True
128 , " " ==> False
129 , "/" ==> False
130 , "A/" ==> False
131 , "/A" ==> False
132 , "A " ==> False
133 , "A A" ==> False
134 , "A " ==> False
135 , "A\t" ==> False
136 , "A \n" ==> False
137 , "(A)A" ==> False
138 , "( )A" ==> False
139 , "(A) A" ==> False
140 , "[ ] A" ==> False
141 , "(A) " ==> False
142 , "(A)" ==> False
143 , "A(A)" ==> False
144 , "[A]A" ==> False
145 , "[A] A" ==> False
146 , "[A] " ==> False
147 , "[A]" ==> False
148 , "\"A \"" ~:
149 (rights
150 [R.runParser
151 (F.read_account_section)
152 () "" ("A "::Text)])
153 ~?=
154 ["A"]
155 ]
156 , "read_account" ~:
157 let (==>) (txt::Text) =
158 (~:) (Text.unpack txt) .
159 (~?=) (rights [R.runParser
160 (F.read_account <* R.eof) () "" txt])
161 in TestList
162 [ "" ==> []
163 , "A" ==> []
164 , "A/" ==> []
165 , "/A" ==> ["A":|[]]
166 , "A " ==> []
167 , " A" ==> []
168 , "/A/B" ==> ["A":|["B"]]
169 , "/A/B/C" ==> ["A":|["B","C"]]
170 , "/Aa/Bbb/Cccc" ==> ["Aa":|["Bbb", "Cccc"]]
171 , "/A a / B b b / C c c c" ==> []
172 , "/A/ /C" ==> []
173 , "/A//C" ==> []
174 , "/A/B/(C)" ==> []
175 ]
176 , "read_amount" ~:
177 let (==>) (txt::Text) =
178 (~:) (Text.unpack txt) .
179 (~?=) (rights [R.runParser (F.read_amount <* R.eof) () "" txt])
180 in TestList
181 [ "" ==> []
182 , "0" ==>
183 [( mempty
184 , F.amount { F.amount_quantity = Decimal 0 0 } )]
185 , "00" ==>
186 [( mempty
187 , F.amount { F.amount_quantity = Decimal 0 0 } )]
188 , "0." ==>
189 [( mempty { F.amount_style_fractioning = Just '.' }
190 , F.amount { F.amount_quantity = Decimal 0 0 } )]
191 , ".0" ==>
192 [( mempty { F.amount_style_fractioning = Just '.' }
193 , F.amount { F.amount_quantity = Decimal 1 0 } )]
194 , "0," ==>
195 [( mempty { F.amount_style_fractioning = Just ',' }
196 , F.amount { F.amount_quantity = Decimal 0 0 } )]
197 , ",0" ==>
198 [( mempty { F.amount_style_fractioning = Just ',' }
199 , F.amount { F.amount_quantity = Decimal 1 0 } )]
200 , "0_" ==> []
201 , "_0" ==> []
202 , "0.0" ==>
203 [( mempty { F.amount_style_fractioning = Just '.' }
204 , F.amount { F.amount_quantity = Decimal 1 0 } )]
205 , "00.00" ==>
206 [( mempty { F.amount_style_fractioning = Just '.' }
207 , F.amount { F.amount_quantity = Decimal 2 0 } )]
208 , "0,0" ==>
209 [( mempty { F.amount_style_fractioning = Just ',' }
210 , F.amount { F.amount_quantity = Decimal 1 0 } )]
211 , "00,00" ==>
212 [( mempty { F.amount_style_fractioning = Just ',' }
213 , F.amount { F.amount_quantity = Decimal 2 0 } )]
214 , "0_0" ==>
215 [( mempty { F.amount_style_grouping_integral = Just $ F.Amount_Style_Grouping '_' [1] }
216 , F.amount { F.amount_quantity = Decimal 0 0 } )]
217 , "00_00" ==>
218 [( mempty { F.amount_style_grouping_integral = Just $ F.Amount_Style_Grouping '_' [2] }
219 , F.amount { F.amount_quantity = Decimal 0 0 } )]
220 , "0,000.00" ==>
221 [( mempty
222 { F.amount_style_fractioning = Just '.'
223 , F.amount_style_grouping_integral = Just $ F.Amount_Style_Grouping ',' [3] }
224 , F.amount { F.amount_quantity = Decimal 2 0 } )]
225 , "0.000,00" ==>
226 [( mempty
227 { F.amount_style_fractioning = Just ','
228 , F.amount_style_grouping_integral = Just $ F.Amount_Style_Grouping '.' [3] }
229 , F.amount { F.amount_quantity = Decimal 2 0 } )]
230 , "1,000.00" ==>
231 [( mempty
232 { F.amount_style_fractioning = Just '.'
233 , F.amount_style_grouping_integral = Just $ F.Amount_Style_Grouping ',' [3] }
234 , F.amount { F.amount_quantity = Decimal 2 100000 } )]
235 , "1.000,00" ==>
236 [( mempty
237 { F.amount_style_fractioning = Just ','
238 , F.amount_style_grouping_integral = Just $ F.Amount_Style_Grouping '.' [3] }
239 , F.amount { F.amount_quantity = Decimal 2 100000 } )]
240 , "1,000.00." ==> []
241 , "1.000,00," ==> []
242 , "1,000.00_" ==> []
243 , "123" ==>
244 [( mempty
245 , F.amount { F.amount_quantity = Decimal 0 123 } )]
246 , "1.2" ==>
247 [( mempty { F.amount_style_fractioning = Just '.' }
248 , F.amount { F.amount_quantity = Decimal 1 12 } )]
249 , "1,2" ==>
250 [( mempty { F.amount_style_fractioning = Just ',' }
251 , F.amount { F.amount_quantity = Decimal 1 12 } )]
252 , "12.34" ==>
253 [( mempty { F.amount_style_fractioning = Just '.' }
254 , F.amount { F.amount_quantity = Decimal 2 1234 } )]
255 , "12,34" ==>
256 [( mempty { F.amount_style_fractioning = Just ',' }
257 , F.amount { F.amount_quantity = Decimal 2 1234 } )]
258 , "1_2" ==>
259 [( mempty { F.amount_style_grouping_integral = Just $ F.Amount_Style_Grouping '_' [1] }
260 , F.amount { F.amount_quantity = Decimal 0 12 } )]
261 , "1_23" ==>
262 [( mempty { F.amount_style_grouping_integral = Just $ F.Amount_Style_Grouping '_' [2] }
263 , F.amount { F.amount_quantity = Decimal 0 123 } )]
264 , "1_23_456" ==>
265 [( mempty { F.amount_style_grouping_integral = Just $ F.Amount_Style_Grouping '_' [3, 2] }
266 , F.amount { F.amount_quantity = Decimal 0 123456 } )]
267 , "1_23_456,7890_12345_678901" ==>
268 [( mempty
269 { F.amount_style_fractioning = Just ','
270 , F.amount_style_grouping_integral = Just $ F.Amount_Style_Grouping '_' [3, 2]
271 , F.amount_style_grouping_fractional = Just $ F.Amount_Style_Grouping '_' [4, 5, 6] }
272 , F.amount { F.amount_quantity = Decimal 15 123456789012345678901 } )]
273 , "1_23_456.7890_12345_678901" ==>
274 [( mempty
275 { F.amount_style_fractioning = Just '.'
276 , F.amount_style_grouping_integral = Just $ F.Amount_Style_Grouping '_' [3, 2]
277 , F.amount_style_grouping_fractional = Just $ F.Amount_Style_Grouping '_' [4, 5, 6] }
278 , F.amount { F.amount_quantity = Decimal 15 123456789012345678901 } )]
279 , "1,23,456.7890_12345_678901" ==>
280 [( mempty
281 { F.amount_style_fractioning = Just '.'
282 , F.amount_style_grouping_integral = Just $ F.Amount_Style_Grouping ',' [3, 2]
283 , F.amount_style_grouping_fractional = Just $ F.Amount_Style_Grouping '_' [4, 5, 6] }
284 , F.amount { F.amount_quantity = Decimal 15 123456789012345678901 } )]
285 , "1.23.456,7890_12345_678901" ==>
286 [( mempty
287 { F.amount_style_fractioning = Just ','
288 , F.amount_style_grouping_integral = Just $ F.Amount_Style_Grouping '.' [3, 2]
289 , F.amount_style_grouping_fractional = Just $ F.Amount_Style_Grouping '_' [4, 5, 6] }
290 , F.amount { F.amount_quantity = Decimal 15 123456789012345678901 } )]
291 , "123456_78901_2345.678_90_1" ==>
292 [( mempty
293 { F.amount_style_fractioning = Just '.'
294 , F.amount_style_grouping_integral = Just $ F.Amount_Style_Grouping '_' [4, 5, 6]
295 , F.amount_style_grouping_fractional = Just $ F.Amount_Style_Grouping '_' [3, 2] }
296 , F.amount { F.amount_quantity = Decimal 6 123456789012345678901 } )]
297 , "$1" ==>
298 [( mempty
299 { F.amount_style_unit_side = Just F.Amount_Style_Side_Left
300 , F.amount_style_unit_spaced = Just False }
301 , F.amount
302 { F.amount_quantity = Decimal 0 1
303 , F.amount_unit = "$" } )]
304 , "1$" ==>
305 [( mempty
306 { F.amount_style_unit_side = Just F.Amount_Style_Side_Right
307 , F.amount_style_unit_spaced = Just False }
308 , F.amount
309 { F.amount_quantity = Decimal 0 1
310 , F.amount_unit = "$" } )]
311 , "$ 1" ==>
312 [( mempty
313 { F.amount_style_unit_side = Just F.Amount_Style_Side_Left
314 , F.amount_style_unit_spaced = Just True }
315 , F.amount
316 { F.amount_quantity = Decimal 0 1
317 , F.amount_unit = "$" } )]
318 , "1 $" ==>
319 [( mempty
320 { F.amount_style_unit_side = Just F.Amount_Style_Side_Right
321 , F.amount_style_unit_spaced = Just True }
322 , F.amount
323 { F.amount_quantity = Decimal 0 1
324 , F.amount_unit = "$" } )]
325 , "-$1" ==>
326 [( mempty
327 { F.amount_style_unit_side = Just F.Amount_Style_Side_Left
328 , F.amount_style_unit_spaced = Just False }
329 , F.amount
330 { F.amount_quantity = Decimal 0 (-1)
331 , F.amount_unit = "$" } )]
332 , "\"4 2\"1" ==>
333 [( mempty
334 { F.amount_style_unit_side = Just F.Amount_Style_Side_Left
335 , F.amount_style_unit_spaced = Just False }
336 , F.amount
337 { F.amount_quantity = Decimal 0 1
338 , F.amount_unit = "4 2" } )]
339 , "1\"4 2\"" ==>
340 [( mempty
341 { F.amount_style_unit_side = Just F.Amount_Style_Side_Right
342 , F.amount_style_unit_spaced = Just False }
343 , F.amount
344 { F.amount_quantity = Decimal 0 1
345 , F.amount_unit = "4 2" } )]
346 , "$1.000,00" ==>
347 [( mempty
348 { F.amount_style_fractioning = Just ','
349 , F.amount_style_grouping_integral = Just $ F.Amount_Style_Grouping '.' [3]
350 , F.amount_style_unit_side = Just F.Amount_Style_Side_Left
351 , F.amount_style_unit_spaced = Just False }
352 , F.amount
353 { F.amount_quantity = Decimal 2 100000
354 , F.amount_unit = "$" } )]
355 , "1.000,00$" ==>
356 [( mempty
357 { F.amount_style_fractioning = Just ','
358 , F.amount_style_grouping_integral = Just $ F.Amount_Style_Grouping '.' [3]
359 , F.amount_style_unit_side = Just F.Amount_Style_Side_Right
360 , F.amount_style_unit_spaced = Just False }
361 , F.amount
362 { F.amount_quantity = Decimal 2 100000
363 , F.amount_unit = "$" } )]
364 ]
365 , "read_comment" ~:
366 let (==>) (txt::Text, end) =
367 (~:) (Text.unpack txt) .
368 (~?=) (rights [R.runParser (F.read_comment <* end) () "" txt])
369 in TestList
370 [ ("; some comment", R.eof) ==> [" some comment"]
371 , ("; some comment \n", R.newline <* R.eof) ==> [ " some comment " ]
372 , ("; some comment \r\n", R.string "\r\n" <* R.eof) ==> [ " some comment " ]
373 ]
374 , "read_comments" ~:
375 let (==>) (txt::Text, end) =
376 (~:) (Text.unpack txt) .
377 (~?=) (rights [R.runParser (F.read_comments <* end) () "" txt])
378 in TestList
379 [ ("; some comment\n ; some other comment", R.eof) ==> [ [" some comment", " some other comment"] ]
380 , ("; some comment \n", R.string "\n" <* R.eof) ==> [ [" some comment "] ]
381 ]
382 , "read_transaction_tag" ~:
383 let (==>) (txt::Text, end) =
384 (~:) (Text.unpack txt) .
385 (~?=) ((\(Transaction.Transaction_Tag t) -> t) <$>
386 rights [R.runParser (F.read_transaction_tag <* end) () "" txt])
387 in TestList
388 [ ("#Name" , R.eof) ==> [("Name":|[], "")]
389 , ("#Name:" , R.eof) ==> []
390 , ("#Name:name" , R.eof) ==> [("Name":|["name"], "")]
391 , ("#Name=Value" , R.eof) ==> [("Name":|[], "Value")]
392 , ("#Name = Value" , R.eof) ==> [("Name":|[], "Value")]
393 , ("#Name=Value\n" , R.string "\n" <* R.eof) ==> [("Name":|[], "Value")]
394 , ("#Name=Val ue" , R.eof) ==> [("Name":|[], "Val ue")]
395 , ("#Name=," , R.eof) ==> [("Name":|[], ",")]
396 , ("#Name=Val,ue" , R.eof) ==> [("Name":|[], "Val,ue")]
397 , ("#Name=Val,ue:" , R.eof) ==> [("Name":|[], "Val,ue:")]
398 , ("#Name=Val,ue :", R.eof) ==> [("Name":|[], "Val,ue :")]
399 ]
400 ,-} "read_posting" ~:
401 let (==>) (txt::Text) =
402 let read_context =
403 ( F.read_context (const ()) F.journal
404 ::F.Read_Context () ()) in
405 (~:) (Text.unpack txt) .
406 (~?=) (
407 either
408 (error . show)
409 (pure) $
410 R.runParser_with_Error
411 (F.read_posting <* R.eof) read_context "" txt) .
412 fmap (\p -> p { F.posting_sourcepos = R.newPos "" 1 1 })
413 in TestList
414 [ "/A/B/C" ==> [F.posting ("A":|["B", "C"])]
415 , "/A/B/C $1" ==> [(F.posting ("A":|["B", "C"]))
416 { F.posting_amounts = Map.fromList [("$", 1)] }]
417 , "/A/B/C $1" ==> [(F.posting ("A":|["B", "C"]))
418 { F.posting_amounts = Map.fromList [("$", 1)] }]
419 , "/A/B/C 1€" ==> [(F.posting ("A":|["B", "C"]))
420 { F.posting_amounts = Map.fromList [("€", 1)] }]
421 , "/A/B/C $1; some comment" ==> [(F.posting ("A":|["B", "C"]))
422 { F.posting_amounts = Map.fromList [("$", 1)]
423 , F.posting_comments = [" some comment"] }]
424 , "/A/B/C; some comment" ==> [(F.posting ("A":|["B", "C"]))
425 { F.posting_amounts = Map.fromList []
426 , F.posting_comments = [" some comment"] }]
427 , "/A/B/C ; some comment" ==> [(F.posting ("A":|["B", "C"]))
428 { F.posting_amounts = Map.fromList []
429 , F.posting_comments = [" some comment"] }]
430 , "/A/B/C ; some comment\n ; some other comment" ==>
431 [(F.posting ("A":|["B", "C"]))
432 { F.posting_amounts = Map.fromList []
433 , F.posting_comments = [" some comment", " some other comment"] }]
434 , "/A/B/C $1 ; some comment" ==>
435 [(F.posting ("A":|["B", "C"]))
436 { F.posting_amounts = Map.fromList [("$", 1)]
437 , F.posting_comments = [" some comment"] }]
438 , "/A/B/C #N=V" ==>
439 [(F.posting ("A":|["B", "C"]))
440 { F.posting_tags = Posting.Posting_Tags $
441 Tag.from_List [ ("N":|[], "V") ] }]
442 , "/A/B/C #N:O=V" ==>
443 [(F.posting ("A":|["B", "C"]))
444 { F.posting_tags = Posting.Posting_Tags $
445 Tag.from_List [ ("N":|["O"], "V") ] }]
446 , "/A/B/C #N=Val;ue" ==>
447 [(F.posting ("A":|["B", "C"]))
448 { F.posting_tags = Posting.Posting_Tags $
449 Tag.from_List [ ("N":|[], "Val;ue") ] }]
450 , "/A/B/C #N=Val#ue" ==>
451 [(F.posting ("A":|["B", "C"]))
452 { F.posting_tags = Posting.Posting_Tags $
453 Tag.from_List [ ("N":|[], "Val#ue") ] }]
454 , "/A/B/C #N=V ; some comment" ==>
455 [(F.posting ("A":|["B", "C"]))
456 { F.posting_tags = Posting.Posting_Tags $
457 Tag.from_List [ ("N":|[], "V") ]
458 , F.posting_comments = [" some comment"] }]
459 , "/A/B/C #N=V #O" ==>
460 [(F.posting ("A":|["B", "C"]))
461 { F.posting_tags = Posting.Posting_Tags $
462 Tag.from_List [ ("N":|[], "V"), ("O":|[], "") ] }]
463 , "/A/B/C #N#O" ==> []
464 , "/A/B/C #N; #O" ==>
465 [(F.posting ("A":|["B", "C"]))
466 { F.posting_tags = Posting.Posting_Tags $
467 Tag.from_List [ ("N":|[], "") ]
468 , F.posting_comments = [" #O"] }]
469 , "/A/B/C #N #O" ==>
470 [(F.posting ("A":|["B", "C"]))
471 { F.posting_tags = Posting.Posting_Tags $
472 Tag.from_List [ ("N":|[], ""), ("O":|[], "") ] }]
473 , "/A/B/C \n #N=V" ==>
474 [(F.posting ("A":|["B", "C"]))
475 { F.posting_tags = Posting.Posting_Tags $
476 Tag.from_List [ ("N":|[], "V") ] }]
477 , "/A/B/C ; some comment\n #N=V" ==>
478 [(F.posting ("A":|["B", "C"]))
479 { F.posting_comments = [" some comment"]
480 , F.posting_tags = Posting.Posting_Tags $
481 Tag.from_List [ ("N":|[], "V") ] }]
482 , "/A/B/C ; some comment\n #N=V v\n #N2=V2 v2" ==>
483 [(F.posting ("A":|["B", "C"]))
484 { F.posting_comments = [" some comment"]
485 , F.posting_tags = Posting.Posting_Tags $
486 Tag.from_List
487 [ ("N":|[], "V v")
488 , ("N2":|[], "V2 v2") ] }]
489 , "/A/B/C\n #N=V\n #N=V2" ==>
490 [(F.posting ("A":|["B", "C"]))
491 { F.posting_tags = Posting.Posting_Tags $
492 Tag.from_List
493 [ ("N":|[], "V")
494 , ("N":|[], "V2")
495 ] }]
496 , "/A/B/C\n #N=V\n #N2=V" ==>
497 [(F.posting ("A":|["B", "C"]))
498 { F.posting_tags = Posting.Posting_Tags $
499 Tag.from_List
500 [ ("N":|[], "V")
501 , ("N2":|[], "V")
502 ] }]
503 ]
504 , "read_transaction" ~:
505 let (==>) (txt::Text) =
506 let read_context =
507 ( F.read_context (const ()) F.journal
508 ::F.Read_Context () ()) in
509 (~:) (Text.unpack txt) .
510 (~?=) (
511 either
512 (error . show)
513 (pure) $
514 R.runParser_with_Error
515 (F.read_transaction <* R.newline <* R.eof) read_context "" txt) .
516 fmap (\t -> t { F.transaction_sourcepos = R.newPos "" 1 1 })
517 in TestList
518 [ Text.unlines
519 [ "2000-01-01 some wording"
520 , " /A/B/C $1"
521 , " /a/b/c $-1"
522 ] ==>
523 [F.transaction
524 { F.transaction_dates=
525 ( Time.zonedTimeToUTC $
526 Time.ZonedTime
527 (Time.LocalTime
528 (Time.fromGregorian 2000 01 01)
529 (Time.TimeOfDay 0 0 0))
530 (Time.utc)
531 , [] )
532 , F.transaction_wording="some wording"
533 , F.transaction_postings = F.postings_by_account
534 [ (F.posting ("A":|["B", "C"]))
535 { F.posting_amounts = Map.fromList [ ("$", 1) ]
536 , F.posting_sourcepos = R.newPos "" 2 2 }
537 , (F.posting ("a":|["b", "c"]))
538 { F.posting_amounts = Map.fromList [ ("$", -1) ]
539 , F.posting_sourcepos = R.newPos "" 3 2 }
540 ]
541 }]
542 , Text.unlines
543 [ "2000-01-01 some wording ; some comment"
544 , "; some other;comment"
545 , " ; some last comment"
546 , " /A/B/C $1"
547 , " /a/b/c"
548 ] ==>
549 [F.transaction
550 { F.transaction_comments =
551 [ " some comment"
552 , " some other;comment"
553 , " some last comment"
554 ]
555 , F.transaction_dates=
556 ( Time.zonedTimeToUTC $
557 Time.ZonedTime
558 (Time.LocalTime
559 (Time.fromGregorian 2000 01 01)
560 (Time.TimeOfDay 0 0 0))
561 (Time.utc)
562 , [] )
563 , F.transaction_wording="some wording"
564 , F.transaction_postings = F.postings_by_account
565 [ (F.posting ("A":|["B", "C"]))
566 { F.posting_amounts = Map.fromList [ ("$", 1) ]
567 , F.posting_sourcepos = R.newPos "" 4 2 }
568 , (F.posting ("a":|["b", "c"]))
569 { F.posting_amounts = Map.fromList [ ("$", -1) ]
570 , F.posting_sourcepos = R.newPos "" 5 2 } ] }]
571 ]
572 , "read_journal" ~: TestList
573 [ let (==>) (txt::Text) e =
574 (~:) (Text.unpack txt) $
575 TestCase $ do
576 jnl <-
577 liftIO $
578 right (\j -> j{F.journal_last_read_time=Date.nil}) <$>
579 R.runParserT_with_Error
580 (F.read_journal "" {-<* R.eof-})
581 ( F.read_context id F.journal
582 ::F.Read_Context (F.Charted F.Transaction)
583 ([F.Charted F.Transaction]))
584 "" (txt::Text)
585 (@?=) (rights [jnl]) e
586 in TestList
587 [ Text.unlines
588 [ "2000-01-01 1° wording"
589 , " /A/B/C $1"
590 , " /a/b/c"
591 , "2000-01-02 2° wording"
592 , " /A/B/C $1"
593 , " /x/y/z"
594 ] ==>
595 [ F.journal
596 { F.journal_content =
597 fmap (Chart.Charted mempty) $
598 [ F.transaction
599 { F.transaction_dates=
600 ( Time.zonedTimeToUTC $
601 Time.ZonedTime
602 (Time.LocalTime
603 (Time.fromGregorian 2000 01 02)
604 (Time.TimeOfDay 0 0 0))
605 (Time.utc)
606 , [] )
607 , F.transaction_wording="2° wording"
608 , F.transaction_postings = F.postings_by_account
609 [ (F.posting ("A":|["B", "C"]))
610 { F.posting_amounts = Map.fromList [ ("$", 1) ]
611 , F.posting_sourcepos = R.newPos "" 5 2
612 }
613 , (F.posting ("x":|["y", "z"]))
614 { F.posting_amounts = Map.fromList [ ("$", -1) ]
615 , F.posting_sourcepos = R.newPos "" 6 2
616 }
617 ]
618 , F.transaction_sourcepos = R.newPos "" 4 1
619 }
620 , F.transaction
621 { F.transaction_dates=
622 ( Time.zonedTimeToUTC $
623 Time.ZonedTime
624 (Time.LocalTime
625 (Time.fromGregorian 2000 01 01)
626 (Time.TimeOfDay 0 0 0))
627 (Time.utc)
628 , [] )
629 , F.transaction_wording="1° wording"
630 , F.transaction_postings = F.postings_by_account
631 [ (F.posting ("A":|["B", "C"]))
632 { F.posting_amounts = Map.fromList [ ("$", 1) ]
633 , F.posting_sourcepos = R.newPos "" 2 2
634 }
635 , (F.posting ("a":|["b", "c"]))
636 { F.posting_amounts = Map.fromList [ ("$", -1) ]
637 , F.posting_sourcepos = R.newPos "" 3 2
638 }
639 ]
640 , F.transaction_sourcepos = R.newPos "" 1 1
641 }
642 ]
643 , F.journal_files = [""]
644 , F.journal_amount_styles = F.Amount_Styles $ Map.fromList
645 [ ( F.Unit "$"
646 , mempty
647 { F.amount_style_unit_side = Just F.Amount_Style_Side_Left
648 , F.amount_style_unit_spaced = Just False }
649 )
650 ]
651 }
652 ]
653 ]
654 ]
655 ]
656 {-, "Write" ~: TestList
657 [ "write_date" ~:
658 let (==>) (txt::Text) e =
659 (~:) (Text.unpack txt) $
660 (~?=)
661 (F.write
662 F.write_style
663 { F.write_style_color = False
664 , F.write_style_align = True } .
665 F.write_date <$>
666 rights [R.runParser_with_Error
667 (F.read_date id Nothing <* R.eof) () "" txt])
668 [e]
669 in TestList
670 [ "" ~:
671 ((F.write
672 F.write_style
673 { F.write_style_color = False
674 , F.write_style_align = True } $
675 F.write_date Date.nil)
676 ~?= "1970-01-01")
677 , "2000-01-01" ==> "2000-01-01"
678 , "2000-01-01_12:34:51_CET" ==> "2000-01-01_11:34:51"
679 , "2000-01-01_12:34:51+01:10" ==> "2000-01-01_11:24:51"
680 , "2000-01-01_12:34:51-01:10" ==> "2000-01-01_13:44:51"
681 , "2000-01-01_01:02:03" ==> "2000-01-01_01:02:03"
682 , "2000-01-01_01:02" ==> "2000-01-01_01:02"
683 , "2000-01-01_01:00" ==> "2000-01-01_01:00"
684 ]
685 , "write_amount" ~:
686 let (<==) (txt::Text) e =
687 (~:) (Text.unpack txt) $
688 (~?=)
689 (F.write
690 F.write_style
691 { F.write_style_color = False
692 , F.write_style_align = True } $
693 F.write_amount e)
694 (TL.fromStrict txt)
695 in TestList
696 [ "0" <==
697 ( mempty
698 , F.amount )
699 , "0.00" <==
700 ( mempty
701 , F.amount { F.amount_quantity = Decimal 2 0 } )
702 , "123" <==
703 ( mempty
704 , F.amount { F.amount_quantity = Decimal 0 123 } )
705 , "-123" <==
706 ( mempty
707 , F.amount { F.amount_quantity = Decimal 0 (- 123) } )
708 , "12.3" <==
709 ( mempty { F.amount_style_fractioning = Just '.' }
710 , F.amount { F.amount_quantity = Decimal 1 123 } )
711 , "1,234.56" <==
712 ( mempty
713 { F.amount_style_fractioning = Just '.'
714 , F.amount_style_grouping_integral = Just $ F.Amount_Style_Grouping ',' [3]
715 }
716 , F.amount { F.amount_quantity = Decimal 2 123456 })
717 , "123,456,789,01,2.3456789" <==
718 ( mempty
719 { F.amount_style_fractioning = Just '.'
720 , F.amount_style_grouping_integral = Just $ F.Amount_Style_Grouping ',' [1, 2, 3]
721 }
722 , F.amount { F.amount_quantity = Decimal 7 1234567890123456789 } )
723 , "1234567.8_90_123_456_789" <==
724 ( mempty
725 { F.amount_style_fractioning = Just '.'
726 , F.amount_style_grouping_fractional = Just $ F.Amount_Style_Grouping '_' [1, 2, 3]
727 }
728 , F.amount { F.amount_quantity = Decimal 12 1234567890123456789 })
729 , "1,2,3,4,5,6,7,89,012.3456789" <==
730 ( mempty
731 { F.amount_style_fractioning = Just '.'
732 , F.amount_style_grouping_integral = Just $ F.Amount_Style_Grouping ',' [3, 2, 1]
733 }
734 , F.amount { F.amount_quantity = Decimal 7 1234567890123456789 })
735 , "1234567.890_12_3_4_5_6_7_8_9" <==
736 ( mempty
737 { F.amount_style_fractioning = Just '.'
738 , F.amount_style_grouping_fractional = Just $ F.Amount_Style_Grouping '_' [3, 2, 1]
739 }
740 , F.amount { F.amount_quantity = Decimal 12 1234567890123456789 })
741 ]
742 , "write_amount_length" ~:
743 let (==>) (txt::Text) =
744 (~:) (Text.unpack txt) $
745 (~?=)
746 (F.write_amount_length <$>
747 rights [R.runParser (F.read_amount <* R.eof) () "" txt])
748 [Text.length txt]
749 in TestList $ (==>) <$>
750 [ "0.00"
751 , "123"
752 , "-123"
753 , "12.3"
754 , "12.5"
755 , "12.3"
756 , "1,234.56"
757 , "123,456,789,01,2.3456789"
758 , "1234567.8_90_123_456_789"
759 , "1,2,3,4,5,6,7,89,012.3456789"
760 , "1234567.890_12_3_4_5_6_7_8_9"
761 , "1000000.000_00_0_0_0_0_0_0_0"
762 , "999"
763 , "1000"
764 , "10,00€"
765 , "10,00 €"
766 , "€10,00"
767 , "€ 10,00"
768 , "EUR 10,00"
769 , "10,00 EUR"
770 , "\"4 2\" 10,00"
771 ]
772 , "write_account" ~:
773 let (==>) txt =
774 (~:) (Text.unpack txt) $
775 (~?=)
776 (let read (t::Text) =
777 rights [R.runParser
778 (F.read_account <* R.eof)
779 () "" t] in
780 F.write
781 F.write_style
782 { F.write_style_color = False
783 , F.write_style_align = True } <$>
784 (liftM F.write_account $ read txt)
785 )
786 [TL.fromStrict txt]
787 in TestList $ (==>) <$>
788 [ "/A/B/C"
789 ]
790 , "write_transaction" ~:
791 let (==>) (txt::Text) =
792 (~:) (Text.unpack txt) .
793 (~?=) (
794 let write (txn, ctx) =
795 F.write
796 F.write_style
797 { F.write_style_color = False
798 , F.write_style_align = True } $
799 let jnl = F.read_context_journal ctx in
800 let sty = F.journal_amount_styles jnl in
801 F.write_transaction sty txn in
802 either
803 -- (const [])
804 (pure . TL.pack . show)
805 (pure . write) $
806 R.runParser_with_Error
807 (R.and_state (F.read_transaction <* R.newline <* R.eof))
808 ( F.read_context Chart.charted F.journal
809 ::F.Read_Context F.Transaction [F.Transaction] )
810 "" txt)
811 in TestList $
812 [ Text.unlines
813 [ "2000-01-01 some wording"
814 , " /A/B/C $1"
815 , " /a/b/c"
816 ] ==> [TL.unlines
817 [ "2000-01-01 some wording"
818 , " /A/B/C $1"
819 , " /a/b/c $-1" ]]
820 , Text.unlines
821 [ "2000-01-01 some wording"
822 , " /A/B/C $1"
823 , " /a/b/c"
824 , " ; first comment"
825 , " ; second comment"
826 , " ; third comment"
827 ] ==> [TL.unlines
828 [ "2000-01-01 some wording"
829 , " /A/B/C $1"
830 , " /a/b/c $-1"
831 , " ; first comment"
832 , " ; second comment"
833 , " ; third comment" ]]
834 , Text.unlines
835 [ "2000-01-01 some wording"
836 , " /A/B/C $1"
837 , " /AA/BB/CC $123"
838 ] ==> []
839 ] ++
840 [ "nil" ~:
841 ((F.write
842 F.write_style
843 { F.write_style_color = False
844 , F.write_style_align = True } $
845 F.write_transaction
846 F.amount_styles
847 F.transaction)
848 ~?= "1970-01-01\n\n")
849 ]
850 ]
851 -}]
A language for accounting