ledger/Hcompta/Ledger/Write/Test.hs

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