{- -----------------------------------------------------------------------------
Copyright 2019-2020 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]

{-# LANGUAGE Safe #-}

module Test.Procedure (tests) where

import Control.Monad
import System.FilePath
import Text.Parsec

import Base.CompileError
import Base.CompileInfo
import Parser.Procedure ()
import Test.Common
import Types.Positional
import Types.Procedure
import Types.TypeCategory
import Types.TypeInstance


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

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

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

    String -> IO (CompileInfo ())
checkShortParseSuccess String
"\\ var",
    String -> IO (CompileInfo ())
checkShortParseFail String
"\\ var var",
    String -> IO (CompileInfo ())
checkShortParseSuccess String
"\\ var.T<#x>.func().func2().func3()",
    String -> IO (CompileInfo ())
checkShortParseSuccess String
"\\ T<#x>.func().func2().func3()",
    String -> IO (CompileInfo ())
checkShortParseSuccess String
"\\ #x.func().func2().func3()",
    String -> IO (CompileInfo ())
checkShortParseFail String
"\\ var.T<#x>.T<#x>.func()",
    String -> IO (CompileInfo ())
checkShortParseFail String
"\\ var.T<#x>.T<#x>.func()",
    String -> IO (CompileInfo ())
checkShortParseFail String
"\\ var.T<#x>",
    String -> IO (CompileInfo ())
checkShortParseFail String
"\\ T<#x> var",
    String -> IO (CompileInfo ())
checkShortParseSuccess String
"\\ T<#x>{ val, var.T<#x>.func() }",
    String -> IO (CompileInfo ())
checkShortParseFail String
"\\ T<#x>{ val var.T<#x>.func() }",
    String -> IO (CompileInfo ())
checkShortParseFail String
"\\ T<#x>{}.call()",
    String -> IO (CompileInfo ())
checkShortParseFail String
"\\ T<#x>$call()",
    String -> IO (CompileInfo ())
checkShortParseSuccess String
"\\ (T<#x>{}).call()",

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

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

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

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

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

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

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

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

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

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

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

    String -> (Expression SourcePos -> Bool) -> IO (CompileInfo ())
checkParsesAs String
"'\"'"
                  (\Expression SourcePos
e -> case Expression SourcePos
e of
                              (Literal (CharLiteral [SourcePos]
_ Char
'"')) -> Bool
True
                              Expression SourcePos
_ -> Bool
False),

    String -> (Expression SourcePos -> Bool) -> IO (CompileInfo ())
checkParsesAs String
"1 + 2 < 4 && 3 >= 1 * 2 + 1 || true"
                  (\Expression SourcePos
e -> case Expression SourcePos
e of
                              (InfixExpression [SourcePos]
_
                                (InfixExpression [SourcePos]
_
                                  (InfixExpression [SourcePos]
_
                                    (InfixExpression [SourcePos]
_
                                      (Literal (IntegerLiteral [SourcePos]
_ Bool
False Integer
1)) (NamedOperator String
"+")
                                      (Literal (IntegerLiteral [SourcePos]
_ Bool
False Integer
2))) (NamedOperator String
"<")
                                    (Literal (IntegerLiteral [SourcePos]
_ Bool
False Integer
4))) (NamedOperator String
"&&")
                                  (InfixExpression [SourcePos]
_
                                    (Literal (IntegerLiteral [SourcePos]
_ Bool
False Integer
3)) (NamedOperator String
">=")
                                    (InfixExpression [SourcePos]
_
                                      (InfixExpression [SourcePos]
_
                                        (Literal (IntegerLiteral [SourcePos]
_ Bool
False Integer
1)) (NamedOperator String
"*")
                                        (Literal (IntegerLiteral [SourcePos]
_ Bool
False Integer
2))) (NamedOperator String
"+")
                                      (Literal (IntegerLiteral [SourcePos]
_ Bool
False Integer
1))))) (NamedOperator String
"||")
                                (Literal (BoolLiteral [SourcePos]
_ Bool
True))) -> Bool
True
                              Expression SourcePos
_ -> 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 SourcePos -> Bool) -> IO (CompileInfo ())
checkParsesAs String
"!x * !y + !z"
                  (\Expression SourcePos
e -> case Expression SourcePos
e of
                              (InfixExpression [SourcePos]
_
                                (InfixExpression [SourcePos]
_
                                  (UnaryExpression [SourcePos]
_ (NamedOperator String
"!")
                                    (Expression [SourcePos]
_ (NamedVariable (OutputValue [SourcePos]
_ (VariableName String
"x"))) [])) (NamedOperator String
"*")
                                  (UnaryExpression [SourcePos]
_ (NamedOperator String
"!")
                                    (Expression [SourcePos]
_ (NamedVariable (OutputValue [SourcePos]
_ (VariableName String
"y"))) []))) (NamedOperator String
"+")
                                (UnaryExpression [SourcePos]
_ (NamedOperator String
"!")
                                  (Expression [SourcePos]
_ (NamedVariable (OutputValue [SourcePos]
_ (VariableName String
"z"))) []))) -> Bool
True
                              Expression SourcePos
_ -> Bool
False),

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

checkParseSuccess :: String -> IO (CompileInfo ())
checkParseSuccess :: String -> IO (CompileInfo ())
checkParseSuccess String
f = do
  String
contents <- String -> IO String
loadFile String
f
  let parsed :: CompileInfo [ExecutableProcedure SourcePos]
parsed = String -> String -> CompileInfo [ExecutableProcedure SourcePos]
forall a. ParseFromSource a => String -> String -> CompileInfo [a]
readMulti String
f String
contents :: CompileInfo [ExecutableProcedure SourcePos]
  CompileInfo () -> IO (CompileInfo ())
forall (m :: * -> *) a. Monad m => a -> m a
return (CompileInfo () -> IO (CompileInfo ()))
-> CompileInfo () -> IO (CompileInfo ())
forall a b. (a -> b) -> a -> b
$ CompileInfo [ExecutableProcedure SourcePos] -> CompileInfo ()
forall (m :: * -> *) a. CompileErrorM m => CompileInfo a -> m ()
check CompileInfo [ExecutableProcedure SourcePos]
parsed
  where
    check :: CompileInfo a -> m ()
check CompileInfo a
c
      | CompileInfo a -> Bool
forall a. CompileInfo a -> Bool
isCompileError CompileInfo a
c = String -> m ()
forall (m :: * -> *) a. CompileErrorM m => String -> m a
compileErrorM (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]
++ CompileMessage -> String
forall a. Show a => a -> String
show (CompileInfo a -> CompileMessage
forall a. CompileInfo a -> CompileMessage
getCompileError CompileInfo a
c)
      | Bool
otherwise = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

checkParseFail :: String -> IO (CompileInfo ())
checkParseFail :: String -> IO (CompileInfo ())
checkParseFail String
f = do
  String
contents <- String -> IO String
loadFile String
f
  let parsed :: CompileInfo [ExecutableProcedure SourcePos]
parsed = String -> String -> CompileInfo [ExecutableProcedure SourcePos]
forall a. ParseFromSource a => String -> String -> CompileInfo [a]
readMulti String
f String
contents :: CompileInfo [ExecutableProcedure SourcePos]
  CompileInfo () -> IO (CompileInfo ())
forall (m :: * -> *) a. Monad m => a -> m a
return (CompileInfo () -> IO (CompileInfo ()))
-> CompileInfo () -> IO (CompileInfo ())
forall a b. (a -> b) -> a -> b
$ CompileInfo [ExecutableProcedure SourcePos] -> CompileInfo ()
forall (m :: * -> *) a.
(CompileErrorM m, Show a) =>
CompileInfo a -> m ()
check CompileInfo [ExecutableProcedure SourcePos]
parsed
  where
    check :: CompileInfo a -> m ()
check CompileInfo a
c
      | CompileInfo a -> Bool
forall a. CompileInfo a -> Bool
isCompileError CompileInfo a
c = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      | Bool
otherwise = String -> m ()
forall (m :: * -> *) a. CompileErrorM m => String -> m a
compileErrorM (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 (CompileInfo a -> a
forall a. CompileInfo a -> a
getCompileSuccess CompileInfo a
c) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n"

checkShortParseSuccess :: String -> IO (CompileInfo ())
checkShortParseSuccess :: String -> IO (CompileInfo ())
checkShortParseSuccess String
s = do
  let parsed :: CompileInfo (Statement SourcePos)
parsed = String -> String -> CompileInfo (Statement SourcePos)
forall a. ParseFromSource a => String -> String -> CompileInfo a
readSingle String
"(string)" String
s :: CompileInfo (Statement SourcePos)
  CompileInfo () -> IO (CompileInfo ())
forall (m :: * -> *) a. Monad m => a -> m a
return (CompileInfo () -> IO (CompileInfo ()))
-> CompileInfo () -> IO (CompileInfo ())
forall a b. (a -> b) -> a -> b
$ CompileInfo (Statement SourcePos) -> CompileInfo ()
forall (m :: * -> *) a. CompileErrorM m => CompileInfo a -> m ()
check CompileInfo (Statement SourcePos)
parsed
  where
    check :: CompileInfo a -> m ()
check CompileInfo a
c
      | CompileInfo a -> Bool
forall a. CompileInfo a -> Bool
isCompileError CompileInfo a
c = String -> m ()
forall (m :: * -> *) a. CompileErrorM m => String -> m a
compileErrorM (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]
++ CompileMessage -> String
forall a. Show a => a -> String
show (CompileInfo a -> CompileMessage
forall a. CompileInfo a -> CompileMessage
getCompileError CompileInfo a
c)
      | Bool
otherwise = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

checkShortParseFail :: String -> IO (CompileInfo ())
checkShortParseFail :: String -> IO (CompileInfo ())
checkShortParseFail String
s = do
  let parsed :: CompileInfo (Statement SourcePos)
parsed = String -> String -> CompileInfo (Statement SourcePos)
forall a. ParseFromSource a => String -> String -> CompileInfo a
readSingle String
"(string)" String
s :: CompileInfo (Statement SourcePos)
  CompileInfo () -> IO (CompileInfo ())
forall (m :: * -> *) a. Monad m => a -> m a
return (CompileInfo () -> IO (CompileInfo ()))
-> CompileInfo () -> IO (CompileInfo ())
forall a b. (a -> b) -> a -> b
$ CompileInfo (Statement SourcePos) -> CompileInfo ()
forall (m :: * -> *) a.
(CompileErrorM m, Show a) =>
CompileInfo a -> m ()
check CompileInfo (Statement SourcePos)
parsed
  where
    check :: CompileInfo a -> m ()
check CompileInfo a
c
      | CompileInfo a -> Bool
forall a. CompileInfo a -> Bool
isCompileError CompileInfo a
c = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      | Bool
otherwise = String -> m ()
forall (m :: * -> *) a. CompileErrorM m => String -> m a
compileErrorM (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 (CompileInfo a -> a
forall a. CompileInfo a -> a
getCompileSuccess CompileInfo a
c) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n"

checkParsesAs :: String -> (Expression SourcePos -> Bool) -> IO (CompileInfo ())
checkParsesAs :: String -> (Expression SourcePos -> Bool) -> IO (CompileInfo ())
checkParsesAs String
s Expression SourcePos -> Bool
m = CompileInfo () -> IO (CompileInfo ())
forall (m :: * -> *) a. Monad m => a -> m a
return (CompileInfo () -> IO (CompileInfo ()))
-> CompileInfo () -> IO (CompileInfo ())
forall a b. (a -> b) -> a -> b
$ do
  let parsed :: CompileInfo (Expression SourcePos)
parsed = String -> String -> CompileInfo (Expression SourcePos)
forall a. ParseFromSource a => String -> String -> CompileInfo a
readSingle String
"(string)" String
s :: CompileInfo (Expression SourcePos)
  CompileInfo (Expression SourcePos) -> CompileInfo ()
forall (m :: * -> *) a. CompileErrorM m => CompileInfo a -> m ()
check CompileInfo (Expression SourcePos)
parsed
  Expression SourcePos
e <- CompileInfo (Expression SourcePos)
parsed
  Bool -> CompileInfo () -> CompileInfo ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Expression SourcePos -> Bool
m Expression SourcePos
e) (CompileInfo () -> CompileInfo ())
-> CompileInfo () -> CompileInfo ()
forall a b. (a -> b) -> a -> b
$
    String -> CompileInfo ()
forall (m :: * -> *) a. CompileErrorM m => String -> m a
compileErrorM (String -> CompileInfo ()) -> String -> CompileInfo ()
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 SourcePos -> String
forall a. Show a => a -> String
show Expression SourcePos
e
  where
    check :: CompileInfo a -> m ()
check CompileInfo a
c
      | CompileInfo a -> Bool
forall a. CompileInfo a -> Bool
isCompileError CompileInfo a
c = String -> m ()
forall (m :: * -> *) a. CompileErrorM m => String -> m a
compileErrorM (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]
++ CompileMessage -> String
forall a. Show a => a -> String
show (CompileInfo a -> CompileMessage
forall a. CompileInfo a -> CompileMessage
getCompileError CompileInfo a
c)
      | Bool
otherwise = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()