lcc/Hcompta/LCC/Read/Test.hs

   1 {-# LANGUAGE StandaloneDeriving #-}
   2 {-# LANGUAGE NoMonomorphismRestriction #-}
   3 {-# LANGUAGE UndecidableInstances #-}
   4 {-# OPTIONS_GHC -fno-warn-orphans #-}
   5 {-# OPTIONS_GHC -O0 #-}
   6 module Read.Test where
   7
   8 import Test.Tasty
   9 import Test.Tasty.HUnit
  10
  11 import Control.Applicative (Applicative(..), Alternative(..))
  12 import Control.Arrow (first)
  13 import Control.Monad (Monad(..), MonadPlus(..))
  14 import Control.Monad.Trans.Class (MonadTrans(..))
  15 import Data.Bool
  16 import Data.Char (Char)
  17 import Data.Data ()
  18 import Data.Decimal (DecimalRaw(..))
  19 import Data.Either (Either(..), rights)
  20 import Data.Eq (Eq)
  21 import Data.Fixed (Pico)
  22 import Data.Function (($), (.), const, flip)
  23 import Data.Functor (Functor(..), (<$>))
  24 import Data.Functor.Identity (Identity(..))
  25 import Data.Int (Int)
  26 import Data.List.NonEmpty (NonEmpty(..))
  27 import Data.Map.Strict (Map)
  28 import Data.Maybe (Maybe(..), fromMaybe)
  29 import Data.Monoid (Monoid(..), (<>))
  30 import Data.Ord (Ord(..))
  31 import Data.Proxy
  32 import Data.String (String)
  33 import Data.Text (Text)
  34 import Data.Type.Equality ((:~:)(..))
  35 import Data.Word (Word)
  36 import Prelude (Integer)
  37 import System.FilePath.Posix (FilePath)
  38 import Text.Show (Show(..))
  39 import qualified Control.Exception.Safe as Exn
  40 import qualified Control.Monad.Classes as MC
  41 import qualified Control.Monad.Trans.State.Strict as SS
  42 import qualified Data.Char as Char
  43 import qualified Data.Foldable as Foldable
  44 import qualified Data.List as List
  45 import qualified Data.List.NonEmpty as NonEmpty
  46 import qualified Data.Map.Strict as Map
  47 import qualified Data.NonNull as NonNull
  48 import qualified Data.Set as Set
  49 import qualified Data.Strict as S
  50 import qualified Data.Text as Text
  51 import qualified Data.Time.Calendar  as Time
  52 import qualified Data.Time.LocalTime as Time
  53 import qualified Data.TreeMap.Strict as TreeMap
  54 import qualified Data.TreeMap.Strict.Zipper as TreeMap
  55 import qualified Language.Symantic as Sym
  56 import qualified Language.Symantic.Lib as Sym
  57 -- import qualified Language.Symantic.Parsing as Sym
  58 import qualified System.FilePath.Posix as FilePath
  59 import qualified System.IO.Error as IO
  60 import qualified Text.Megaparsec as P
  61 import qualified Text.Megaparsec.Prim as P
  62
  63 import qualified Hcompta as H
  64 import qualified Hcompta.LCC as LCC
  65 import qualified Hcompta.LCC.Lib.Strict as S
  66 import qualified Hcompta.LCC.Sym as Sym
  67 import System.IO (IO)
  68 import Prelude (Bounded)
  69 import Control.Applicative (Alternative)
  70 import Data.NonNull (NonNull)
  71
  72 test :: Text -> Assertion -> TestTree
  73 test = testCase . elide . Foldable.foldMap escapeChar . Text.unpack
  74
  75 escapeChar :: Char -> String
  76 escapeChar c | Char.isPrint c = [c]
  77 escapeChar c = Char.showLitChar c ""
  78
  79 elide :: String -> String
  80 elide s | List.length s > 42 = List.take 42 s <> ['…']
  81 elide s = s
  82
  83 account :: [Text] -> LCC.Account
  84 account = LCC.Account . NonNull.impureNonNull . (LCC.Name <$>)
  85
  86 tag :: [Text] -> Text -> LCC.Tag
  87 tag p v = LCC.Tag
  88          (LCC.Tag_Path $ NonNull.impureNonNull (LCC.Name <$> p))
  89          (LCC.Tag_Data v)
  90
  91 account_ref :: [Text] -> LCC.Tag_Path
  92 account_ref p = LCC.Tag_Path $ NonNull.impureNonNull $ LCC.Name <$> p
  93
  94 account_refs :: [([Text], [[Text]])] -> Map LCC.Tag_Path (Map LCC.Account ())
  95 account_refs l =
  96         Map.fromList $
  97         (<$> l) $ \(anch, accts) ->
  98                 ( LCC.Tag_Path $ NonNull.impureNonNull $ LCC.Name <$> anch
  99                 , Map.fromList $ (,()) . account <$> accts
 100                 )
 101
 102 tags :: [([Text], Text)] -> LCC.Tags
 103 tags l =
 104         LCC.Tags $
 105         TreeMap.from_List (flip (<>)) $
 106         (<$> l) $ \(p, v) ->
 107                 (NonNull.impureNonNull (LCC.Name <$> p), [LCC.Tag_Data v])
 108
 109 amounts :: [(Text, LCC.Quantity)] -> LCC.Amounts
 110 amounts l =
 111         LCC.Amounts $
 112         Map.fromList $
 113         (<$> l) $ \(u, q) ->
 114                 (LCC.Unit u, q)
 115
 116 postings :: [LCC.Posting] -> LCC.Postings
 117 postings l =
 118         LCC.Postings $
 119         Map.fromListWith (flip (<>)) $
 120         (<$> l) $ \p ->
 121                 (LCC.posting_account p, [p])
 122
 123 comments :: [Text] -> [LCC.Comment]
 124 comments = (LCC.Comment <$>)
 125
 126 sourcePos :: FilePath -> Word -> Word -> P.SourcePos
 127 sourcePos fp l c = P.SourcePos fp (P.unsafePos l) (P.unsafePos c)
 128
 129 date :: Integer -> Int -> Int -> Int -> Int -> Pico -> Time.TimeZone -> LCC.Date
 130 date y m d h m' s tz =
 131         Time.zonedTimeToUTC $
 132         Time.ZonedTime
 133          (Time.LocalTime
 134                  (Time.fromGregorian y m d)
 135                  (Time.TimeOfDay h m' s))
 136          tz
 137
 138 -- * Type 'Parsec'
 139 newtype Parsec e s m a
 140  =      Parsec { unParsec :: P.ParsecT e s m a }
 141  deriving (Functor, Applicative, Monad, MonadTrans, Alternative, MonadPlus, P.MonadParsec e s)
 142
 143 type instance MC.CanDo (Parsec e s m) (MC.EffState a) = 'False
 144 type instance MC.CanDo (Parsec e s m) (MC.EffReader P.SourcePos) = 'True
 145 type instance MC.CanDo (Parsec e s m) (MC.EffReader (S.Either Exn.IOException LCC.CanonFile)) = 'True
 146
 147 instance -- Gram_File
 148  ( LCC.ParsecC e s
 149  , Monad m
 150  , MC.MonadState Context_Test (Parsec e s m)
 151  , P.MonadParsec e s (P.ParsecT e s m)
 152  , P.MonadParsec e s (Parsec e s m)
 153  , s ~ Text
 154  ) => LCC.Gram_IO (Parsec e Text m) where
 155         g_canonfile g = do
 156                 fp <- g
 157                 return (fp, Right $ LCC.CanonFile fp)
 158         g_read g_path g = do
 159                 lr <- LCC.g_at $ do
 160                         lr_path <- g_path
 161                         case lr_path of
 162                          S.Left e -> return $ \at -> S.Left $ at e
 163                          S.Right fp -> do
 164                                 db <- context_test_files <$> MC.get
 165                                 case Map.lookup fp db of
 166                                  Nothing -> return $ \at -> S.Left $ at $
 167                                         LCC.Error_Journal_Read fp $
 168                                         IO.userError $ show db
 169                                  Just txt -> return $ const $ S.Right (fp, txt)
 170                 case lr of
 171                  S.Left e -> return $ S.Left [e]
 172                  S.Right (LCC.PathFile fp_new, s_new) -> do
 173                         P.pushPosition $ P.initialPos fp_new
 174                         s_old <- P.getInput; P.setInput s_new
 175
 176                         lr_a <- g
 177
 178                         P.setInput s_old
 179                         P.popPosition
 180
 181                         return lr_a
 182 deriving instance LCC.ParsecC e s => Sym.Alter                 (Parsec e s m)
 183 deriving instance LCC.ParsecC e s => Sym.Alt                   (Parsec e s m)
 184 deriving instance LCC.ParsecC e s => Sym.App                   (Parsec e s m)
 185 deriving instance LCC.ParsecC e s => Sym.Try                   (Parsec e s m)
 186 deriving instance LCC.ParsecC e s => Sym.Gram_Rule             (Parsec e s m)
 187 deriving instance LCC.ParsecC e s => Sym.Gram_Terminal         (Parsec e s m)
 188 deriving instance LCC.ParsecC e s => Sym.Gram_RegR             (Parsec e s m)
 189 deriving instance LCC.ParsecC e s => Sym.Gram_RegL             (Parsec e s m)
 190 deriving instance LCC.ParsecC e s => Sym.Gram_CF               (Parsec e s m)
 191 deriving instance LCC.ParsecC e s => Sym.Gram_Meta P.SourcePos (Parsec e s m)
 192 deriving instance LCC.ParsecC e s => Sym.Gram_Lexer            (Parsec e s m)
 193 deriving instance LCC.ParsecC e s => Sym.Gram_Op               (Parsec e s m)
 194 deriving instance LCC.ParsecC e s => LCC.Gram_Count            (Parsec e s m)
 195 deriving instance LCC.ParsecC e s => LCC.Gram_At               (Parsec e s m)
 196 deriving instance LCC.ParsecC e s => LCC.Gram_Char             (Parsec e s m)
 197 deriving instance LCC.ParsecC e s => LCC.Gram_Comment          (Parsec e s m)
 198 deriving instance LCC.ParsecC e s => LCC.Gram_Tag              (Parsec e s m)
 199 deriving instance LCC.ParsecC e s => LCC.Gram_Account          (Parsec e s m)
 200 deriving instance LCC.ParsecC e s => LCC.Gram_Amount           (Parsec e s m)
 201 deriving instance -- Gram_Posting
 202  ( LCC.ParsecC e s
 203  , LCC.Gram_Posting (P.ParsecT e s m)
 204  , MC.MonadState (S.Maybe LCC.Unit) m
 205  , MC.MonadState LCC.Chart m
 206  , MC.MonadState LCC.Style_Amounts m
 207  , MC.MonadState LCC.Year m
 208  ) => LCC.Gram_Posting (Parsec e s m)
 209 deriving instance -- Gram_Date
 210  ( LCC.ParsecC e s
 211  , LCC.Gram_Date (P.ParsecT e s m)
 212  , MC.MonadState LCC.Year m
 213  ) => LCC.Gram_Date (Parsec e s m)
 214 deriving instance -- Gram_Transaction
 215  ( LCC.ParsecC e s
 216  , LCC.Gram_Transaction (P.ParsecT e s m)
 217  , MC.MonadState (S.Maybe LCC.Unit) m
 218  , MC.MonadState LCC.Chart m
 219  , MC.MonadState LCC.Section m
 220  , MC.MonadState LCC.Style_Amounts m
 221  , MC.MonadState LCC.Year m
 222  ) => LCC.Gram_Transaction (Parsec e s m)
 223 deriving instance -- Gram_Chart
 224  ( LCC.ParsecC e s
 225  , LCC.Gram_Chart (P.ParsecT e s m)
 226  , MC.MonadState LCC.Chart m
 227  , MC.MonadState LCC.Section m
 228  ) => LCC.Gram_Chart (Parsec e s m)
 229 deriving instance (LCC.ParsecC e s, LCC.Gram_File (P.ParsecT e s m))
 230  => LCC.Gram_File (Parsec e s m)
 231 instance -- Gram_Journal
 232  ( LCC.Gram_Account g
 233  , LCC.Gram_At g
 234  , LCC.Gram_Chart g
 235  , LCC.Gram_File g
 236  , LCC.Gram_IO g
 237  , LCC.Gram_Reader (S.Either Exn.IOException LCC.CanonFile) g
 238  , LCC.Gram_State Context_Test g
 239  , LCC.Gram_State (LCC.Context_Read j) g
 240  , LCC.Gram_State (LCC.Journal j) g
 241  , LCC.Gram_State (LCC.Journals j) g
 242  , LCC.Gram_State (LCC.Env cs is) g
 243  , LCC.Gram_Transaction g
 244  , LCC.Gram_Term cs is (Parsec e Text m)
 245  , LCC.ParsecC e Text
 246  , Sym.Try g
 247  , Sym.Gram_Lexer g
 248  , Monoid j
 249  , g ~ Parsec e Text m
 250  ) => LCC.Gram_Journal cs is j (Parsec e Text m)
 251 deriving instance -- Gram_Term
 252  ( Sym.Gram_Term is LCC.Meta (P.ParsecT e s m)
 253  , Sym.Gram_Term_AtomsR LCC.Meta is is (Parsec e s m)
 254  , LCC.ParsecC e s
 255  ) => Sym.Gram_Term is LCC.Meta (Parsec e s m)
 256 deriving instance LCC.ParsecC e s => Sym.Gram_Meta LCC.Meta      (Parsec e s m)
 257 deriving instance LCC.ParsecC e s => Sym.Gram_Error              (Parsec e s m)
 258 deriving instance LCC.ParsecC e s => Sym.Gram_Name               (Parsec e s m)
 259 deriving instance LCC.ParsecC e s => Sym.Gram_Term_Type LCC.Meta (Parsec e s m)
 260 deriving instance LCC.ParsecC e s => Sym.Gram_Type LCC.Meta      (Parsec e s m)
 261 deriving instance -- Gram_Term
 262  ( LCC.Gram_Term cs is (P.ParsecT e s m)
 263  , Sym.Gram_Term is LCC.Meta (Parsec e s m)
 264  , MC.MonadState (LCC.Env cs is) m
 265  , LCC.ParsecC e s
 266  ) => LCC.Gram_Term cs is (Parsec e s m)
 267 instance -- Gram_State
 268  ( LCC.ParsecC e s
 269  , MC.MonadState ctx (Parsec e s m)
 270  ) => LCC.Gram_State ctx (Parsec e s m) where
 271         g_get g = do
 272                 f <- g
 273                 s <- MC.get
 274                 return (f s)
 275         g_state g = do
 276                 f <- g
 277                 s <- MC.get
 278                 let (s', a) = f s
 279                 MC.put s'
 280                 return a
 281         g_put g = do
 282                 (s, a) <- g
 283                 MC.put s
 284                 return a
 285 instance -- Gram_Reader
 286  ( LCC.ParsecC e s
 287  , MC.MonadReader ctx (Parsec e s m)
 288  ) => LCC.Gram_Reader ctx (Parsec e s m) where
 289         g_ask g = do
 290                 f <- g
 291                 s <- MC.ask
 292                 return (f s)
 293         g_ask_before g = do
 294                 s <- MC.ask
 295                 f <- g
 296                 return (f s)
 297 instance LCC.ParsecC e s => MC.MonadReaderN 'MC.Zero
 298  P.SourcePos (Parsec e s m) where
 299         askN _px = Parsec P.getPosition
 300 instance LCC.ParsecC e s => MC.MonadReaderN 'MC.Zero
 301  (NonEmpty P.SourcePos) (Parsec e s m) where
 302         askN _px = Parsec $ P.statePos <$> P.getParserState
 303 instance LCC.ParsecC e s => MC.MonadReaderN 'MC.Zero
 304  (S.Either Exn.IOException LCC.CanonFile) (Parsec e s m) where
 305         askN _px = Parsec $ S.Right . LCC.CanonFile . LCC.PathFile . P.sourceName <$> P.getPosition
 306
 307 -- * Type 'Context_Test'
 308 data Context_Test
 309  =   Context_Test
 310  {   context_test_files :: Map LCC.PathFile Text
 311  } deriving (Eq, Show)
 312 type instance MC.CanDo (S.StateT (LCC.Context_Read j) m)    (MC.EffState Context_Test) = 'False
 313 type instance MC.CanDo (S.StateT Context_Test m)            (MC.EffState Context_Test) = 'True
 314 type instance MC.CanDo (S.StateT (LCC.Context_Sym cs is) m) (MC.EffState Context_Test) = 'False
 315 instance Monad m => MC.MonadStateN 'MC.Zero Context_Test (S.StateT Context_Test m) where
 316         stateN _px = S.StateT . SS.state
 317
 318 type instance MC.CanDo (S.StateT Context_Test m) (MC.EffState (Sym.Tokenizers meta is)) = 'False
 319
 320 read
 321  :: forall is j cs e m a.
 322  ( Monoid j
 323  , LCC.Gram_File (P.ParsecT P.Dec Text m)
 324  , Sym.Tokenize LCC.Meta is
 325  , m ~ S.StateT (LCC.Context_Read j)
 326       (S.StateT (LCC.Context_Sym cs is)
 327       (S.StateT Context_Test Identity))
 328  , e ~ P.ParseError Char P.Dec
 329  , cs ~ Sym.TyConsts_of_Ifaces is
 330  ) => Sym.CF (Parsec P.Dec Text m) a
 331  -> [(LCC.PathFile, Text)]
 332  -> FilePath
 333  -> Text
 334  -> Either (P.ParseError Char P.Dec) a
 335 read g files fp inp =
 336         runIdentity $
 337         S.evalState Context_Test{ context_test_files = Map.fromList files } $
 338         S.evalState LCC.context_sym $
 339         S.evalState LCC.context_read $
 340         P.runParserT (unParsec . Sym.unCF $ g <* Sym.eoi)
 341          (case fp of "" -> ""; _ -> FilePath.normalise fp) inp
 342
 343 type M cs is j
 344  = S.StateT (LCC.Context_Read j)
 345   (S.StateT (LCC.Context_Sym cs is)
 346   (S.StateT Context_Test Identity))
 347
 348 test_compile
 349  :: forall is is' cs h j.
 350  ( Eq h
 351  , is ~ (Proxy Bool ': Proxy LCC.Journal ': Proxy LCC.Transaction ': Proxy [] ': is')
 352  , Sym.Tokenize LCC.Meta is
 353  , Sym.Inj_Token LCC.Meta is (->)
 354  , Sym.Inj_TyConst cs Bool
 355  , Sym.Inj_TyConst cs LCC.Journal
 356  , Sym.Inj_TyConst cs LCC.Transaction
 357  , Sym.Inj_TyConst cs []
 358  -- , Sym.Inj_TyConst cs Show
 359  -- , Sym.Inj_TyConst cs Eq
 360  , Show h
 361  , Sym.Show_Token LCC.Meta is
 362  , Sym.Show_TyConst cs
 363  , Sym.Compile cs is
 364  , Sym.Eq_Token LCC.Meta is
 365  , Sym.Gram_Term is LCC.Meta (P.ParsecT P.Dec Text (M cs is j))
 366  , Sym.Sym_of_Ifaces is Sym.HostI
 367  , Sym.Gram_Term_AtomsR LCC.Meta is is (P.ParsecT P.Dec Text (M cs is j))
 368  , Sym.Gram_Term_AtomsR LCC.Meta is is (Parsec    P.Dec Text (M cs is j))
 369  , cs ~ Sym.TyConsts_of_Ifaces is
 370  , Monoid j
 371  ) => Proxy j
 372  -> [Text]
 373  -> ( Sym.TeName
 374     , Sym.Type cs h
 375     , Either (Either (P.ParseError Char P.Dec)
 376                      (LCC.At (Sym.Error_Term LCC.Meta cs is)))
 377              h
 378     )
 379  -> TestTree
 380 test_compile _j i (n_exp, ty_exp, lr_exp) =
 381         let inp = Text.intercalate "\n" i in
 382         let env :: LCC.Env cs is = Map.fromList
 383                  [ ("j"  , Sym.ETerm (Sym.ty @Bool) $ Sym.Term $ Sym.bool True)
 384                  , ("jnl", Sym.ETerm (Sym.ty @LCC.Journal Sym.:$ (Sym.ty @[] Sym.:$ Sym.ty @LCC.Transaction)) $ Sym.Term $ Sym.journal LCC.journal)
 385                  ] in
 386         test inp $
 387         case read @is @j (LCC.g_put (pure (env, ())) *> LCC.g_term) [] "" inp of
 388          Left err_syn -> Left (Left err_syn) @?= lr_exp
 389          Right (n_got, lr_sem) ->
 390                 case lr_sem of
 391                  Left err_sem -> Left (Right err_sem) @?= lr_exp
 392                  Right (Sym.ETerm ty_got t@(Sym.Term te_got)) ->
 393                         let () = t in
 394                         case lr_exp of
 395                          Left err -> Right ("…"::Text) @?= Left err
 396                          Right (_te_exp::h) ->
 397                                 (>>= (@?= (n_exp, lr_exp))) $
 398                                 (n_got,) <$>
 399                                 case ty_got `Sym.eq_Type` ty_exp of
 400                                  Nothing ->
 401                                         return $
 402                                                 Left $ Right $
 403                                                 LCC.At (P.initialPos "" :| []) (P.initialPos "") $
 404                                                 Sym.Error_Term_Con_Type $ Right $
 405                                                 Sym.Con_TyEq
 406                                                  (Right $ Sym.At Nothing $ Sym.EType ty_got)
 407                                                  (Sym.At Nothing $ Sym.EType ty_exp)
 408                                  Just Refl ->
 409                                         let () = te_got in
 410                                         return $
 411                                                 Right $ Sym.host_from_term te_got
 412
 413 read_gram
 414  :: forall is cs j e m a.
 415  ( Monoid j
 416  , LCC.Gram_File (P.ParsecT P.Dec Text m)
 417  , Sym.Tokenize LCC.Meta is
 418  , m ~ S.StateT (LCC.Context_Read j)
 419       (S.StateT (LCC.Context_Sym cs is)
 420       (S.StateT Context_Test Identity))
 421  , e ~ P.ParseError Char P.Dec
 422  , j ~ [LCC.Transaction]
 423  , cs ~ Sym.TyConsts_of_Ifaces is
 424  , is ~ '[Proxy (->)]
 425  )
 426  => Sym.CF (Parsec P.Dec Text m) a
 427  -> Text
 428  -> Either (P.ParseError Char P.Dec) a
 429 read_gram g inp =
 430         runIdentity $
 431         S.evalState Context_Test{ context_test_files = Map.fromList [] } $
 432         S.evalState LCC.context_sym $
 433         S.evalState LCC.context_read $
 434         P.runParserT (unParsec . Sym.unCF $ g <* Sym.eoi) "" inp
 435
 436 tests :: TestTree
 437 tests = testGroup "Read"
 438  [{- testGroup "Date" $
 439         let (==>) inp exp =
 440                 test inp $
 441                 read_gram LCC.g_date inp @?= Right (S.Right exp) in
 442          [ "2000-01-13"              ==> date 2000 01 13 0 0 0 Time.utc
 443          , "2000-01-13_12:34"        ==> date 2000 01 13 12 34 0 Time.utc
 444          , "2000-01-13_12:34:56"     ==> date 2000 01 13 12 34 56 Time.utc
 445          , "2000-01-13_12:34_CET"    ==> date 2000 01 13 12 34 0 (Time.TimeZone 60 True "CET")
 446          , "2000-01-13_12:34+01:30"  ==> date 2000 01 13 12 34 0 (Time.TimeZone 90 False "+01:30")
 447          , "2000-01-13_12:34:56_CET" ==> date 2000 01 13 12 34 56 (Time.TimeZone 60 True "CET")
 448          , "01-01"                   ==> date 1970 01 01 0 0 0 Time.utc
 449          , testGroup "Parsing errors" $
 450                 let (!=>) inp exp =
 451                         test inp $
 452                         read_gram LCC.g_date inp @?= Left exp in
 453                  [ "2000/01/13" !=> P.ParseError
 454                          { P.errorPos        = sourcePos "" 1 5 :| []
 455                          , P.errorUnexpected = Set.fromList [P.Tokens ('/' :| "")]
 456                          , P.errorExpected   = Set.fromList [P.Tokens ('-' :| "")]
 457                          , P.errorCustom     = Set.fromList []
 458                          }
 459                  ]
 460          , testGroup "Semantic errors" $
 461                 let (=!>) inp exp =
 462                         test inp $
 463                         read_gram LCC.g_date inp @?= Right (S.Left exp) in
 464                  [ "2000-13-01" =!> LCC.At
 465                                  { LCC.atBegin = pure $ sourcePos "" 1 1
 466                                  , LCC.atEnd   = sourcePos "" 1 11
 467                                  , LCC.atItem  = LCC.Error_Date_Day_invalid (2000, 13, 01) }
 468                  , "2001-02-29" =!> LCC.At
 469                                  { LCC.atBegin = pure $ sourcePos "" 1 1
 470                                  , LCC.atEnd   = sourcePos "" 1 11
 471                                  , LCC.atItem  = LCC.Error_Date_Day_invalid (2001, 2, 29) }
 472                  , "2000-01-13_12:60" =!> LCC.At
 473                                  { LCC.atBegin = pure $ sourcePos "" 1 12
 474                                  , LCC.atEnd   = sourcePos "" 1 17
 475                                  , LCC.atItem  = LCC.Error_Date_TimeOfDay_invalid (12, 60, 0) }
 476                  ]
 477          ]
 478  , testGroup "Account_Section" $
 479         let (==>) inp exp =
 480                 test inp $
 481                 rights [read_gram LCC.g_account_section inp]
 482                  @?= [LCC.Name inp | exp] in
 483          [ "A"    ==> True
 484          , "AA"   ==> True
 485          , "(A)A" ==> True
 486          , "(A)"  ==> True
 487          , "A(A)" ==> True
 488          , "[A]A" ==> True
 489          , "[A]"  ==> True
 490          , testGroup "Parsing errors"
 491                  [ ""      ==> False
 492                  , " "     ==> False
 493                  , "/"     ==> False
 494                  , "A/"    ==> False
 495                  , "/A"    ==> False
 496                  , "A "    ==> False
 497                  , "A A"   ==> False
 498                  , "A "    ==> False
 499                  , "A\t"   ==> False
 500                  , "A \n"  ==> False
 501                  , "( )A"  ==> False
 502                  , "(A) A" ==> False
 503                  , "[ ] A" ==> False
 504                  , "(A)  " ==> False
 505                  , "[A] A" ==> False
 506                  , "[A]  " ==> False
 507                  ]
 508          ]
 509  , testGroup "Account" $
 510         let (==>) inp exp =
 511                 test inp $
 512                 read_gram LCC.g_account inp
 513                  @?= Right (account exp) in
 514          [ "/A"           ==> ["A"]
 515          , "/A/B"         ==> ["A", "B"]
 516          , "/A/B/C"       ==> ["A", "B","C"]
 517          , "/Aa/Bbb/Cccc" ==> ["Aa", "Bbb", "Cccc"]
 518          , "/A/B/(C)"     ==> ["A", "B", "(C)"]
 519          , testGroup "Parsing errors" $
 520                 let (!=>) inp _exp =
 521                         test inp $
 522                         rights [read_gram LCC.g_account inp]
 523                          @?= [] in
 524                  [ ""       !=> []
 525                  , "A"      !=> []
 526                  , "A/"     !=> []
 527                  , "A "     !=> []
 528                  , " A"     !=> []
 529                  , "/A/ /C" !=> []
 530                  , "/A//C"  !=> []
 531                  , "/A a / B b b / C c c c" !=> []
 532                  ]
 533          ]
 534  , testGroup "Amount" $
 535         let (==>) inp exp =
 536                 test inp $
 537                 read_gram LCC.g_amount inp @?= Right exp in
 538          [ "0" ==>
 539                 ( LCC.style_amount
 540                 , LCC.amount { LCC.amount_quantity = Decimal 0 0 } )
 541          , "00" ==>
 542                 ( LCC.style_amount
 543                 , LCC.amount { LCC.amount_quantity = Decimal 0 0 } )
 544          , "0." ==>
 545                 ( LCC.style_amount { LCC.style_amount_fractioning = pure '.' }
 546                 , LCC.amount { LCC.amount_quantity = Decimal 0 0 } )
 547          , "0," ==>
 548                 ( LCC.style_amount { LCC.style_amount_fractioning = pure ',' }
 549                 , LCC.amount { LCC.amount_quantity = Decimal 0 0 } )
 550          , "0.0" ==>
 551                 ( LCC.style_amount { LCC.style_amount_fractioning = pure '.' }
 552                 , LCC.amount { LCC.amount_quantity = Decimal 1 0 } )
 553          , "00.00" ==>
 554                 ( LCC.style_amount { LCC.style_amount_fractioning = pure '.' }
 555                 , LCC.amount { LCC.amount_quantity = Decimal 2 0 } )
 556          , "0,0" ==>
 557                 ( LCC.style_amount { LCC.style_amount_fractioning = pure ',' }
 558                 , LCC.amount { LCC.amount_quantity = Decimal 1 0 } )
 559          , "00,00" ==>
 560                 ( LCC.style_amount { LCC.style_amount_fractioning = pure ',' }
 561                 , LCC.amount { LCC.amount_quantity = Decimal 2 0 } )
 562          , "0_0" ==>
 563                 ( LCC.style_amount { LCC.style_amount_grouping_integral = pure $ LCC.Style_Amount_Grouping '_' [1] }
 564                 , LCC.amount { LCC.amount_quantity = Decimal 0 0 } )
 565          , "00_00" ==>
 566                 ( LCC.style_amount { LCC.style_amount_grouping_integral = pure $ LCC.Style_Amount_Grouping '_' [2] }
 567                 , LCC.amount { LCC.amount_quantity = Decimal 0 0 } )
 568          , "0,000.00" ==>
 569                 ( LCC.style_amount
 570                  { LCC.style_amount_fractioning       = pure '.'
 571                  , LCC.style_amount_grouping_integral = pure $ LCC.Style_Amount_Grouping ',' [3] }
 572                 , LCC.amount { LCC.amount_quantity = Decimal 2 0 } )
 573          , "0.000,00" ==>
 574                 ( LCC.style_amount
 575                  { LCC.style_amount_fractioning       = pure ','
 576                  , LCC.style_amount_grouping_integral = pure $ LCC.Style_Amount_Grouping '.' [3] }
 577                 , LCC.amount { LCC.amount_quantity = Decimal 2 0 } )
 578          , "1,000.00" ==>
 579                 ( LCC.style_amount
 580                  { LCC.style_amount_fractioning       = pure '.'
 581                  , LCC.style_amount_grouping_integral = pure $ LCC.Style_Amount_Grouping ',' [3] }
 582                 , LCC.amount { LCC.amount_quantity = Decimal 2 100000 } )
 583          , "1.000,00" ==>
 584                 ( LCC.style_amount
 585                  { LCC.style_amount_fractioning       = pure ','
 586                  , LCC.style_amount_grouping_integral = pure $ LCC.Style_Amount_Grouping '.' [3] }
 587                 , LCC.amount { LCC.amount_quantity = Decimal 2 100000 } )
 588          , "123" ==>
 589                 ( LCC.style_amount
 590                 , LCC.amount { LCC.amount_quantity = Decimal 0 123 } )
 591          , "1.2" ==>
 592                 ( LCC.style_amount { LCC.style_amount_fractioning = pure '.' }
 593                 , LCC.amount { LCC.amount_quantity = Decimal 1 12 } )
 594          , "1,2" ==>
 595                 ( LCC.style_amount { LCC.style_amount_fractioning = pure ',' }
 596                 , LCC.amount { LCC.amount_quantity = Decimal 1 12 } )
 597          , "12.34" ==>
 598                 ( LCC.style_amount { LCC.style_amount_fractioning = pure '.' }
 599                 , LCC.amount { LCC.amount_quantity = Decimal 2 1234 } )
 600          , "12,34" ==>
 601                 ( LCC.style_amount { LCC.style_amount_fractioning = pure ',' }
 602                 , LCC.amount { LCC.amount_quantity = Decimal 2 1234 } )
 603          , "1_2" ==>
 604                 ( LCC.style_amount { LCC.style_amount_grouping_integral = pure $ LCC.Style_Amount_Grouping '_' [1] }
 605                 , LCC.amount { LCC.amount_quantity = Decimal 0 12 } )
 606          , "1_23" ==>
 607                 ( LCC.style_amount { LCC.style_amount_grouping_integral = pure $ LCC.Style_Amount_Grouping '_' [2] }
 608                 , LCC.amount { LCC.amount_quantity = Decimal 0 123 } )
 609          , "1_23_456" ==>
 610                 ( LCC.style_amount { LCC.style_amount_grouping_integral = pure $ LCC.Style_Amount_Grouping '_' [3, 2] }
 611                 , LCC.amount { LCC.amount_quantity = Decimal 0 123456 } )
 612          , "1_23_456,7890_12345_678901" ==>
 613                 ( LCC.style_amount
 614                  { LCC.style_amount_fractioning         = pure ','
 615                  , LCC.style_amount_grouping_integral   = pure $ LCC.Style_Amount_Grouping '_' [3, 2]
 616                  , LCC.style_amount_grouping_fractional = pure $ LCC.Style_Amount_Grouping '_' [4, 5, 6] }
 617                 , LCC.amount { LCC.amount_quantity = Decimal 15 123456789012345678901 } )
 618          , "1_23_456.7890_12345_678901" ==>
 619                 ( LCC.style_amount
 620                  { LCC.style_amount_fractioning         = pure '.'
 621                  , LCC.style_amount_grouping_integral   = pure $ LCC.Style_Amount_Grouping '_' [3, 2]
 622                  , LCC.style_amount_grouping_fractional = pure $ LCC.Style_Amount_Grouping '_' [4, 5, 6] }
 623                 , LCC.amount { LCC.amount_quantity = Decimal 15 123456789012345678901 } )
 624          , "1,23,456.7890_12345_678901" ==>
 625                 ( LCC.style_amount
 626                  { LCC.style_amount_fractioning         = pure '.'
 627                  , LCC.style_amount_grouping_integral   = pure $ LCC.Style_Amount_Grouping ',' [3, 2]
 628                  , LCC.style_amount_grouping_fractional = pure $ LCC.Style_Amount_Grouping '_' [4, 5, 6] }
 629                 , LCC.amount { LCC.amount_quantity = Decimal 15 123456789012345678901 } )
 630          , "1.23.456,7890_12345_678901" ==>
 631                 ( LCC.style_amount
 632                  { LCC.style_amount_fractioning         = pure ','
 633                  , LCC.style_amount_grouping_integral   = pure $ LCC.Style_Amount_Grouping '.' [3, 2]
 634                  , LCC.style_amount_grouping_fractional = pure $ LCC.Style_Amount_Grouping '_' [4, 5, 6] }
 635                 , LCC.amount { LCC.amount_quantity = Decimal 15 123456789012345678901 } )
 636          , "123456_78901_2345.678_90_1" ==>
 637                 ( LCC.style_amount
 638                  { LCC.style_amount_fractioning         = pure '.'
 639                  , LCC.style_amount_grouping_integral   = pure $ LCC.Style_Amount_Grouping '_' [4, 5, 6]
 640                  , LCC.style_amount_grouping_fractional = pure $ LCC.Style_Amount_Grouping '_' [3, 2] }
 641                 , LCC.amount { LCC.amount_quantity = Decimal 6 123456789012345678901 } )
 642          , "$1" ==>
 643                 ( LCC.style_amount
 644                  { LCC.style_amount_unit_side   = pure LCC.L
 645                  , LCC.style_amount_unit_spaced = pure False }
 646                 , LCC.amount
 647                  { LCC.amount_quantity = Decimal 0 1
 648                  , LCC.amount_unit     = "$" } )
 649          , "1$" ==>
 650                 ( LCC.style_amount
 651                  { LCC.style_amount_unit_side   = pure LCC.R
 652                  , LCC.style_amount_unit_spaced = pure False }
 653                 , LCC.amount
 654                  { LCC.amount_quantity = Decimal 0 1
 655                  , LCC.amount_unit     = "$" } )
 656          , "$ 1" ==>
 657                 ( LCC.style_amount
 658                  { LCC.style_amount_unit_side   = pure LCC.L
 659                  , LCC.style_amount_unit_spaced = pure True }
 660                 , LCC.amount
 661                  { LCC.amount_quantity = Decimal 0 1
 662                  , LCC.amount_unit     = "$" } )
 663          , "1 $" ==>
 664                 ( LCC.style_amount
 665                  { LCC.style_amount_unit_side   = pure LCC.R
 666                  , LCC.style_amount_unit_spaced = pure True }
 667                 , LCC.amount
 668                  { LCC.amount_quantity = Decimal 0 1
 669                  , LCC.amount_unit     = "$" } )
 670          , "-$1" ==>
 671                 ( LCC.style_amount
 672                  { LCC.style_amount_unit_side   = pure LCC.L
 673                  , LCC.style_amount_unit_spaced = pure False }
 674                 , LCC.amount
 675                  { LCC.amount_quantity = Decimal 0 (-1)
 676                  , LCC.amount_unit     = "$" } )
 677          , "$1.000,00" ==>
 678                 ( LCC.style_amount
 679                  { LCC.style_amount_fractioning       = pure ','
 680                  , LCC.style_amount_grouping_integral = pure $ LCC.Style_Amount_Grouping '.' [3]
 681                  , LCC.style_amount_unit_side         = pure LCC.L
 682                  , LCC.style_amount_unit_spaced       = pure False }
 683                 , LCC.amount
 684                  { LCC.amount_quantity = Decimal 2 100000
 685                  , LCC.amount_unit     = "$" } )
 686          , "1.000,00$" ==>
 687                 ( LCC.style_amount
 688                  { LCC.style_amount_fractioning       = pure ','
 689                  , LCC.style_amount_grouping_integral = pure $ LCC.Style_Amount_Grouping '.' [3]
 690                  , LCC.style_amount_unit_side         = pure LCC.R
 691                  , LCC.style_amount_unit_spaced       = pure False }
 692                 , LCC.amount
 693                  { LCC.amount_quantity = Decimal 2 100000
 694                  , LCC.amount_unit     = "$" } )
 695          , testGroup "Parsing errors" $
 696                 let (!=>) inp _exp =
 697                         test inp $
 698                         rights [read_gram LCC.g_amount inp] @?= [] in
 699                  [ ""          !=> []
 700                  , ".0"        !=> []
 701                  , ",0"        !=> []
 702                  , "0_"        !=> []
 703                  , "_0"        !=> []
 704                  , "1,000.00." !=> []
 705                  , "1.000,00," !=> []
 706                  , "1,000.00_" !=> []
 707                  ]
 708          ]
 709  , testGroup "Comment" $
 710         let (==>) (inp, post) exp =
 711                 test inp $
 712                 rights [read_gram (LCC.g_comment <* post) inp]
 713                  @?= (LCC.Comment <$> exp) in
 714          [ ("; a b  c"     , Sym.eoi)            ==> [ "a b  c" ]
 715          , ("; #a"         , Sym.eoi)            ==> [ "#a" ]
 716          , ("; a b  c \n"  , Sym.string " \n")   ==> [ "a b  c" ]
 717          , ("; a b  c \r\n", Sym.string " \r\n") ==> [ "a b  c" ]
 718          -- , ("; a b  c\n  ;  d  e f", Sym.eoi)    ==> [ ["a b  c", "d  e f"] ]
 719          -- , ("; a b  c \n", Sym.string " \n")     ==> [ ["a b  c"] ]
 720          ]
 721  , testGroup "Transaction_Tag" $
 722         let (==>) inp exp =
 723                 test inp $
 724                 read_gram LCC.g_transaction_tag inp
 725                  @?= Right (LCC.Transaction_Tag exp) in
 726          [ "#Name"          ==> tag ["Name"] ""
 727          , "#Name:name"     ==> tag ["Name", "name"] ""
 728          , "#Name=Value"    ==> tag ["Name"] "Value"
 729          , "#Name = Value"  ==> tag ["Name"] "Value"
 730          , "#Name=Val ue"   ==> tag ["Name"] "Val ue"
 731          , "#Name=,"        ==> tag ["Name"] ","
 732          , "#Name=Val,ue"   ==> tag ["Name"] "Val,ue"
 733          , "#Name=Val,ue:"  ==> tag ["Name"] "Val,ue:"
 734          , "#Name=Val,ue :" ==> tag ["Name"] "Val,ue :"
 735          , testGroup "Parsing errors" $
 736                 let (!=>) inp _exp =
 737                         test inp $
 738                         rights [read_gram LCC.g_transaction_tag inp] @?= [] in
 739                  [ "#Name:"        !=> []
 740                  , "#Name=Value\n" !=> []
 741                  ]
 742          ]
 743  , testGroup "Posting" $
 744         let (==>) inp exp =
 745                 test inp $
 746                 read_gram LCC.g_posting inp @?= Right (S.Right exp) in
 747          [ "/A/B/C" ==> LCC.posting (account ["A", "B", "C"])
 748          , "/A/B/C $1" ==> (LCC.posting $ account ["A", "B", "C"])
 749                  { LCC.posting_amounts = amounts [("$", 1)] }
 750          , "/A/B/C  $1" ==> (LCC.posting $ account ["A", "B", "C"])
 751                  { LCC.posting_amounts = amounts [("$", 1)] }
 752          , "/A/B/C 1€" ==> (LCC.posting $ account ["A", "B", "C"])
 753                  { LCC.posting_amounts = amounts [("€", 1)] }
 754          , "/A/B/C $1; some comment" ==> (LCC.posting $ account ["A", "B", "C"])
 755                  { LCC.posting_amounts  = amounts [("$", 1)]
 756                  , LCC.posting_comments = comments ["some comment"] }
 757          , "/A/B/C; some comment" ==>
 758                 (LCC.posting $ account ["A", "B", "C"])
 759                  { LCC.posting_comments = comments ["some comment"] }
 760          , "/A/B/C ; some comment" ==> (LCC.posting $ account ["A", "B", "C"])
 761                  { LCC.posting_amounts  = amounts []
 762                  , LCC.posting_comments = comments ["some comment"] }
 763          , "/A/B/C ; some comment\n  ; some other comment" ==>
 764                 (LCC.posting $ account ["A", "B", "C"])
 765                  { LCC.posting_amounts  = amounts []
 766                  , LCC.posting_comments = comments ["some comment", "some other comment"] }
 767          , "/A/B/C $1 ; some comment" ==>
 768                 (LCC.posting $ account ["A", "B", "C"])
 769                  { LCC.posting_amounts  = amounts [("$", 1)]
 770                  , LCC.posting_comments = comments ["some comment"] }
 771          , "/A/B/C #N=V" ==>
 772                 (LCC.posting $ account ["A", "B", "C"])
 773                  { LCC.posting_tags = LCC.Posting_Tags $ tags [ (["N"], "V") ] }
 774          , "/A/B/C #N:O=V" ==>
 775                 (LCC.posting $ account ["A", "B", "C"])
 776                  { LCC.posting_tags = LCC.Posting_Tags $ tags [ (["N", "O"], "V") ] }
 777          , "/A/B/C #N=Val;ue" ==>
 778                 (LCC.posting $ account ["A", "B", "C"])
 779                  { LCC.posting_tags = LCC.Posting_Tags $ tags [ (["N"], "Val;ue") ] }
 780          , "/A/B/C #N=Val#ue" ==>
 781                 (LCC.posting $ account ["A", "B", "C"])
 782                  { LCC.posting_tags = LCC.Posting_Tags $ tags [ (["N"], "Val#ue") ] }
 783          , "/A/B/C #N=V ; not a comment" ==>
 784                 (LCC.posting $ account ["A", "B", "C"])
 785                  { LCC.posting_tags = LCC.Posting_Tags $ tags [ (["N"], "V ; not a comment") ] }
 786          , "/A/B/C #N=V #O" ==>
 787                 (LCC.posting $ account ["A", "B", "C"])
 788                  { LCC.posting_tags = LCC.Posting_Tags $ tags [ (["N"], "V #O") ] }
 789          , "/A/B/C #N#O" ==>
 790                 (LCC.posting $ account ["A", "B", "C"])
 791                  { LCC.posting_tags = LCC.Posting_Tags $ tags [ (,) ["N"] "", (,) ["O"] "" ] }
 792          , "/A/B/C #N; #O" ==>
 793                 (LCC.posting $ account ["A", "B", "C"])
 794                  { LCC.posting_tags     = LCC.Posting_Tags $ tags [ (["N"], "") ]
 795                  , LCC.posting_comments = comments ["#O"] }
 796          , "/A/B/C #N #O" ==>
 797                 (LCC.posting $ account ["A", "B", "C"])
 798                  { LCC.posting_tags = LCC.Posting_Tags $ tags [ (,) ["N"] "", (,) ["O"] "" ] }
 799          , "/A/B/C \n #N=V" ==>
 800                 (LCC.posting $ account ["A", "B", "C"])
 801                  { LCC.posting_tags = LCC.Posting_Tags $ tags [ (["N"], "V") ] }
 802          , "/A/B/C ; some comment\n #N=V" ==>
 803                 (LCC.posting $ account ["A", "B", "C"])
 804                  { LCC.posting_comments = comments ["some comment"]
 805                  , LCC.posting_tags     = LCC.Posting_Tags $ tags [ (["N"], "V") ] }
 806          , "/A/B/C ; some comment\n #N=V v\n #N2=V2 v2" ==>
 807                 (LCC.posting $ account ["A", "B", "C"])
 808                  { LCC.posting_comments = comments ["some comment"]
 809                  , LCC.posting_tags     = LCC.Posting_Tags $ tags
 810                          [ (["N"], "V v")
 811                          , (["N2"], "V2 v2") ] }
 812          , "/A/B/C\n #N=V\n #N=V2" ==>
 813                 (LCC.posting $ account ["A", "B", "C"])
 814                  { LCC.posting_tags = LCC.Posting_Tags $ tags
 815                          [ (["N"], "V")
 816                          , (["N"], "V2")
 817                          ] }
 818          , "/A/B/C\n #N=V\n #N2=V" ==>
 819                 (LCC.posting $ account ["A", "B", "C"])
 820                  { LCC.posting_tags = LCC.Posting_Tags $ tags
 821                          [ (["N"], "V")
 822                          , (["N2"], "V")
 823                          ] }
 824          ]
 825  , testGroup "Transaction" $
 826         let (==>) i e =
 827                 let inp = Text.intercalate "\n" i in
 828                 test inp $
 829                 read_gram LCC.g_transaction inp @?= Right (S.Right e) in
 830          [ [ "2000-01-01 some wording"
 831                  , " /A/B/C $1"
 832                  , " /D/E/F $-1"
 833                  ] ==> LCC.transaction
 834                  { LCC.transaction_dates    = date 2000 01 01 0 0 0 Time.utc `NonNull.ncons` []
 835                  , LCC.transaction_wording  = "some wording"
 836                  , LCC.transaction_postings = postings
 837                          [ (LCC.posting $ account ["A", "B", "C"])
 838                                  { LCC.posting_amounts   = amounts [ ("$", 1) ]
 839                                  , LCC.posting_sourcepos = sourcePos "" 2 2 }
 840                          , (LCC.posting $ account ["D", "E", "F"])
 841                                  { LCC.posting_amounts   = amounts [ ("$", -1) ]
 842                                  , LCC.posting_sourcepos = sourcePos "" 3 2 }
 843                          ]
 844                  }
 845          , [ "2000-01-01 some wording  ;  not a comment"
 846                  , "; some other;comment"
 847                  , " ; some last comment"
 848                  , " /A/B/C  $1"
 849                  , " /D/E/F"
 850                  ] ==> LCC.transaction
 851                  { LCC.transaction_comments = comments
 852                          [ "some other;comment"
 853                          , "some last comment"
 854                          ]
 855                  , LCC.transaction_dates    = date 2000 01 01 0 0 0 Time.utc `NonNull.ncons` []
 856                  , LCC.transaction_wording  = "some wording  ;  not a comment"
 857                  , LCC.transaction_postings = postings
 858                          [ (LCC.posting $ account ["A", "B", "C"])
 859                                  { LCC.posting_amounts   = amounts [ ("$", 1) ]
 860                                  , LCC.posting_sourcepos = sourcePos "" 4 2 }
 861                          , (LCC.posting $ account ["D", "E", "F"])
 862                                  { LCC.posting_amounts   = amounts [ ("$", -1) ]
 863                                  , LCC.posting_sourcepos = sourcePos "" 5 2 }
 864                          ]
 865                  }
 866          , testGroup "Semantic errors" $
 867                 let (=!>) i e =
 868                         let inp = Text.intercalate "\n" i in
 869                         test inp $
 870                         read_gram LCC.g_transaction inp @?= Right (S.Left e) in
 871                  [ [ "2000-01-01 wording"
 872                          , " /A/B/C $1"
 873                          , " /D/E/F $-2"
 874                          ] =!> LCC.At
 875                          { LCC.atBegin = pure $ sourcePos "" 1 1
 876                          , LCC.atEnd   = sourcePos "" 3 12
 877                          , LCC.atItem  = LCC.Error_Transaction_not_equilibrated
 878                                 LCC.transaction
 879                                  { LCC.transaction_dates    = date 2000 01 01 0 0 0 Time.utc `NonNull.ncons` []
 880                                  , LCC.transaction_wording  = "wording"
 881                                  , LCC.transaction_postings = postings
 882                                          [ (LCC.posting $ account ["A", "B", "C"])
 883                                                  { LCC.posting_amounts   = amounts [ ("$", 1) ]
 884                                                  , LCC.posting_sourcepos = sourcePos "" 2 2 }
 885                                          , (LCC.posting $ account ["D", "E", "F"])
 886                                                  { LCC.posting_amounts   = amounts [ ("$", -2) ]
 887                                                  , LCC.posting_sourcepos = sourcePos "" 3 2 }
 888                                          ]
 889                                  }
 890                                  [( LCC.Unit "$"
 891                                         , H.SumByUnit
 892                                          { H.sumByUnit_quantity = H.Polarized_Both (-2) 1
 893                                          , H.sumByUnit_accounts = Map.fromList []
 894                                          })]
 895                          }
 896                  ]
 897          ]
 898  ,-} testGroup "Term" $
 899         let (==>) = test_compile
 900                 @'[ Proxy Bool
 901                   , Proxy LCC.Journal
 902                   , Proxy LCC.Transaction
 903                   , Proxy []
 904                   -- , Proxy LCC.Postings
 905                   , Proxy LCC.Posting
 906                   , Proxy (->)
 907                   , Proxy Alternative
 908                   , Proxy Bounded
 909                   , Proxy Either
 910                   , Proxy H.Addable
 911                   , Proxy H.Negable
 912                   , Proxy H.Subable
 913                   , Proxy LCC.Account
 914                   , Proxy LCC.Amounts
 915                   , Proxy LCC.Date
 916                   , Proxy LCC.PathFile
 917                   , Proxy LCC.Quantity
 918                   , Proxy LCC.Unit
 919                   , Proxy Map
 920                   , Proxy NonNull
 921                   , Proxy TreeMap.Zipper
 922                   , Proxy []
 923                   ] (Proxy @[LCC.Transaction]) in
 924          [ [ "x = 42" ]          ==> ("x", Sym.ty @LCC.Quantity, Right 42.0)
 925          , [ "x = 40 + 2" ]      ==> ("x", Sym.ty @LCC.Quantity, Right 42.0)
 926          , [ "x = $4.2" ]        ==> ("x", Sym.ty @LCC.Amounts, Right $ amounts [ ("$", 4.2) ])
 927          , [ "x = 4,2€" ]        ==> ("x", Sym.ty @LCC.Amounts, Right $ amounts [ ("€", 4.2) ])
 928          , [ "x = 4,2€ + $2.4" ] ==> ("x", Sym.ty @LCC.Amounts, Right $ amounts [ ("$", 2.4), ("€", 4.2) ])
 929          , [ "x = 4,0€ + 0.2€" ] ==> ("x", Sym.ty @LCC.Amounts, Right $ amounts [ ("€", 4.2) ])
 930          , [ "x = j" ]           ==> ("x", Sym.ty @Bool, Right $ True )
 931          , testGroup "Semantic errors" $
 932                 let (=!>) i e =
 933                         let inp = Text.intercalate "\n" i in
 934                         test inp $
 935                         read_gram LCC.g_transaction inp @?= Right (S.Left e) in
 936                  [
 937                  ]
 938          ]
 939  {-, testGroup "Chart" $
 940         let (==>) i e =
 941                 let inp = Text.intercalate "\n" i in
 942                 test inp $
 943                 read_gram (
 944                         LCC.g_get $ (\_txn ch -> ch) <$>
 945                         LCC.g_journal @(Sym.TyConsts_of_Ifaces '[Proxy (->)]) @'[Proxy (->)] (:)
 946                  ) inp @?= Right e in
 947         let acct_path = NonEmpty.fromList . (LCC.Name <$>) in
 948         let acct_tags = LCC.Account_Tags . tags in
 949          [ [ "/A/B/C"
 950                  , "/D/E/F"
 951                  ] ==>
 952                         LCC.Chart
 953                          { LCC.chart_accounts = TreeMap.from_List (<>)
 954                                  [ (acct_path ["A", "B", "C"], acct_tags [])
 955                                  , (acct_path ["D", "E", "F"], acct_tags [])
 956                                  ]
 957                          , LCC.chart_tags = Map.empty
 958                          }
 959          , [ "/A/B/C"
 960                  , " ~t0:t1"
 961                  , " ~a0:a1:a2"
 962                  , "/D/E/F"
 963                  , " ~t0:t1 = v0"
 964                  , " ~t0:t1 = v1"
 965                  ] ==>
 966                         LCC.Chart
 967                          { LCC.chart_accounts = TreeMap.from_List (<>)
 968                                  [ (acct_path ["A", "B", "C"], acct_tags
 969                                          [ (["t0", "t1"], "")
 970                                          , (["a0", "a1", "a2"], "")
 971                                          ])
 972                                  , (acct_path ["D", "E", "F"], acct_tags
 973                                          [ (["t0", "t1"], "v0")
 974                                          , (["t0", "t1"], "v1") ])
 975                                  ]
 976                          , LCC.chart_tags = account_refs
 977                                  [ (,) ["t0", "t1"]
 978                                          [ ["A", "B", "C"]
 979                                          , ["D", "E", "F"] ]
 980                                  , (,) ["a0", "a1", "a2"]
 981                                          [ ["A", "B", "C"] ]
 982                                  ]
 983                          }
 984          ]
 985  , testGroup "Journal" $
 986         let run fe i e =
 987                 let inp = (Text.intercalate "\n" <$>) <$> i in
 988                 let jnl = fromMaybe "" $ List.lookup "" inp in
 989                 let exp = ((LCC.Journals . Map.fromList .  (first LCC.CanonFile <$>)) <$>) <$> fe e in
 990                 test jnl $
 991                 read @'[Proxy (->)] @[LCC.Transaction] (
 992                         LCC.g_get $ (\j (js::LCC.Journals [LCC.Transaction]) -> const js <$> j) <$>
 993                         LCC.g_journal
 994                          @(Sym.TyConsts_of_Ifaces '[Proxy (->)])
 995                          @'[Proxy (->)]
 996                          (:)
 997                  ) inp "" jnl @?= exp in
 998         let (==>) = run (Right . S.Right) ; infixr 0 ==> in
 999         let jnl :: LCC.Journal [LCC.Transaction] = LCC.journal in
1000          [ [ ("",)
1001                          [ "2000-01-01 wording"
1002                          , " /A/B/C $1"
1003                          , " /D/E/F"
1004                          ]
1005                  ] ==>
1006                  [ ("",) jnl
1007                          { LCC.journal_content =
1008                                  [ LCC.transaction
1009                                          { LCC.transaction_dates     = date 2000 01 01 0 0 0 Time.utc `NonNull.ncons` []
1010                                          , LCC.transaction_wording   = "wording"
1011                                          , LCC.transaction_sourcepos = sourcePos "" 1 1
1012                                          , LCC.transaction_postings  = postings
1013                                                  [ (LCC.posting $ account ["A", "B", "C"])
1014                                                          { LCC.posting_amounts   = amounts [ ("$", 1) ]
1015                                                          , LCC.posting_sourcepos = sourcePos "" 2 2
1016                                                          }
1017                                                  , (LCC.posting $ account ["D", "E", "F"])
1018                                                          { LCC.posting_amounts   = amounts [ ("$", -1) ]
1019                                                          , LCC.posting_sourcepos = sourcePos "" 3 2
1020                                                          }
1021                                                  ]
1022                                          }
1023                                  ]
1024                          {-, LCC.journal_amount_styles = LCC.Amount_Styles $ Map.fromList
1025                                  [ ( LCC.Unit "$"
1026                                          , mempty
1027                                                  { LCC.amount_style_unit_side   = Just LCC.L
1028                                                  , LCC.amount_style_unit_spaced = Just False }
1029                                          )
1030                                  ]
1031                          -}
1032                          }
1033                  ]
1034          , [ ("",)
1035                          [ "2000-01-01 1° wording"
1036                          , " /A/B/C  $1"
1037                          , " /D/E/F"
1038                          , "2000-01-02 2° wording"
1039                          , " /A/B/C $1"
1040                          , " /x/y/z"
1041                          ]
1042                  ] ==>
1043                  [ ("",) jnl
1044                          { LCC.journal_content =
1045                                  [ LCC.transaction
1046                                          { LCC.transaction_dates     = date 2000 01 02 0 0 0 Time.utc `NonNull.ncons` []
1047                                          , LCC.transaction_wording   = "2° wording"
1048                                          , LCC.transaction_sourcepos = sourcePos "" 4 1
1049                                          , LCC.transaction_postings  = postings
1050                                                  [ (LCC.posting $ account ["A", "B", "C"])
1051                                                          { LCC.posting_amounts   = amounts [ ("$", 1) ]
1052                                                          , LCC.posting_sourcepos = sourcePos "" 5 2
1053                                                          }
1054                                                  , (LCC.posting $ account ["x", "y", "z"])
1055                                                          { LCC.posting_amounts   = amounts [ ("$", -1) ]
1056                                                          , LCC.posting_sourcepos = sourcePos "" 6 2
1057                                                          }
1058                                                  ]
1059                                          }
1060                                  , LCC.transaction
1061                                          { LCC.transaction_dates     = date 2000 01 01 0 0 0 Time.utc `NonNull.ncons` []
1062                                          , LCC.transaction_wording   = "1° wording"
1063                                          , LCC.transaction_sourcepos = sourcePos "" 1 1
1064                                          , LCC.transaction_postings  = postings
1065                                                  [ (LCC.posting $ account ["A", "B", "C"])
1066                                                          { LCC.posting_amounts   = amounts [ ("$", 1) ]
1067                                                          , LCC.posting_sourcepos = sourcePos "" 2 2
1068                                                          }
1069                                                  , (LCC.posting $ account ["D", "E", "F"])
1070                                                          { LCC.posting_amounts   = amounts [ ("$", -1) ]
1071                                                          , LCC.posting_sourcepos = sourcePos "" 3 2
1072                                                          }
1073                                                  ]
1074                                          }
1075                                  ]
1076                          }
1077                  ]
1078          , [ ("",)
1079                          [ "/A/B ~AB"
1080                          , ""
1081                          , "2000-01-01 wording"
1082                          , " ~AB/C $1"
1083                          , " /D/E/F"
1084                          ]
1085                  ] ==>
1086                  [ ("",) jnl
1087                          { LCC.journal_content =
1088                                  [ LCC.transaction
1089                                          { LCC.transaction_dates     = date 2000 01 01 0 0 0 Time.utc `NonNull.ncons` []
1090                                          , LCC.transaction_wording   = "wording"
1091                                          , LCC.transaction_sourcepos = sourcePos "" 3 1
1092                                          , LCC.transaction_postings  = postings
1093                                                  [ (LCC.posting $ account ["A", "B", "C"])
1094                                                          { LCC.posting_amounts        = amounts [ ("$", 1) ]
1095                                                          , LCC.posting_account_ref = S.Just $ account_ref ["AB"] S.:!: S.Just (account ["C"])
1096                                                          , LCC.posting_sourcepos      = sourcePos "" 4 2
1097                                                          }
1098                                                  , (LCC.posting $ account ["D", "E", "F"])
1099                                                          { LCC.posting_amounts   = amounts [ ("$", -1) ]
1100                                                          , LCC.posting_sourcepos = sourcePos "" 5 2
1101                                                          }
1102                                                  ]
1103                                          }
1104                                  ]
1105                          }
1106                  ]
1107          , [ ("",)
1108                          [ "./chart"
1109                          , ""
1110                          , "2000-01-01 wording"
1111                          , " ~AB/C $1"
1112                          , " ~D/E/F"
1113                          ]
1114                  , ("chart",)
1115                          [ "/A/B ~AB"
1116                          , "/D"
1117                          , "; comment"
1118                          , " ~D"
1119                          ]
1120                  ] ==>
1121                  [ ("",) jnl
1122                          { LCC.journal_includes =
1123                                  [ LCC.CanonFile "chart"
1124                                  ]
1125                          , LCC.journal_content =
1126                                  [ LCC.transaction
1127                                          { LCC.transaction_dates     = date 2000 01 01 0 0 0 Time.utc `NonNull.ncons` []
1128                                          , LCC.transaction_wording   = "wording"
1129                                          , LCC.transaction_sourcepos = sourcePos "" 3 1
1130                                          , LCC.transaction_postings  = postings
1131                                                  [ (LCC.posting $ account ["A", "B", "C"])
1132                                                          { LCC.posting_amounts     = amounts [ ("$", 1) ]
1133                                                          , LCC.posting_account_ref = S.Just $ account_ref ["AB"] S.:!: S.Just (account ["C"])
1134                                                          , LCC.posting_sourcepos   = sourcePos "" 4 2
1135                                                          }
1136                                                  , (LCC.posting $ account ["D", "E", "F"])
1137                                                          { LCC.posting_amounts     = amounts [ ("$", -1) ]
1138                                                          , LCC.posting_account_ref = S.Just $ account_ref ["D"] S.:!: S.Just (account ["E", "F"])
1139                                                          , LCC.posting_sourcepos   = sourcePos "" 5 2
1140                                                          }
1141                                                  ]
1142                                          }
1143                                  ]
1144                          }
1145                  , ("chart",) jnl
1146                          { LCC.journal_file = "chart"
1147                          }
1148                  ]
1149          , [ ("",)
1150                          [ "2000-01-01 w"
1151                          , " /A/B/C $1"
1152                          , " /D/E/F"
1153                          , "./0"
1154                          , "./1"
1155                          ]
1156                  , ("0",)
1157                          [ "2000-01-02 w0"
1158                          , " /A/B/C $2"
1159                          , " /D/E/F"
1160                          ]
1161                  , ("1",)
1162                          [ "2000-01-03 w1"
1163                          , " /A/B/C $3"
1164                          , " /D/E/F"
1165                          ]
1166                  ] ==>
1167                  [ ("",) jnl
1168                          { LCC.journal_includes =
1169                                  [ LCC.CanonFile "0"
1170                                  , LCC.CanonFile "1"
1171                                  ]
1172                          , LCC.journal_content =
1173                                  [ LCC.transaction
1174                                          { LCC.transaction_dates     = date 2000 01 01 0 0 0 Time.utc `NonNull.ncons` []
1175                                          , LCC.transaction_wording   = "w"
1176                                          , LCC.transaction_sourcepos = sourcePos "" 1 1
1177                                          , LCC.transaction_postings  = postings
1178                                                  [ (LCC.posting $ account ["A", "B", "C"])
1179                                                          { LCC.posting_amounts   = amounts [ ("$", 1) ]
1180                                                          , LCC.posting_sourcepos = sourcePos "" 2 2
1181                                                          }
1182                                                  , (LCC.posting $ account ["D", "E", "F"])
1183                                                          { LCC.posting_amounts   = amounts [ ("$", -1) ]
1184                                                          , LCC.posting_sourcepos = sourcePos "" 3 2
1185                                                          }
1186                                                  ]
1187                                          }
1188                                  ]
1189                          }
1190                  , ("0",) jnl
1191                          { LCC.journal_file    = "0"
1192                          , LCC.journal_content =
1193                                  [ LCC.transaction
1194                                          { LCC.transaction_dates     = date 2000 01 02 0 0 0 Time.utc `NonNull.ncons` []
1195                                          , LCC.transaction_wording   = "w0"
1196                                          , LCC.transaction_sourcepos = sourcePos "0" 1 1
1197                                          , LCC.transaction_postings  = postings
1198                                                  [ (LCC.posting $ account ["A", "B", "C"])
1199                                                          { LCC.posting_amounts   = amounts [ ("$", 2) ]
1200                                                          , LCC.posting_sourcepos = sourcePos "0" 2 2
1201                                                          }
1202                                                  , (LCC.posting $ account ["D", "E", "F"])
1203                                                          { LCC.posting_amounts   = amounts [ ("$", -2) ]
1204                                                          , LCC.posting_sourcepos = sourcePos "0" 3 2
1205                                                          }
1206                                                  ]
1207                                          }
1208                                  ]
1209                          }
1210                  , ("1",) jnl
1211                          { LCC.journal_file    = "1"
1212                          , LCC.journal_content =
1213                                  [ LCC.transaction
1214                                          { LCC.transaction_dates     = date 2000 01 03 0 0 0 Time.utc `NonNull.ncons` []
1215                                          , LCC.transaction_wording   = "w1"
1216                                          , LCC.transaction_sourcepos = sourcePos "1" 1 1
1217                                          , LCC.transaction_postings  = postings
1218                                                  [ (LCC.posting $ account ["A", "B", "C"])
1219                                                          { LCC.posting_amounts   = amounts [ ("$", 3) ]
1220                                                          , LCC.posting_sourcepos = sourcePos "1" 2 2
1221                                                          }
1222                                                  , (LCC.posting $ account ["D", "E", "F"])
1223                                                          { LCC.posting_amounts   = amounts [ ("$", -3) ]
1224                                                          , LCC.posting_sourcepos = sourcePos "1" 3 2
1225                                                          }
1226                                                  ]
1227                                          }
1228                                  ]
1229                          }
1230                  ]
1231          , testGroup "Parsing errors" $
1232                 let (!=>) = run Left ; infixr 0 !=> in
1233                  [ [ ("",)
1234                                  [ "./j"
1235                                  ]
1236                          , ("j",)
1237                                  [ "2000-01_01 wording"
1238                                  , " /A/B/C $1"
1239                                  , " /D/E/F"
1240                                  ]
1241                          ] !=> P.ParseError
1242                          { P.errorPos        = sourcePos "j" 1 8 :| [sourcePos "" 1 4]
1243                          , P.errorUnexpected = Set.fromList [P.Tokens ('_' :| "")]
1244                          , P.errorExpected   = Set.fromList [P.Tokens ('-' :| "")]
1245                          , P.errorCustom     = Set.fromList []
1246                          }
1247                  ]
1248          , testGroup "Semantic errors" $
1249                 let (=!>) = run (Right . S.Left) ; infixr 0 =!> in
1250                  [ [ ("",)
1251                                  [ "2000-01-01 wording"
1252                                  , " /A/B/C $1"
1253                                  , " /D/E/F"
1254                                  , ""
1255                                  , "./chart"
1256                                  , ""
1257                                  , "2000-01-01 wording"
1258                                  , " ~AB/C $1"
1259                                  , " /D/E/F"
1260                                  ]
1261                          , ("chart",)
1262                                  [ "/A/B ~AB"
1263                                  ]
1264                          ] =!>
1265                          [ LCC.At
1266                                  { LCC.atBegin = sourcePos "chart" 1 1 :| [sourcePos "" 5 8]
1267                                  , LCC.atEnd   = sourcePos "chart" 1 9
1268                                  , LCC.atItem  =
1269                                         LCC.Error_Journal_Section
1270                                          LCC.Section_Transaction
1271                                          LCC.Section_Chart
1272                                  }
1273                          , LCC.At
1274                                  { LCC.atBegin = sourcePos "" 8 2 :| []
1275                                  , LCC.atEnd   = sourcePos "" 8 5
1276                                  , LCC.atItem  =
1277                                         LCC.Error_Journal_Transaction $
1278                                         LCC.Error_Transaction_Posting $
1279                                         LCC.Error_Posting_Account_Ref_unknown $
1280                                         account_ref ["AB"]
1281                                  }
1282                          ]
1283                  , [ ("",)
1284                                  [ "./j"
1285                                  ]
1286                          , ("j",)
1287                                  [ "2000-01-01 wording"
1288                                  , " /A/B/C $1"
1289                                  , " /D/E/F"
1290                                  , ""
1291                                  , "./j"
1292                                  ]
1293                          ] =!>
1294                          [ LCC.At
1295                                  { LCC.atBegin = sourcePos "j" 5 1 :| [sourcePos "" 1 4]
1296                                  , LCC.atEnd   = sourcePos "j" 5 4
1297                                  , LCC.atItem  = LCC.Error_Journal_Include_loop $ LCC.CanonFile "j"
1298                                  }
1299                          ]
1300                  ]
1301          ]
1302  -}]