lcc/Hcompta/LCC/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.LCC as LCC
  39 import qualified Hcompta.LCC.Lib.Parsec as R
  40
  41 import Read.Test (test)
  42
  43 tests :: TestTree
  44 tests = testGroup "Write"
  45  [ testGroup "write_date" $
  46         let (==>) (txt::Text) e =
  47                 test (Text.unpack txt) $
  48                 (@?=)
  49                  (LCC.write
  50                         LCC.write_style
  51                          { LCC.write_style_color = False
  52                          , LCC.write_style_align = True } .
  53                         LCC.write_date <$>
  54                         rights [R.runParserWithError
  55                          (LCC.read_date id Nothing <* R.eof) () "" txt])
  56                  [e] in
  57          [ test "date_epoch" $
  58                 LCC.write
  59                  LCC.write_style
  60                          { LCC.write_style_color = False
  61                          , LCC.write_style_align = True }
  62                  (LCC.write_date H.date_epoch)
  63                 @?= "1970-01-01"
  64          , "2000-01-01"                ==> "2000-01-01"
  65          , "2000-01-01_12:34:51_CET"   ==> "2000-01-01_11:34:51"
  66          , "2000-01-01_12:34:51+01:10" ==> "2000-01-01_11:24:51"
  67          , "2000-01-01_12:34:51-01:10" ==> "2000-01-01_13:44:51"
  68          , "2000-01-01_01:02:03"       ==> "2000-01-01_01:02:03"
  69          , "2000-01-01_01:02"          ==> "2000-01-01_01:02"
  70          , "2000-01-01_01:00"          ==> "2000-01-01_01:00"
  71          ]
  72  , testGroup "write_amount" $
  73         let (<==) (txt::Text) e =
  74                 test (Text.unpack txt) $
  75                 (@?=)
  76                  (LCC.write
  77                         LCC.write_style
  78                          { LCC.write_style_color = False
  79                          , LCC.write_style_align = True } $
  80                         LCC.write_amount e)
  81                  (TL.fromStrict txt) in
  82          [ "0" <==
  83                 ( mempty
  84                 , LCC.amount )
  85          , "0.00" <==
  86                 ( mempty
  87                 , LCC.amount { LCC.amount_quantity = Decimal 2 0 } )
  88          , "123" <==
  89                 ( mempty
  90                 , LCC.amount { LCC.amount_quantity = Decimal 0 123 } )
  91          , "-123" <==
  92                 ( mempty
  93                 , LCC.amount { LCC.amount_quantity = Decimal 0 (- 123) } )
  94          , "12.3" <==
  95                 ( mempty { LCC.amount_style_fractioning = Just '.' }
  96                 , LCC.amount { LCC.amount_quantity = Decimal 1 123 } )
  97          , "1,234.56" <==
  98                 ( mempty
  99                          { LCC.amount_style_fractioning       = Just '.'
 100                          , LCC.amount_style_grouping_integral = Just $ LCC.Amount_Style_Grouping ',' [3]
 101                          }
 102                 , LCC.amount { LCC.amount_quantity = Decimal 2 123456 })
 103          , "123,456,789,01,2.3456789" <==
 104                 ( mempty
 105                          { LCC.amount_style_fractioning       = Just '.'
 106                          , LCC.amount_style_grouping_integral = Just $ LCC.Amount_Style_Grouping ',' [1, 2, 3]
 107                          }
 108                 , LCC.amount { LCC.amount_quantity = Decimal 7 1234567890123456789 } )
 109          , "1234567.8_90_123_456_789" <==
 110                 ( mempty
 111                          { LCC.amount_style_fractioning         = Just '.'
 112                          , LCC.amount_style_grouping_fractional = Just $ LCC.Amount_Style_Grouping '_' [1, 2, 3]
 113                          }
 114                 , LCC.amount { LCC.amount_quantity = Decimal 12 1234567890123456789 })
 115          , "1,2,3,4,5,6,7,89,012.3456789" <==
 116                 ( mempty
 117                          { LCC.amount_style_fractioning       = Just '.'
 118                          , LCC.amount_style_grouping_integral = Just $ LCC.Amount_Style_Grouping ',' [3, 2, 1]
 119                          }
 120                 , LCC.amount { LCC.amount_quantity = Decimal 7 1234567890123456789 })
 121          , "1234567.890_12_3_4_5_6_7_8_9" <==
 122                 ( mempty
 123                          { LCC.amount_style_fractioning         = Just '.'
 124                          , LCC.amount_style_grouping_fractional = Just $ LCC.Amount_Style_Grouping '_' [3, 2, 1]
 125                          }
 126                 , LCC.amount { LCC.amount_quantity = Decimal 12 1234567890123456789 })
 127          ]
 128  , testGroup "write_amount_length" $
 129         let (==>) (txt::Text) =
 130                 test (Text.unpack txt) $
 131                 (@?=)
 132                  (LCC.write_amount_length <$>
 133                         rights [R.runParser (LCC.read_amount <* R.eof) () "" txt])
 134                  [Text.length txt] in
 135         (==>) <$>
 136          [ "0.00"
 137          , "123"
 138          , "-123"
 139          , "12.3"
 140          , "12.5"
 141          , "12.3"
 142          , "1,234.56"
 143          , "123,456,789,01,2.3456789"
 144          , "1234567.8_90_123_456_789"
 145          , "1,2,3,4,5,6,7,89,012.3456789"
 146          , "1234567.890_12_3_4_5_6_7_8_9"
 147          , "1000000.000_00_0_0_0_0_0_0_0"
 148          , "999"
 149          , "1000"
 150          , "10,00€"
 151          , "10,00 €"
 152          , "€10,00"
 153          , "€ 10,00"
 154          , "EUR 10,00"
 155          , "10,00 EUR"
 156          , "\"4 2\" 10,00"
 157          ]
 158  , testGroup "write_account" $
 159         let (==>) txt =
 160                 test (Text.unpack txt) $
 161                 (@?=)
 162                  (let read (t::Text) =
 163                                 rights [R.runParser
 164                                  (LCC.read_account <* R.eof)
 165                                  () "" t] in
 166                         LCC.write
 167                          LCC.write_style
 168                                  { LCC.write_style_color = False
 169                                  , LCC.write_style_align = True } <$>
 170                          (LCC.write_account <$> read txt)
 171                  )
 172                  [TL.fromStrict txt] in
 173         (==>) <$>
 174          [ "/A/B/C"
 175          ]
 176  , testGroup "write_transaction" $
 177         let (==>) (lines::[Text]) =
 178                 let txt = Text.unlines lines in
 179                 test (Text.unpack txt) .
 180                 (@?=) (
 181                         let write (txn, ctx) =
 182                                 LCC.write
 183                                  LCC.write_style
 184                                          { LCC.write_style_color = False
 185                                          , LCC.write_style_align = True } $
 186                                         let jnl = LCC.context_read_journal ctx in
 187                                         let sty = LCC.journal_amount_styles jnl in
 188                                         LCC.write_transaction sty txn in
 189                         either
 190                          (const [])
 191                          -- (pure . TL.pack . show)
 192                          (pure . write) $
 193                         R.runParserWithError
 194                          (R.and_state (LCC.read_transaction <* R.newline <* R.eof))
 195                          ( LCC.context_read LCC.charted LCC.journal
 196                          ::LCC.Context_Read LCC.Transaction [LCC.Transaction] )
 197                          "" txt) .
 198                 (TL.unlines <$>) in
 199          [ [ "2000-01-01 some wording"
 200                  , "  /A/B/C  $1"
 201                  , "  /a/b/c"
 202                  ] ==> [
 203                  [ "2000-01-01 some wording"
 204                  , "  /A/B/C  $1"
 205                  , "  /a/b/c $-1" ]]
 206          , [ "2000-01-01 some wording"
 207                  , "  /A/B/C $1"
 208                  , "  /a/b/c"
 209                  , "   ; first comment"
 210                  , "   ; second comment"
 211                  , "   ; third comment"
 212                  ] ==> [
 213                  [ "2000-01-01 some wording"
 214                  , "  /A/B/C  $1"
 215                  , "  /a/b/c $-1"
 216                  , "   ; first comment"
 217                  , "   ; second comment"
 218                  , "   ; third comment" ]]
 219          , [ "2000-01-01 some wording"
 220                  , "  /A/B/C      $1"
 221                  , "  /AA/BB/CC $123"
 222                  ] ==> []
 223          , test "empty" $
 224                 LCC.write
 225                  LCC.write_style
 226                          { LCC.write_style_color = False
 227                          , LCC.write_style_align = True }
 228                  (LCC.write_transaction
 229                          LCC.amount_styles
 230                          LCC.transaction)
 231                 @?= "1970-01-01\n\n"
 232          ]
 233  ]