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