lcc/Hcompta/LCC/Write/Test.hs

   1 module Write.Test where
   2
   3 import           Test.Tasty
   4 import           Test.Tasty.HUnit
   5
   6 import           Data.Bool
   7 import           Data.Data ()
   8 import           Data.Decimal (DecimalRaw(..))
   9 import           Data.Either (Either(..))
  10 import           Data.Function (($), (.))
  11 import           Data.Functor ((<$>))
  12 import           Data.Monoid (Monoid(..))
  13 import           Data.Text (Text)
  14 import qualified Data.Text as Text
  15 import qualified Data.Text.Lazy as TL
  16 import           Data.Tuple (uncurry)
  17 import qualified Data.Strict as S
  18
  19 import qualified Hcompta as H
  20 import qualified Hcompta.LCC as LCC
  21
  22 import Read.Test (test, read_gram)
  23
  24 tests :: TestTree
  25 tests = testGroup "Write"
  26  [ testGroup "Date" $
  27         let (==>) (inp::Text) exp =
  28                 test inp $
  29                 (LCC.write
  30                  LCC.style_write
  31                          { LCC.style_write_color = False
  32                          , LCC.style_write_align = True } .
  33                  LCC.write_date <$>) <$>
  34                 read_gram LCC.g_date inp
  35                  @?= Right (S.Right exp) in
  36          [ test "Epoch" $
  37                 LCC.write
  38                  LCC.style_write
  39                          { LCC.style_write_color = False
  40                          , LCC.style_write_align = True }
  41                  (LCC.write_date H.date_epoch)
  42                 @?= "1970-01-01"
  43          , "2000-01-01"                ==> "2000-01-01"
  44          , "2000-01-01_12:34:51_CET"   ==> "2000-01-01_11:34:51"
  45          , "2000-01-01_12:34:51+01:10" ==> "2000-01-01_11:24:51"
  46          , "2000-01-01_12:34:51-01:10" ==> "2000-01-01_13:44:51"
  47          , "2000-01-01_01:02:03"       ==> "2000-01-01_01:02:03"
  48          , "2000-01-01_01:02"          ==> "2000-01-01_01:02"
  49          , "2000-01-01_01:00"          ==> "2000-01-01_01:00"
  50          ]
  51  , testGroup "Amount" $
  52         let (<==) (inp::Text) exp =
  53                 test inp $
  54                 LCC.write
  55                  LCC.style_write
  56                          { LCC.style_write_color = False
  57                          , LCC.style_write_align = True }
  58                  (LCC.write_amount exp)
  59                  @?= TL.fromStrict inp in
  60          [ "0" <==
  61                 ( mempty
  62                 , LCC.amount )
  63          , "0.00" <==
  64                 ( mempty
  65                 , LCC.amount { LCC.amount_quantity = Decimal 2 0 } )
  66          , "123" <==
  67                 ( mempty
  68                 , LCC.amount { LCC.amount_quantity = Decimal 0 123 } )
  69          , "-123" <==
  70                 ( mempty
  71                 , LCC.amount { LCC.amount_quantity = Decimal 0 (- 123) } )
  72          , "12.3" <==
  73                 ( mempty { LCC.style_amount_fractioning = S.Just '.' }
  74                 , LCC.amount { LCC.amount_quantity = Decimal 1 123 } )
  75          , "1,234.56" <==
  76                 ( mempty
  77                          { LCC.style_amount_fractioning       = S.Just '.'
  78                          , LCC.style_amount_grouping_integral = S.Just $ LCC.Style_Amount_Grouping ',' [3]
  79                          }
  80                 , LCC.amount { LCC.amount_quantity = Decimal 2 123456 })
  81          , "123,456,789,01,2.3456789" <==
  82                 ( mempty
  83                          { LCC.style_amount_fractioning       = S.Just '.'
  84                          , LCC.style_amount_grouping_integral = S.Just $ LCC.Style_Amount_Grouping ',' [1, 2, 3]
  85                          }
  86                 , LCC.amount { LCC.amount_quantity = Decimal 7 1234567890123456789 } )
  87          , "1234567.8_90_123_456_789" <==
  88                 ( mempty
  89                          { LCC.style_amount_fractioning         = S.Just '.'
  90                          , LCC.style_amount_grouping_fractional = S.Just $ LCC.Style_Amount_Grouping '_' [1, 2, 3]
  91                          }
  92                 , LCC.amount { LCC.amount_quantity = Decimal 12 1234567890123456789 })
  93          , "1,2,3,4,5,6,7,89,012.3456789" <==
  94                 ( mempty
  95                          { LCC.style_amount_fractioning       = S.Just '.'
  96                          , LCC.style_amount_grouping_integral = S.Just $ LCC.Style_Amount_Grouping ',' [3, 2, 1]
  97                          }
  98                 , LCC.amount { LCC.amount_quantity = Decimal 7 1234567890123456789 })
  99          , "1234567.890_12_3_4_5_6_7_8_9" <==
 100                 ( mempty
 101                          { LCC.style_amount_fractioning         = S.Just '.'
 102                          , LCC.style_amount_grouping_fractional = S.Just $ LCC.Style_Amount_Grouping '_' [3, 2, 1]
 103                          }
 104                 , LCC.amount { LCC.amount_quantity = Decimal 12 1234567890123456789 })
 105          , testGroup "Width" $
 106                 let (==>) (inp::Text) =
 107                         test inp $
 108                         LCC.width_amount <$> read_gram LCC.g_amount inp
 109                          @?= Right (Text.length inp) in
 110                 (==>) <$>
 111                  [ "0.00"
 112                  , "123"
 113                  , "-123"
 114                  , "12.3"
 115                  , "12.5"
 116                  , "12.3"
 117                  , "1,234.56"
 118                  , "123,456,789,01,2.3456789"
 119                  , "1234567.8_90_123_456_789"
 120                  , "1,2,3,4,5,6,7,89,012.3456789"
 121                  , "1234567.890_12_3_4_5_6_7_8_9"
 122                  , "1000000.000_00_0_0_0_0_0_0_0"
 123                  , "999"
 124                  , "1000"
 125                  , "10,00€"
 126                  , "10,00 €"
 127                  , "€10,00"
 128                  , "€ 10,00"
 129                  -- , "EUR 10,00"
 130                  -- , "10,00 EUR"
 131                  ]
 132          ]
 133  , testGroup "Account" $
 134         let (==>) inp =
 135                 test inp $
 136                 LCC.write
 137                  LCC.style_write
 138                          { LCC.style_write_color = False
 139                          , LCC.style_write_align = True } .
 140                  LCC.write_account <$>
 141                 read_gram LCC.g_account inp
 142                  @?= Right (TL.fromStrict inp) in
 143         (==>) <$>
 144          [ "/A/B/C"
 145          ]
 146  , testGroup "Transaction" $
 147         let (==>) i e =
 148                 let inp = Text.intercalate "\n" i in
 149                 let exp = Text.intercalate "\n" e in
 150                 test inp $
 151                 (LCC.write
 152                   LCC.style_write
 153                          { LCC.style_write_color = False
 154                          , LCC.style_write_align = True } .
 155                  (uncurry LCC.write_transaction) <$>) <$>
 156                 read_gram (LCC.g_get $
 157                         (\txn context_write_amounts ->
 158                                 (LCC.Context_Write
 159                                  { LCC.context_write_account_ref       = True
 160                                  , LCC.context_write_max_posting_width = 0
 161                                  , LCC.context_write_amounts
 162                                  },) <$> txn
 163                          ) <$> LCC.g_transaction
 164                  ) inp
 165                  @?= Right (S.Right (TL.fromStrict exp))
 166                 in
 167          [ [ "2000-01-01 some wording"
 168                  , "  /A/B/C  $1"
 169                  , "  /a/b/c"
 170                  ] ==>
 171                  [ "2000-01-01 some wording"
 172                  , "  /A/B/C  $1"
 173                  , "  /a/b/c $-1"
 174                  ]
 175          , [ "2000-01-01 some wording"
 176                  , "  /A/B/C $1"
 177                  , "  /a/b/c"
 178                  , "   ; first comment"
 179                  , "   ; second comment"
 180                  , "   ; third comment"
 181                  ] ==>
 182                  [ "2000-01-01 some wording"
 183                  , "  /A/B/C  $1"
 184                  , "  /a/b/c $-1"
 185                  , "   ; first comment"
 186                  , "   ; second comment"
 187                  , "   ; third comment"
 188                  ]
 189          , test "empty" $
 190                 LCC.write
 191                  LCC.style_write
 192                          { LCC.style_write_color = False
 193                          , LCC.style_write_align = True }
 194                  (LCC.write_transaction
 195                          LCC.context_write
 196                          LCC.transaction)
 197                 @?= "1970-01-01\n"
 198          ]
 199  ]