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