]> Git — Sourcephile - comptalang.git/blob - ledger/Test/Main.hs
sourcephile / git / comptalang.git / blob
? search:
summary | shortlog | log | commit | commitdiff | tree
history | raw | HEAD
.gitignore
[comptalang.git] / ledger / 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 (Monad(..))
12 import Control.Monad.IO.Class (liftIO)
13 import Data.Bool (Bool(..))
14 import Data.Decimal (DecimalRaw(..))
15 import qualified Data.Either
16 import Data.Either (rights, either)
17 import Data.Eq (Eq(..))
18 import Data.Function (($), (.), id, const)
19 import Data.Functor (Functor(..), (<$>))
20 import Data.List ((++))
21 import Data.List.NonEmpty (NonEmpty(..))
22 import qualified Data.Map.Strict as Map
23 import Data.Maybe (Maybe(..), maybe)
24 import Data.Monoid (Monoid(..))
25 import Data.Text (Text)
26 import qualified Data.Text as Text
27 import qualified Data.Text.Lazy as TL
28 import qualified Data.Time.Calendar as Time
29 import qualified Data.Time.LocalTime as Time
30 import System.IO (IO)
31 import qualified Text.Parsec as R hiding (char, space, spaces, string)
32 import qualified Text.Parsec.Pos as R
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.Ledger as F
42 import qualified Hcompta.Format.Ledger.Read as F
43 import qualified Hcompta.Format.Ledger.Write as F
44
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 [ Time.zonedTimeToUTC $
69 Time.ZonedTime
70 (Time.LocalTime
71 (Time.fromGregorian 2000 01 01)
72 (Time.TimeOfDay 0 0 0))
73 (Time.utc) ]
74 , "2000-01-01_12:34" ==>
75 [ Time.zonedTimeToUTC $
76 Time.ZonedTime
77 (Time.LocalTime
78 (Time.fromGregorian 2000 01 01)
79 (Time.TimeOfDay 12 34 0))
80 (Time.utc) ]
81 , "2000-01-01_12:34:56" ==>
82 [ Time.zonedTimeToUTC $
83 Time.ZonedTime
84 (Time.LocalTime
85 (Time.fromGregorian 2000 01 01)
86 (Time.TimeOfDay 12 34 56))
87 (Time.utc) ]
88 , "2000-01-01_12:34_CET" ==>
89 [ Time.zonedTimeToUTC $
90 Time.ZonedTime
91 (Time.LocalTime
92 (Time.fromGregorian 2000 01 01)
93 (Time.TimeOfDay 12 34 0))
94 (Time.TimeZone 60 True "CET") ]
95 , "2000-01-01_12:34+01:30" ==>
96 [ Time.zonedTimeToUTC $
97 Time.ZonedTime
98 (Time.LocalTime
99 (Time.fromGregorian 2000 01 01)
100 (Time.TimeOfDay 12 34 0))
101 (Time.TimeZone 90 False "+01:30") ]
102 , "2000-01-01_12:34:56_CET" ==>
103 [ Time.zonedTimeToUTC $
104 Time.ZonedTime
105 (Time.LocalTime
106 (Time.fromGregorian 2000 01 01)
107 (Time.TimeOfDay 12 34 56))
108 (Time.TimeZone 60 True "CET") ]
109 , "2001-02-29" ==> []
110 ] ++
111 let (==>) (txt::Text, def) =
112 (~:) (Text.unpack txt) .
113 (~?=) (rights [R.runParser_with_Error
114 (F.read_date id (Just def) <* R.eof) () "" txt])
115 in
116 [ ("01-01", 2000) ==>
117 [ Time.zonedTimeToUTC $
118 Time.ZonedTime
119 (Time.LocalTime
120 (Time.fromGregorian 2000 01 01)
121 (Time.TimeOfDay 0 0 0))
122 (Time.utc)]
123 ]
124 , "read_account_section" ~:
125 let (==>) (txt::Text) b =
126 (~:) (Text.unpack txt) $
127 (~?=)
128 (rights [R.runParser (F.read_account_section <* R.eof) () "" txt])
129 (if b then [txt] else [])
130 in TestList
131 [ "" ==> False
132 , "A" ==> True
133 , "AA" ==> True
134 , " " ==> False
135 , ":" ==> False
136 , "A:" ==> False
137 , ":A" ==> False
138 , "A " ==> False
139 , "A A" ==> True
140 , "A " ==> False
141 , "A\t" ==> False
142 , "A \n" ==> False
143 , "(A)A" ==> True
144 , "( )A" ==> True
145 , "(A) A" ==> True
146 , "[ ] A" ==> True
147 , "(A) " ==> False
148 , "(A)" ==> True
149 , "A(A)" ==> True
150 , "[A]A" ==> True
151 , "[A] A" ==> True
152 , "[A] " ==> False
153 , "[A]" ==> True
154 , "\"A \"" ~:
155 (rights
156 [R.runParser
157 (F.read_account_section)
158 () "" ("A "::Text)])
159 ~?=
160 ["A"]
161 ]
162 , "read_account" ~:
163 let (==>) (txt::Text) =
164 (~:) (Text.unpack txt) .
165 (~?=) (rights [R.runParser
166 (F.read_account <* R.eof) () "" txt])
167 in TestList
168 [ "" ==> []
169 , "A" ==> ["A":|[]]
170 , "A:" ==> []
171 , ":A" ==> []
172 , "A " ==> []
173 , " A" ==> []
174 , "A:B" ==> ["A":|["B"]]
175 , "A:B:C" ==> ["A":|["B","C"]]
176 , "Aa:Bbb:Cccc" ==> ["Aa":|["Bbb", "Cccc"]]
177 , "A a : B b b : C c c c" ==> ["A a ":|[" B b b ", " C c c c"]]
178 , "A: :C" ==> ["A":|[" ", "C"]]
179 , "A::C" ==> []
180 , "A:B:(C)" ==> ["A":|["B", "(C)"]]
181 ]
182 , "read_amount" ~:
183 let (==>) (txt::Text) =
184 (~:) (Text.unpack txt) .
185 (~?=) (rights [R.runParser (F.read_amount <* R.eof) () "" txt])
186 in TestList
187 [ "" ==> []
188 , "0" ==>
189 [( mempty
190 , F.amount { F.amount_quantity = Decimal 0 0 } )]
191 , "00" ==>
192 [( mempty
193 , F.amount { F.amount_quantity = Decimal 0 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 [( mempty { F.amount_style_fractioning = Just ',' }
202 , F.amount { F.amount_quantity = Decimal 0 0 } )]
203 , ",0" ==>
204 [( mempty { F.amount_style_fractioning = Just ',' }
205 , F.amount { F.amount_quantity = Decimal 1 0 } )]
206 , "0_" ==> []
207 , "_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_fractioning = Just ',' }
216 , F.amount { F.amount_quantity = Decimal 1 0 } )]
217 , "00,00" ==>
218 [( mempty { F.amount_style_fractioning = Just ',' }
219 , F.amount { F.amount_quantity = Decimal 2 0 } )]
220 , "0_0" ==>
221 [( mempty { F.amount_style_grouping_integral = Just $ F.Amount_Style_Grouping '_' [1] }
222 , F.amount { F.amount_quantity = Decimal 0 0 } )]
223 , "00_00" ==>
224 [( mempty { F.amount_style_grouping_integral = Just $ F.Amount_Style_Grouping '_' [2] }
225 , F.amount { F.amount_quantity = Decimal 0 0 } )]
226 , "0,000.00" ==>
227 [( mempty
228 { F.amount_style_fractioning = Just '.'
229 , F.amount_style_grouping_integral = Just $ F.Amount_Style_Grouping ',' [3] }
230 , F.amount { F.amount_quantity = Decimal 2 0 } )]
231 , "0.000,00" ==>
232 [( mempty
233 { F.amount_style_fractioning = Just ','
234 , F.amount_style_grouping_integral = Just $ F.Amount_Style_Grouping '.' [3] }
235 , F.amount { F.amount_quantity = Decimal 2 0 } )]
236 , "1,000.00" ==>
237 [( mempty
238 { F.amount_style_fractioning = Just '.'
239 , F.amount_style_grouping_integral = Just $ F.Amount_Style_Grouping ',' [3] }
240 , F.amount { F.amount_quantity = Decimal 2 100000 } )]
241 , "1.000,00" ==>
242 [( mempty
243 { F.amount_style_fractioning = Just ','
244 , F.amount_style_grouping_integral = Just $ F.Amount_Style_Grouping '.' [3] }
245 , F.amount { F.amount_quantity = Decimal 2 100000 } )]
246 , "1,000.00." ==> []
247 , "1.000,00," ==> []
248 , "1,000.00_" ==> []
249 , "123" ==>
250 [( mempty
251 , F.amount { F.amount_quantity = Decimal 0 123 } )]
252 , "1.2" ==>
253 [( mempty { F.amount_style_fractioning = Just '.' }
254 , F.amount { F.amount_quantity = Decimal 1 12 } )]
255 , "1,2" ==>
256 [( mempty { F.amount_style_fractioning = Just ',' }
257 , F.amount { F.amount_quantity = Decimal 1 12 } )]
258 , "12.34" ==>
259 [( mempty { F.amount_style_fractioning = Just '.' }
260 , F.amount { F.amount_quantity = Decimal 2 1234 } )]
261 , "12,34" ==>
262 [( mempty { F.amount_style_fractioning = Just ',' }
263 , F.amount { F.amount_quantity = Decimal 2 1234 } )]
264 , "1_2" ==>
265 [( mempty { F.amount_style_grouping_integral = Just $ F.Amount_Style_Grouping '_' [1] }
266 , F.amount { F.amount_quantity = Decimal 0 12 } )]
267 , "1_23" ==>
268 [( mempty { F.amount_style_grouping_integral = Just $ F.Amount_Style_Grouping '_' [2] }
269 , F.amount { F.amount_quantity = Decimal 0 123 } )]
270 , "1_23_456" ==>
271 [( mempty { F.amount_style_grouping_integral = Just $ F.Amount_Style_Grouping '_' [3, 2] }
272 , F.amount { F.amount_quantity = Decimal 0 123456 } )]
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 , "1.23.456,7890_12345_678901" ==>
292 [( mempty
293 { F.amount_style_fractioning = Just ','
294 , F.amount_style_grouping_integral = Just $ F.Amount_Style_Grouping '.' [3, 2]
295 , F.amount_style_grouping_fractional = Just $ F.Amount_Style_Grouping '_' [4, 5, 6] }
296 , F.amount { F.amount_quantity = Decimal 15 123456789012345678901 } )]
297 , "123456_78901_2345.678_90_1" ==>
298 [( mempty
299 { F.amount_style_fractioning = Just '.'
300 , F.amount_style_grouping_integral = Just $ F.Amount_Style_Grouping '_' [4, 5, 6]
301 , F.amount_style_grouping_fractional = Just $ F.Amount_Style_Grouping '_' [3, 2] }
302 , F.amount { F.amount_quantity = Decimal 6 123456789012345678901 } )]
303 , "$1" ==>
304 [( mempty
305 { F.amount_style_unit_side = Just F.Amount_Style_Side_Left
306 , F.amount_style_unit_spaced = Just False }
307 , F.amount
308 { F.amount_quantity = Decimal 0 1
309 , F.amount_unit = "$" } )]
310 , "1$" ==>
311 [( mempty
312 { F.amount_style_unit_side = Just F.Amount_Style_Side_Right
313 , F.amount_style_unit_spaced = Just False }
314 , F.amount
315 { F.amount_quantity = Decimal 0 1
316 , F.amount_unit = "$" } )]
317 , "$ 1" ==>
318 [( mempty
319 { F.amount_style_unit_side = Just F.Amount_Style_Side_Left
320 , F.amount_style_unit_spaced = Just True }
321 , F.amount
322 { F.amount_quantity = Decimal 0 1
323 , F.amount_unit = "$" } )]
324 , "1 $" ==>
325 [( mempty
326 { F.amount_style_unit_side = Just F.Amount_Style_Side_Right
327 , F.amount_style_unit_spaced = Just True }
328 , F.amount
329 { F.amount_quantity = Decimal 0 1
330 , F.amount_unit = "$" } )]
331 , "-$1" ==>
332 [( mempty
333 { F.amount_style_unit_side = Just F.Amount_Style_Side_Left
334 , F.amount_style_unit_spaced = Just False }
335 , F.amount
336 { F.amount_quantity = Decimal 0 (-1)
337 , F.amount_unit = "$" } )]
338 , "\"4 2\"1" ==>
339 [( mempty
340 { F.amount_style_unit_side = Just F.Amount_Style_Side_Left
341 , F.amount_style_unit_spaced = Just False }
342 , F.amount
343 { F.amount_quantity = Decimal 0 1
344 , F.amount_unit = "4 2" } )]
345 , "1\"4 2\"" ==>
346 [( mempty
347 { F.amount_style_unit_side = Just F.Amount_Style_Side_Right
348 , F.amount_style_unit_spaced = Just False }
349 , F.amount
350 { F.amount_quantity = Decimal 0 1
351 , F.amount_unit = "4 2" } )]
352 , "$1.000,00" ==>
353 [( mempty
354 { F.amount_style_fractioning = Just ','
355 , F.amount_style_grouping_integral = Just $ F.Amount_Style_Grouping '.' [3]
356 , F.amount_style_unit_side = Just F.Amount_Style_Side_Left
357 , F.amount_style_unit_spaced = Just False }
358 , F.amount
359 { F.amount_quantity = Decimal 2 100000
360 , F.amount_unit = "$" } )]
361 , "1.000,00$" ==>
362 [( mempty
363 { F.amount_style_fractioning = Just ','
364 , F.amount_style_grouping_integral = Just $ F.Amount_Style_Grouping '.' [3]
365 , F.amount_style_unit_side = Just F.Amount_Style_Side_Right
366 , F.amount_style_unit_spaced = Just False }
367 , F.amount
368 { F.amount_quantity = Decimal 2 100000
369 , F.amount_unit = "$" } )]
370 ]
371 , "read_posting_type" ~:
372 let (==>) a (ty, ac) =
373 let read (t::Text) = rights [R.runParser
374 (F.read_account <* R.eof) () "" t] in
375 (~:) (Text.unpack a) $
376 (~?=)
377 (F.read_posting_type <$> read a)
378 (F.Posting_Typed ty <$> read (maybe a id ac))
379 in TestList
380 [ "A" ==> (F.Posting_Type_Regular, Nothing)
381 , "(" ==> (F.Posting_Type_Regular, Nothing)
382 , ")" ==> (F.Posting_Type_Regular, Nothing)
383 , "()" ==> (F.Posting_Type_Regular, Nothing)
384 , "( )" ==> (F.Posting_Type_Regular, Nothing)
385 , "(A)" ==> (F.Posting_Type_Virtual, Just "A")
386 , "(A:B:C)" ==> (F.Posting_Type_Virtual, Just "A:B:C")
387 , "A:B:C" ==> (F.Posting_Type_Regular, Nothing)
388 , "(A):B:C" ==> (F.Posting_Type_Regular, Nothing)
389 , "A:(B):C" ==> (F.Posting_Type_Regular, Nothing)
390 , "A:B:(C)" ==> (F.Posting_Type_Regular, Nothing)
391 , "[" ==> (F.Posting_Type_Regular, Nothing)
392 , "]" ==> (F.Posting_Type_Regular, Nothing)
393 , "[]" ==> (F.Posting_Type_Regular, Nothing)
394 , "[ ]" ==> (F.Posting_Type_Regular, Nothing)
395 , "[A]" ==> (F.Posting_Type_Virtual_Balanced, Just "A")
396 , "[A:B:C]" ==> (F.Posting_Type_Virtual_Balanced, Just "A:B:C")
397 , "A:B:C" ==> (F.Posting_Type_Regular, Nothing)
398 , "[A]:B:C" ==> (F.Posting_Type_Regular, Nothing)
399 , "A:[B]:C" ==> (F.Posting_Type_Regular, Nothing)
400 , "A:B:[C]" ==> (F.Posting_Type_Regular, Nothing)
401 ]
402 , "read_comment" ~:
403 let (==>) (txt::Text, end) =
404 (~:) (Text.unpack txt) .
405 (~?=) (rights [R.runParser (F.read_comment <* end) () "" txt])
406 in TestList
407 [ ("; some comment", R.eof) ==> [" some comment"]
408 , ("; some comment \n", R.newline <* R.eof) ==> [ " some comment " ]
409 , ("; some comment \r\n", R.string "\r\n" <* R.eof) ==> [ " some comment " ]
410 ]
411 , "read_comments" ~:
412 let (==>) (txt::Text, end) =
413 (~:) (Text.unpack txt) .
414 (~?=) (rights [R.runParser (F.read_comments <* end) () "" txt])
415 in TestList
416 [ ("; some comment\n ; some other comment", R.eof) ==> [ [" some comment", " some other comment"] ]
417 , ("; some comment \n", R.string "\n" <* R.eof) ==> [ [" some comment "] ]
418 ]
419 , "read_tag_value" ~:
420 let (==>) (txt::Text, end) =
421 (~:) (Text.unpack txt) .
422 (~?=) (rights [R.runParser (F.read_tag_value <* end) () "" txt])
423 in TestList
424 [ (",", R.eof) ==> [","]
425 , (",\n", R.char '\n' <* R.eof) ==> [","]
426 , (",x", R.eof) ==> [",x"]
427 , (",x:", R.string ",x:" <* R.eof) ==> [""]
428 , ("v, v, n:", R.string ", n:" <* R.eof) ==> ["v, v"]
429 ]
430 , "read_tag" ~:
431 let (==>) (txt::Text, end) =
432 (~:) (Text.unpack txt) .
433 (~?=) (rights [R.runParser (F.read_tag <* end) () "" txt])
434 in TestList
435 [ ("Name:" , R.eof) ==> [("Name":|[], "")]
436 , ("Name:Value" , R.eof) ==> [("Name":|[], "Value")]
437 , ("Name:Value\n" , R.string "\n" <* R.eof) ==> [("Name":|[], "Value")]
438 , ("Name:Val ue" , R.eof) ==> [("Name":|[], "Val ue")]
439 , ("Name:," , R.eof) ==> [("Name":|[], ",")]
440 , ("Name:Val,ue" , R.eof) ==> [("Name":|[], "Val,ue")]
441 , ("Name:Val,ue:" , R.string ",ue:" <* R.eof) ==> [("Name":|[], "Val")]
442 , ("Name:Val,ue :", R.eof) ==> [("Name":|[], "Val,ue :")]
443 ]
444 , "read_tags" ~:
445 let (==>) (txt::Text) =
446 (~:) (Text.unpack txt) .
447 (~?=) (rights [R.runParser (F.read_tags <* R.eof) () "" txt]) .
448 pure . Map.fromList
449 in TestList
450 [ "Name:" ==> [ ("Name":|[], [""]) ]
451 , "Name:," ==> [ ("Name":|[], [","]) ]
452 , "Name:,Name:" ==> [ ("Name":|[], ["", ""]) ]
453 , "Name:,Name2:" ==>
454 [ ("Name":|[], [""])
455 , ("Name2":|[], [""])
456 ]
457 , "Name: , Name2:" ==>
458 [ ("Name":|[], [" "])
459 , ("Name2":|[], [""])
460 ]
461 , "Name:,Name2:,Name3:" ==>
462 [ ("Name":|[], [""])
463 , ("Name2":|[], [""])
464 , ("Name3":|[], [""])
465 ]
466 , "Name:Val ue,Name2:V a l u e,Name3:V al ue" ==>
467 [ ("Name":|[], ["Val ue"])
468 , ("Name2":|[], ["V a l u e"])
469 , ("Name3":|[], ["V al ue"])
470 ]
471 ]
472 , "read_posting" ~:
473 let (==>) (txt::Text) =
474 let read_context =
475 ( F.read_context (const ()) F.journal
476 ::F.Read_Context () ()) in
477 (~:) (Text.unpack txt) .
478 (~?=) (rights [R.runParser_with_Error
479 (F.read_posting <* R.eof) read_context "" txt]) .
480 fmap (\p -> F.Posting_Typed F.Posting_Type_Regular
481 p { F.posting_sourcepos = R.newPos "" 1 1 })
482 in TestList
483 [ " A:B:C" ==> [F.posting ("A":|["B", "C"])]
484 , "A:B:C" ==> []
485 , " !A:B:C" ==> [(F.posting ("A":|["B", "C"]))
486 { F.posting_status = True }]
487 , " *A:B:C" ==> [(F.posting ("A":|["B", "C"]))
488 { F.posting_status = True }]
489 , " A:B:C $1" ==> [F.posting ("A":|["B", "C $1"])]
490 , " A:B:C $1" ==> [(F.posting ("A":|["B", "C"]))
491 { F.posting_amounts = Map.fromList [("$", 1)] }]
492 , " A:B:C $1 + 1€" ==> [(F.posting ("A":|["B", "C"]))
493 { F.posting_amounts = Map.fromList [("$", 1), ("€", 1)] }]
494 , " A:B:C $1 + 1$" ==> [(F.posting ("A":|["B", "C"]))
495 { F.posting_amounts = Map.fromList [("$", 2)] }]
496 , " A:B:C $1 + 1$ + 1$" ==> [(F.posting ("A":|["B", "C"]))
497 { F.posting_amounts = Map.fromList [("$", 3)] }]
498 , " A:B:C ; some comment" ==> [(F.posting ("A":|["B", "C"]))
499 { F.posting_amounts = Map.fromList []
500 , F.posting_comments = [" some comment"] }]
501 , " A:B:C ; some comment\n ; some other comment" ==>
502 [(F.posting ("A":|["B", "C"]))
503 { F.posting_amounts = Map.fromList []
504 , F.posting_comments = [" some comment", " some other comment"] }]
505 , " A:B:C $1 ; some comment" ==>
506 [(F.posting ("A":|["B", "C"]))
507 { F.posting_amounts = Map.fromList [("$", 1)]
508 , F.posting_comments = [" some comment"] }]
509 , " A:B:C ; N:V" ==>
510 [(F.posting ("A":|["B", "C"]))
511 { F.posting_comments = [" N:V"]
512 , F.posting_tags = Posting.Posting_Tags $
513 Tag.from_List [ ("N":|[], "V") ] }]
514 , " A:B:C ; some comment N:V" ==>
515 [(F.posting ("A":|["B", "C"]))
516 { F.posting_comments = [" some comment N:V"]
517 , F.posting_tags = Posting.Posting_Tags $
518 Tag.from_List [ ("N":|[], "V") ] }]
519 , " A:B:C ; some comment N:V v, N2:V2 v2" ==>
520 [(F.posting ("A":|["B", "C"]))
521 { F.posting_comments = [" some comment N:V v, N2:V2 v2"]
522 , F.posting_tags = Posting.Posting_Tags $
523 Tag.from_List
524 [ ("N":|[], "V v")
525 , ("N2":|[], "V2 v2") ] }]
526 , " A:B:C ; N:V\n ; N:V2" ==>
527 [(F.posting ("A":|["B", "C"]))
528 { F.posting_comments = [" N:V", " N:V2"]
529 , F.posting_tags = Posting.Posting_Tags $
530 Tag.from_List
531 [ ("N":|[], "V")
532 , ("N":|[], "V2")
533 ] }]
534 , " A:B:C ; N:V\n ; N2:V" ==>
535 [(F.posting ("A":|["B", "C"]))
536 { F.posting_comments = [" N:V", " N2:V"]
537 , F.posting_tags = Posting.Posting_Tags $
538 Tag.from_List
539 [ ("N":|[], "V")
540 , ("N2":|[], "V")
541 ] }]
542 , " A:B:C ; date:2001-01-01" ==>
543 [(F.posting ("A":|["B", "C"]))
544 { F.posting_comments = [" date:2001-01-01"]
545 , F.posting_dates =
546 [ Time.zonedTimeToUTC $
547 Time.ZonedTime
548 (Time.LocalTime
549 (Time.fromGregorian 2001 01 01)
550 (Time.TimeOfDay 0 0 0))
551 Time.utc
552 ]
553 , F.posting_tags = Posting.Posting_Tags $
554 Tag.from_List
555 [ ("date":|[], "2001-01-01") ] }]
556 , " (A:B:C) = Right (A:B:C)" ~:
557 (rights [R.runParser_with_Error
558 (F.read_posting <* R.eof)
559 ( F.read_context (const ()) F.journal
560 ::F.Read_Context () ())
561 "" (" (A:B:C)"::Text)]) ~?=
562 [F.Posting_Typed
563 F.Posting_Type_Virtual
564 (F.posting ("A":|["B", "C"]))]
565 , " [A:B:C] = Right [A:B:C]" ~:
566 (rights [R.runParser_with_Error
567 (F.read_posting <* R.eof)
568 ( F.read_context (const ()) F.journal
569 ::F.Read_Context () ())
570 "" (" [A:B:C]"::Text)]) ~?=
571 [F.Posting_Typed
572 F.Posting_Type_Virtual_Balanced
573 (F.posting ("A":|["B", "C"]))]
574 ]
575 , "read_transaction" ~:
576 let (==>) (txt::Text) =
577 let read_context =
578 ( F.read_context (const ()) F.journal
579 ::F.Read_Context () ()) in
580 (~:) (Text.unpack txt) .
581 (~?=) (rights [R.runParser_with_Error
582 (F.read_transaction <* R.eof) read_context "" txt]) .
583 fmap (\t -> t { F.transaction_sourcepos = R.newPos "" 1 1 })
584 in TestList
585 [ "2000-01-01 some wording\n A:B:C $1\n a:b:c" ==>
586 [F.transaction
587 { F.transaction_dates=
588 ( Time.zonedTimeToUTC $
589 Time.ZonedTime
590 (Time.LocalTime
591 (Time.fromGregorian 2000 01 01)
592 (Time.TimeOfDay 0 0 0))
593 (Time.utc)
594 , [] )
595 , F.transaction_wording="some wording"
596 , F.transaction_postings = F.postings_by_account
597 [ (F.posting ("A":|["B", "C"]))
598 { F.posting_amounts = Map.fromList [ ("$", 1) ]
599 , F.posting_sourcepos = R.newPos "" 2 1 }
600 , (F.posting ("a":|["b", "c"]))
601 { F.posting_amounts = Map.fromList [ ("$", -1) ]
602 , F.posting_sourcepos = R.newPos "" 3 1 }
603 ]
604 }]
605 , "2000-01-01 some wording\n A:B:C $1\n a:b:c\n" ==> []
606 , "2000-01-01 some wording ; some comment\n ; some other;comment\n ; some Tag:\n ; some last comment\n A:B:C $1\n a:b:c" ==>
607 [F.transaction
608 { F.transaction_comments_after =
609 [ " some comment"
610 , " some other;comment"
611 , " some Tag:"
612 , " some last comment"
613 ]
614 , F.transaction_dates=
615 ( Time.zonedTimeToUTC $
616 Time.ZonedTime
617 (Time.LocalTime
618 (Time.fromGregorian 2000 01 01)
619 (Time.TimeOfDay 0 0 0))
620 (Time.utc)
621 , [] )
622 , F.transaction_wording="some wording"
623 , F.transaction_postings = F.postings_by_account
624 [ (F.posting ("A":|["B", "C"]))
625 { F.posting_amounts = Map.fromList [ ("$", 1) ]
626 , F.posting_sourcepos = R.newPos "" 5 1 }
627 , (F.posting ("a":|["b", "c"]))
628 { F.posting_amounts = Map.fromList [ ("$", -1) ]
629 , F.posting_sourcepos = R.newPos "" 6 1 } ]
630 , F.transaction_tags = Transaction.Transaction_Tags $
631 Tag.from_List [ ("Tag":|[], "") ] }]
632 ]
633 , "read_journal" ~: TestList
634 [ "2000-01-01 1° wording\\n A:B:C $1\\n a:b:c\\n2000-01-02 2° wording\\n A:B:C $1\\n x:y:z" ~: TestCase $ do
635 jnl <- liftIO $
636 R.runParserT_with_Error
637 (F.read_journal "" {-<* R.eof-})
638 ( F.read_context id F.journal
639 ::F.Read_Context (F.Charted F.Transaction)
640 ([F.Charted F.Transaction]))
641 "" ("2000-01-01 1° wording\n A:B:C $1\n a:b:c\n2000-01-02 2° wording\n A:B:C $1\n x:y:z"::Text)
642 ((\j -> j{F.journal_last_read_time=Date.nil}) <$>
643 Data.Either.rights [jnl])
644 @?=
645 [F.journal
646 { F.journal_content =
647 fmap (Chart.Charted mempty) $
648 [ F.transaction
649 { F.transaction_dates=
650 ( Time.zonedTimeToUTC $
651 Time.ZonedTime
652 (Time.LocalTime
653 (Time.fromGregorian 2000 01 02)
654 (Time.TimeOfDay 0 0 0))
655 (Time.utc)
656 , [] )
657 , F.transaction_wording="2° wording"
658 , F.transaction_postings = F.postings_by_account
659 [ (F.posting ("A":|["B", "C"]))
660 { F.posting_amounts = Map.fromList [ ("$", 1) ]
661 , F.posting_sourcepos = R.newPos "" 5 1
662 }
663 , (F.posting ("x":|["y", "z"]))
664 { F.posting_amounts = Map.fromList [ ("$", -1) ]
665 , F.posting_sourcepos = R.newPos "" 6 1
666 }
667 ]
668 , F.transaction_sourcepos = R.newPos "" 4 1
669 }
670 , F.transaction
671 { F.transaction_dates=
672 ( Time.zonedTimeToUTC $
673 Time.ZonedTime
674 (Time.LocalTime
675 (Time.fromGregorian 2000 01 01)
676 (Time.TimeOfDay 0 0 0))
677 (Time.utc)
678 , [] )
679 , F.transaction_wording="1° wording"
680 , F.transaction_postings = F.postings_by_account
681 [ (F.posting ("A":|["B", "C"]))
682 { F.posting_amounts = Map.fromList [ ("$", 1) ]
683 , F.posting_sourcepos = R.newPos "" 2 1
684 }
685 , (F.posting ("a":|["b", "c"]))
686 { F.posting_amounts = Map.fromList [ ("$", -1) ]
687 , F.posting_sourcepos = R.newPos "" 3 1
688 }
689 ]
690 , F.transaction_sourcepos = R.newPos "" 1 1
691 }
692 ]
693 , F.journal_files = [""]
694 , F.journal_amount_styles = F.Amount_Styles $ Map.fromList
695 [ ( F.Unit "$"
696 , mempty
697 { F.amount_style_unit_side = Just F.Amount_Style_Side_Left
698 , F.amount_style_unit_spaced = Just False }
699 )
700 ]
701 }
702 ]
703 ]
704 , "read_journal" ~: TestList
705 [ let (==>) (txt::Text) e =
706 (~:) (Text.unpack txt) $
707 TestCase $ do
708 jnl <-
709 liftIO $
710 right (\j -> j{F.journal_last_read_time=Date.nil}) <$>
711 R.runParserT_with_Error
712 (F.read_journal "" {-<* R.eof-})
713 ( F.read_context id F.journal
714 ::F.Read_Context (F.Charted F.Transaction)
715 ([F.Charted F.Transaction]))
716 "" (txt::Text)
717 (@?=) (rights [jnl]) e
718 in TestList
719 [ Text.unlines
720 [ "2000-01-01 1° wording"
721 , " A:B:C $1"
722 , " a:b:c"
723 , "2000-01-02 2° wording"
724 , " A:B:C $1"
725 , " x:y:z"
726 ] ==>
727 [ F.journal
728 { F.journal_content =
729 fmap (Chart.Charted mempty) $
730 [ F.transaction
731 { F.transaction_dates=
732 ( Time.zonedTimeToUTC $
733 Time.ZonedTime
734 (Time.LocalTime
735 (Time.fromGregorian 2000 01 02)
736 (Time.TimeOfDay 0 0 0))
737 (Time.utc)
738 , [] )
739 , F.transaction_wording="2° wording"
740 , F.transaction_postings = F.postings_by_account
741 [ (F.posting ("A":|["B", "C"]))
742 { F.posting_amounts = Map.fromList [ ("$", 1) ]
743 , F.posting_sourcepos = R.newPos "" 5 1
744 }
745 , (F.posting ("x":|["y", "z"]))
746 { F.posting_amounts = Map.fromList [ ("$", -1) ]
747 , F.posting_sourcepos = R.newPos "" 6 1
748 }
749 ]
750 , F.transaction_sourcepos = R.newPos "" 4 1
751 }
752 , F.transaction
753 { F.transaction_dates=
754 ( Time.zonedTimeToUTC $
755 Time.ZonedTime
756 (Time.LocalTime
757 (Time.fromGregorian 2000 01 01)
758 (Time.TimeOfDay 0 0 0))
759 (Time.utc)
760 , [] )
761 , F.transaction_wording="1° wording"
762 , F.transaction_postings = F.postings_by_account
763 [ (F.posting ("A":|["B", "C"]))
764 { F.posting_amounts = Map.fromList [ ("$", 1) ]
765 , F.posting_sourcepos = R.newPos "" 2 1
766 }
767 , (F.posting ("a":|["b", "c"]))
768 { F.posting_amounts = Map.fromList [ ("$", -1) ]
769 , F.posting_sourcepos = R.newPos "" 3 1
770 }
771 ]
772 , F.transaction_sourcepos = R.newPos "" 1 1
773 }
774 ]
775 , F.journal_files = [""]
776 , F.journal_amount_styles = F.Amount_Styles $ Map.fromList
777 [ ( F.Unit "$"
778 , mempty
779 { F.amount_style_unit_side = Just F.Amount_Style_Side_Left
780 , F.amount_style_unit_spaced = Just False }
781 )
782 ]
783 }
784 ]
785 ]
786 ]
787 ]
788 , "Write" ~: TestList
789 [ "write_date" ~:
790 let (==>) (txt::Text) e =
791 (~:) (Text.unpack txt) $
792 (~?=)
793 (F.write
794 F.write_style
795 { F.write_style_color = False
796 , F.write_style_align = True } .
797 F.write_date <$>
798 rights [R.runParser_with_Error
799 (F.read_date id Nothing <* R.eof) () "" txt])
800 [e]
801 in TestList
802 [ "" ~:
803 ((F.write
804 F.write_style
805 { F.write_style_color = False
806 , F.write_style_align = True } $
807 F.write_date Date.nil)
808 ~?= "1970-01-01")
809 , "2000-01-01" ==> "2000-01-01"
810 , "2000-01-01_12:34:51_CET" ==> "2000-01-01_11:34:51"
811 , "2000-01-01_12:34:51+01:10" ==> "2000-01-01_11:24:51"
812 , "2000-01-01_12:34:51-01:10" ==> "2000-01-01_13:44:51"
813 , "2000-01-01_01:02:03" ==> "2000-01-01_01:02:03"
814 , "2000-01-01_01:02" ==> "2000-01-01_01:02"
815 , "2000-01-01_01:00" ==> "2000-01-01_01:00"
816 ]
817 , "write_amount" ~:
818 let (<==) (txt::Text) e =
819 (~:) (Text.unpack txt) $
820 (~?=)
821 (F.write
822 F.write_style
823 { F.write_style_color = False
824 , F.write_style_align = True } $
825 F.write_amount e)
826 (TL.fromStrict txt)
827 in TestList
828 [ "0" <==
829 ( mempty
830 , F.amount )
831 , "0.00" <==
832 ( mempty
833 , F.amount { F.amount_quantity = Decimal 2 0 } )
834 , "123" <==
835 ( mempty
836 , F.amount { F.amount_quantity = Decimal 0 123 } )
837 , "-123" <==
838 ( mempty
839 , F.amount { F.amount_quantity = Decimal 0 (- 123) } )
840 , "12.3" <==
841 ( mempty { F.amount_style_fractioning = Just '.' }
842 , F.amount { F.amount_quantity = Decimal 1 123 } )
843 , "1,234.56" <==
844 ( mempty
845 { F.amount_style_fractioning = Just '.'
846 , F.amount_style_grouping_integral = Just $ F.Amount_Style_Grouping ',' [3]
847 }
848 , F.amount { F.amount_quantity = Decimal 2 123456 })
849 , "123,456,789,01,2.3456789" <==
850 ( mempty
851 { F.amount_style_fractioning = Just '.'
852 , F.amount_style_grouping_integral = Just $ F.Amount_Style_Grouping ',' [1, 2, 3]
853 }
854 , F.amount { F.amount_quantity = Decimal 7 1234567890123456789 } )
855 , "1234567.8_90_123_456_789" <==
856 ( mempty
857 { F.amount_style_fractioning = Just '.'
858 , F.amount_style_grouping_fractional = Just $ F.Amount_Style_Grouping '_' [1, 2, 3]
859 }
860 , F.amount { F.amount_quantity = Decimal 12 1234567890123456789 })
861 , "1,2,3,4,5,6,7,89,012.3456789" <==
862 ( mempty
863 { F.amount_style_fractioning = Just '.'
864 , F.amount_style_grouping_integral = Just $ F.Amount_Style_Grouping ',' [3, 2, 1]
865 }
866 , F.amount { F.amount_quantity = Decimal 7 1234567890123456789 })
867 , "1234567.890_12_3_4_5_6_7_8_9" <==
868 ( mempty
869 { F.amount_style_fractioning = Just '.'
870 , F.amount_style_grouping_fractional = Just $ F.Amount_Style_Grouping '_' [3, 2, 1]
871 }
872 , F.amount { F.amount_quantity = Decimal 12 1234567890123456789 })
873 ]
874 , "write_amount_length" ~:
875 let (==>) (txt::Text) =
876 (~:) (Text.unpack txt) $
877 (~?=)
878 (F.write_amount_length <$>
879 rights [R.runParser (F.read_amount <* R.eof) () "" txt])
880 [Text.length txt]
881 in TestList $ (==>) <$>
882 [ "0.00"
883 , "123"
884 , "-123"
885 , "12.3"
886 , "12.5"
887 , "12.3"
888 , "1,234.56"
889 , "123,456,789,01,2.3456789"
890 , "1234567.8_90_123_456_789"
891 , "1,2,3,4,5,6,7,89,012.3456789"
892 , "1234567.890_12_3_4_5_6_7_8_9"
893 , "1000000.000_00_0_0_0_0_0_0_0"
894 , "999"
895 , "1000"
896 , "10,00€"
897 , "10,00 €"
898 , "€10,00"
899 , "€ 10,00"
900 , "EUR 10,00"
901 , "10,00 EUR"
902 , "\"4 2\" 10,00"
903 ]
904 , "write_account" ~:
905 let (==>) txt =
906 (~:) (Text.unpack txt) $
907 (~?=)
908 (let read (t::Text) =
909 rights [R.runParser
910 (F.read_account <* R.eof)
911 () "" t] in
912 F.write
913 F.write_style
914 { F.write_style_color = False
915 , F.write_style_align = True } <$>
916 (read txt >>= \a ->
917 let F.Posting_Typed ty ac = F.read_posting_type a in
918 return $ F.write_account ty ac)
919 )
920 [TL.fromStrict txt]
921 in TestList $ (==>) <$>
922 [ "A"
923 , "(A:B:C)"
924 , "[A:B:C]"
925 ]
926 , "write_transaction" ~:
927 let (==>) (txt::Text) =
928 (~:) (Text.unpack txt) .
929 (~?=) (
930 let write (txn, ctx) =
931 F.write
932 F.write_style
933 { F.write_style_color = False
934 , F.write_style_align = True } $
935 let jnl = F.read_context_journal ctx in
936 let sty = F.journal_amount_styles jnl in
937 F.write_transaction sty txn in
938 either
939 (const []) {-(pure . TL.pack . show)-}
940 (pure . write) $
941 R.runParser_with_Error
942 (R.and_state (F.read_transaction <* R.newline <* R.eof))
943 ( F.read_context Chart.charted F.journal
944 ::F.Read_Context F.Transaction [F.Transaction] )
945 "" txt)
946 in TestList $
947 [ Text.unlines
948 [ "2000-01-01 some wording"
949 , " A:B:C $1"
950 , " a:b:c"
951 ] ==> [TL.unlines
952 [ "2000-01-01 some wording"
953 , " A:B:C $1"
954 , " a:b:c $-1"
955 ]]
956 , Text.unlines
957 [ "2000-01-01 some wording"
958 , " A:B:C $1"
959 , " a:b:c"
960 , " ; first comment"
961 , " ; second comment"
962 , " ; third comment"
963 ] ==> [TL.unlines
964 [ "2000-01-01 some wording"
965 , " A:B:C $1"
966 , " a:b:c $-1"
967 , " ; first comment"
968 , " ; second comment"
969 , " ; third comment"
970 ]]
971 , Text.unlines
972 [ "2000-01-01 some wording"
973 , " A:B:C $1"
974 , " AA:BB:CC $123"
975 ] ==> []
976 ] ++
977 [ "nil" ~:
978 ((F.write
979 F.write_style
980 { F.write_style_color = False
981 , F.write_style_align = True } $
982 F.write_transaction
983 F.amount_styles
984 F.transaction)
985 ~?= "1970-01-01\n\n")
986 ]
987 ]
988 ]
A language for accounting