ledger/Hcompta/Ledger/Read/Test.hs

   1 {-# LANGUAGE OverloadedStrings #-}
   2 {-# LANGUAGE ScopedTypeVariables #-}
   3
   4 module Read.Test where
   5
   6 import           Control.Applicative (Applicative(..), (<*))
   7 import           Control.Arrow (right)
   8 import           Control.Monad.IO.Class (MonadIO(..))
   9 import           Data.Bool
  10 import           Data.Data ()
  11 import           Data.Decimal (DecimalRaw(..))
  12 import           Data.Either (rights)
  13 import           Data.Function (($), (.), id, const)
  14 import           Data.Functor ((<$>))
  15 import           Data.List.NonEmpty (NonEmpty(..))
  16 import qualified Data.Map.Strict as Map
  17 import           Data.Maybe (Maybe(..), fromMaybe)
  18 import           Data.Monoid (Monoid(..), (<>))
  19 import           Data.Text (Text)
  20 import qualified Data.Text as Text
  21 import qualified Data.Time.Calendar  as Time
  22 import qualified Data.Time.LocalTime as Time
  23 import           Test.Tasty
  24 import           Test.Tasty.HUnit
  25 import qualified Text.Parsec as R hiding
  26                   ( char
  27                   , anyChar
  28                   , crlf
  29                   , newline
  30                   , noneOf
  31                   , oneOf
  32                   , satisfy
  33                   , space
  34                   , spaces
  35                   , string
  36                   , tab
  37                   )
  38 import qualified Text.Parsec.Combinator.CorrectSourcePosWithTab as R
  39 import qualified Text.Parsec.Error.Custom as R
  40 import qualified Text.Parsec.Pos as R
  41
  42 import qualified Hcompta as H
  43 import qualified Hcompta.Ledger as Ledger
  44
  45 tests :: TestTree
  46 tests = testGroup "Read"
  47  [ testGroup "read_date" $
  48         (let (==>) (txt::Text) =
  49                 testCase (Text.unpack txt) .
  50                 (@?=) (rights [R.runParserWithError
  51                  (Ledger.read_date id Nothing <* R.eof) () "" txt]) in
  52          [ "2000-01-01" ==>
  53                  [ Time.zonedTimeToUTC $
  54                         Time.ZonedTime
  55                          (Time.LocalTime
  56                                  (Time.fromGregorian 2000 01 01)
  57                                  (Time.TimeOfDay 0 0 0))
  58                          Time.utc ]
  59          , "2000/01/01" ==> []
  60          , "2000-01-01_12:34" ==>
  61                  [ Time.zonedTimeToUTC $
  62                         Time.ZonedTime
  63                          (Time.LocalTime
  64                                  (Time.fromGregorian 2000 01 01)
  65                                  (Time.TimeOfDay 12 34 0))
  66                          Time.utc ]
  67          , "2000-01-01_12:34:56" ==>
  68                  [ Time.zonedTimeToUTC $
  69                         Time.ZonedTime
  70                          (Time.LocalTime
  71                                  (Time.fromGregorian 2000 01 01)
  72                                  (Time.TimeOfDay 12 34 56))
  73                          Time.utc ]
  74          , "2000-01-01_12:34_CET" ==>
  75                  [ Time.zonedTimeToUTC $
  76                         Time.ZonedTime
  77                          (Time.LocalTime
  78                                  (Time.fromGregorian 2000 01 01)
  79                                  (Time.TimeOfDay 12 34 0))
  80                          (Time.TimeZone 60 True "CET") ]
  81          , "2000-01-01_12:34+01:30" ==>
  82                  [ Time.zonedTimeToUTC $
  83                         Time.ZonedTime
  84                          (Time.LocalTime
  85                                  (Time.fromGregorian 2000 01 01)
  86                                  (Time.TimeOfDay 12 34 0))
  87                          (Time.TimeZone 90 False "+01:30") ]
  88          , "2000-01-01_12:34:56_CET" ==>
  89                  [ Time.zonedTimeToUTC $
  90                         Time.ZonedTime
  91                          (Time.LocalTime
  92                                  (Time.fromGregorian 2000 01 01)
  93                                  (Time.TimeOfDay 12 34 56))
  94                          (Time.TimeZone 60 True "CET") ]
  95          , "2001-02-29" ==> []
  96          ]) <>
  97         (let (==>) (txt::Text, def) =
  98                 testCase (Text.unpack txt) .
  99                 (@?=) (rights [R.runParserWithError
 100                  (Ledger.read_date id (Just def) <* R.eof) () "" txt]) in
 101          [ ("01-01", 2000) ==>
 102                  [ Time.zonedTimeToUTC $
 103                         Time.ZonedTime
 104                          (Time.LocalTime
 105                                  (Time.fromGregorian 2000 01 01)
 106                                  (Time.TimeOfDay 0 0 0))
 107                          Time.utc]
 108          ])
 109  , testGroup "read_account_section" $
 110         let (==>) (txt::Text) b =
 111                 testCase (Text.unpack txt) $
 112                 (@?=) (rights [R.runParser
 113                          (Ledger.read_account_section <* R.eof) () "" txt])
 114                  [txt | b] in
 115          [ ""      ==> False
 116          , "A"     ==> True
 117          , "AA"    ==> True
 118          , " "     ==> False
 119          , ":"     ==> False
 120          , "A:"    ==> False
 121          , ":A"    ==> False
 122          , "A "    ==> False
 123          , "A A"   ==> True
 124          , "A "    ==> False
 125          , "A\t"   ==> False
 126          , "A \n"  ==> False
 127          , "(A)A"  ==> True
 128          , "( )A"  ==> True
 129          , "(A) A" ==> True
 130          , "[ ] A" ==> True
 131          , "(A)  " ==> False
 132          , "(A)"   ==> True
 133          , "A(A)"  ==> True
 134          , "[A]A"  ==> True
 135          , "[A] A" ==> True
 136          , "[A]  " ==> False
 137          , "[A]"   ==> True
 138          , testCase "\"A \"" $
 139                         rights [R.runParser
 140                          Ledger.read_account_section
 141                          () "" ("A "::Text)]
 142                  @?=
 143                         ["A"]
 144          ]
 145  , testGroup "read_account" $
 146         let (==>) (txt::Text) =
 147                 testCase (Text.unpack txt) .
 148                 (@?=) (rights [R.runParser
 149                          (Ledger.read_account <* R.eof) () "" txt]) in
 150          [ "" ==> []
 151          , "A" ==> [ "A":|[] ]
 152          , "A:" ==> []
 153          , ":A" ==> []
 154          , "A " ==> []
 155          , " A" ==> []
 156          , "A:B" ==> [ "A":|["B"] ]
 157          , "A:B:C" ==> [ "A":|["B","C"] ]
 158          , "Aa:Bbb:Cccc" ==> [ "Aa":|["Bbb", "Cccc"] ]
 159          , "A a : B b b : C c c c" ==> [ "A a ":|[" B b b ", " C c c c"] ]
 160          , "A: :C" ==> [ "A":|[" ", "C"] ]
 161          , "A::C" ==> []
 162          , "A:B:(C)" ==> [ "A":|["B", "(C)"] ]
 163          ]
 164  , testGroup "read_amount" $
 165         let (==>) (txt::Text) =
 166                 testCase (Text.unpack txt) .
 167                 (@?=) (rights [R.runParser
 168                          (Ledger.read_amount <* R.eof) () "" txt]) in
 169          [ ""  ==> []
 170          , "0" ==>
 171                  [( mempty
 172                         , Ledger.amount { Ledger.amount_quantity = Decimal 0 0 } )]
 173          , "00" ==>
 174                  [( mempty
 175                         , Ledger.amount { Ledger.amount_quantity = Decimal 0 0 } )]
 176          , "0." ==>
 177                  [( mempty { Ledger.amount_style_fractioning = Just '.' }
 178                         , Ledger.amount { Ledger.amount_quantity = Decimal 0 0 } )]
 179          , ".0" ==>
 180                  [( mempty { Ledger.amount_style_fractioning = Just '.' }
 181                         , Ledger.amount { Ledger.amount_quantity = Decimal 1 0 } )]
 182          , "0," ==>
 183                  [( mempty { Ledger.amount_style_fractioning = Just ',' }
 184                         , Ledger.amount { Ledger.amount_quantity = Decimal 0 0 } )]
 185          , ",0" ==>
 186                  [( mempty { Ledger.amount_style_fractioning = Just ',' }
 187                         , Ledger.amount { Ledger.amount_quantity = Decimal 1 0 } )]
 188          , "0_" ==> []
 189          , "_0" ==> []
 190          , "0.0" ==>
 191                  [( mempty { Ledger.amount_style_fractioning = Just '.' }
 192                         , Ledger.amount { Ledger.amount_quantity = Decimal 1 0 } )]
 193          , "00.00" ==>
 194                  [( mempty { Ledger.amount_style_fractioning = Just '.' }
 195                         , Ledger.amount { Ledger.amount_quantity = Decimal 2 0 } )]
 196          , "0,0" ==>
 197                  [( mempty { Ledger.amount_style_fractioning = Just ',' }
 198                         , Ledger.amount { Ledger.amount_quantity = Decimal 1 0 } )]
 199          , "00,00" ==>
 200                  [( mempty { Ledger.amount_style_fractioning = Just ',' }
 201                         , Ledger.amount { Ledger.amount_quantity = Decimal 2 0 } )]
 202          , "0_0" ==>
 203                  [( mempty { Ledger.amount_style_grouping_integral = Just $ Ledger.Amount_Style_Grouping '_' [1] }
 204                         , Ledger.amount { Ledger.amount_quantity = Decimal 0 0 } )]
 205          , "00_00" ==>
 206                  [( mempty { Ledger.amount_style_grouping_integral = Just $ Ledger.Amount_Style_Grouping '_' [2] }
 207                         , Ledger.amount { Ledger.amount_quantity = Decimal 0 0 } )]
 208          , "0,000.00" ==>
 209                  [( mempty
 210                          { Ledger.amount_style_fractioning       = Just '.'
 211                          , Ledger.amount_style_grouping_integral = Just $ Ledger.Amount_Style_Grouping ',' [3] }
 212                         , Ledger.amount { Ledger.amount_quantity = Decimal 2 0 } )]
 213          , "0.000,00" ==>
 214                  [( mempty
 215                          { Ledger.amount_style_fractioning       = Just ','
 216                          , Ledger.amount_style_grouping_integral = Just $ Ledger.Amount_Style_Grouping '.' [3] }
 217                         , Ledger.amount { Ledger.amount_quantity = Decimal 2 0 } )]
 218          , "1,000.00" ==>
 219                  [( mempty
 220                          { Ledger.amount_style_fractioning       = Just '.'
 221                          , Ledger.amount_style_grouping_integral = Just $ Ledger.Amount_Style_Grouping ',' [3] }
 222                         , Ledger.amount { Ledger.amount_quantity = Decimal 2 100000 } )]
 223          , "1.000,00" ==>
 224                  [( mempty
 225                          { Ledger.amount_style_fractioning       = Just ','
 226                          , Ledger.amount_style_grouping_integral = Just $ Ledger.Amount_Style_Grouping '.' [3] }
 227                         , Ledger.amount { Ledger.amount_quantity = Decimal 2 100000 } )]
 228          , "1,000.00." ==> []
 229          , "1.000,00," ==> []
 230          , "1,000.00_" ==> []
 231          , "123" ==>
 232                  [( mempty
 233                         , Ledger.amount { Ledger.amount_quantity = Decimal 0 123 } )]
 234          , "1.2" ==>
 235                  [( mempty { Ledger.amount_style_fractioning = Just '.' }
 236                         , Ledger.amount { Ledger.amount_quantity = Decimal 1 12 } )]
 237          , "1,2" ==>
 238                  [( mempty { Ledger.amount_style_fractioning = Just ',' }
 239                         , Ledger.amount { Ledger.amount_quantity = Decimal 1 12 } )]
 240          , "12.34" ==>
 241                  [( mempty { Ledger.amount_style_fractioning = Just '.' }
 242                         , Ledger.amount { Ledger.amount_quantity = Decimal 2 1234 } )]
 243          , "12,34" ==>
 244                  [( mempty { Ledger.amount_style_fractioning = Just ',' }
 245                         , Ledger.amount { Ledger.amount_quantity = Decimal 2 1234 } )]
 246          , "1_2" ==>
 247                  [( mempty { Ledger.amount_style_grouping_integral = Just $ Ledger.Amount_Style_Grouping '_' [1] }
 248                         , Ledger.amount { Ledger.amount_quantity = Decimal 0 12 } )]
 249          , "1_23" ==>
 250                  [( mempty { Ledger.amount_style_grouping_integral = Just $ Ledger.Amount_Style_Grouping '_' [2] }
 251                         , Ledger.amount { Ledger.amount_quantity = Decimal 0 123 } )]
 252          , "1_23_456" ==>
 253                  [( mempty { Ledger.amount_style_grouping_integral = Just $ Ledger.Amount_Style_Grouping '_' [3, 2] }
 254                         , Ledger.amount { Ledger.amount_quantity = Decimal 0 123456 } )]
 255          , "1_23_456,7890_12345_678901" ==>
 256                  [( mempty
 257                          { Ledger.amount_style_fractioning         = Just ','
 258                          , Ledger.amount_style_grouping_integral   = Just $ Ledger.Amount_Style_Grouping '_' [3, 2]
 259                          , Ledger.amount_style_grouping_fractional = Just $ Ledger.Amount_Style_Grouping '_' [4, 5, 6] }
 260                         , Ledger.amount { Ledger.amount_quantity = Decimal 15 123456789012345678901 } )]
 261          , "1_23_456.7890_12345_678901" ==>
 262                  [( mempty
 263                          { Ledger.amount_style_fractioning         = Just '.'
 264                          , Ledger.amount_style_grouping_integral   = Just $ Ledger.Amount_Style_Grouping '_' [3, 2]
 265                          , Ledger.amount_style_grouping_fractional = Just $ Ledger.Amount_Style_Grouping '_' [4, 5, 6] }
 266                         , Ledger.amount { Ledger.amount_quantity = Decimal 15 123456789012345678901 } )]
 267          , "1,23,456.7890_12345_678901" ==>
 268                  [( mempty
 269                          { Ledger.amount_style_fractioning         = Just '.'
 270                          , Ledger.amount_style_grouping_integral   = Just $ Ledger.Amount_Style_Grouping ',' [3, 2]
 271                          , Ledger.amount_style_grouping_fractional = Just $ Ledger.Amount_Style_Grouping '_' [4, 5, 6] }
 272                         , Ledger.amount { Ledger.amount_quantity = Decimal 15 123456789012345678901 } )]
 273          , "1.23.456,7890_12345_678901" ==>
 274                  [( mempty
 275                          { Ledger.amount_style_fractioning         = Just ','
 276                          , Ledger.amount_style_grouping_integral   = Just $ Ledger.Amount_Style_Grouping '.' [3, 2]
 277                          , Ledger.amount_style_grouping_fractional = Just $ Ledger.Amount_Style_Grouping '_' [4, 5, 6] }
 278                         , Ledger.amount { Ledger.amount_quantity = Decimal 15 123456789012345678901 } )]
 279          , "123456_78901_2345.678_90_1" ==>
 280                  [( mempty
 281                          { Ledger.amount_style_fractioning         = Just '.'
 282                          , Ledger.amount_style_grouping_integral   = Just $ Ledger.Amount_Style_Grouping '_' [4, 5, 6]
 283                          , Ledger.amount_style_grouping_fractional = Just $ Ledger.Amount_Style_Grouping '_' [3, 2] }
 284                         , Ledger.amount { Ledger.amount_quantity = Decimal 6 123456789012345678901 } )]
 285          , "$1" ==>
 286                  [( mempty
 287                          { Ledger.amount_style_unit_side   = Just Ledger.Amount_Style_Side_Left
 288                          , Ledger.amount_style_unit_spaced = Just False }
 289                  , Ledger.amount
 290                          { Ledger.amount_quantity = Decimal 0 1
 291                          , Ledger.amount_unit     = "$" } )]
 292          , "1$" ==>
 293                  [( mempty
 294                          { Ledger.amount_style_unit_side   = Just Ledger.Amount_Style_Side_Right
 295                          , Ledger.amount_style_unit_spaced = Just False }
 296                  , Ledger.amount
 297                          { Ledger.amount_quantity = Decimal 0 1
 298                          , Ledger.amount_unit     = "$" } )]
 299          , "$ 1" ==>
 300                  [( mempty
 301                          { Ledger.amount_style_unit_side   = Just Ledger.Amount_Style_Side_Left
 302                          , Ledger.amount_style_unit_spaced = Just True }
 303                  , Ledger.amount
 304                          { Ledger.amount_quantity = Decimal 0 1
 305                          , Ledger.amount_unit     = "$" } )]
 306          , "1 $" ==>
 307                  [( mempty
 308                          { Ledger.amount_style_unit_side   = Just Ledger.Amount_Style_Side_Right
 309                          , Ledger.amount_style_unit_spaced = Just True }
 310                  , Ledger.amount
 311                          { Ledger.amount_quantity = Decimal 0 1
 312                          , Ledger.amount_unit     = "$" } )]
 313          , "-$1" ==>
 314                  [( mempty
 315                          { Ledger.amount_style_unit_side   = Just Ledger.Amount_Style_Side_Left
 316                          , Ledger.amount_style_unit_spaced = Just False }
 317                  , Ledger.amount
 318                          { Ledger.amount_quantity = Decimal 0 (-1)
 319                          , Ledger.amount_unit     = "$" } )]
 320          , "\"4 2\"1" ==>
 321                  [( mempty
 322                          { Ledger.amount_style_unit_side   = Just Ledger.Amount_Style_Side_Left
 323                          , Ledger.amount_style_unit_spaced = Just False }
 324                  , Ledger.amount
 325                          { Ledger.amount_quantity = Decimal 0 1
 326                          , Ledger.amount_unit     = "4 2" } )]
 327          , "1\"4 2\"" ==>
 328                  [( mempty
 329                          { Ledger.amount_style_unit_side   = Just Ledger.Amount_Style_Side_Right
 330                          , Ledger.amount_style_unit_spaced = Just False }
 331                  , Ledger.amount
 332                          { Ledger.amount_quantity = Decimal 0 1
 333                          , Ledger.amount_unit     = "4 2" } )]
 334          , "$1.000,00" ==>
 335                  [( mempty
 336                          { Ledger.amount_style_fractioning       = Just ','
 337                          , Ledger.amount_style_grouping_integral = Just $ Ledger.Amount_Style_Grouping '.' [3]
 338                          , Ledger.amount_style_unit_side         = Just Ledger.Amount_Style_Side_Left
 339                          , Ledger.amount_style_unit_spaced       = Just False }
 340                         , Ledger.amount
 341                          { Ledger.amount_quantity = Decimal 2 100000
 342                          , Ledger.amount_unit     = "$" } )]
 343          , "1.000,00$" ==>
 344                  [( mempty
 345                          { Ledger.amount_style_fractioning       = Just ','
 346                          , Ledger.amount_style_grouping_integral = Just $ Ledger.Amount_Style_Grouping '.' [3]
 347                          , Ledger.amount_style_unit_side         = Just Ledger.Amount_Style_Side_Right
 348                          , Ledger.amount_style_unit_spaced       = Just False }
 349                         , Ledger.amount
 350                          { Ledger.amount_quantity = Decimal 2 100000
 351                          , Ledger.amount_unit     = "$" } )]
 352          ]
 353  , testGroup "read_posting_type" $
 354         let (==>) a (ty, ac) =
 355                 let read (t::Text) = rights [R.runParser
 356                          (Ledger.read_account <* R.eof) () "" t] in
 357                 testCase (Text.unpack a) $
 358                 (@?=)
 359                  (Ledger.read_posting_type <$> read a)
 360                  (Ledger.Posting_Typed ty  <$> read (fromMaybe a ac)) in
 361          [ "A"       ==> (Ledger.Posting_Type_Regular, Nothing)
 362          , "("       ==> (Ledger.Posting_Type_Regular, Nothing)
 363          , ")"       ==> (Ledger.Posting_Type_Regular, Nothing)
 364          , "()"      ==> (Ledger.Posting_Type_Regular, Nothing)
 365          , "( )"     ==> (Ledger.Posting_Type_Regular, Nothing)
 366          , "(A)"     ==> (Ledger.Posting_Type_Virtual, Just "A")
 367          , "(A:B:C)" ==> (Ledger.Posting_Type_Virtual, Just "A:B:C")
 368          , "A:B:C"   ==> (Ledger.Posting_Type_Regular, Nothing)
 369          , "(A):B:C" ==> (Ledger.Posting_Type_Regular, Nothing)
 370          , "A:(B):C" ==> (Ledger.Posting_Type_Regular, Nothing)
 371          , "A:B:(C)" ==> (Ledger.Posting_Type_Regular, Nothing)
 372          , "["       ==> (Ledger.Posting_Type_Regular, Nothing)
 373          , "]"       ==> (Ledger.Posting_Type_Regular, Nothing)
 374          , "[]"      ==> (Ledger.Posting_Type_Regular, Nothing)
 375          , "[ ]"     ==> (Ledger.Posting_Type_Regular, Nothing)
 376          , "[A]"     ==> (Ledger.Posting_Type_Virtual_Balanced, Just "A")
 377          , "[A:B:C]" ==> (Ledger.Posting_Type_Virtual_Balanced, Just "A:B:C")
 378          , "A:B:C"   ==> (Ledger.Posting_Type_Regular, Nothing)
 379          , "[A]:B:C" ==> (Ledger.Posting_Type_Regular, Nothing)
 380          , "A:[B]:C" ==> (Ledger.Posting_Type_Regular, Nothing)
 381          , "A:B:[C]" ==> (Ledger.Posting_Type_Regular, Nothing)
 382          ]
 383  , testGroup "read_comment" $
 384         let (==>) (txt::Text, end) =
 385                 testCase (Text.unpack txt) .
 386                 (@?=) (rights [R.runParser
 387                          (Ledger.read_comment <* end) () "" txt]) in
 388          [ ("; some comment", R.eof) ==> [" some comment"]
 389          , ("; some comment \n", R.newline <* R.eof) ==> [ " some comment " ]
 390          , ("; some comment \r\n", R.string "\r\n" <* R.eof) ==> [ " some comment " ]
 391          ]
 392  , testGroup "read_comments" $
 393         let (==>) (txt::Text, end) =
 394                 testCase (Text.unpack txt) .
 395                 (@?=) (rights [R.runParser
 396                          (Ledger.read_comments <* end) () "" txt]) in
 397          [ ("; some comment\n  ; some other comment", R.eof) ==> [ [" some comment", " some other comment"] ]
 398          , ("; some comment \n", R.string "\n" <* R.eof) ==> [ [" some comment "] ]
 399          ]
 400  , testGroup "read_tag_value" $
 401         let (==>) (txt::Text, end) =
 402                 testCase (Text.unpack txt) .
 403                 (@?=) (rights [R.runParser
 404                          (Ledger.read_tag_value <* end) () "" txt]) in
 405          [ (",", R.eof) ==> [","]
 406          , (",\n", R.char '\n' <* R.eof) ==> [","]
 407          , (",x", R.eof) ==> [",x"]
 408          , (",x:", R.string ",x:" <* R.eof) ==> [""]
 409          , ("v, v, n:", R.string ", n:" <* R.eof) ==> ["v, v"]
 410          ]
 411  , testGroup "read_tag" $
 412         let (==>) (txt::Text, end) =
 413                 testCase (Text.unpack txt) .
 414                 (@?=) (rights [R.runParser
 415                          (Ledger.read_tag <* end) () "" txt]) in
 416          [ ("Name:"        , R.eof)                    ==> [ ("Name":|[], "") ]
 417          , ("Name:Value"   , R.eof)                    ==> [ ("Name":|[], "Value") ]
 418          , ("Name:Value\n" , R.string "\n" <* R.eof)   ==> [ ("Name":|[], "Value") ]
 419          , ("Name:Val ue"  , R.eof)                    ==> [ ("Name":|[], "Val ue") ]
 420          , ("Name:,"       , R.eof)                    ==> [ ("Name":|[], ",") ]
 421          , ("Name:Val,ue"  , R.eof)                    ==> [ ("Name":|[], "Val,ue") ]
 422          , ("Name:Val,ue:" , R.string ",ue:" <* R.eof) ==> [ ("Name":|[], "Val") ]
 423          , ("Name:Val,ue :", R.eof)                    ==> [ ("Name":|[], "Val,ue :") ]
 424          ]
 425  , testGroup "read_tags" $
 426         let (==>) (txt::Text) =
 427                 testCase (Text.unpack txt) .
 428                 (@?=) (rights [R.runParser
 429                          (Ledger.read_tags <* R.eof) () "" txt]) .
 430                 pure . Map.fromList in
 431          [ "Name:" ==> [ ("Name":|[], [""]) ]
 432          , "Name:," ==> [ ("Name":|[], [","]) ]
 433          , "Name:,Name:" ==> [ ("Name":|[], ["", ""]) ]
 434          , "Name:,Name2:" ==>
 435                  [ ("Name":|[], [""])
 436                  , ("Name2":|[], [""])
 437                  ]
 438          , "Name: , Name2:" ==>
 439                  [ ("Name":|[], [" "])
 440                  , ("Name2":|[], [""])
 441                  ]
 442          , "Name:,Name2:,Name3:" ==>
 443                  [ ("Name":|[], [""])
 444                  , ("Name2":|[], [""])
 445                  , ("Name3":|[], [""])
 446                  ]
 447          , "Name:Val ue,Name2:V a l u e,Name3:V al ue" ==>
 448                  [ ("Name":|[], ["Val ue"])
 449                  , ("Name2":|[], ["V a l u e"])
 450                  , ("Name3":|[], ["V al ue"])
 451                  ]
 452          ]
 453  , testGroup "read_posting" $
 454         let (==>) (txt::Text) =
 455                 let context_read =
 456                          ( Ledger.context_read (const ()) Ledger.journal
 457                          ::Ledger.Context_Read ()        ()) in
 458                 testCase (Text.unpack txt) .
 459                 (@?=) (rights [R.runParserWithError
 460                          (Ledger.read_posting <* R.eof) context_read "" txt]) .
 461                 ((\p -> Ledger.Posting_Typed Ledger.Posting_Type_Regular
 462                         p { Ledger.posting_sourcepos = R.newPos "" 1 1 }) <$>) in
 463          [ " A:B:C" ==> [Ledger.posting ("A":|["B", "C"])]
 464          , "A:B:C" ==> []
 465          , " !A:B:C" ==> [(Ledger.posting ("A":|["B", "C"]))
 466                  { Ledger.posting_status = True }]
 467          , " *A:B:C" ==> [(Ledger.posting ("A":|["B", "C"]))
 468                  { Ledger.posting_status = True }]
 469          , " A:B:C $1" ==> [Ledger.posting ("A":|["B", "C $1"])]
 470          , " A:B:C  $1" ==> [(Ledger.posting ("A":|["B", "C"]))
 471                  { Ledger.posting_amounts = Map.fromList [("$", 1)] }]
 472          , " A:B:C  $1 + 1€" ==> [(Ledger.posting ("A":|["B", "C"]))
 473                  { Ledger.posting_amounts = Map.fromList [("$", 1), ("€", 1)] }]
 474          , " A:B:C  $1 + 1$" ==> [(Ledger.posting ("A":|["B", "C"]))
 475                  { Ledger.posting_amounts = Map.fromList [("$", 2)] }]
 476          , " A:B:C  $1 + 1$ + 1$" ==> [(Ledger.posting ("A":|["B", "C"]))
 477                  { Ledger.posting_amounts = Map.fromList [("$", 3)] }]
 478          , " A:B:C ; some comment" ==> [(Ledger.posting ("A":|["B", "C"]))
 479                  { Ledger.posting_amounts  = Map.fromList []
 480                  , Ledger.posting_comments = [" some comment"] }]
 481          , " A:B:C ; some comment\n  ; some other comment" ==>
 482                 [(Ledger.posting ("A":|["B", "C"]))
 483                  { Ledger.posting_amounts  = Map.fromList []
 484                  , Ledger.posting_comments = [" some comment", " some other comment"] }]
 485          , " A:B:C  $1 ; some comment" ==>
 486                 [(Ledger.posting ("A":|["B", "C"]))
 487                  { Ledger.posting_amounts  = Map.fromList [("$", 1)]
 488                  , Ledger.posting_comments = [" some comment"] }]
 489          , " A:B:C ; N:V" ==>
 490                 [(Ledger.posting ("A":|["B", "C"]))
 491                  { Ledger.posting_comments = [" N:V"]
 492                  , Ledger.posting_tags     = H.Posting_Tags $
 493                         H.tag_from_List [ ("N":|[], "V") ] }]
 494          , " A:B:C ; some comment N:V" ==>
 495                 [(Ledger.posting ("A":|["B", "C"]))
 496                  { Ledger.posting_comments = [" some comment N:V"]
 497                  , Ledger.posting_tags = H.Posting_Tags $
 498                         H.tag_from_List [ ("N":|[], "V") ] }]
 499          , " A:B:C ; some comment N:V v, N2:V2 v2" ==>
 500                 [(Ledger.posting ("A":|["B", "C"]))
 501                  { Ledger.posting_comments = [" some comment N:V v, N2:V2 v2"]
 502                  , Ledger.posting_tags     = H.Posting_Tags $
 503                         H.tag_from_List
 504                          [ ("N":|[], "V v")
 505                          , ("N2":|[], "V2 v2") ] }]
 506          , " A:B:C ; N:V\n ; N:V2" ==>
 507                 [(Ledger.posting ("A":|["B", "C"]))
 508                  { Ledger.posting_comments = [" N:V", " N:V2"]
 509                  , Ledger.posting_tags     = H.Posting_Tags $
 510                         H.tag_from_List
 511                          [ ("N":|[], "V")
 512                          , ("N":|[], "V2")
 513                          ] }]
 514          , " A:B:C ; N:V\n ; N2:V" ==>
 515                 [(Ledger.posting ("A":|["B", "C"]))
 516                  { Ledger.posting_comments = [" N:V", " N2:V"]
 517                  , Ledger.posting_tags     = H.Posting_Tags $
 518                         H.tag_from_List
 519                          [ ("N":|[], "V")
 520                          , ("N2":|[], "V")
 521                          ] }]
 522          , " A:B:C ; date:2001-01-01" ==>
 523                 [(Ledger.posting ("A":|["B", "C"]))
 524                  { Ledger.posting_comments = [" date:2001-01-01"]
 525                  , Ledger.posting_dates =
 526                          [ Time.zonedTimeToUTC $
 527                                 Time.ZonedTime
 528                                  (Time.LocalTime
 529                                          (Time.fromGregorian 2001 01 01)
 530                                          (Time.TimeOfDay 0 0 0))
 531                                  Time.utc
 532                          ]
 533                  , Ledger.posting_tags = H.Posting_Tags $
 534                         H.tag_from_List
 535                          [ ("date":|[], "2001-01-01") ] }]
 536          , testCase " (A:B:C) = Right (A:B:C)" $
 537                         rights [R.runParserWithError
 538                          (Ledger.read_posting <* R.eof)
 539                                  ( Ledger.context_read (const ()) Ledger.journal
 540                                  ::Ledger.Context_Read () ())
 541                                  "" (" (A:B:C)"::Text)] @?=
 542                  [Ledger.Posting_Typed
 543                          Ledger.Posting_Type_Virtual
 544                          (Ledger.posting ("A":|["B", "C"]))]
 545          , testCase " [A:B:C] = Right [A:B:C]" $
 546                         rights [R.runParserWithError
 547                          (Ledger.read_posting <* R.eof)
 548                                  ( Ledger.context_read (const ()) Ledger.journal
 549                                  ::Ledger.Context_Read () ())
 550                                  "" (" [A:B:C]"::Text)] @?=
 551                  [Ledger.Posting_Typed
 552                          Ledger.Posting_Type_Virtual_Balanced
 553                          (Ledger.posting ("A":|["B", "C"]))]
 554          ]
 555  , testGroup "read_transaction" $
 556         let (==>) (txt::Text) =
 557                 let context_read =
 558                          ( Ledger.context_read (const ()) Ledger.journal
 559                          ::Ledger.Context_Read () ()) in
 560                 testCase (Text.unpack txt) .
 561                 (@?=) (rights [R.runParserWithError
 562                          (Ledger.read_transaction <* R.eof) context_read "" txt]) .
 563                 ((\t -> t { Ledger.transaction_sourcepos = R.newPos "" 1 1 }) <$>) in
 564          [ "2000-01-01 some wording\n A:B:C  $1\n a:b:c" ==>
 565                 [Ledger.transaction
 566                  { Ledger.transaction_dates=
 567                          ( Time.zonedTimeToUTC $
 568                                 Time.ZonedTime
 569                                  (Time.LocalTime
 570                                          (Time.fromGregorian 2000 01 01)
 571                                          (Time.TimeOfDay 0 0 0))
 572                                  Time.utc
 573                          , [] )
 574                  , Ledger.transaction_wording="some wording"
 575                  , Ledger.transaction_postings = Ledger.postings_by_account
 576                          [ (Ledger.posting ("A":|["B", "C"]))
 577                                  { Ledger.posting_amounts = Map.fromList [ ("$", 1) ]
 578                                  , Ledger.posting_sourcepos = R.newPos "" 2 1 }
 579                          , (Ledger.posting ("a":|["b", "c"]))
 580                                  { Ledger.posting_amounts = Map.fromList [ ("$", -1) ]
 581                                  , Ledger.posting_sourcepos = R.newPos "" 3 1 }
 582                          ]
 583                  }]
 584          , "2000-01-01 some wording\n A:B:C  $1\n a:b:c\n" ==> []
 585          , "2000-01-01 some wording  ;  some comment\n ; some other;comment\n ; some Tag:\n ; some last comment\n A:B:C  $1\n a:b:c" ==>
 586                 [Ledger.transaction
 587                  { Ledger.transaction_comments_after =
 588                          [ "  some comment"
 589                          , " some other;comment"
 590                          , " some Tag:"
 591                          , " some last comment"
 592                          ]
 593                  , Ledger.transaction_dates=
 594                          ( Time.zonedTimeToUTC $
 595                                 Time.ZonedTime
 596                                  (Time.LocalTime
 597                                          (Time.fromGregorian 2000 01 01)
 598                                          (Time.TimeOfDay 0 0 0))
 599                                  Time.utc
 600                          , [] )
 601                  , Ledger.transaction_wording="some wording"
 602                  , Ledger.transaction_postings = Ledger.postings_by_account
 603                          [ (Ledger.posting ("A":|["B", "C"]))
 604                                  { Ledger.posting_amounts = Map.fromList [ ("$", 1) ]
 605                                  , Ledger.posting_sourcepos = R.newPos "" 5 1 }
 606                          , (Ledger.posting ("a":|["b", "c"]))
 607                                  { Ledger.posting_amounts = Map.fromList [ ("$", -1) ]
 608                                  , Ledger.posting_sourcepos = R.newPos "" 6 1 } ]
 609                  , Ledger.transaction_tags = H.Transaction_Tags $
 610                         H.tag_from_List [ ("Tag":|[], "") ] }]
 611          ]
 612  , testGroup "read_journal"
 613          [ testCase "2000-01-01 1° wording\\n A:B:C  $1\\n a:b:c\\n2000-01-02 2° wording\\n A:B:C  $1\\n x:y:z" $ do
 614                 jnl <- liftIO $
 615                         R.runParserTWithError
 616                          (Ledger.read_journal "" {-<* R.eof-})
 617                                  ( Ledger.context_read id  Ledger.journal
 618                                  ::Ledger.Context_Read (Ledger.Charted Ledger.Transaction)
 619                                                        [Ledger.Charted Ledger.Transaction])
 620                                  "" ("2000-01-01 1° wording\n A:B:C  $1\n a:b:c\n2000-01-02 2° wording\n A:B:C  $1\n x:y:z"::Text)
 621                 ((\j -> j{Ledger.journal_last_read_time=H.date_epoch}) <$> rights [jnl])
 622                  @?=
 623                  [Ledger.journal
 624                          { Ledger.journal_content =
 625                                 Ledger.Charted mempty <$>
 626                                  [ Ledger.transaction
 627                                          { Ledger.transaction_dates=
 628                                                  ( Time.zonedTimeToUTC $
 629                                                         Time.ZonedTime
 630                                                          (Time.LocalTime
 631                                                                  (Time.fromGregorian 2000 01 02)
 632                                                                  (Time.TimeOfDay 0 0 0))
 633                                                          Time.utc
 634                                                  , [] )
 635                                          , Ledger.transaction_wording="2° wording"
 636                                          , Ledger.transaction_postings = Ledger.postings_by_account
 637                                                  [ (Ledger.posting ("A":|["B", "C"]))
 638                                                          { Ledger.posting_amounts = Map.fromList [ ("$", 1) ]
 639                                                          , Ledger.posting_sourcepos = R.newPos "" 5 1
 640                                                          }
 641                                                  , (Ledger.posting ("x":|["y", "z"]))
 642                                                          { Ledger.posting_amounts = Map.fromList [ ("$", -1) ]
 643                                                          , Ledger.posting_sourcepos = R.newPos "" 6 1
 644                                                          }
 645                                                  ]
 646                                          , Ledger.transaction_sourcepos = R.newPos "" 4 1
 647                                          }
 648                                  , Ledger.transaction
 649                                          { Ledger.transaction_dates=
 650                                                  ( Time.zonedTimeToUTC $
 651                                                         Time.ZonedTime
 652                                                          (Time.LocalTime
 653                                                                  (Time.fromGregorian 2000 01 01)
 654                                                                  (Time.TimeOfDay 0 0 0))
 655                                                          Time.utc
 656                                                  , [] )
 657                                          , Ledger.transaction_wording="1° wording"
 658                                          , Ledger.transaction_postings = Ledger.postings_by_account
 659                                                  [ (Ledger.posting ("A":|["B", "C"]))
 660                                                          { Ledger.posting_amounts = Map.fromList [ ("$", 1) ]
 661                                                          , Ledger.posting_sourcepos = R.newPos "" 2 1
 662                                                          }
 663                                                  , (Ledger.posting ("a":|["b", "c"]))
 664                                                          { Ledger.posting_amounts = Map.fromList [ ("$", -1) ]
 665                                                          , Ledger.posting_sourcepos = R.newPos "" 3 1
 666                                                          }
 667                                                  ]
 668                                          , Ledger.transaction_sourcepos = R.newPos "" 1 1
 669                                          }
 670                                  ]
 671                          , Ledger.journal_files = [""]
 672                          , Ledger.journal_amount_styles = Ledger.Amount_Styles $ Map.fromList
 673                                  [ ( Ledger.Unit "$"
 674                                          , mempty
 675                                                  { Ledger.amount_style_unit_side   = Just Ledger.Amount_Style_Side_Left
 676                                                  , Ledger.amount_style_unit_spaced = Just False }
 677                                          )
 678                                  ]
 679                          }
 680                  ]
 681          ]
 682  , testGroup "read_journal" $
 683         let (==>) (txt::Text) e =
 684                 testCase (Text.unpack txt) $ do
 685                 jnl <-
 686                         liftIO $
 687                         right (\j -> j{Ledger.journal_last_read_time=H.date_epoch}) <$>
 688                         R.runParserTWithError
 689                          (Ledger.read_journal "" {-<* R.eof-})
 690                                  ( Ledger.context_read id  Ledger.journal
 691                                  ::Ledger.Context_Read (Ledger.Charted Ledger.Transaction)
 692                                                        [Ledger.Charted Ledger.Transaction])
 693                                  "" (txt::Text)
 694                 (@?=) (rights [jnl]) e in
 695          [ Text.unlines
 696                  [ "2000-01-01 1° wording"
 697                  , " A:B:C  $1"
 698                  , " a:b:c"
 699                  , "2000-01-02 2° wording"
 700                  , " A:B:C  $1"
 701                  , " x:y:z"
 702                  ] ==>
 703                 [ Ledger.journal
 704                          { Ledger.journal_content =
 705                                  Ledger.Charted mempty <$>
 706                                  [ Ledger.transaction
 707                                          { Ledger.transaction_dates =
 708                                                  ( Time.zonedTimeToUTC $
 709                                                         Time.ZonedTime
 710                                                          (Time.LocalTime
 711                                                                  (Time.fromGregorian 2000 01 02)
 712                                                                  (Time.TimeOfDay 0 0 0))
 713                                                          Time.utc
 714                                                  , [] )
 715                                          , Ledger.transaction_wording ="2° wording"
 716                                          , Ledger.transaction_postings = Ledger.postings_by_account
 717                                                  [ (Ledger.posting ("A":|["B", "C"]))
 718                                                          { Ledger.posting_amounts = Map.fromList [ ("$", 1) ]
 719                                                          , Ledger.posting_sourcepos = R.newPos "" 5 1
 720                                                          }
 721                                                  , (Ledger.posting ("x":|["y", "z"]))
 722                                                          { Ledger.posting_amounts = Map.fromList [ ("$", -1) ]
 723                                                          , Ledger.posting_sourcepos = R.newPos "" 6 1
 724                                                          }
 725                                                  ]
 726                                          , Ledger.transaction_sourcepos = R.newPos "" 4 1
 727                                          }
 728                                  , Ledger.transaction
 729                                          { Ledger.transaction_dates =
 730                                                  ( Time.zonedTimeToUTC $
 731                                                         Time.ZonedTime
 732                                                          (Time.LocalTime
 733                                                                  (Time.fromGregorian 2000 01 01)
 734                                                                  (Time.TimeOfDay 0 0 0))
 735                                                          Time.utc
 736                                                  , [] )
 737                                          , Ledger.transaction_wording  = "1° wording"
 738                                          , Ledger.transaction_postings = Ledger.postings_by_account
 739                                                  [ (Ledger.posting ("A":|["B", "C"]))
 740                                                          { Ledger.posting_amounts   = Map.fromList [ ("$", 1) ]
 741                                                          , Ledger.posting_sourcepos = R.newPos "" 2 1
 742                                                          }
 743                                                  , (Ledger.posting ("a":|["b", "c"]))
 744                                                          { Ledger.posting_amounts   = Map.fromList [ ("$", -1) ]
 745                                                          , Ledger.posting_sourcepos = R.newPos "" 3 1
 746                                                          }
 747                                                  ]
 748                                          , Ledger.transaction_sourcepos = R.newPos "" 1 1
 749                                          }
 750                                  ]
 751                          , Ledger.journal_files = [""]
 752                          , Ledger.journal_amount_styles = Ledger.Amount_Styles $ Map.fromList
 753                                  [ ( Ledger.Unit "$"
 754                                          , mempty
 755                                                  { Ledger.amount_style_unit_side   = Just Ledger.Amount_Style_Side_Left
 756                                                  , Ledger.amount_style_unit_spaced = Just False }
 757                                          )
 758                                  ]
 759                          }
 760                  ]
 761          ]
 762  ]