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