{- -----------------------------------------------------------------------------
Copyright 2019-2023 Kevin P. Barry

Licensed under the Apache License, Version 2.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at

    http://www.apache.org/licenses/LICENSE-2.0

Unless required by applicable law or agreed to in writing, software
distributed under the License is distributed on an "AS IS" BASIS,
WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
See the License for the specific language governing permissions and
limitations under the License.
----------------------------------------------------------------------------- -}

-- Author: Kevin P. Barry [ta0kira@gmail.com]

module Test.Procedure (tests) where

import Control.Monad
import System.FilePath

import Base.CompilerError
import Base.Positional
import Base.TrackedErrors
import Parser.Procedure
import Parser.TextParser (SourceContext)
import Test.Common
import Types.Procedure
import Types.TypeCategory
import Types.TypeInstance


tests :: [IO (TrackedErrors ())]
tests :: [IO (TrackedErrors ())]
tests = [
    String -> IO (TrackedErrors ())
checkParseSuccess (String
"testfiles" String -> String -> String
</> String
"procedures.0rx"),

    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"return _",
    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"return var",
    String -> IO (TrackedErrors ())
checkShortParseFail String
"return var var",
    String -> IO (TrackedErrors ())
checkShortParseFail String
"return _ var",
    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"return call()",
    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"return var?T<#x>.func()",
    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"return var?T<#x>",
    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"return var, var?T<#x>.func()",
    String -> IO (TrackedErrors ())
checkShortParseFail String
"return var  var?T<#x>.func()",
    String -> IO (TrackedErrors ())
checkShortParseFail String
"return var.T<#x>.func()",
    String -> IO (TrackedErrors ())
checkShortParseFail String
"return var.T<#x>",
    String -> IO (TrackedErrors ())
checkShortParseFail String
"return var, _",
    String -> IO (TrackedErrors ())
checkShortParseFail String
"return T<#x> var",
    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"return T<#x>{ val }",
    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"\\ T:func()",
    String -> IO (TrackedErrors ())
checkShortParseFail String
"\\ T$$func()",
    String -> IO (TrackedErrors ())
checkShortParseFail String
"\\ T$ $func()",
    String -> IO (TrackedErrors ())
checkShortParseFail String
"\\ T<#x>:func()",
    String -> IO (TrackedErrors ())
checkShortParseFail String
"\\ var.T:func()",

    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"break",
    String -> IO (TrackedErrors ())
checkShortParseFail String
"break var",
    String -> IO (TrackedErrors ())
checkShortParseFail String
"break _",
    String -> IO (TrackedErrors ())
checkShortParseFail String
"break { }",

    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"\\ var",
    String -> IO (TrackedErrors ())
checkShortParseFail String
"\\ var var",
    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"\\ var?T<#x>.func().func2().func3()",
    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"\\ T<#x>.func().func2().func3()",
    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"\\ #x.func().func2().func3()",
    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"\\ var?T<#x>?T<#x>.func()",
    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"\\ var?T<#x>",
    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"\\ var?#x",
    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"\\ var?[T1|T2]",
    String -> IO (TrackedErrors ())
checkShortParseFail String
"\\ T<#x> var",
    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"\\ T<#x>{ val, var?T<#x>.func() }",
    String -> IO (TrackedErrors ())
checkShortParseFail String
"\\ T<#x>{ val var?T<#x>.func() }",
    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"\\ T<#x>{}.call()",
    String -> IO (TrackedErrors ())
checkShortParseFail String
"\\ T<#x>$call()",
    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"\\ (T<#x>{}).call()",
    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"\\ (\"abc\").call()",
    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"\\ \"abc\".call()",
    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"\\ ('a').call()",
    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"\\ 'a'.call()",
    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"\\ (false).call()",
    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"\\ false.call()",
    String -> IO (TrackedErrors ())
checkShortParseFail String
"\\ 1.call()",
    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"\\ empty.call()",

    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"\\ foo(arg1: 123)",
    String -> IO (TrackedErrors ())
checkShortParseFail String
"\\ foo(arg1 : 123)",

    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"x <- var.func()",
    String -> IO (TrackedErrors ())
checkShortParseFail String
"x <- var.func() var.func()",
    String -> IO (TrackedErrors ())
checkShortParseFail String
"x <- y <- var.func()",
    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"x <- empty",
    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"x <- true",
    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"x <- false",
    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"x <- require(y)",
    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"x <- reduce<#x,#y>(z)",
    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"x <- self",
    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"x <- self.f()",
    String -> IO (TrackedErrors ())
checkShortParseFail String
"empty <- x",
    String -> IO (TrackedErrors ())
checkShortParseFail String
"true <- x",
    String -> IO (TrackedErrors ())
checkShortParseFail String
"false <- x",
    String -> IO (TrackedErrors ())
checkShortParseFail String
"require <- x",
    String -> IO (TrackedErrors ())
checkShortParseFail String
"reduce <- x",
    String -> IO (TrackedErrors ())
checkShortParseFail String
"self <- x",
    String -> IO (TrackedErrors ())
checkShortParseFail String
"T<#x> empty <- x",
    String -> IO (TrackedErrors ())
checkShortParseFail String
"T<#x> true <- x",
    String -> IO (TrackedErrors ())
checkShortParseFail String
"T<#x> false <- x",
    String -> IO (TrackedErrors ())
checkShortParseFail String
"T<#x> require <- x",
    String -> IO (TrackedErrors ())
checkShortParseFail String
"T<#x> reduce <- x",
    String -> IO (TrackedErrors ())
checkShortParseFail String
"T<#x> self <- x",
    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"T<#x> x <- var.func()",
    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"weak T<#x> x <- var.func()",
    String -> IO (TrackedErrors ())
checkShortParseFail String
"\\ T<#x> x <- var.func()",
    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"_, weak T<#x> x <- var.func()",
    String -> IO (TrackedErrors ())
checkShortParseFail String
"_, weak T<#x> x <- T<#x> x",

    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"a <-> b",
    String -> IO (TrackedErrors ())
checkShortParseFail String
"self <-> b",
    String -> IO (TrackedErrors ())
checkShortParseFail String
"a <-> self",
    String -> IO (TrackedErrors ())
checkShortParseFail String
"_ <-> b",
    String -> IO (TrackedErrors ())
checkShortParseFail String
"a <-> _",
    String -> IO (TrackedErrors ())
checkShortParseFail String
"\\ a <-> b",
    String -> IO (TrackedErrors ())
checkShortParseFail String
"a, b <-> c",
    String -> IO (TrackedErrors ())
checkShortParseFail String
"a <-> b, c",
    String -> IO (TrackedErrors ())
checkShortParseFail String
"#a <-> b",
    String -> IO (TrackedErrors ())
checkShortParseFail String
"a <-> #b",
    String -> IO (TrackedErrors ())
checkShortParseFail String
"a.foo() <-> b",
    String -> IO (TrackedErrors ())
checkShortParseFail String
"a <-> b.foo()",

    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"if (var.func()) { \\ val.call() }",
    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"if (present(var)) { \\ val.call() }",
    String -> IO (TrackedErrors ())
checkShortParseFail String
"if (T<#x> x) { \\ val.call() }",
    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"if (var) { \\ val.call() } else { \\ val.call() }",
    String -> IO (TrackedErrors ())
checkShortParseFail String
"if (var) { \\ val.call() } elif { \\ val.call() }",
    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"if (v) { \\ c() } elif (v) { \\ c() }",
    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"if (v) { \\ c() } elif (v) { \\ c() } else { \\ c() }",
    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"if (v) { \\ c() } elif (v) { \\ c() } elif (v) { \\ c() }",

    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"while (var.func()) { \\ val.call() }",
    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"while (var.func()) { \\ val.call() } update { \\ call() }",

    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"scoped { T<#x> x <- y } in return _",
    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"scoped { T<#x> x <- y } in return var, var?T<#x>.func()",
    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"scoped { T<#x> x <- y } in \\ var?T<#x>.func()",
    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"scoped { T<#x> x <- y } in _, weak T<#x> x <- var.func()",

    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"scoped { T<#x> x <- y } in if (var.func()) { \\ val.call() }",
    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"scoped { T<#x> x <- y } in while (var.func()) { \\ val.call() }",

    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"x <- (((var.func()))?T.call())",
    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"\\ (x <- var).func()",
    String -> IO (TrackedErrors ())
checkShortParseFail String
"x <- (((var.func()))",
    String -> IO (TrackedErrors ())
checkShortParseFail String
"(((x <- var.func())))",
    String -> IO (TrackedErrors ())
checkShortParseFail String
"(x) <- y",
    String -> IO (TrackedErrors ())
checkShortParseFail String
"T (x) <- y",
    String -> IO (TrackedErrors ())
checkShortParseFail String
"\\ (T x <- var).func()",
    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"\\ call(((var.func()))?T.call())",
    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"if (((var.func())?T.call())) { }",
    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"fail(\"reason\")",
    String -> IO (TrackedErrors ())
checkShortParseFail String
"\\ fail(\"reason\")",
    String -> IO (TrackedErrors ())
checkShortParseFail String
"\\ fail()",
    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"exit(1)",
    String -> IO (TrackedErrors ())
checkShortParseFail String
"\\ exit(1)",
    String -> IO (TrackedErrors ())
checkShortParseFail String
"\\ exit()",
    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"failed <- 10",

    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"\\var?T<#x>.func().func2().func3()",
    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"\\T<#x>{val,var?T<#x>.func()}",
    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"x<-var.func()",
    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"T<#x>x<-var.func()",
    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"_,weak T<#x>x<-var.func()",
    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"if(v){\\c()}elif(v){\\c()}",
    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"if(v){\\c()}elif(v){\\c()}else{\\c()}",
    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"if(v){\\c()}elif(v){\\c()}elif(v){\\c()}",
    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"while(var.func()){\\val.call()}",
    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"scoped{T<#x>x<-y}in\\var?T<#x>.func()",
    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"scoped{T<#x>x<-y}in{x<-1}",
    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"scoped{T<#x>x<-y}in x<-1",
    String -> IO (TrackedErrors ())
checkShortParseFail String
"scoped{T<#x>x<-y}in{x}",

    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"x <- !y",
    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"x <- !y",
    String -> IO (TrackedErrors ())
checkShortParseFail String
"x <- !!=y",
    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"x <- (!y).func()",
    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"\\ !y",
    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"if (!y) { }",

    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"\\ !x + !y",
    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"\\ !x - !y",
    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"\\ !x * !y",
    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"\\ !x / !y",
    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"\\ !x % !y",
    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"\\ !x == !y",
    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"\\ !x != !y",
    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"\\ !x < !y",
    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"\\ !x <= !y",
    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"\\ !x > !y",
    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"\\ !x >= !y",
    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"\\ !x && !y",
    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"\\ !x || !y",
    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"\\ ~x >> ~y",
    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"\\ ~x << ~y",
    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"\\ ~x & ~y",
    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"\\ ~x | ~y",
    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"\\ ~x ^ ~y",

    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"\\ a+b",
    String -> IO (TrackedErrors ())
checkShortParseFail String
"\\ a++b",
    String -> IO (TrackedErrors ())
checkShortParseFail String
"\\ a+/b",
    String -> IO (TrackedErrors ())
checkShortParseFail String
"\\ a/=b",
    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"\\ a+/*c*//*c*/d",
    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"\\ a+//c\nd",
    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"\\ a/*c*//*c*/+d",
    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"\\ a//c\n+d",

    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"x <- y + z",
    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"x <- !y == !z",
    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"x <- (x + y) / z",
    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"\\ x <= y",
    String -> IO (TrackedErrors ())
checkShortParseFail String
"\\ x < <- y",

    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"x <- 123 + 123",
    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"x <- 123.0 - 123.0",
    String -> IO (TrackedErrors ())
checkShortParseFail String
"x <- 123.",
    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"x <- 0.123 * 0.123",
    String -> IO (TrackedErrors ())
checkShortParseFail String
"x <- .123",
    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"x <- 12.3 / 12.3",
    String -> IO (TrackedErrors ())
checkShortParseFail String
"x <- 12.3.",
    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"x <- 12.3 + -456.7",
    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"x <- \\x123aBc + \\x123aBc",
    String -> IO (TrackedErrors ())
checkShortParseFail String
"x <- \\x123aQc",
    String -> IO (TrackedErrors ())
checkShortParseFail String
"x <- \\x",
    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"x <- \" return \\\"\\\" \" + \"1fds\"",
    String -> IO (TrackedErrors ())
checkShortParseFail String
"x <- \"fsdfd",
    String -> IO (TrackedErrors ())
checkShortParseFail String
"x <- \"\"fsdfd",
    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"x <- 123.0 + z.call()",
    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"x <- \"123\".call()",
    String -> IO (TrackedErrors ())
checkShortParseFail String
"x <- 123.call()",
    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"x <- 'x'",
    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"x <- '\\xAA'",
    String -> IO (TrackedErrors ())
checkShortParseFail String
"x <- '\\xAAZ'",
    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"x <- '\076'",
    String -> IO (TrackedErrors ())
checkShortParseFail String
"x <- '\\07'",
    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"x <- '\\n'",
    String -> IO (TrackedErrors ())
checkShortParseFail String
"x <- 'x",
    String -> IO (TrackedErrors ())
checkShortParseFail String
"x <- 'xx'",
    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"x <- \"'xx\"",

    String -> IO (TrackedErrors ())
checkShortParseFail String
"_ <- 1 < 2 < 3",
    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"_ <- 1 << 2 >> 3",
    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"_ <- 1 - 2 - 3",
    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"_ <- 1 - 2 / 3",
    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"_ <- 1 / 2 - 3",
    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"_ <- x < y || z > w",

    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"\\ call(){0}",
    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"\\ call(){0}.bar()",
    String -> IO (TrackedErrors ())
checkShortParseFail String
"\\ call(){x}",
    String -> IO (TrackedErrors ())
checkShortParseFail String
"\\ call(){-1}",

    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"x <- `strong` y",
    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"x <- `present` y",
    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"x <- `require` y",
    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"x <- `reduce<#x,#y>` y",
    String -> IO (TrackedErrors ())
checkShortParseFail String
"x <- `typename<#y>` y",

    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"x <- 123.456",
    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"x <- \\d123.456",
    String -> IO (TrackedErrors ())
checkShortParseFail String
"x <- 123.",
    String -> IO (TrackedErrors ())
checkShortParseFail String
"x <- \\d123.",
    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"x <- 123.456E1",
    String -> IO (TrackedErrors ())
checkShortParseFail String
"x <- \\d123.456E1",

    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"x <- \\b101.101",
    String -> IO (TrackedErrors ())
checkShortParseFail String
"x <- \\b101.",
    String -> IO (TrackedErrors ())
checkShortParseFail String
"x <- \\b101.101E1",

    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"x <- \\xABC.DEF",
    String -> IO (TrackedErrors ())
checkShortParseFail String
"x <- \\xABC.",

    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"x <- \\o123.456",
    String -> IO (TrackedErrors ())
checkShortParseFail String
"x <- \\o123.",
    String -> IO (TrackedErrors ())
checkShortParseFail String
"x <- \\o123.456E1",

    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"x <-| 123",
    String -> IO (TrackedErrors ())
checkShortParseFail String
"Int x <-| 123",
    String -> IO (TrackedErrors ())
checkShortParseFail String
"_ <-| 123",
    String -> IO (TrackedErrors ())
checkShortParseFail String
"x, y <-| 123",

    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"\\ x <|| y",
    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"\\ empty?Int <|| y",
    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"\\ 123 <|| 456",
    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"\\ empty <|| 'a'",
    String -> IO (TrackedErrors ())
checkShortParseFail String
"Int x <|| 'a'",
    String -> IO (TrackedErrors ())
checkShortParseFail String
"x, y <|| 'a'",
    String -> IO (TrackedErrors ())
checkShortParseFail String
"\\ _ <|| 'a'",

    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"\\ \"123\"?String < \"456\"",
    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"\\ \"123\"?ReadAt < Char>",
    String -> IO (TrackedErrors ())
checkShortParseSuccess String
"\\ \"123\"?String < String.default()",

    String
-> (Expression SourceContext -> Bool) -> IO (TrackedErrors ())
checkParsesAs String
"'\"'"
                  (\Expression SourceContext
e -> case Expression SourceContext
e of
                              (Expression [SourceContext]
_ (UnambiguousLiteral (CharLiteral [SourceContext]
_ Char
'"')) []) -> Bool
True
                              Expression SourceContext
_ -> Bool
False),

    String
-> (Expression SourceContext -> Bool) -> IO (TrackedErrors ())
checkParsesAs String
"1 + 2 < 4 && 3 >= 1 * 2 + 1 || true"
                  (\Expression SourceContext
e -> case Expression SourceContext
e of
                              (InfixExpression [SourceContext]
_
                                (InfixExpression [SourceContext]
_
                                  (InfixExpression [SourceContext]
_
                                    (Literal (IntegerLiteral [SourceContext]
_ Bool
False Integer
1)) (NamedOperator [SourceContext]
_ String
"+")
                                    (Literal (IntegerLiteral [SourceContext]
_ Bool
False Integer
2))) (NamedOperator [SourceContext]
_ String
"<")
                                  (Literal (IntegerLiteral [SourceContext]
_ Bool
False Integer
4))) (NamedOperator [SourceContext]
_ String
"&&")
                                (InfixExpression [SourceContext]
_
                                  (InfixExpression [SourceContext]
_
                                    (Literal (IntegerLiteral [SourceContext]
_ Bool
False Integer
3)) (NamedOperator [SourceContext]
_ String
">=")
                                    (InfixExpression [SourceContext]
_
                                      (InfixExpression [SourceContext]
_
                                        (Literal (IntegerLiteral [SourceContext]
_ Bool
False Integer
1)) (NamedOperator [SourceContext]
_ String
"*")
                                        (Literal (IntegerLiteral [SourceContext]
_ Bool
False Integer
2))) (NamedOperator [SourceContext]
_ String
"+")
                                      (Literal (IntegerLiteral [SourceContext]
_ Bool
False Integer
1)))) (NamedOperator [SourceContext]
_ String
"||")
                                  (Expression [SourceContext]
_ (UnambiguousLiteral (BoolLiteral [SourceContext]
_ Bool
True)) []))) -> Bool
True
                              Expression SourceContext
_ -> Bool
False),

    -- This expression isn't really valid, but it ensures that the first ! is
    -- applied only to x and not x*!y.
    String
-> (Expression SourceContext -> Bool) -> IO (TrackedErrors ())
checkParsesAs String
"!x * !y + !z"
                  (\Expression SourceContext
e -> case Expression SourceContext
e of
                              (InfixExpression [SourceContext]
_
                                (InfixExpression [SourceContext]
_
                                  (UnaryExpression [SourceContext]
_ (NamedOperator [SourceContext]
_ String
"!")
                                    (Expression [SourceContext]
_ (NamedVariable (OutputValue [SourceContext]
_ (VariableName String
"x"))) [])) (NamedOperator [SourceContext]
_ String
"*")
                                  (UnaryExpression [SourceContext]
_ (NamedOperator [SourceContext]
_ String
"!")
                                    (Expression [SourceContext]
_ (NamedVariable (OutputValue [SourceContext]
_ (VariableName String
"y"))) []))) (NamedOperator [SourceContext]
_ String
"+")
                                (UnaryExpression [SourceContext]
_ (NamedOperator [SourceContext]
_ String
"!")
                                  (Expression [SourceContext]
_ (NamedVariable (OutputValue [SourceContext]
_ (VariableName String
"z"))) []))) -> Bool
True
                              Expression SourceContext
_ -> Bool
False),

    String
-> (Expression SourceContext -> Bool) -> IO (TrackedErrors ())
checkParsesAs String
"1 `Int.lessThan` 2"
                  (\Expression SourceContext
e -> case Expression SourceContext
e of
                              (InfixExpression [SourceContext]
_
                                (Literal (IntegerLiteral [SourceContext]
_ Bool
False Integer
1))
                                (FunctionOperator [SourceContext]
_ (
                                  FunctionSpec [SourceContext]
_
                                    (TypeFunction [SourceContext]
_ (JustTypeInstance (TypeInstance CategoryName
BuiltinInt (Positional []))))
                                    (FunctionName String
"lessThan") (Positional [])))
                                (Literal (IntegerLiteral [SourceContext]
_ Bool
False Integer
2))) -> Bool
True
                              Expression SourceContext
_ -> Bool
False),

    String
-> (Expression SourceContext -> Bool) -> IO (TrackedErrors ())
checkParsesAs String
"1 `Something:foo` 2"
                  (\Expression SourceContext
e -> case Expression SourceContext
e of
                              (InfixExpression [SourceContext]
_
                                (Literal (IntegerLiteral [SourceContext]
_ Bool
False Integer
1))
                                (FunctionOperator [SourceContext]
_
                                  (FunctionSpec [SourceContext]
_
                                    (CategoryFunction [SourceContext]
_ (CategoryName String
"Something"))
                                    (FunctionName String
"foo") (Positional [])))
                                (Literal (IntegerLiteral [SourceContext]
_ Bool
False Integer
2))) -> Bool
True
                              Expression SourceContext
_ -> Bool
False),

    String
-> (Expression SourceContext -> Bool) -> IO (TrackedErrors ())
checkParsesAs String
"1 `something.foo` 2"
                  (\Expression SourceContext
e -> case Expression SourceContext
e of
                              (InfixExpression [SourceContext]
_
                                (Literal (IntegerLiteral [SourceContext]
_ Bool
False Integer
1))
                                (FunctionOperator [SourceContext]
_
                                  (FunctionSpec [SourceContext]
_
                                    (ValueFunction [SourceContext]
_ ValueCallType
AlwaysCall
                                      (Expression [SourceContext]
_ (NamedVariable (OutputValue [SourceContext]
_ (VariableName String
"something"))) []))
                                    (FunctionName String
"foo") (Positional [])))
                                (Literal (IntegerLiteral [SourceContext]
_ Bool
False Integer
2))) -> Bool
True
                              Expression SourceContext
_ -> Bool
False),

    String
-> (Expression SourceContext -> Bool) -> IO (TrackedErrors ())
checkParsesAs String
"1 `require(x).foo` 2"
                  (\Expression SourceContext
e -> case Expression SourceContext
e of
                              InfixExpression [SourceContext]
_
                                (Literal (IntegerLiteral [SourceContext]
_ Bool
False Integer
1))
                                  (FunctionOperator [SourceContext]
_
                                    (FunctionSpec [SourceContext]
_
                                      (ValueFunction [SourceContext]
_ ValueCallType
AlwaysCall
                                        (Expression [SourceContext]
_ (BuiltinCall [SourceContext]
_ (FunctionCall [SourceContext]
_ FunctionName
BuiltinRequire (Positional [])
                                          (Positional [(Maybe (CallArgLabel SourceContext)
Nothing,Expression [SourceContext]
_ (NamedVariable (OutputValue [SourceContext]
_ (VariableName String
"x"))) [])]))) []))
                                        (FunctionName String
"foo") (Positional [])))
                                (Literal (IntegerLiteral [SourceContext]
_ Bool
False Integer
2)) -> Bool
True
                              Expression SourceContext
_ -> Bool
False),

    String
-> (Expression SourceContext -> Bool) -> IO (TrackedErrors ())
checkParsesAs String
"1 `foo` 2"
                  (\Expression SourceContext
e -> case Expression SourceContext
e of
                              (InfixExpression [SourceContext]
_
                                (Literal (IntegerLiteral [SourceContext]
_ Bool
False Integer
1))
                                (FunctionOperator [SourceContext]
_
                                  (FunctionSpec [SourceContext]
_ FunctionQualifier SourceContext
UnqualifiedFunction (FunctionName String
"foo") (Positional [])))
                                (Literal (IntegerLiteral [SourceContext]
_ Bool
False Integer
2))) -> Bool
True
                              Expression SourceContext
_ -> Bool
False),

    String
-> (Expression SourceContext -> Bool) -> IO (TrackedErrors ())
checkParsesAs String
"`Bits.not` 2"
                  (\Expression SourceContext
e -> case Expression SourceContext
e of
                              (UnaryExpression [SourceContext]
_
                                (FunctionOperator [SourceContext]
_ (
                                  FunctionSpec [SourceContext]
_
                                    (TypeFunction [SourceContext]
_ (JustTypeInstance (TypeInstance (CategoryName String
"Bits") (Positional []))))
                                    (FunctionName String
"not") (Positional [])))
                                (Literal (IntegerLiteral [SourceContext]
_ Bool
False Integer
2))) -> Bool
True
                              Expression SourceContext
_ -> Bool
False),

    String
-> (Expression SourceContext -> Bool) -> IO (TrackedErrors ())
checkParsesAs String
"`Bits:not` 2"
                  (\Expression SourceContext
e -> case Expression SourceContext
e of
                              (UnaryExpression [SourceContext]
_
                                (FunctionOperator [SourceContext]
_
                                  (FunctionSpec [SourceContext]
_
                                    (CategoryFunction [SourceContext]
_ (CategoryName String
"Bits"))
                                    (FunctionName String
"not") (Positional [])))
                                (Literal (IntegerLiteral [SourceContext]
_ Bool
False Integer
2))) -> Bool
True
                              Expression SourceContext
_ -> Bool
False),

    String
-> (Expression SourceContext -> Bool) -> IO (TrackedErrors ())
checkParsesAs String
"`bits.not` 2"
                  (\Expression SourceContext
e -> case Expression SourceContext
e of
                              (UnaryExpression [SourceContext]
_
                                (FunctionOperator [SourceContext]
_
                                  (FunctionSpec [SourceContext]
_
                                    (ValueFunction [SourceContext]
_ ValueCallType
AlwaysCall
                                      (Expression [SourceContext]
_ (NamedVariable (OutputValue [SourceContext]
_ (VariableName String
"bits"))) []))
                                    (FunctionName String
"not") (Positional [])))
                                (Literal (IntegerLiteral [SourceContext]
_ Bool
False Integer
2))) -> Bool
True
                              Expression SourceContext
_ -> Bool
False),

    String
-> (Expression SourceContext -> Bool) -> IO (TrackedErrors ())
checkParsesAs String
"`require(x).not` 2"
                  (\Expression SourceContext
e -> case Expression SourceContext
e of
                              UnaryExpression [SourceContext]
_
                                  (FunctionOperator [SourceContext]
_
                                    (FunctionSpec [SourceContext]
_
                                      (ValueFunction [SourceContext]
_ ValueCallType
AlwaysCall
                                        (Expression [SourceContext]
_ (BuiltinCall [SourceContext]
_ (FunctionCall [SourceContext]
_ FunctionName
BuiltinRequire (Positional [])
                                          (Positional [(Maybe (CallArgLabel SourceContext)
Nothing,Expression [SourceContext]
_ (NamedVariable (OutputValue [SourceContext]
_ (VariableName String
"x"))) [])]))) []))
                                        (FunctionName String
"not") (Positional [])))
                                (Literal (IntegerLiteral [SourceContext]
_ Bool
False Integer
2)) -> Bool
True
                              Expression SourceContext
_ -> Bool
False),

    String
-> (Expression SourceContext -> Bool) -> IO (TrackedErrors ())
checkParsesAs String
"`strong(x)&.not` 2"
                  (\Expression SourceContext
e -> case Expression SourceContext
e of
                              UnaryExpression [SourceContext]
_
                                  (FunctionOperator [SourceContext]
_
                                    (FunctionSpec [SourceContext]
_
                                      (ValueFunction [SourceContext]
_ ValueCallType
CallUnlessEmpty
                                        (Expression [SourceContext]
_ (BuiltinCall [SourceContext]
_ (FunctionCall [SourceContext]
_ FunctionName
BuiltinStrong (Positional [])
                                          (Positional [(Maybe (CallArgLabel SourceContext)
Nothing,Expression [SourceContext]
_ (NamedVariable (OutputValue [SourceContext]
_ (VariableName String
"x"))) [])]))) []))
                                        (FunctionName String
"not") (Positional [])))
                                (Literal (IntegerLiteral [SourceContext]
_ Bool
False Integer
2)) -> Bool
True
                              Expression SourceContext
_ -> Bool
False),

    String
-> (Expression SourceContext -> Bool) -> IO (TrackedErrors ())
checkParsesAs String
"`not` 2"
                  (\Expression SourceContext
e -> case Expression SourceContext
e of
                              (UnaryExpression [SourceContext]
_
                                (FunctionOperator [SourceContext]
_
                                  (FunctionSpec [SourceContext]
_ FunctionQualifier SourceContext
UnqualifiedFunction (FunctionName String
"not") (Positional [])))
                                (Literal (IntegerLiteral [SourceContext]
_ Bool
False Integer
2))) -> Bool
True
                              Expression SourceContext
_ -> Bool
False),

    String
-> (Expression SourceContext -> Bool) -> IO (TrackedErrors ())
checkParsesAs String
"\\b10" (\Expression SourceContext
e -> case Expression SourceContext
e of
                                      (Literal (IntegerLiteral [SourceContext]
_ Bool
True Integer
2)) -> Bool
True
                                      Expression SourceContext
_ -> Bool
False),

    String
-> (Expression SourceContext -> Bool) -> IO (TrackedErrors ())
checkParsesAs String
"\\B10" (\Expression SourceContext
e -> case Expression SourceContext
e of
                                      (Literal (IntegerLiteral [SourceContext]
_ Bool
True Integer
2)) -> Bool
True
                                      Expression SourceContext
_ -> Bool
False),

    String
-> (Expression SourceContext -> Bool) -> IO (TrackedErrors ())
checkParsesAs String
"\\o10" (\Expression SourceContext
e -> case Expression SourceContext
e of
                                      (Literal (IntegerLiteral [SourceContext]
_ Bool
True Integer
8)) -> Bool
True
                                      Expression SourceContext
_ -> Bool
False),

    String
-> (Expression SourceContext -> Bool) -> IO (TrackedErrors ())
checkParsesAs String
"\\O10" (\Expression SourceContext
e -> case Expression SourceContext
e of
                                      (Literal (IntegerLiteral [SourceContext]
_ Bool
True Integer
8)) -> Bool
True
                                      Expression SourceContext
_ -> Bool
False),

    String
-> (Expression SourceContext -> Bool) -> IO (TrackedErrors ())
checkParsesAs String
"\\d10" (\Expression SourceContext
e -> case Expression SourceContext
e of
                                      (Literal (IntegerLiteral [SourceContext]
_ Bool
True Integer
10)) -> Bool
True
                                      Expression SourceContext
_ -> Bool
False),

    String
-> (Expression SourceContext -> Bool) -> IO (TrackedErrors ())
checkParsesAs String
"\\D10" (\Expression SourceContext
e -> case Expression SourceContext
e of
                                      (Literal (IntegerLiteral [SourceContext]
_ Bool
True Integer
10)) -> Bool
True
                                      Expression SourceContext
_ -> Bool
False),

    String
-> (Expression SourceContext -> Bool) -> IO (TrackedErrors ())
checkParsesAs String
"\\x10" (\Expression SourceContext
e -> case Expression SourceContext
e of
                                      (Literal (IntegerLiteral [SourceContext]
_ Bool
True Integer
16)) -> Bool
True
                                      Expression SourceContext
_ -> Bool
False),

    String
-> (Expression SourceContext -> Bool) -> IO (TrackedErrors ())
checkParsesAs String
"\\X10" (\Expression SourceContext
e -> case Expression SourceContext
e of
                                      (Literal (IntegerLiteral [SourceContext]
_ Bool
True Integer
16)) -> Bool
True
                                      Expression SourceContext
_ -> Bool
False),

    String
-> (Expression SourceContext -> Bool) -> IO (TrackedErrors ())
checkParsesAs String
"10" (\Expression SourceContext
e -> case Expression SourceContext
e of
                                   (Literal (IntegerLiteral [SourceContext]
_ Bool
False Integer
10)) -> Bool
True
                                   Expression SourceContext
_ -> Bool
False),

    String
-> (Expression SourceContext -> Bool) -> IO (TrackedErrors ())
checkParsesAs String
"1.2345" (\Expression SourceContext
e -> case Expression SourceContext
e of
                                       (Literal (DecimalLiteral [SourceContext]
_ Integer
12345 (-4) Integer
10)) -> Bool
True
                                       Expression SourceContext
_ -> Bool
False),

    String
-> (Expression SourceContext -> Bool) -> IO (TrackedErrors ())
checkParsesAs String
"1.2345E+4" (\Expression SourceContext
e -> case Expression SourceContext
e of
                                          (Literal (DecimalLiteral [SourceContext]
_ Integer
12345 Integer
0 Integer
10)) -> Bool
True
                                          Expression SourceContext
_ -> Bool
False),

    String
-> (Expression SourceContext -> Bool) -> IO (TrackedErrors ())
checkParsesAs String
"1.2345E-4" (\Expression SourceContext
e -> case Expression SourceContext
e of
                                          (Literal (DecimalLiteral [SourceContext]
_ Integer
12345 (-8) Integer
10)) -> Bool
True
                                          Expression SourceContext
_ -> Bool
False),

    String
-> (Expression SourceContext -> Bool) -> IO (TrackedErrors ())
checkParsesAs String
"\\xF.F" (\Expression SourceContext
e -> case Expression SourceContext
e of
                                          (Literal (DecimalLiteral [SourceContext]
_ Integer
255 (-1) Integer
16)) -> Bool
True
                                          Expression SourceContext
_ -> Bool
False),

    String
-> (Expression SourceContext -> Bool) -> IO (TrackedErrors ())
checkParsesAs String
"\\o7.7" (\Expression SourceContext
e -> case Expression SourceContext
e of
                                          (Literal (DecimalLiteral [SourceContext]
_ Integer
63 (-1) Integer
8)) -> Bool
True
                                          Expression SourceContext
_ -> Bool
False),

    String
-> (Expression SourceContext -> Bool) -> IO (TrackedErrors ())
checkParsesAs String
"\\b1.1" (\Expression SourceContext
e -> case Expression SourceContext
e of
                                          (Literal (DecimalLiteral [SourceContext]
_ Integer
3 (-1) Integer
2)) -> Bool
True
                                          Expression SourceContext
_ -> Bool
False),

    String
-> TextParser (PragmaProcedure SourceContext)
-> (PragmaProcedure SourceContext -> Bool)
-> IO (TrackedErrors ())
forall a.
Show a =>
String -> TextParser a -> (a -> Bool) -> IO (TrackedErrors ())
checkParseMatch String
"$NoTrace$" TextParser (PragmaProcedure SourceContext)
pragmaNoTrace
      (\PragmaProcedure SourceContext
e -> case PragmaProcedure SourceContext
e of
                  PragmaTracing [SourceContext]
_ TraceType
NoTrace -> Bool
True
                  PragmaProcedure SourceContext
_ -> Bool
False),

    String
-> TextParser (PragmaProcedure SourceContext)
-> (PragmaProcedure SourceContext -> Bool)
-> IO (TrackedErrors ())
forall a.
Show a =>
String -> TextParser a -> (a -> Bool) -> IO (TrackedErrors ())
checkParseMatch String
"$TraceCreation$" TextParser (PragmaProcedure SourceContext)
pragmaTraceCreation
      (\PragmaProcedure SourceContext
e -> case PragmaProcedure SourceContext
e of
                  PragmaTracing [SourceContext]
_ TraceType
TraceCreation -> Bool
True
                  PragmaProcedure SourceContext
_ -> Bool
False),

    String
-> TextParser (PragmaStatement SourceContext)
-> (PragmaStatement SourceContext -> Bool)
-> IO (TrackedErrors ())
forall a.
Show a =>
String -> TextParser a -> (a -> Bool) -> IO (TrackedErrors ())
checkParseMatch String
"$ReadOnly[foo,bar]$" TextParser (PragmaStatement SourceContext)
pragmaReadOnly
      (\PragmaStatement SourceContext
e -> case PragmaStatement SourceContext
e of
                  PragmaMarkVars [SourceContext]
_ MarkType
ReadOnly [VariableName String
"foo", VariableName String
"bar"] -> Bool
True
                  PragmaStatement SourceContext
_ -> Bool
False),

    String
-> TextParser (PragmaStatement SourceContext)
-> (PragmaStatement SourceContext -> Bool)
-> IO (TrackedErrors ())
forall a.
Show a =>
String -> TextParser a -> (a -> Bool) -> IO (TrackedErrors ())
checkParseMatch String
"$Hidden[foo,bar]$" TextParser (PragmaStatement SourceContext)
pragmaHidden
      (\PragmaStatement SourceContext
e -> case PragmaStatement SourceContext
e of
                  PragmaMarkVars [SourceContext]
_ MarkType
Hidden [VariableName String
"foo", VariableName String
"bar"] -> Bool
True
                  PragmaStatement SourceContext
_ -> Bool
False),

    String
-> TextParser (PragmaExpr SourceContext)
-> (PragmaExpr SourceContext -> Bool)
-> IO (TrackedErrors ())
forall a.
Show a =>
String -> TextParser a -> (a -> Bool) -> IO (TrackedErrors ())
checkParseMatch String
"$SourceContext$" TextParser (PragmaExpr SourceContext)
pragmaSourceContext
      (\PragmaExpr SourceContext
e -> case PragmaExpr SourceContext
e of
                  PragmaSourceContext SourceContext
_ -> Bool
True
                  PragmaExpr SourceContext
_ -> Bool
False),

    String
-> TextParser (PragmaExpr SourceContext)
-> (PragmaExpr SourceContext -> Bool)
-> IO (TrackedErrors ())
forall a.
Show a =>
String -> TextParser a -> (a -> Bool) -> IO (TrackedErrors ())
checkParseMatch String
"$ExprLookup[ \nMODULE_PATH /*comment*/\n ]$" TextParser (PragmaExpr SourceContext)
pragmaExprLookup
      (\PragmaExpr SourceContext
e -> case PragmaExpr SourceContext
e of
                  PragmaExprLookup [SourceContext]
_ (MacroName String
"MODULE_PATH") -> Bool
True
                  PragmaExpr SourceContext
_ -> Bool
False),

    String
-> String
-> TextParser (PragmaExpr SourceContext)
-> IO (TrackedErrors ())
forall a.
Show a =>
String -> String -> TextParser a -> IO (TrackedErrors ())
checkParseError String
"$ExprLookup[ \"bad stuff\" ]$" String
"macro name" TextParser (PragmaExpr SourceContext)
pragmaExprLookup,
    String
-> String
-> TextParser (PragmaStatement SourceContext)
-> IO (TrackedErrors ())
forall a.
Show a =>
String -> String -> TextParser a -> IO (TrackedErrors ())
checkParseError String
"$ReadOnly$" String
"requires arguments" TextParser (PragmaStatement SourceContext)
pragmaReadOnly,
    String
-> String
-> TextParser (PragmaStatement SourceContext)
-> IO (TrackedErrors ())
forall a.
Show a =>
String -> String -> TextParser a -> IO (TrackedErrors ())
checkParseError String
"$Hidden$" String
"requires arguments" TextParser (PragmaStatement SourceContext)
pragmaHidden
  ]

