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  ]