checkParseSuccess :: String -> IO (TrackedErrors ())
checkParseSuccess :: String -> IO (TrackedErrors ())
checkParseSuccess String
f = do
  String
contents <- String -> IO String
loadFile String
f
  let parsed :: TrackedErrors [ExecutableProcedure SourceContext]
parsed = String
-> String -> TrackedErrors [ExecutableProcedure SourceContext]
forall a.
ParseFromSource a =>
String -> String -> TrackedErrors [a]
readMulti String
f String
contents :: TrackedErrors [ExecutableProcedure SourceContext]
  TrackedErrors () -> IO (TrackedErrors ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (TrackedErrors () -> IO (TrackedErrors ()))
-> TrackedErrors () -> IO (TrackedErrors ())
forall a b. (a -> b) -> a -> b
$ TrackedErrors [ExecutableProcedure SourceContext]
-> TrackedErrors ()
forall {m :: * -> *} {a}.
ErrorContextM m =>
TrackedErrorsT Identity a -> m ()
check TrackedErrors [ExecutableProcedure SourceContext]
parsed
  where
    check :: TrackedErrorsT Identity a -> m ()
check TrackedErrorsT Identity a
c
      | TrackedErrorsT Identity a -> Bool
forall (t :: (* -> *) -> * -> *) a.
(ErrorContextT t, ErrorContextM (t Identity)) =>
t Identity a -> Bool
isCompilerError TrackedErrorsT Identity a
c = String -> m ()
forall a. String -> m a
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"Parse " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
f String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
":\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ CompilerMessage -> String
forall a. Show a => a -> String
show (TrackedErrorsT Identity a -> CompilerMessage
forall a. TrackedErrors a -> CompilerMessage
getCompilerError TrackedErrorsT Identity a
c)
      | Bool
otherwise = () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

checkParseFail :: String -> IO (TrackedErrors ())
checkParseFail :: String -> IO (TrackedErrors ())
checkParseFail String
f = do
  String
contents <- String -> IO String
loadFile String
f
  let parsed :: TrackedErrors [ExecutableProcedure SourceContext]
parsed = String
-> String -> TrackedErrors [ExecutableProcedure SourceContext]
forall a.
ParseFromSource a =>
String -> String -> TrackedErrors [a]
readMulti String
f String
contents :: TrackedErrors [ExecutableProcedure SourceContext]
  TrackedErrors () -> IO (TrackedErrors ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (TrackedErrors () -> IO (TrackedErrors ()))
-> TrackedErrors () -> IO (TrackedErrors ())
forall a b. (a -> b) -> a -> b
$ TrackedErrors [ExecutableProcedure SourceContext]
-> TrackedErrors ()
forall {m :: * -> *} {a}.
(ErrorContextM m, Show a) =>
TrackedErrorsT Identity a -> m ()
check TrackedErrors [ExecutableProcedure SourceContext]
parsed
  where
    check :: TrackedErrorsT Identity a -> m ()
check TrackedErrorsT Identity a
c
      | TrackedErrorsT Identity a -> Bool
forall (t :: (* -> *) -> * -> *) a.
(ErrorContextT t, ErrorContextM (t Identity)) =>
t Identity a -> Bool
isCompilerError TrackedErrorsT Identity a
c = () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      | Bool
otherwise = String -> m ()
forall a. String -> m a
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"Parse " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
f String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": Expected failure but got\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
                                   a -> String
forall a. Show a => a -> String
show (TrackedErrorsT Identity a -> a
forall a. TrackedErrors a -> a
getCompilerSuccess TrackedErrorsT Identity a
c) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n"

checkShortParseSuccess :: String -> IO (TrackedErrors ())
checkShortParseSuccess :: String -> IO (TrackedErrors ())
checkShortParseSuccess String
s = do
  let parsed :: TrackedErrors (Statement SourceContext)
parsed = String -> String -> TrackedErrors (Statement SourceContext)
forall a. ParseFromSource a => String -> String -> TrackedErrors a
readSingle String
"(string)" String
s :: TrackedErrors (Statement SourceContext)
  TrackedErrors () -> IO (TrackedErrors ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (TrackedErrors () -> IO (TrackedErrors ()))
-> TrackedErrors () -> IO (TrackedErrors ())
forall a b. (a -> b) -> a -> b
$ TrackedErrors (Statement SourceContext) -> TrackedErrors ()
forall {m :: * -> *} {a}.
ErrorContextM m =>
TrackedErrorsT Identity a -> m ()
check TrackedErrors (Statement SourceContext)
parsed
  where
    check :: TrackedErrorsT Identity a -> m ()
check TrackedErrorsT Identity a
c
      | TrackedErrorsT Identity a -> Bool
forall (t :: (* -> *) -> * -> *) a.
(ErrorContextT t, ErrorContextM (t Identity)) =>
t Identity a -> Bool
isCompilerError TrackedErrorsT Identity a
c = String -> m ()
forall a. String -> m a
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"Parse '" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"':\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ CompilerMessage -> String
forall a. Show a => a -> String
show (TrackedErrorsT Identity a -> CompilerMessage
forall a. TrackedErrors a -> CompilerMessage
getCompilerError TrackedErrorsT Identity a
c)
      | Bool
otherwise = () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

checkShortParseFail :: String -> IO (TrackedErrors ())
checkShortParseFail :: String -> IO (TrackedErrors ())
checkShortParseFail String
s = do
  let parsed :: TrackedErrors (Statement SourceContext)
parsed = String -> String -> TrackedErrors (Statement SourceContext)
forall a. ParseFromSource a => String -> String -> TrackedErrors a
readSingle String
"(string)" String
s :: TrackedErrors (Statement SourceContext)
  TrackedErrors () -> IO (TrackedErrors ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (TrackedErrors () -> IO (TrackedErrors ()))
-> TrackedErrors () -> IO (TrackedErrors ())
forall a b. (a -> b) -> a -> b
$ TrackedErrors (Statement SourceContext) -> TrackedErrors ()
forall {m :: * -> *} {a}.
(ErrorContextM m, Show a) =>
TrackedErrorsT Identity a -> m ()
check TrackedErrors (Statement SourceContext)
parsed
  where
    check :: TrackedErrorsT Identity a -> m ()
check TrackedErrorsT Identity a
c
      | TrackedErrorsT Identity a -> Bool
forall (t :: (* -> *) -> * -> *) a.
(ErrorContextT t, ErrorContextM (t Identity)) =>
t Identity a -> Bool
isCompilerError TrackedErrorsT Identity a
c = () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      | Bool
otherwise = String -> m ()
forall a. String -> m a
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"Parse '" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"': Expected failure but got\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
                                   a -> String
forall a. Show a => a -> String
show (TrackedErrorsT Identity a -> a
forall a. TrackedErrors a -> a
getCompilerSuccess TrackedErrorsT Identity a
c) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n"

checkParsesAs :: String -> (Expression SourceContext -> Bool) -> IO (TrackedErrors ())
checkParsesAs :: String
-> (Expression SourceContext -> Bool) -> IO (TrackedErrors ())
checkParsesAs String
s Expression SourceContext -> Bool
m = TrackedErrors () -> IO (TrackedErrors ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (TrackedErrors () -> IO (TrackedErrors ()))
-> TrackedErrors () -> IO (TrackedErrors ())
forall a b. (a -> b) -> a -> b
$ do
  let parsed :: TrackedErrors (Expression SourceContext)
parsed = String -> String -> TrackedErrors (Expression SourceContext)
forall a. ParseFromSource a => String -> String -> TrackedErrors a
readSingle String
"(string)" String
s :: TrackedErrors (Expression SourceContext)
  TrackedErrors (Expression SourceContext) -> TrackedErrors ()
forall {m :: * -> *} {a}.
ErrorContextM m =>
TrackedErrorsT Identity a -> m ()
check TrackedErrors (Expression SourceContext)
parsed
  Expression SourceContext
e <- TrackedErrors (Expression SourceContext)
parsed
  Bool -> TrackedErrors () -> TrackedErrors ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Expression SourceContext -> Bool
m Expression SourceContext
e) (TrackedErrors () -> TrackedErrors ())
-> TrackedErrors () -> TrackedErrors ()
forall a b. (a -> b) -> a -> b
$
    String -> TrackedErrors ()
forall a. String -> TrackedErrorsT Identity a
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM (String -> TrackedErrors ()) -> String -> TrackedErrors ()
forall a b. (a -> b) -> a -> b
$ String
"No match in '" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"':\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Expression SourceContext -> String
forall a. Show a => a -> String
show Expression SourceContext
e
  where
    check :: TrackedErrorsT Identity a -> m ()
check TrackedErrorsT Identity a
c
      | TrackedErrorsT Identity a -> Bool
forall (t :: (* -> *) -> * -> *) a.
(ErrorContextT t, ErrorContextM (t Identity)) =>
t Identity a -> Bool
isCompilerError TrackedErrorsT Identity a
c = String -> m ()
forall a. String -> m a
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"Parse '" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"':\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ CompilerMessage -> String
forall a. Show a => a -> String
show (TrackedErrorsT Identity a -> CompilerMessage
forall a. TrackedErrors a -> CompilerMessage
getCompilerError TrackedErrorsT Identity a
c)
      | Bool
otherwise = () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()