diff --git a/devbox.lock b/devbox.lock index 1ab2eb9..d834c1d 100644 --- a/devbox.lock +++ b/devbox.lock @@ -2,8 +2,8 @@ "lockfile_version": "1", "packages": { "github:NixOS/nixpkgs/nixpkgs-unstable": { - "last_modified": "2025-09-25T01:21:52Z", - "resolved": "github:NixOS/nixpkgs/e57b3b16ad8758fd681511a078f35c416a8cc939?lastModified=1758763312&narHash=sha256-puBMviZhYlqOdUUgEmMVJpXqC%2FToEqSvkyZ30qQ09xM%3D" + "last_modified": "2025-10-12T08:13:11Z", + "resolved": "github:NixOS/nixpkgs/832e3b6db48508ae436c2c7bfc0cf914eac6938e?lastModified=1760256791&narHash=sha256-uTpzDHRASEDeFUuToWSQ46Re8beXyG9dx4W36FQa0%2Fc%3D" }, "gren@0.6": { "last_modified": "2025-09-18T16:33:27Z", diff --git a/gren.json b/gren.json index 2d603ae..9a5bb31 100644 --- a/gren.json +++ b/gren.json @@ -6,6 +6,7 @@ "license": "BSD-3-Clause", "version": "3.0.7", "exposed-modules": [ + "AST.Source", "CLI.Parser", "CLI.PrettyPrinter", "Compiler.Backend", @@ -17,13 +18,22 @@ "Compiler.Paths", "Compiler.License", "FileSystem.Lock", + "Parse.Expression", + "Parse.Number", + "Parse.String", + "Parse.Space", + "Parse.Pattern", + "Parse.Variable", + "Parse.Type", "SemanticVersion", "SemanticVersionRange", - "String.EditDistance" + "String.EditDistance", + "SourcePosition" ], "gren-version": "0.6.0 <= v < 0.7.0", "dependencies": { - "gren-lang/core": "7.1.0 <= v < 8.0.0", - "gren-lang/node": "6.1.0 <= v < 7.0.0" + "gren-lang/core": "7.2.1 <= v < 8.0.0", + "gren-lang/node": "6.1.0 <= v < 7.0.0", + "gren-lang/parser": "6.2.0 <= v < 7.0.0" } } diff --git a/gren_packages/gren_lang_core__7_1_0.pkg.gz b/gren_packages/gren_lang_core__7_1_0.pkg.gz deleted file mode 100644 index 19df64c..0000000 Binary files a/gren_packages/gren_lang_core__7_1_0.pkg.gz and /dev/null differ diff --git a/gren_packages/gren_lang_core__7_2_1.pkg.gz b/gren_packages/gren_lang_core__7_2_1.pkg.gz new file mode 100644 index 0000000..24387f6 Binary files /dev/null and b/gren_packages/gren_lang_core__7_2_1.pkg.gz differ diff --git a/gren_packages/gren_lang_parser__6_2_0.pkg.gz b/gren_packages/gren_lang_parser__6_2_0.pkg.gz new file mode 100644 index 0000000..7c9b010 Binary files /dev/null and b/gren_packages/gren_lang_parser__6_2_0.pkg.gz differ diff --git a/integration-tests/Makefile b/integration-tests/Makefile index 5fde977..144e56e 100644 --- a/integration-tests/Makefile +++ b/integration-tests/Makefile @@ -1,7 +1,7 @@ node_modules: package.json package-lock.json npm ci -bin/app: Makefile gren.json node_modules +bin/app: Makefile gren.json node_modules ../gren.json ../src/**/*.gren gren make Main --output=bin/app chmod +x bin/app diff --git a/integration-tests/gren.json b/integration-tests/gren.json index d201500..59458dc 100644 --- a/integration-tests/gren.json +++ b/integration-tests/gren.json @@ -7,12 +7,13 @@ "gren-version": "0.6.3", "dependencies": { "direct": { - "gren-lang/core": "7.1.0", + "gren-lang/core": "7.2.1", "gren-lang/node": "6.1.0", "gren-lang/compiler-node": "local:.." }, "indirect": { - "gren-lang/url": "6.0.0" + "gren-lang/url": "6.0.0", + "gren-lang/parser": "6.2.0" } } } diff --git a/integration-tests/gren_packages/gren_lang_core__7_1_0.pkg.gz b/integration-tests/gren_packages/gren_lang_core__7_1_0.pkg.gz deleted file mode 100644 index 19df64c..0000000 Binary files a/integration-tests/gren_packages/gren_lang_core__7_1_0.pkg.gz and /dev/null differ diff --git a/integration-tests/gren_packages/gren_lang_core__7_2_1.pkg.gz b/integration-tests/gren_packages/gren_lang_core__7_2_1.pkg.gz new file mode 100644 index 0000000..24387f6 Binary files /dev/null and b/integration-tests/gren_packages/gren_lang_core__7_2_1.pkg.gz differ diff --git a/integration-tests/gren_packages/gren_lang_parser__6_2_0.pkg.gz b/integration-tests/gren_packages/gren_lang_parser__6_2_0.pkg.gz new file mode 100644 index 0000000..7c9b010 Binary files /dev/null and b/integration-tests/gren_packages/gren_lang_parser__6_2_0.pkg.gz differ diff --git a/src/AST/Source.gren b/src/AST/Source.gren new file mode 100644 index 0000000..0599226 --- /dev/null +++ b/src/AST/Source.gren @@ -0,0 +1,197 @@ +module AST.Source exposing + ( Expression + , Expression_ (..) + , VarType (..) + , BinopsSegment + , IfBranch + , WhenBranch + , RecordField + , Def (..) + , Pattern + , Pattern_ (..) + , PRecordField + , Type + , Type_ (..) + , TRecordField + ) + +import SourcePosition +import Parse.Number as Number + + +type alias Expression = + SourcePosition.Located Expression_ + + +type Expression_ + = CharLiteral Char + | StringLiteral String + | NumberLiteral Number.Outcome + | Var + { varType : VarType + , name : String + } + | VarQual + { varType : VarType + , qualifier : String + , name : String + } + | ArrayLiteral (Array Expression) + | Record (Array RecordField) + | Update + { record : Expression + , newValues : Array RecordField + } + | Operator String + | Negate Expression + | Binops + { segments : Array BinopsSegment + , finalExpression : Expression + } + | Lambda + { patterns : Array Pattern + , body : Expression + } + | Call + { fn : Expression + , args : Array Expression + } + | Let + { defs : Array (SourcePosition.Located Def) + , body : Expression + } + | If + { branches : Array IfBranch + , elseBranch : Expression + } + | When + { expression : Expression + , branches : Array WhenBranch + } + | Accessor String + | Access + { expression : Expression + , accessor : String + } + | Parens Expression + + +type VarType + = LowVar + | CapVar + + +type alias BinopsSegment = + { leadingExpression : Expression + , operatorName : SourcePosition.Located String + } + + +type alias IfBranch = + { test : Expression + , body : Expression + } + + +type alias WhenBranch = + { pattern : Pattern + , body : Expression + } + + +type alias RecordField = + { field : SourcePosition.Located String + , value : Expression + } + + +-- DEFINITIONS + + +type Def + = Define + { name : SourcePosition.Located String + , args : Array Pattern + , body : Expression + , typeSignature : Maybe Type + } + | Destruct + { pattern : Pattern + , expression : Expression + } + + +-- PATTERN + + +type alias Pattern + = SourcePosition.Located Pattern_ + + +type Pattern_ + = PAnything String + | PVar String + | PRecord (Array PRecordField) + | PAlias + { pattern : Pattern + , name : SourcePosition.Located String + } + | PCtor + { name : SourcePosition.Located String + , arg : Maybe Pattern + } + | PCtorQual + { varRegion : SourcePosition.Region + , module_ : String + , name : String + , arg : Maybe Pattern + } + | PArray (Array Pattern) + | PChr Char + | PStr String + | PInt + { value : Int + , isHex : Bool + } + + +type alias PRecordField = + { field : SourcePosition.Located String + , pattern : Maybe Pattern + } + + +-- TYPE + + +type alias Type = + SourcePosition.Located Type_ + + +type Type_ + = TLambda + { from : Type + , to : Type + } + | TVar String + | TType + { name : SourcePosition.Located String + , args : Array Type + } + | TTypeQual + { varRegion : SourcePosition.Region + , qualifier : String + , name : String + , args : Array Type + } + | TRecord + { fields : Array TRecordField + , extending : Maybe (SourcePosition.Located String) + } + | TParens Type + + +type alias TRecordField = + { field : SourcePosition.Located String + , signature : Type + } diff --git a/src/Compiler/Backend.gren b/src/Compiler/Backend.gren index 3c3d03a..56f50a7 100644 --- a/src/Compiler/Backend.gren +++ b/src/Compiler/Backend.gren @@ -1,7 +1,5 @@ module Compiler.Backend exposing - ( version - -- - , Command(..) + ( Command(..) , ReplFlags , MakeFlags , MakeOutput(..) @@ -47,19 +45,6 @@ import HttpClient import Process -{-| Version of the compiler blob. This might not match the version of the Gren compiler as a whole, -as the Haskell- and Gren-parts are versioned seperatly. --} -version : String -version = - -- TODO: Let's get rid of this. - -- We're already planning to keep backend and frontend releases in sync moving forward - "0.6.3" - - --- Binary - - {-| Type used to signal that the given platform isn't supported. Meaning that there doesn't exist a pre-built compiler blob. -} @@ -70,8 +55,8 @@ type UnsupportedPlatform {-| Construct a URL from which you can download a compiler blob compatible with the given platform and cpu architecture. -} -downloadUrl : Node.Platform -> Node.CpuArchitecture -> Result UnsupportedPlatform String -downloadUrl platform cpuArch = +downloadUrl : SemanticVersion -> Node.Platform -> Node.CpuArchitecture -> Result UnsupportedPlatform String +downloadUrl version platform cpuArch = let maybeFilename = when { platform = platform, cpuArch = cpuArch } is @@ -95,7 +80,7 @@ downloadUrl platform cpuArch = Ok <| String.join "/" [ "https://github.com/gren-lang/compiler/releases/download" - , version + , SemanticVersion.toString version , filename ] diff --git a/src/Parse/Expression.gren b/src/Parse/Expression.gren new file mode 100644 index 0000000..e92aee1 --- /dev/null +++ b/src/Parse/Expression.gren @@ -0,0 +1,399 @@ +module Parse.Expression exposing + ( Error (..) + , parser + ) + + +import Parser.Advanced as Parser exposing (Parser) +import AST.Source as AST +import SourcePosition +import Parse.Number as Number +import Parse.String as String +import Parse.Space as Space +import Parse.Variable as Variable +import Parse.Pattern as Pattern + + +type Error + = ExpectedChar Char + | ExpectedKeyword String + | VariableError Variable.Error + | NumberError Number.Error + | StringError String.Error + | PatternError Pattern.Error + | WildcardAttempt + | ExpectedLowerVariable AST.Expression + + +parser : Parser c Error AST.Expression +parser = + Parser.oneOf + [ ifParser + , whenParser + , function + , possiblyNegativeTerm + ] + + +-- IF + + +ifParser : Parser c Error AST.Expression +ifParser = + Parser.succeed (\startPos firstBranch -> { startPos = startPos, firstBranch = firstBranch }) + |> Parser.keep Parser.getPosition + |> Parser.keep ifBranchParser + |> Parser.andThen + (\{ startPos, firstBranch } -> + Parser.loop [ firstBranch ] (ifElseLoop startPos) + ) + + +ifBranchParser : Parser c Error AST.IfBranch +ifBranchParser = + Parser.succeed (\test body -> { test = test, body = body }) + |> Parser.skip (Parser.keyword (Parser.Token { str = "if", expecting = ExpectedKeyword "if" })) + |> Parser.skip Space.parser + |> Parser.keep (Parser.lazy (\_ -> parser)) + |> Parser.skip Space.parser + |> Parser.skip (Parser.keyword (Parser.Token { str = "then", expecting = ExpectedKeyword "then" })) + |> Parser.skip Space.parser + |> Parser.keep (Parser.lazy (\_ -> parser)) + |> Parser.skip Space.parser + |> Parser.skip (Parser.keyword (Parser.Token { str = "else", expecting = ExpectedKeyword "else" })) + |> Parser.skip Space.parser + + +ifElseLoop : { row : Int, col : Int } -> Array AST.IfBranch -> Parser c Error (Parser.Step (Array AST.IfBranch) AST.Expression) +ifElseLoop startPos branches = + Parser.oneOf + [ Parser.succeed (\branch -> Parser.Loop (Array.pushLast branch branches)) + |> Parser.keep ifBranchParser + , Parser.succeed + (\expr -> + Parser.Done <| + SourcePosition.at + startPos + expr.end + (AST.If + { branches = branches + , elseBranch = expr + } + ) + ) + |> Parser.keep parser + |> Parser.skip Space.parser + ] + + +-- WHEN IS + + +whenParser : Parser c Error AST.Expression +whenParser = + Parser.succeed (\start expr firstBranch -> { start = start, expr = expr, firstBranch = firstBranch }) + |> Parser.keep Parser.getPosition + |> Parser.skip (Parser.keyword (Parser.Token { str = "when", expecting = ExpectedKeyword "when" })) + |> Parser.skip Space.parser + |> Parser.keep (Parser.lazy (\_ -> parser)) + |> Parser.skip Space.parser + |> Parser.skip (Parser.keyword (Parser.Token { str = "is", expecting = ExpectedKeyword "is" })) + |> Parser.skip Space.parser + |> Parser.keep whenBranchParser + |> Parser.andThen + (\{ start, expr, firstBranch } -> + Parser.loop [ firstBranch ] whenBranchLoopParser + |> Parser.map + (\branches -> + let + endLocation = + Array.last branches + |> Maybe.map .body + |> Maybe.map .end + |> Maybe.withDefault { row = 1, col = 1 } + in + SourcePosition.at + start + endLocation + (AST.When { expression = expr, branches = branches }) + ) + ) + +whenBranchParser : Parser c Error AST.WhenBranch +whenBranchParser = + Parser.succeed (\pattern body -> { pattern = pattern, body = body }) + |> Parser.keep (Parser.mapError PatternError Pattern.parser) + |> Parser.skip Space.parser + |> Parser.skip (Parser.keyword (Parser.Token { str = "->", expecting = ExpectedKeyword "->" })) + |> Parser.skip Space.parser + |> Parser.keep (Parser.lazy (\_ -> parser)) + |> Parser.skip Space.parser + + +whenBranchLoopParser : Array AST.WhenBranch -> Parser c Error (Parser.Step (Array AST.WhenBranch) (Array AST.WhenBranch)) +whenBranchLoopParser branches = + Parser.oneOf + [ Parser.succeed (\branch -> Parser.Loop (Array.pushLast branch branches)) + |> Parser.keep whenBranchParser + , Parser.succeed (Parser.Done branches) + ] + + +-- FUNCTION + + +function : Parser c Error AST.Expression +function = + Parser.succeed (\startPos firstArg -> { startPos = startPos, firstArg = firstArg }) + |> Parser.keep Parser.getPosition + |> Parser.skip (Parser.chompIf (\c -> c == '\\') (ExpectedChar '\\')) + |> Parser.skip Space.parser + |> Parser.keep (Parser.mapError PatternError Pattern.parser) + |> Parser.skip Space.parser + |> Parser.andThen + (\{ startPos, firstArg } -> + Parser.succeed + (\args body -> + SourcePosition.at + startPos + body.end + (AST.Lambda + { patterns = args + , body = body + } + ) + ) + |> Parser.keep (Parser.loop [ firstArg ] functionArgsParser) + |> Parser.skip Space.parser + |> Parser.keep parser + |> Parser.skip Space.parser + ) + + +functionArgsParser : Array AST.Pattern -> Parser c Error (Parser.Step (Array AST.Pattern) (Array AST.Pattern)) +functionArgsParser array = + Parser.oneOf + [ Parser.succeed (Parser.Done array) + |> Parser.skip (Parser.symbol (Parser.Token { str = "->", expecting = ExpectedKeyword "->" })) + , Parser.succeed (\expr -> Parser.Loop (Array.pushLast expr array)) + |> Parser.keep (Parser.mapError PatternError Pattern.parser) + |> Parser.skip Space.parser + ] + + +-- TERM + +possiblyNegativeTerm : Parser c Error AST.Expression +possiblyNegativeTerm = + Parser.oneOf + [ Parser.succeed (\start expr end -> SourcePosition.at start end (AST.Negate expr)) + |> Parser.keep Parser.getPosition + |> Parser.skip (Parser.chompIf (\c -> c == '-') (ExpectedChar '-')) + |> Parser.keep term + |> Parser.keep Parser.getPosition + , term + ] + + +term : Parser c Error AST.Expression +term = + Parser.succeed (\start expr end -> SourcePosition.at start end expr) + |> Parser.keep Parser.getPosition + |> Parser.keep + ( Parser.oneOf + [ lowerCaseVariable + |> Parser.map (\name -> AST.Var { name = name, varType = AST.LowVar }) + , Variable.upperCase + |> Parser.mapError VariableError + |> Parser.map (\name -> AST.Var { name = name, varType = AST.CapVar }) + , Number.parser + |> Parser.mapError NumberError + |> Parser.map AST.NumberLiteral + , String.char + |> Parser.mapError StringError + |> Parser.map AST.CharLiteral + , String.string + |> Parser.mapError StringError + |> Parser.map AST.StringLiteral + , arrayParser + |> Parser.map AST.ArrayLiteral + , recordParser + , Parser.succeed AST.Accessor + |> Parser.skip (Parser.chompIf (\c -> c == '.') (ExpectedChar '.')) + |> Parser.keep lowerCaseVariable + , Parser.succeed identity + |> Parser.skip (Parser.chompIf (\c -> c == '_') (ExpectedChar '_')) + |> Parser.keep lowerCaseVariable + |> Parser.andThen + (\_ -> Parser.problem WildcardAttempt) + ] + ) + |> Parser.keep Parser.getPosition + |> Parser.andThen + (\expr -> + when expr.value is + AST.Var { varType = AST.LowVar } -> + accessible expr + + _ -> + Parser.succeed expr + ) + + +lowerCaseVariable : Parser c Error String +lowerCaseVariable = + Variable.lowerCase + |> Parser.mapError VariableError + + +accessible : AST.Expression -> Parser c Error AST.Expression +accessible currentExpression = + Parser.oneOf + [ Parser.succeed + (\start name end -> + SourcePosition.at + start + end + (AST.Access + { accessor = name + , expression = currentExpression + } + ) + ) + |> Parser.skip (Parser.chompIf (\c -> c == '.') (ExpectedChar '.')) + |> Parser.keep Parser.getPosition + |> Parser.keep lowerCaseVariable + |> Parser.keep Parser.getPosition + |> Parser.andThen accessible + , Parser.succeed currentExpression + ] + + +-- ARRAY + + +arrayParser : Parser c Error (Array AST.Expression) +arrayParser = + Parser.succeed identity + |> Parser.skip (Parser.chompIf (\c -> c == '[') (ExpectedChar '[')) + |> Parser.skip Space.parser + |> Parser.keep + (Parser.oneOf + [ Parser.succeed [] + |> Parser.skip (Parser.chompIf (\c -> c == ']') (ExpectedChar ']')) + , Parser.lazy (\_ -> parser) + |> Parser.andThen + (\firstElement -> + Parser.succeed identity + |> Parser.skip Space.parser + |> Parser.keep (Parser.loop [ firstElement ] innerArrayParser) + ) + ] + ) + + +innerArrayParser : Array AST.Expression -> Parser c Error (Parser.Step (Array AST.Expression) (Array AST.Expression)) +innerArrayParser array = + Parser.oneOf + [ Parser.succeed (Parser.Done array) + |> Parser.skip (Parser.chompIf (\c -> c == ']') (ExpectedChar ']')) + , Parser.succeed (\expr -> Parser.Loop (Array.pushLast expr array)) + |> Parser.skip (Parser.chompIf (\c -> c == ',') (ExpectedChar ',')) + |> Parser.skip Space.parser + |> Parser.keep (Parser.lazy (\_ -> parser)) + |> Parser.skip Space.parser + ] + + +-- RECORD + + +recordParser : Parser c Error AST.Expression_ +recordParser = + Parser.succeed identity + |> Parser.skip (Parser.chompIf (\c -> c == '{') (ExpectedChar '{')) + |> Parser.skip Space.parser + |> Parser.keep + (Parser.oneOf + [ Parser.succeed (AST.Record []) + |> Parser.skip (Parser.chompIf (\c -> c == '}') (ExpectedChar '}')) + , Parser.succeed identity + |> Parser.keep (Parser.lazy (\_ -> parser)) + |> Parser.skip Space.parser + |> Parser.andThen + (\firstVarName -> + Parser.oneOf + [ Parser.succeed identity + |> Parser.skip (Parser.chompIf (\c -> c == '|') (ExpectedChar '|')) + |> Parser.skip Space.parser + |> Parser.keep recordFieldParser + |> Parser.andThen + (\firstPair -> + Parser.succeed + (\fields -> + AST.Update + { record = firstVarName + , newValues = fields + } + ) + |> Parser.skip Space.parser + |> Parser.keep (Parser.loop [ firstPair ] innerRecordParser) + ) + , Parser.succeed identity + |> Parser.skip (Parser.chompIf (\c -> c == '=') (ExpectedChar '=')) + |> Parser.skip Space.parser + |> Parser.keep (Parser.lazy (\_ -> parser)) + |> Parser.skip Space.parser + |> Parser.andThen + (\value -> + when firstVarName.value is + AST.Var { name, varType = AST.LowVar } -> + let + locatedField = + SourcePosition.at firstVarName.start firstVarName.end name + in + Parser.succeed AST.Record + |> Parser.skip Space.parser + |> Parser.keep + (Parser.loop + [ { field = locatedField, value = value } ] + innerRecordParser + ) + + _ -> + Parser.problem (ExpectedLowerVariable firstVarName) + ) + ] + ) + ] + ) + + +recordFieldParser : Parser c Error AST.RecordField +recordFieldParser = + Parser.succeed + (\fieldStart field fieldEnd value -> + { field = SourcePosition.at fieldStart fieldEnd field + , value = value + } + ) + |> Parser.keep Parser.getPosition + |> Parser.keep lowerCaseVariable + |> Parser.keep Parser.getPosition + |> Parser.skip Space.parser + |> Parser.skip (Parser.chompIf (\c -> c == '=') (ExpectedChar '=')) + |> Parser.skip Space.parser + |> Parser.keep (Parser.lazy (\_ -> parser)) + + +innerRecordParser : Array AST.RecordField -> Parser c Error (Parser.Step (Array AST.RecordField) (Array AST.RecordField)) +innerRecordParser array = + Parser.oneOf + [ Parser.succeed (Parser.Done array) + |> Parser.skip (Parser.chompIf (\c -> c == '}') (ExpectedChar '}')) + , Parser.succeed (\expr -> Parser.Loop (Array.pushLast expr array)) + |> Parser.skip (Parser.chompIf (\c -> c == ',') (ExpectedChar ',')) + |> Parser.skip Space.parser + |> Parser.keep recordFieldParser + |> Parser.skip Space.parser + ] diff --git a/src/Parse/Number.gren b/src/Parse/Number.gren new file mode 100644 index 0000000..54f9306 --- /dev/null +++ b/src/Parse/Number.gren @@ -0,0 +1,141 @@ +module Parse.Number exposing + ( Outcome (..) + , Error (..) + , parser + , hexParser + ) + + +import Parser.Advanced as Parser exposing (Parser) + + +type Outcome + = Integer Int + | FloatingPoint Float + | Hex Int + + +type Error + = NotANumber + | LeadingZero + | ExpectedInt + | ExpectedHex + + +parser : Parser c Error Outcome +parser = + Parser.oneOf + [ Parser.succeed + (\outcome -> + when outcome is + Integer int -> + Integer (negate int) + + FloatingPoint float -> + FloatingPoint (negate float) + + Hex hex -> + Hex (negate hex) + ) + |> Parser.skip (Parser.symbol negateSign) + |> Parser.keep numParser + , numParser + ] + |> Parser.andThen + (\successCase -> + Parser.oneOf + [ Parser.chompIf Char.isAlpha NotANumber + |> Parser.andThen (\_ -> Parser.problem NotANumber) + , Parser.succeed successCase + ] + ) + + +negateSign : Parser.Token Error +negateSign = + Parser.Token { str = "-", expecting = NotANumber } + + +numParser : Parser c Error Outcome +numParser = + Parser.oneOf + [ Parser.chompIf (\c -> c == '0') NotANumber + |> Parser.andThen + (\_ -> + Parser.oneOf + [ Parser.chompIf (\c -> c == 'x') NotANumber + |> Parser.andThen (\_ -> hexParser ExpectedHex) + |> Parser.map Hex + , Parser.chompIf (\c -> c == '.') NotANumber + |> Parser.andThen (\_ -> fractalParser "0") + , Parser.chompIf Char.isDigit NotANumber + |> Parser.andThen (\_ -> Parser.problem LeadingZero) + , Parser.succeed (Integer 0) + ] + ) + , Parser.chompIf Char.isDigit NotANumber + |> Parser.skip (Parser.chompWhile Char.isDigit) + |> Parser.getChompedString + |> Parser.andThen + (\str -> + when String.toInt str is + Nothing -> + Parser.problem NotANumber + + Just num -> + Parser.oneOf + [ Parser.chompIf (\c -> c == '.') NotANumber + |> Parser.andThen (\_ -> fractalParser str) + , Parser.succeed (Integer num) + ] + ) + ] + + +fractalParser : String -> Parser c Error Outcome +fractalParser str = + Parser.chompIf Char.isDigit ExpectedInt + |> Parser.skip (Parser.chompWhile Char.isDigit) + |> Parser.getChompedString + |> Parser.andThen + (\postDot -> + when String.toFloat (str ++ "." ++ postDot) is + Nothing -> + Parser.problem NotANumber + + Just float -> + Parser.succeed (FloatingPoint float) + ) + +hexParser : error -> Parser c error Int +hexParser err = + Parser.chompIf Char.isHexDigit err + |> Parser.skip (Parser.chompWhile Char.isHexDigit) + |> Parser.getChompedString + |> Parser.andThen + (\hexString -> + String.foldl hexFolder 0 hexString + |> Parser.succeed + ) + + +hexFolder : Char -> Int -> Int +hexFolder char acc = + let + charCode = + Char.toCode char + in + if charCode >= 48 && charCode <= 57 then + -- 0-9 + 16 * acc + charCode - 48 + + else if charCode >= 65 && charCode <= 70 then + -- A-F + 16 * acc + 10 + charCode - 65 + + else if charCode >= 97 && charCode <= 102 then + -- a-f + 16 * acc + 10 + charCode - 97 + + else + acc diff --git a/src/Parse/Pattern.gren b/src/Parse/Pattern.gren new file mode 100644 index 0000000..a4325dc --- /dev/null +++ b/src/Parse/Pattern.gren @@ -0,0 +1,200 @@ +module Parse.Pattern exposing + ( Error (..) + , parser + ) + + +import Parser.Advanced as Parser exposing (Parser) +import AST.Source as AST +import SourcePosition +import Parse.Number as Number +import Parse.String as String +import Parse.Space as Space +import Parse.Variable as Variable +import Parse.Number as Number + + +type Error + = ExpectedChar Char + | ExpectedKeyword String + | VariableError Variable.Error + | NumberError Number.Error + | FloatNotSupported + | StringError String.Error + + +parser : Parser c Error AST.Pattern +parser = + Parser.oneOf + [ record + , array + , parenthesized + , term + ] + + +record : Parser c Error AST.Pattern +record = + Parser.succeed (\start fields end -> SourcePosition.at start end (AST.PRecord fields)) + |> Parser.keep Parser.getPosition + |> Parser.skip (Parser.chompIf (\c -> c == '{') (ExpectedChar '{')) + |> Parser.skip Space.parser + |> Parser.keep (Parser.loop [] recordInnerLoop) + |> Parser.keep Parser.getPosition + |> Parser.skip Space.parser + + +recordInnerLoop : Array AST.PRecordField -> Parser c Error (Parser.Step (Array AST.PRecordField) (Array AST.PRecordField)) +recordInnerLoop acc = + Parser.oneOf + [ Parser.succeed (Parser.Done acc) + |> Parser.skip (Parser.chompIf (\c -> c == '}') (ExpectedChar '}')) + , Parser.succeed (\start fieldName end -> SourcePosition.at start end fieldName) + |> Parser.keep Parser.getPosition + |> Parser.keep lowerCaseVariable + |> Parser.keep Parser.getPosition + |> Parser.skip Space.parser + |> Parser.andThen + (\field -> + Parser.oneOf + [ Parser.succeed (Parser.Done <| Array.pushLast { field = field, pattern = Nothing } acc) + |> Parser.skip (Parser.chompIf (\c -> c == '}') (ExpectedChar '}')) + , Parser.succeed (Parser.Loop <| Array.pushLast { field = field, pattern = Nothing } acc) + |> Parser.skip (Parser.chompIf (\c -> c == ',') (ExpectedChar ',')) + |> Parser.skip Space.parser + , Parser.succeed identity + |> Parser.skip (Parser.chompIf (\c -> c == '=') (ExpectedChar '=')) + |> Parser.skip Space.parser + |> Parser.keep parser + |> Parser.andThen + (\pattern -> + Parser.oneOf + [ Parser.succeed (Parser.Loop <| Array.pushLast { field = field, pattern = Just pattern } acc) + |> Parser.skip (Parser.chompIf (\c -> c == ',') (ExpectedChar ',')) + |> Parser.skip Space.parser + , Parser.succeed (Parser.Done <| Array.pushLast { field = field, pattern = Just pattern } acc) + |> Parser.skip (Parser.chompIf (\c -> c == '}') (ExpectedChar '}')) + ] + ) + ] + ) + ] + + +array : Parser c Error AST.Pattern +array = + Parser.succeed (\start arr end -> SourcePosition.at start end (AST.PArray arr)) + |> Parser.keep Parser.getPosition + |> Parser.skip (Parser.chompIf (\c -> c == '[') (ExpectedChar '[')) + |> Parser.skip Space.parser + |> Parser.keep + ( Parser.oneOf + [ Parser.lazy (\_ -> parser) + |> Parser.andThen (\firstArg -> Parser.loop [ firstArg ] arrayInnerLoop) + , Parser.succeed [] + |> Parser.skip (Parser.chompIf (\c -> c == ']') (ExpectedChar ']')) + ] + ) + |> Parser.keep Parser.getPosition + |> Parser.skip Space.parser + + +arrayInnerLoop : Array AST.Pattern -> Parser c Error (Parser.Step (Array AST.Pattern) (Array AST.Pattern)) +arrayInnerLoop acc = + Parser.oneOf + [ Parser.succeed (Parser.Done acc) + |> Parser.skip (Parser.chompIf (\c -> c == ']') (ExpectedChar ']')) + , Parser.succeed (\expr -> Parser.Loop (Array.pushLast expr acc)) + |> Parser.skip (Parser.chompIf (\c -> c == ',') (ExpectedChar ',')) + |> Parser.skip Space.parser + |> Parser.keep parser + |> Parser.skip Space.parser + ] + + +parenthesized : Parser c Error AST.Pattern +parenthesized = + Parser.succeed identity + |> Parser.skip (Parser.chompIf (\c -> c == '(') (ExpectedChar '(')) + |> Parser.keep (Parser.lazy (\_ -> parser)) + |> Parser.skip (Parser.chompIf (\c -> c == ')') (ExpectedChar ')')) + |> Parser.skip Space.parser + + +term : Parser c Error AST.Pattern +term = + Parser.succeed (\start expr end -> SourcePosition.at start end expr) + |> Parser.keep Parser.getPosition + |> Parser.keep + ( Parser.oneOf + [ Parser.succeed (\name -> AST.PAnything name) + |> Parser.skip (Parser.chompIf (\c -> c == '_') (ExpectedChar '_')) + |> Parser.keep + (Parser.oneOf + [ lowerCaseVariable + , Parser.succeed "" + ] + ) + , lowerCaseVariable + |> Parser.map AST.PVar + , Parser.succeed (\start var end arg -> { ctor = SourcePosition.at start end var, arg = arg }) + |> Parser.keep Parser.getPosition + |> Parser.keep Variable.foreignUpper + |> Parser.mapError VariableError + |> Parser.keep Parser.getPosition + |> Parser.skip Space.parser + |> Parser.keep + (Parser.oneOf + [ Parser.lazy (\_ -> parser) + |> Parser.backtrackable + |> Parser.map Just + , Parser.succeed Nothing + ] + ) + |> Parser.map + (\{ ctor = { start, end, value }, arg } -> + when value is + Variable.Unqualified ctor -> + AST.PCtor + { name = SourcePosition.at start end ctor + , arg = arg + } + + Variable.Qualified { module_, name } -> + AST.PCtorQual + { varRegion = { start = start, end = end } + , module_ = module_ + , name = name + , arg = arg + } + ) + , Number.parser + |> Parser.mapError NumberError + |> Parser.andThen + (\num -> + when num is + Number.Integer int -> + Parser.succeed <| AST.PInt { isHex = False, value = int } + + Number.Hex int -> + Parser.succeed <| AST.PInt { isHex = True, value = int } + + Number.FloatingPoint _ -> + Parser.problem FloatNotSupported + ) + , String.string + |> Parser.mapError StringError + |> Parser.map AST.PStr + , String.char + |> Parser.mapError StringError + |> Parser.map AST.PChr + ] + ) + |> Parser.keep Parser.getPosition + |> Parser.skip Space.parser + + +lowerCaseVariable : Parser c Error String +lowerCaseVariable = + Variable.lowerCase + |> Parser.mapError VariableError diff --git a/src/Parse/Space.gren b/src/Parse/Space.gren new file mode 100644 index 0000000..c99e6b0 --- /dev/null +++ b/src/Parse/Space.gren @@ -0,0 +1,11 @@ +module Parse.Space exposing + ( parser + ) + + +import Parser.Advanced as Parser exposing (Parser) + + +parser : Parser c err {} +parser = + Parser.chompWhile (\c -> c == ' ' || c == '\t' || c == '\n' || c == '\r') diff --git a/src/Parse/String.gren b/src/Parse/String.gren new file mode 100644 index 0000000..0b4cb1b --- /dev/null +++ b/src/Parse/String.gren @@ -0,0 +1,181 @@ +module Parse.String exposing + ( Error (..) + , char + , string + ) + + +import Parser.Advanced as Parser exposing (Parser) +import Parse.Number as Number + + +type Error + = ExpectedQuote + | ExpectedChar + | ExpectedEscapeChar String + | ExpectedUnicodeOpening + | ExpectedValidUnicode + | ExpectedUnicodeClosing + | ExpectedNewline + | MisalignedMultiQuotes + + +char : Parser c Error Char +char = + Parser.succeed identity + |> Parser.skip (Parser.symbol charQuote) + |> Parser.keep coreParser + |> Parser.skip (Parser.symbol charQuote) + + +coreParser : Parser c Error Char +coreParser = + Parser.oneOf + [ Parser.chompIf (\c -> c == '\\') ExpectedChar + |> Parser.andThen + (\_ -> + Parser.oneOf + [ Parser.chompIf (\c -> c == 'n') ExpectedChar + |> Parser.map (\_ -> '\n') + , Parser.chompIf (\c -> c == 'r') ExpectedChar + |> Parser.map (\_ -> '\r') + , Parser.chompIf (\c -> c == 't') ExpectedChar + |> Parser.map (\_ -> '\t') + , Parser.chompIf (\c -> c == '\\') ExpectedChar + |> Parser.map (\_ -> '\\') + , Parser.chompIf (\c -> c == '\'') ExpectedChar + |> Parser.map (\_ -> '\'') + , Parser.chompIf (\c -> c == '\"') ExpectedChar + |> Parser.map (\_ -> '\"') + , Parser.succeed identity + |> Parser.skip (Parser.symbol unicodeOpening) + |> Parser.keep (Number.hexParser ExpectedValidUnicode) + |> Parser.skip (Parser.chompIf (\c -> c == '}') ExpectedUnicodeClosing) + |> Parser.andThen + (\num -> + let + character = + Char.fromCode num + in + -- Check if char is valid (replacement character) + if character == '\u{FFFD}' then + Parser.problem ExpectedValidUnicode + + else + Parser.succeed character + ) + , Parser.chompIf (\_ -> True) ExpectedChar + |> Parser.getChompedString + |> Parser.andThen (Parser.problem << ExpectedEscapeChar) + ] + ) + , Parser.chompIf (\_ -> True) ExpectedChar + |> Parser.getChompedString + |> Parser.andThen + (\str -> + when String.popFirst str is + Nothing -> + Parser.problem ExpectedChar + + Just { first = c } -> + Parser.succeed c + ) + ] + + +charQuote : Parser.Token Error +charQuote = + Parser.Token { str = "\'", expecting = ExpectedQuote } + + +singleLineStrQuote : Parser.Token Error +singleLineStrQuote = + Parser.Token { str = "\"", expecting = ExpectedQuote } + + +multiLineStrQuote : Parser.Token Error +multiLineStrQuote = + Parser.Token { str = "\"\"\"", expecting = ExpectedQuote } + + +unicodeOpening : Parser.Token Error +unicodeOpening = + Parser.Token { str = "u{", expecting = ExpectedUnicodeOpening } + + +crlf : Parser.Token Error +crlf = + Parser.Token { str = "\r\n", expecting = ExpectedNewline } + + +string : Parser c Error String +string = + Parser.oneOf + [ Parser.succeed + (\startPos str endPos -> + { start = startPos + , str = String.trimRight str + , end = endPos + } + ) + |> Parser.keep Parser.getPosition + |> Parser.skip (Parser.symbol multiLineStrQuote) + |> Parser.skip + (Parser.oneOf + [ Parser.chompIf (\c -> c == '\n') ExpectedNewline + , Parser.symbol crlf + ] + ) + |> Parser.keep (Parser.loop "" (innerSingleLineString multiLineStrQuote)) + |> Parser.keep Parser.getPosition + |> Parser.andThen + (\{ start, str, end } -> + if end.col - 3 /= start.col then + Parser.problem MisalignedMultiQuotes + + else + let + requiredIndent = + start.col - 1 + + lines = + String.split "\n" str + + linesSufficientlyIndented = + lines + |> Array.all + (\line -> + let + whiteSpacePortion = + String.takeFirst requiredIndent line + in + String.count whiteSpacePortion == requiredIndent + && String.all (\c -> c == ' ') whiteSpacePortion + ) + in + if linesSufficientlyIndented then + lines + |> Array.map (String.dropFirst requiredIndent) + |> String.join "\n" + |> Parser.succeed + + else + Parser.problem MisalignedMultiQuotes + ) + , Parser.succeed identity + |> Parser.skip (Parser.symbol singleLineStrQuote) + |> Parser.keep (Parser.loop "" (innerSingleLineString singleLineStrQuote)) + ] + + +innerSingleLineString : Parser.Token Error -> String -> Parser c Error (Parser.Step String String) +innerSingleLineString endToken str = + Parser.oneOf + [ Parser.succeed {} + |> Parser.skip (Parser.symbol endToken) + |> Parser.map (\_ -> Parser.Done str) + , Parser.succeed (\_ -> Parser.Loop (String.pushLast '\n' str)) + |> Parser.keep (Parser.symbol crlf) + , Parser.succeed (\chr -> Parser.Loop (String.pushLast chr str)) + |> Parser.keep coreParser + ] diff --git a/src/Parse/Type.gren b/src/Parse/Type.gren new file mode 100644 index 0000000..c53174e --- /dev/null +++ b/src/Parse/Type.gren @@ -0,0 +1,204 @@ +module Parse.Type exposing + ( Error (..) + , expression + ) + + +import Parser.Advanced as Parser exposing (Parser) +import SourcePosition +import AST.Source as AST +import Parse.Variable as Variable +import Parse.Space as Space + + +type Error + = ExpectedChar Char + | ExpectedString String + | VariableError Variable.Error + + +expression : Parser c Error AST.Type +expression = + Parser.oneOf + [ app + , term + ] + |> Parser.andThen + (\tipe -> + Parser.oneOf + [ Parser.succeed + (\next -> + SourcePosition.at + tipe.start + next.end + (AST.TLambda { from = tipe, to = next }) + ) + |> Parser.skip (Parser.symbol (Parser.Token { str = "->", expecting = ExpectedString "->" })) + |> Parser.skip Space.parser + |> Parser.keep (Parser.lazy (\_ -> expression)) + , Parser.succeed tipe + ] + ) + + +app : Parser c Error AST.Type +app = + Parser.succeed + (\start var end args -> + let + argsEnd = + Array.last args + |> Maybe.map .end + |> Maybe.withDefault end + in + when var is + Variable.Unqualified name -> + SourcePosition.at start argsEnd <| + AST.TType + { name = SourcePosition.at start end name + , args = args + } + + Variable.Qualified { module_, name } -> + SourcePosition.at start argsEnd <| + AST.TTypeQual + { varRegion = { start = start, end = end } + , qualifier = module_ + , name = name + , args = args + } + ) + |> Parser.keep Parser.getPosition + |> Parser.keep (Parser.mapError VariableError Variable.foreignUpper) + |> Parser.keep Parser.getPosition + |> Parser.skip Space.parser + |> Parser.keep (Parser.loop [] typeArgsParser) + + +typeArgsParser : Array AST.Type -> Parser c Error (Parser.Step (Array AST.Type) (Array AST.Type)) +typeArgsParser array = + Parser.oneOf + [ Parser.succeed (\expr -> Parser.Loop (Array.pushLast expr array)) + |> Parser.keep expression + |> Parser.skip Space.parser + , Parser.succeed (Parser.Done array) + ] + + +term : Parser c Error AST.Type +term = + Parser.getPosition + |> Parser.andThen + (\start -> + Parser.oneOf + [ Parser.succeed + (\var end -> + SourcePosition.at + start + end + (when var is + Variable.Unqualified name -> + AST.TType + { name = SourcePosition.at start end name + , args = [] + } + + Variable.Qualified { module_, name } -> + AST.TTypeQual + { varRegion = { start = start, end = end } + , qualifier = module_ + , name = name + , args = [] + } + ) + ) + |> Parser.keep (Parser.mapError VariableError Variable.foreignUpper) + |> Parser.keep Parser.getPosition + , Parser.succeed (\var end -> SourcePosition.at start end (AST.TVar var)) + |> Parser.keep (Parser.mapError VariableError Variable.lowerCase) + |> Parser.keep Parser.getPosition + , Parser.succeed (\expr end -> SourcePosition.at start end (AST.TParens expr)) + |> Parser.skip (Parser.chompIf (\c -> c == '(') (ExpectedChar '(')) + |> Parser.skip Space.parser + |> Parser.keep expression + |> Parser.keep Parser.getPosition + |> Parser.skip (Parser.chompIf (\c -> c == ')') (ExpectedChar ')')) + , Parser.succeed (\record end -> SourcePosition.at start end record) + |> Parser.keep recordParser + |> Parser.keep Parser.getPosition + ] + |> Parser.skip Space.parser + ) + + +recordParser : Parser c Error AST.Type_ +recordParser = + Parser.succeed identity + |> Parser.skip (Parser.chompIf (\c -> c == '{') (ExpectedChar '{')) + |> Parser.skip Space.parser + |> Parser.keep + (Parser.oneOf + [ Parser.succeed (AST.TRecord { fields = [], extending = Nothing }) + |> Parser.skip (Parser.chompIf (\c -> c == '}') (ExpectedChar '}')) + , Parser.succeed (\start var end -> SourcePosition.at start end var) + |> Parser.keep Parser.getPosition + |> Parser.keep (Parser.mapError VariableError Variable.lowerCase) + |> Parser.keep Parser.getPosition + |> Parser.skip Space.parser + |> Parser.andThen + (\var -> + Parser.oneOf + [ Parser.succeed identity + |> Parser.skip (Parser.chompIf (\c -> c == '|') (ExpectedChar '|')) + |> Parser.skip Space.parser + |> Parser.keep recordFieldParser + |> Parser.skip Space.parser + |> Parser.andThen + (\firstPair -> + Parser.loop [ firstPair ] innerRecordParser + ) + |> Parser.map (\fields -> AST.TRecord { fields = fields, extending = Just var }) + , Parser.succeed identity + |> Parser.skip (Parser.chompIf (\c -> c == ':') (ExpectedChar ':')) + |> Parser.skip Space.parser + |> Parser.keep expression + |> Parser.skip Space.parser + |> Parser.andThen + (\expr -> + Parser.loop [ { field = var, signature = expr } ] innerRecordParser + ) + |> Parser.map (\fields -> AST.TRecord { fields = fields, extending = Nothing }) + ] + ) + ] + ) + + +recordFieldParser : Parser c Error AST.TRecordField +recordFieldParser = + Parser.succeed + (\fieldStart field fieldEnd signature -> + { field = SourcePosition.at fieldStart fieldEnd field + , signature = signature + } + ) + |> Parser.keep Parser.getPosition + |> Parser.keep (Parser.mapError VariableError Variable.lowerCase) + |> Parser.keep Parser.getPosition + |> Parser.skip Space.parser + |> Parser.skip (Parser.chompIf (\c -> c == ':') (ExpectedChar ':')) + |> Parser.skip Space.parser + |> Parser.keep expression + + +innerRecordParser : Array AST.TRecordField -> Parser c Error (Parser.Step (Array AST.TRecordField) (Array AST.TRecordField)) +innerRecordParser array = + Parser.oneOf + [ Parser.succeed (Parser.Done array) + |> Parser.skip (Parser.chompIf (\c -> c == '}') (ExpectedChar '}')) + , Parser.succeed (\expr -> Parser.Loop (Array.pushLast expr array)) + |> Parser.skip (Parser.chompIf (\c -> c == ',') (ExpectedChar ',')) + |> Parser.skip Space.parser + |> Parser.keep recordFieldParser + |> Parser.skip Space.parser + ] diff --git a/src/Parse/Variable.gren b/src/Parse/Variable.gren new file mode 100644 index 0000000..2d63f45 --- /dev/null +++ b/src/Parse/Variable.gren @@ -0,0 +1,142 @@ +module Parse.Variable exposing + ( Error (..) + , lowerCase + , upperCase + , ForeignVar (..) + , foreignUpper + , reservedWords + ) + + +import Parser.Advanced as Parser exposing (Parser) +import String.Regex as Regex exposing (Regex) +import Set exposing (Set) + + +type Error + = InvalidCharacter + | ExpectedDot + | ReservedWord String + + +lowerCase : Parser c Error String +lowerCase = + -- TODO: simply stops parsing at invalid character, in lack of better alternatives + -- Revisit this once gren-lang/parser has gotten more flexible + Parser.succeed {} + |> Parser.skip (Parser.chompIf isLowerCaseLetter InvalidCharacter) + |> Parser.skip (Parser.chompWhile isInner) + |> Parser.getChompedString + |> Parser.andThen + (\word -> + if Set.member word reservedWords then + Parser.problem (ReservedWord word) + + else + Parser.succeed word + ) + + +reservedWords : Set String +reservedWords = + Set.fromArray + [ "if" + , "then" + , "else" + , "when" + , "is" + , "let" + , "in" + , "type" + , "module" + , "where" + , "import" + , "exposing" + , "as" + , "port" + ] + + +upperCase : Parser c Error String +upperCase = + Parser.succeed {} + |> Parser.skip (Parser.chompIf isUpperCaseLetter InvalidCharacter) + |> Parser.skip (Parser.chompWhile isInner) + |> Parser.getChompedString + + +type ForeignVar + = Unqualified String + | Qualified { module_ : String, name : String } + + +foreignUpper : Parser c Error ForeignVar +foreignUpper = + upperCase + |> Parser.andThen + (\first -> + Parser.loop { module_ = [], name = first } foreignUpperLoop + |> Parser.map + (\{ module_, name } -> + when module_ is + [] -> + Unqualified name + + _ -> + Qualified + { module_ = String.join "." module_ + , name = name + } + ) + ) + + +type alias ForeignUpperStep = + { module_ : Array String + , name : String + } + + +foreignUpperLoop : ForeignUpperStep -> Parser c Error (Parser.Step ForeignUpperStep ForeignUpperStep) +foreignUpperLoop acc = + Parser.oneOf + [ Parser.succeed + (\next -> + Parser.Loop { module_ = Array.pushLast acc.name acc.module_, name = next } + ) + |> Parser.skip (Parser.chompIf (\c -> c == '.') ExpectedDot) + |> Parser.keep upperCase + , Parser.succeed (Parser.Done acc) + ] + + +lowerCaseLetterRegex : Regex +lowerCaseLetterRegex = + Regex.fromString "\\p{Ll}" + |> Maybe.withDefault Regex.never + + +isLowerCaseLetter : Char -> Bool +isLowerCaseLetter char = + String.fromChar char + |> Regex.contains lowerCaseLetterRegex + + +upperCaseLetterRegex : Regex +upperCaseLetterRegex = + Regex.fromString "\\p{Lu}" + |> Maybe.withDefault Regex.never + + +isUpperCaseLetter : Char -> Bool +isUpperCaseLetter char = + String.fromChar char + |> Regex.contains upperCaseLetterRegex + + +isInner : Char -> Bool +isInner char = + Char.isAlphaNum char + || char == '_' + || isLowerCaseLetter char + || isUpperCaseLetter char diff --git a/src/SourcePosition.gren b/src/SourcePosition.gren new file mode 100644 index 0000000..5674388 --- /dev/null +++ b/src/SourcePosition.gren @@ -0,0 +1,39 @@ +module SourcePosition exposing + ( Position + , emptyPos + , Region + , Located + , at + ) + + +type alias Position = + { row : Int + , col : Int + } + + +emptyPos : Position +emptyPos = + -- matches initial values of parser position + { row = 1 + , col = 1 + } + + +type alias Region = + { start : Position + , end : Position + } + + +type alias Located a = + { start : Position + , end : Position + , value : a + } + + +at : Position -> Position -> a -> Located a +at start end a = + { start = start, end = end, value = a } diff --git a/tests/gren.json b/tests/gren.json index b9b391e..9333f68 100644 --- a/tests/gren.json +++ b/tests/gren.json @@ -8,8 +8,9 @@ "dependencies": { "direct": { "gren-lang/node": "6.1.0", - "gren-lang/core": "7.1.0", + "gren-lang/core": "7.2.1", "gren-lang/test": "5.0.0", + "gren-lang/parser": "6.2.0", "gren-lang/test-runner-node": "7.0.0", "gren-lang/compiler-node": "local:.." }, diff --git a/tests/gren_packages/gren_lang_core__7_1_0.pkg.gz b/tests/gren_packages/gren_lang_core__7_1_0.pkg.gz deleted file mode 100644 index 19df64c..0000000 Binary files a/tests/gren_packages/gren_lang_core__7_1_0.pkg.gz and /dev/null differ diff --git a/tests/gren_packages/gren_lang_core__7_2_1.pkg.gz b/tests/gren_packages/gren_lang_core__7_2_1.pkg.gz new file mode 100644 index 0000000..24387f6 Binary files /dev/null and b/tests/gren_packages/gren_lang_core__7_2_1.pkg.gz differ diff --git a/tests/gren_packages/gren_lang_parser__6_2_0.pkg.gz b/tests/gren_packages/gren_lang_parser__6_2_0.pkg.gz new file mode 100644 index 0000000..7c9b010 Binary files /dev/null and b/tests/gren_packages/gren_lang_parser__6_2_0.pkg.gz differ diff --git a/tests/src/Main.gren b/tests/src/Main.gren index 2f74ed7..fd6ff1e 100644 --- a/tests/src/Main.gren +++ b/tests/src/Main.gren @@ -2,29 +2,40 @@ module Main exposing (main) import Test import Test.Runner.Node as TestRunner -import Test.CLI.Parser as CLIParser -import Test.CLI.PrettyPrinter as PrettyPrinter -import Test.SemanticVersion as SemanticVersion -import Test.SemanticVersionRange as SemanticVersionRange -import Test.Compiler.Dependencies as Dependencies -import Test.Compiler.PackageName as PackageName -import Test.Compiler.ModuleName as ModuleName -import Test.Compiler.Platform as Platform -import Test.String.EditDistance as EditDistance -import Node exposing (Program) +import Test.CLI.Parser +import Test.CLI.PrettyPrinter +import Test.SemanticVersion +import Test.SemanticVersionRange +import Test.Compiler.Dependencies +import Test.Compiler.PackageName +import Test.Compiler.ModuleName +import Test.Compiler.Platform +import Test.String.EditDistance +import Test.Parse.Number +import Test.Parse.String +import Test.Parse.Variable +import Test.Parse.Pattern +import Test.Parse.Expression +import Test.Parse.Type main : TestRunner.Program main = TestRunner.run <| Test.describe "Gren Compiler Node tests" - [ CLIParser.tests - , Dependencies.tests - , PrettyPrinter.tests - , SemanticVersion.tests - , SemanticVersionRange.tests - , PackageName.tests - , ModuleName.tests - , Platform.tests - , EditDistance.tests + [ Test.CLI.Parser.tests + , Test.CLI.PrettyPrinter.tests + , Test.SemanticVersion.tests + , Test.SemanticVersionRange.tests + , Test.Compiler.Dependencies.tests + , Test.Compiler.PackageName.tests + , Test.Compiler.ModuleName.tests + , Test.Compiler.Platform.tests + , Test.String.EditDistance.tests + , Test.Parse.Expression.tests + , Test.Parse.Number.tests + , Test.Parse.String.tests + , Test.Parse.Pattern.tests + , Test.Parse.Variable.tests + , Test.Parse.Type.tests ] diff --git a/tests/src/Test/Parse/Expression.gren b/tests/src/Test/Parse/Expression.gren new file mode 100644 index 0000000..1de770f --- /dev/null +++ b/tests/src/Test/Parse/Expression.gren @@ -0,0 +1,357 @@ +module Test.Parse.Expression exposing ( tests ) + +import Expect exposing (Expectation) +import Test exposing (Test, describe, test, fuzz) +import Fuzz exposing (Fuzzer) +import Parser.Advanced as Parser +import Parse.Expression as PE +import Parse.Number as Number +import AST.Source as AST +import SourcePosition + + +tests : Test +tests = + describe "Parse.Expression" + [ describe "Primitives" + [ test "Int" <| \_ -> + Parser.run PE.parser "5" + |> expectExpression (AST.NumberLiteral (Number.Integer 5)) + , test "Negative Int" <| \_ -> + Parser.run PE.parser "-15" + |> expectExpression + (AST.Negate + { start = { row = 1, col = 2 } + , end = { row = 1, col = 4 } + , value = AST.NumberLiteral (Number.Integer 15) + } + ) + , test "Float" <| \_ -> + Parser.run PE.parser "3.14" + |> expectExpression (AST.NumberLiteral (Number.FloatingPoint 3.14)) + , test "Hex" <| \_ -> + Parser.run PE.parser "0xDE" + |> expectExpression (AST.NumberLiteral (Number.Hex 0xDE)) + , test "Char" <| \_ -> + Parser.run PE.parser "'z'" + |> expectExpression (AST.CharLiteral 'z') + , test "String" <| \_ -> + Parser.run PE.parser "\"test\"" + |> expectExpression (AST.StringLiteral "test") + , test "Ctor" <| \_ -> + Parser.run PE.parser "True" + |> expectExpression (AST.Var { name = "True", varType = AST.CapVar }) + , test "var name" <| \_ -> + Parser.run PE.parser "myvar" + |> expectExpression (AST.Var { name = "myvar", varType = AST.LowVar }) + , test "accessor" <| \_ -> + Parser.run PE.parser ".field" + |> expectExpression (AST.Accessor "field") + , test "wildcard error" <| \_ -> + Parser.run PE.parser "_unused" + |> expectErr PE.WildcardAttempt + , test "nested accessors" <| \_ -> + Parser.run PE.parser "nested.accessor.expression" + |> expectExpression + (AST.Access + { expression = + { start = { row = 1, col = 8} + , end = { row = 1, col = 16} + , value = + AST.Access + { expression = + { start = { row = 1, col = 1 } + , end = { row = 1, col = 7 } + , value = AST.Var { name = "nested", varType = AST.LowVar } + } + , accessor = "accessor" + } + } + , accessor = "expression" + } + ) + ] + , describe "Array" + [ test "Empty array" <| \_ -> + Parser.run PE.parser "[]" + |> expectExpression (AST.ArrayLiteral []) + , test "Empty array (with whitespace)" <| \_ -> + Parser.run PE.parser "[ \n ]" + |> expectExpression (AST.ArrayLiteral []) + , test "Singleton" <| \_ -> + Parser.run PE.parser "[ 1 ]" + |> expectExpression + (AST.ArrayLiteral + [ { start = { row = 1, col = 3 } + , end = { row = 1, col = 4 } + , value = AST.NumberLiteral (Number.Integer 1) + } + ] + ) + , test "Multiples" <| \_ -> + Parser.run PE.parser "[ \"one\", \"two\", \n \"three\" ]" + |> expectExpression + (AST.ArrayLiteral + [ { start = { row = 1, col = 3 } + , end = { row = 1, col = 8 } + , value = AST.StringLiteral "one" + } + , { start = { row = 1, col = 10 } + , end = { row = 1, col = 15 } + , value = AST.StringLiteral "two" + } + , { start = { row = 2, col = 2 } + , end = { row = 2, col = 9 } + , value = AST.StringLiteral "three" + } + ] + ) + ] + , describe "Record" + [ test "Empty record" <| \_ -> + Parser.run PE.parser "{}" + |> expectExpression (AST.Record []) + , test "Empty array (with whitespace)" <| \_ -> + Parser.run PE.parser "{ \n }" + |> expectExpression (AST.Record []) + , test "Singleton" <| \_ -> + Parser.run PE.parser "{ field1 = 1 }" + |> expectExpression + (AST.Record + [ { field = + SourcePosition.at + { row = 1, col = 3 } + { row = 1, col = 9 } + "field1" + , value = + SourcePosition.at + { row = 1, col = 12 } + { row = 1, col = 13 } + (AST.NumberLiteral (Number.Integer 1)) + } + ] + ) + , test "Multiples" <| \_ -> + Parser.run PE.parser "{ field1 = 1, field2 = 10 }" + |> expectExpression + (AST.Record + [ { field = + SourcePosition.at + { row = 1, col = 3 } + { row = 1, col = 9 } + "field1" + , value = + SourcePosition.at + { row = 1, col = 12 } + { row = 1, col = 13 } + (AST.NumberLiteral (Number.Integer 1)) + } + , { field = + SourcePosition.at + { row = 1, col = 15 } + { row = 1, col = 21 } + "field2" + , value = + SourcePosition.at + { row = 1, col = 24 } + { row = 1, col = 26 } + (AST.NumberLiteral (Number.Integer 10)) + } + ] + ) + , test "Update" <| \_ -> + Parser.run PE.parser "{ old | field1 = 1, field2 = 10 }" + |> expectExpression + (AST.Update + { record = + SourcePosition.at + { row = 1, col = 3 } + { row = 1, col = 6 } + (AST.Var { name = "old", varType = AST.LowVar }) + , newValues = + [ { field = + SourcePosition.at + { row = 1, col = 9 } + { row = 1, col = 15 } + "field1" + , value = + SourcePosition.at + { row = 1, col = 18 } + { row = 1, col = 19 } + (AST.NumberLiteral (Number.Integer 1)) + } + , { field = + SourcePosition.at + { row = 1, col = 21 } + { row = 1, col = 27 } + "field2" + , value = + SourcePosition.at + { row = 1, col = 30 } + { row = 1, col = 32 } + (AST.NumberLiteral (Number.Integer 10)) + } + ] + } + ) + ] + , describe "if-expressions" + [ test "simple test" <| \_ -> + Parser.run PE.parser "if True then 1 else 2" + |> expectExpression + (AST.If + { branches = + [ { test = + SourcePosition.at + { row = 1, col = 4 } + { row = 1, col = 8 } + (AST.Var { name = "True", varType = AST.CapVar }) + , body = + SourcePosition.at + { row = 1, col = 14 } + { row = 1, col = 15 } + (AST.NumberLiteral (Number.Integer 1)) + } + ] + , elseBranch = + SourcePosition.at + { row = 1, col = 21 } + { row = 1, col = 22 } + (AST.NumberLiteral (Number.Integer 2)) + } + ) + ] + , describe "lambdas" + [ test "simple test" <| \_ -> + Parser.run PE.parser "\\a b -> a" + |> expectExpression + (AST.Lambda + { patterns = + [ SourcePosition.at + { row = 1, col = 2 } + { row = 1, col = 3 } + (AST.PVar "a") + , SourcePosition.at + { row = 1, col = 4 } + { row = 1, col = 5 } + (AST.PVar "b") + ] + , body = + SourcePosition.at + { row = 1, col = 9 } + { row = 1, col = 10 } + (AST.Var { name = "a", varType = AST.LowVar }) + } + ) + ] + , describe "when-is" + [ test "simple test" <| \_ -> + Parser.run PE.parser "when myVar is A -> 'a'" + |> expectExpression + (AST.When + { expression = + SourcePosition.at + { row = 1, col = 6 } + { row = 1, col = 11 } + (AST.Var { name = "myVar", varType = AST.LowVar }) + , branches = + [ { pattern = + SourcePosition.at + { row = 1, col = 15 } + { row = 1, col = 17 } + (AST.PCtor + { name = + SourcePosition.at + { row = 1, col = 15 } + { row = 1, col = 16 } + "A" + , arg = Nothing + } + ) + , body = + SourcePosition.at + { row = 1, col = 20 } + { row = 1, col = 23 } + (AST.CharLiteral 'a') + } + ] + } + ) + , test "multiple branches" <| \_ -> + Parser.run PE.parser "when myVar is A -> 'a' B -> 'b'" + |> expectExpression + (AST.When + { expression = + SourcePosition.at + { row = 1, col = 6 } + { row = 1, col = 11 } + (AST.Var { name = "myVar", varType = AST.LowVar }) + , branches = + [ { pattern = + SourcePosition.at + { row = 1, col = 15 } + { row = 1, col = 17 } + (AST.PCtor + { name = + SourcePosition.at + { row = 1, col = 15 } + { row = 1, col = 16 } + "A" + , arg = Nothing + } + ) + , body = + SourcePosition.at + { row = 1, col = 20 } + { row = 1, col = 23 } + (AST.CharLiteral 'a') + } + , { pattern = + SourcePosition.at + { row = 1, col = 24 } + { row = 1, col = 26 } + (AST.PCtor + { name = + SourcePosition.at + { row = 1, col = 24 } + { row = 1, col = 25 } + "B" + , arg = Nothing + } + ) + , body = + SourcePosition.at + { row = 1, col = 29 } + { row = 1, col = 32 } + (AST.CharLiteral 'b') + } + ] + } + ) + ] + ] + + +expectExpression : a -> Result (Array (Parser.DeadEnd c e)) (SourcePosition.Located a) -> Expectation +expectExpression expected result = + when result is + Err err -> + Expect.fail (Debug.toString err) + + Ok { value } -> + Expect.equal expected value + + +expectErr : PE.Error -> Result (Array (Parser.DeadEnd c PE.Error)) a -> Expectation +expectErr expected result = + when result is + Ok _ -> + Expect.fail "Expected error" + + Err problems -> + when Array.first problems is + Just firstProblem -> + Expect.equal expected firstProblem.problem + + Nothing -> + Expect.fail "Failed, but with no problems..." diff --git a/tests/src/Test/Parse/Number.gren b/tests/src/Test/Parse/Number.gren new file mode 100644 index 0000000..68838e1 --- /dev/null +++ b/tests/src/Test/Parse/Number.gren @@ -0,0 +1,81 @@ +module Test.Parse.Number exposing ( tests ) + +import Expect exposing (Expectation) +import Test exposing (Test, describe, test, fuzz) +import Fuzz exposing (Fuzzer) +import Parser.Advanced as Parser +import Parse.Number as PN + + +tests : Test +tests = + describe "Parse.Number" + [ describe "Integers" + [ fuzz Fuzz.int "Can parse regular integers" <| \int -> + run (String.fromInt int) + |> Expect.equal (Ok (PN.Integer int)) + , test "empty string fails" <| \{} -> + run "" + |> expectErr PN.NotANumber + , test "leading 0 fails" <| \{} -> + run "012" + |> expectErr PN.LeadingZero + , test "leading negative 0 fails" <| \{} -> + run "-012" + |> expectErr PN.LeadingZero + , test "when followed by letter, it fails" <| \{} -> + run "123a" + |> expectErr PN.NotANumber + ] + , describe "Floats" + [ fuzz (Fuzz.floatRange 0 32000) "Can parse regular floats" <| \float -> + run (String.fromFloat float) + |> Result.map + (\outcome -> + when outcome is + PN.Integer value -> + PN.FloatingPoint (toFloat value) + + _ -> + outcome + ) + |> Expect.equal (Ok (PN.FloatingPoint float)) + , test "Requires a number after ." <| \{} -> + run "0." + |> expectErr PN.ExpectedInt + , test "when followed by letter, it fails" <| \{} -> + run "0.15a" + |> expectErr PN.NotANumber + ] + , describe "Hex" + [ test "Can parse hex" <| \{} -> + run "0xAFFE" + |> Expect.equal (Ok (PN.Hex 45054)) + , test "Requires a hex digit after 0x" <| \{} -> + run "0x" + |> expectErr PN.ExpectedHex + , test "When followed by illegal character, it fails" <| \{} -> + run "0xABZ" + |> expectErr PN.NotANumber + ] + ] + + +run : String -> Result (Array (Parser.DeadEnd c PN.Error)) PN.Outcome +run str = + Parser.run PN.parser str + + +expectErr : PN.Error -> Result (Array (Parser.DeadEnd c PN.Error)) PN.Outcome -> Expectation +expectErr expected result = + when result is + Ok _ -> + Expect.fail "Expected error" + + Err problems -> + when Array.first problems is + Just firstProblem -> + Expect.equal expected firstProblem.problem + + Nothing -> + Expect.fail "Failed, but with no problems..." diff --git a/tests/src/Test/Parse/Pattern.gren b/tests/src/Test/Parse/Pattern.gren new file mode 100644 index 0000000..a7a61ac --- /dev/null +++ b/tests/src/Test/Parse/Pattern.gren @@ -0,0 +1,218 @@ +module Test.Parse.Pattern exposing ( tests ) + +import Expect exposing (Expectation) +import Test exposing (Test, describe, test, fuzz) +import Fuzz exposing (Fuzzer) +import Parser.Advanced as Parser +import Parse.Pattern as PT +import AST.Source as AST +import SourcePosition + + +tests : Test +tests = + describe "Parse.Pattern" + [ test "vars" <| \_ -> + Parser.run PT.parser "var" + |> expectPattern (AST.PVar "var") + , test "wildcard" <| \_ -> + Parser.run PT.parser "_" + |> expectPattern (AST.PAnything "") + , test "wildcard (named)" <| \_ -> + Parser.run PT.parser "_test" + |> expectPattern (AST.PAnything "test") + , test "constructor (unqualified)" <| \_ -> + Parser.run PT.parser "Ctor" + |> expectPattern + (AST.PCtor + { arg = Nothing + , name = + SourcePosition.at + { row = 1, col = 1 } + { row = 1, col = 5 } + "Ctor" + } + ) + , test "constructor (with args)" <| \_ -> + Parser.run PT.parser "Ctor arg" + |> expectPattern + (AST.PCtor + { arg = + Just <| + SourcePosition.at + { row = 1, col = 6 } + { row = 1, col = 9 } + (AST.PVar "arg") + , name = + SourcePosition.at + { row = 1, col = 1 } + { row = 1, col = 5 } + "Ctor" + } + ) + , test "constructor (terminated by ->)" <| \_ -> + Parser.run PT.parser "Ctor ->" + |> expectPattern + (AST.PCtor + { arg = Nothing + , name = + SourcePosition.at + { row = 1, col = 1 } + { row = 1, col = 5 } + "Ctor" + } + ) + , test "constructor (parenthesized with args)" <| \_ -> + Parser.run PT.parser "(Ctor arg)" + |> expectPattern + (AST.PCtor + { arg = + Just <| + SourcePosition.at + { row = 1, col = 7 } + { row = 1, col = 10 } + (AST.PVar "arg") + , name = + SourcePosition.at + { row = 1, col = 2 } + { row = 1, col = 6 } + "Ctor" + } + ) + , test "constructor (qualified)" <| \_ -> + Parser.run PT.parser "My.Ctor" + |> expectPattern + (AST.PCtorQual + { varRegion = + { start = { row = 1, col = 1 } + , end = { row = 1, col = 8 } + } + , arg = Nothing + , module_ = "My" + , name = "Ctor" + } + ) + , test "ints" <| \_ -> + Parser.run PT.parser "160" + |> expectPattern + (AST.PInt { isHex = False, value = 160 }) + , test "ints (hex)" <| \_ -> + Parser.run PT.parser "0xAB" + |> expectPattern + (AST.PInt { isHex = True, value = 171 }) + , test "string" <| \_ -> + Parser.run PT.parser "\"some String\"" + |> expectPattern + (AST.PStr "some String") + , test "char" <| \_ -> + Parser.run PT.parser "'z'" + |> expectPattern + (AST.PChr 'z') + , test "array (empty)" <| \_ -> + Parser.run PT.parser "[]" + |> expectPattern + (AST.PArray []) + , test "array" <| \_ -> + Parser.run PT.parser "[ a, 2, b ]" + |> expectPattern + (AST.PArray + [ SourcePosition.at + { row = 1, col = 3 } + { row = 1, col = 4 } + (AST.PVar "a") + , SourcePosition.at + { row = 1, col = 6 } + { row = 1, col = 7 } + (AST.PInt { isHex = False, value = 2 }) + , SourcePosition.at + { row = 1, col = 9 } + { row = 1, col = 10 } + (AST.PVar "b") + ] + ) + , test "record (empty)" <| \_ -> + Parser.run PT.parser "{}" + |> expectPattern + (AST.PRecord []) + , test "record" <| \_ -> + Parser.run PT.parser "{ a = 1, b = _ }" + |> expectPattern + (AST.PRecord + [ { field = + SourcePosition.at + { row = 1, col = 3 } + { row = 1, col = 4 } + "a" + , pattern = + Just <| + SourcePosition.at + { row = 1, col = 7 } + { row = 1, col = 8 } + (AST.PInt { isHex = False, value = 1 }) + } + , { field = + SourcePosition.at + { row = 1, col = 10 } + { row = 1, col = 11 } + "b" + , pattern = + Just <| + SourcePosition.at + { row = 1, col = 14 } + { row = 1, col = 15 } + (AST.PAnything "") + } + ] + ) + , test "record (shorthand)" <| \_ -> + Parser.run PT.parser "{ a, b = _ }" + |> expectPattern + (AST.PRecord + [ { field = + SourcePosition.at + { row = 1, col = 3 } + { row = 1, col = 4 } + "a" + , pattern = + Nothing + } + , { field = + SourcePosition.at + { row = 1, col = 6 } + { row = 1, col = 7 } + "b" + , pattern = + Just <| + SourcePosition.at + { row = 1, col = 10 } + { row = 1, col = 11 } + (AST.PAnything "") + } + ] + ) + ] + + +expectPattern : a -> Result (Array (Parser.DeadEnd c e)) (SourcePosition.Located a) -> Expectation +expectPattern expected result = + when result is + Err err -> + Expect.fail (Debug.toString err) + + Ok { value } -> + Expect.equal expected value + + +expectErr : PT.Error -> Result (Array (Parser.DeadEnd c PT.Error)) a -> Expectation +expectErr expected result = + when result is + Ok _ -> + Expect.fail "Expected error" + + Err problems -> + when Array.first problems is + Just firstProblem -> + Expect.equal expected firstProblem.problem + + Nothing -> + Expect.fail "Failed, but with no problems..." diff --git a/tests/src/Test/Parse/String.gren b/tests/src/Test/Parse/String.gren new file mode 100644 index 0000000..a306377 --- /dev/null +++ b/tests/src/Test/Parse/String.gren @@ -0,0 +1,117 @@ +module Test.Parse.String exposing ( tests ) + +import Expect exposing (Expectation) +import Test exposing (Test, describe, test, fuzz) +import Fuzz exposing (Fuzzer) +import Parser.Advanced as Parser +import Parse.String as PS + + +tests : Test +tests = + describe "Parse.String" + [ describe "Characters" + [ fuzz Fuzz.char "Can parse unicode chars" <| \char -> + let + charString = + if char == '\\' then + "\\\\" + + else + String.fromChar char + in + Parser.run PS.char ("\'" ++ charString ++ "\'") + |> Expect.equal (Ok char) + , test "There is no such thing as an empty char" <| \_ -> + Parser.run PS.char "\'\'" + |> expectErr PS.ExpectedQuote + , test "Unicode character requiring surrogate pairs" <| \_ -> + let + char = '𐐷' + in + Parser.run PS.char ("\'" ++ String.fromChar char ++ "\'") + |> Expect.equal (Ok char) + , test "Unicode character requiring surrogate pairs, using escape sequence" <| \_ -> + Parser.run PS.char ("\'\\u{10437}\'") + |> Expect.equal (Ok '𐐷') + , test "Escape newline" <| \_ -> + Parser.run PS.char "\'\\n\'" + |> Expect.equal (Ok '\n') + , test "Escape return" <| \_ -> + Parser.run PS.char "\'\\r\'" + |> Expect.equal (Ok '\r') + , test "Escape tab" <| \_ -> + Parser.run PS.char "\'\\t\'" + |> Expect.equal (Ok '\t') + , test "Escape slash" <| \_ -> + Parser.run PS.char "\'\\\\'" + |> Expect.equal (Ok '\\') + , test "Escape single quote" <| \_ -> + Parser.run PS.char "\'\\\'\'" + |> Expect.equal (Ok '\'') + , test "Escape double quote" <| \_ -> + Parser.run PS.char "\'\\\"\'" + |> Expect.equal (Ok '\"') + , test "Bad escape" <| \_ -> + Parser.run PS.char "\'\\a\'" + |> expectErr (PS.ExpectedEscapeChar "a") + ] + , describe "Strings" + [ test "Example" <| \_ -> + Parser.run PS.string "\"this is a \\\" Test -String_\"" + |> Expect.equal (Ok "this is a \" Test -String_") + , test "Example with surrogate pair" <| \_ -> + Parser.run PS.string "\"this is a \\\" Test 𤭢 -String_\"" + |> Expect.equal (Ok "this is a \" Test 𤭢 -String_") + , test "crlf is normalized to lf" <| \_ -> + Parser.run PS.string "\"\r\n\"" + |> Expect.equal (Ok "\n") + ] + , describe "Multi-line Strings" + [ test "Simple case" <| \_ -> + Parser.run PS.string "\"\"\"\nnormal string\n\"\"\"" + |> Expect.equal (Ok "normal string") + , test "Simple case with crlf" <| \_ -> + Parser.run PS.string "\"\"\"\r\nnormal string\r\n\"\"\"" + |> Expect.equal (Ok "normal string") + , test "crlf works in general" <| \_ -> + Parser.run PS.string "\"\"\"\r\nstring \r\n with crlf\r\n\"\"\"" + |> Expect.equal (Ok "string \n with crlf") + , test "quotes must be aligned" <| \_ -> + Parser.run (skipLeadingWhitespace PS.string) " \"\"\"\nnormal string\n\"\"\"" + |> expectErr PS.MisalignedMultiQuotes + , test "must end in newline (due to alignment)" <| \_ -> + Parser.run (skipLeadingWhitespace PS.string) "\"\"\"\nnormal string\"\"\"" + |> expectErr PS.MisalignedMultiQuotes + , test "content must be aligned with opening quote" <| \_ -> + Parser.run (skipLeadingWhitespace PS.string) " \"\"\"\nnormal string\n \"\"\"" + |> expectErr PS.MisalignedMultiQuotes + , test "leading whitespace is dropped" <| \_ -> + Parser.run (skipLeadingWhitespace PS.string) " \"\"\"\n normal string\n second line\n \"\"\"" + |> Expect.equal (Ok "normal string\n second line") + , test "leading whitespace is determined by quote placement" <| \_ -> + Parser.run (skipLeadingWhitespace PS.string) "\"\"\"\n normal string\n second line\n\"\"\"" + |> Expect.equal (Ok " normal string\n second line") + ] + ] + + +skipLeadingWhitespace : Parser.Parser c PS.Error a -> Parser.Parser c PS.Error a +skipLeadingWhitespace p = + Parser.chompWhile (\c -> c == ' ') + |> Parser.andThen (\_ -> p) + + +expectErr : PS.Error -> Result (Array (Parser.DeadEnd c PS.Error)) a -> Expectation +expectErr expected result = + when result is + Ok _ -> + Expect.fail "Expected error" + + Err problems -> + when Array.first problems is + Just firstProblem -> + Expect.equal expected firstProblem.problem + + Nothing -> + Expect.fail "Failed, but with no problems..." diff --git a/tests/src/Test/Parse/Type.gren b/tests/src/Test/Parse/Type.gren new file mode 100644 index 0000000..7f44269 --- /dev/null +++ b/tests/src/Test/Parse/Type.gren @@ -0,0 +1,266 @@ +module Test.Parse.Type exposing ( tests ) + +import Expect exposing (Expectation) +import Test exposing (Test, describe, test) +import Parser.Advanced as Parser +import Parse.Type as PT +import AST.Source as AST +import SourcePosition + + +tests : Test +tests = + describe "Parse.Type" + [ test "Type" <| \_ -> + Parser.run PT.expression "MyType" + |> expectExpression + (AST.TType + { name = + SourcePosition.at + { row = 1 , col = 1 } + { row = 1 , col = 7 } + "MyType" + , args = [] + } + ) + , test "Type (with args)" <| \_ -> + Parser.run PT.expression "MyType a String" + |> expectExpression + (AST.TType + { name = + SourcePosition.at + { row = 1 , col = 1 } + { row = 1 , col = 7 } + "MyType" + , args = + [ SourcePosition.at + { row = 1, col = 8 } + { row = 1, col = 9 } + (AST.TVar "a") + , SourcePosition.at + { row = 1, col = 10 } + { row = 1, col = 16 } + (AST.TType + { name = + SourcePosition.at + { row = 1, col = 10 } + { row = 1, col = 16 } + "String" + , args = [] + } + ) + ] + } + ) + , test "Qualified Type" <| \_ -> + Parser.run PT.expression "Main.Module.MyType" + |> expectExpression + (AST.TTypeQual + { varRegion = { start = { row = 1, col = 1 }, end = { row = 1, col = 19 } } + , name = "MyType" + , qualifier = "Main.Module" + , args = [] + } + ) + , test "Qualified Type (wtih args)" <| \_ -> + Parser.run PT.expression "Main.Module.MyType msg" + |> expectExpression + (AST.TTypeQual + { varRegion = { start = { row = 1, col = 1 }, end = { row = 1, col = 19 } } + , name = "MyType" + , qualifier = "Main.Module" + , args = + [ SourcePosition.at + { row = 1, col = 20 } + { row = 1, col = 23 } + (AST.TVar "msg") + ] + } + ) + , test "Type variable" <| \_ -> + Parser.run PT.expression "msg" + |> expectExpression + (AST.TVar "msg") + , test "Parenthesized" <| \_ -> + Parser.run PT.expression "(a)" + |> expectExpression + (AST.TParens <| + SourcePosition.at + { row = 1, col = 2 } + { row = 1, col = 3 } + (AST.TVar "a") + ) + , test "Empty Record" <| \_ -> + Parser.run PT.expression "{ }" + |> expectExpression + (AST.TRecord + { fields = [] + , extending = Nothing + } + ) + , test "Record with one field" <| \_ -> + Parser.run PT.expression "{ hello : String }" + |> expectExpression + (AST.TRecord + { fields = + [ { field = + SourcePosition.at + { row = 1, col = 3 } + { row = 1, col = 8 } + "hello" + , signature = + SourcePosition.at + { row = 1, col = 11 } + { row = 1, col = 17 } + (AST.TType + { args = [] + , name = + SourcePosition.at + { row = 1, col = 11 } + { row = 1, col = 17 } + "String" + } + ) + } + ] + , extending = Nothing + } + ) + , test "Record with two fields" <| \_ -> + Parser.run PT.expression "{ hello : String, person : String }" + |> expectExpression + (AST.TRecord + { fields = + [ { field = + SourcePosition.at + { row = 1, col = 3 } + { row = 1, col = 8 } + "hello" + , signature = + SourcePosition.at + { row = 1, col = 11 } + { row = 1, col = 17 } + (AST.TType + { args = [] + , name = + SourcePosition.at + { row = 1, col = 11 } + { row = 1, col = 17 } + "String" + } + ) + } + , { field = + SourcePosition.at + { row = 1, col = 19 } + { row = 1, col = 25 } + "person" + , signature = + SourcePosition.at + { row = 1, col = 28 } + { row = 1, col = 34 } + (AST.TType + { args = [] + , name = + SourcePosition.at + { row = 1, col = 28 } + { row = 1, col = 34 } + "String" + } + ) + } + ] + , extending = Nothing + } + ) + , test "Record update with two fields" <| \_ -> + Parser.run PT.expression "{ rec | hello : String, person : String }" + |> expectExpression + (AST.TRecord + { fields = + [ { field = + SourcePosition.at + { row = 1, col = 9 } + { row = 1, col = 14 } + "hello" + , signature = + SourcePosition.at + { row = 1, col = 17 } + { row = 1, col = 23 } + (AST.TType + { args = [] + , name = + SourcePosition.at + { row = 1, col = 17 } + { row = 1, col = 23 } + "String" + } + ) + } + , { field = + SourcePosition.at + { row = 1, col = 25 } + { row = 1, col = 31 } + "person" + , signature = + SourcePosition.at + { row = 1, col = 34 } + { row = 1, col = 40 } + (AST.TType + { args = [] + , name = + SourcePosition.at + { row = 1, col = 34 } + { row = 1, col = 40 } + "String" + } + ) + } + ] + , extending = + Just <| + SourcePosition.at + { row = 1, col = 3 } + { row = 1, col = 6 } + "rec" + } + ) + , test "Lambda" <| \_ -> + Parser.run PT.expression "a -> b -> c" + |> expectExpression + (AST.TLambda + { from = + SourcePosition.at + { row = 1, col = 1 } + { row = 1, col = 2 } + (AST.TVar "a") + , to = + SourcePosition.at + { row = 1, col = 6 } + { row = 1, col = 12 } + (AST.TLambda + { from = + SourcePosition.at + { row = 1, col = 6 } + { row = 1, col = 7 } + (AST.TVar "b") + , to = + SourcePosition.at + { row = 1, col = 11 } + { row = 1, col = 12 } + (AST.TVar "c") + } + ) + } + ) + ] + + +expectExpression : a -> Result (Array (Parser.DeadEnd c e)) (SourcePosition.Located a) -> Expectation +expectExpression expected result = + when result is + Err err -> + Expect.fail (Debug.toString err) + + Ok { value } -> + Expect.equal expected value diff --git a/tests/src/Test/Parse/Variable.gren b/tests/src/Test/Parse/Variable.gren new file mode 100644 index 0000000..c5e0fd2 --- /dev/null +++ b/tests/src/Test/Parse/Variable.gren @@ -0,0 +1,90 @@ +module Test.Parse.Variable exposing ( tests ) + +import Expect exposing (Expectation) +import Test exposing (Test, describe, test) +import Parser.Advanced as Parser +import Parse.Variable as PV +import Set + + +tests : Test +tests = + describe "Parse.Variable" + [ describe "Lower case" + [ test "Simple case" <| \_ -> + Parser.run PV.lowerCase "myvar" + |> Expect.equal (Ok "myvar") + , test "unicode" <| \_ -> + Parser.run PV.lowerCase "åberg albert" + |> Expect.equal (Ok "åberg") + , test "underscore" <| \_ -> + Parser.run PV.lowerCase "my_var" + |> Expect.equal (Ok "my_var") + , test "with unicode, upper case, digits and underscore" <| \_ -> + Parser.run PV.lowerCase "miN_1_Øse" + |> Expect.equal (Ok "miN_1_Øse") + , test "no emojis" <| \_ -> + Parser.run PV.lowerCase "hey🫵" + |> Expect.equal (Ok "hey") + , test "cannot start with digit" <| \_ -> + Parser.run PV.lowerCase "1month" + |> expectErr PV.InvalidCharacter + , test "cannot start with upper case" <| \_ -> + Parser.run PV.lowerCase "Month" + |> expectErr PV.InvalidCharacter + , test "refuses to parse reserved words" <| \_ -> + Set.toArray PV.reservedWords + |> Array.map (Parser.run PV.lowerCase) + |> Result.firstOk + |> Expect.equal Nothing + ] + , describe "Upper case" + [ test "Simple case" <| \_ -> + Parser.run PV.upperCase "Myvar" + |> Expect.equal (Ok "Myvar") + , test "unicode" <| \_ -> + Parser.run PV.upperCase "Åberg albert" + |> Expect.equal (Ok "Åberg") + , test "underscore" <| \_ -> + Parser.run PV.upperCase "My_var" + |> Expect.equal (Ok "My_var") + , test "with unicode, upper case, digits and underscore" <| \_ -> + Parser.run PV.upperCase "MiN_1_Øse" + |> Expect.equal (Ok "MiN_1_Øse") + , test "no emojis" <| \_ -> + Parser.run PV.upperCase "Hey🫵" + |> Expect.equal (Ok "Hey") + , test "cannot start with digit" <| \_ -> + Parser.run PV.upperCase "1month" + |> expectErr PV.InvalidCharacter + , test "cannot start with lower case" <| \_ -> + Parser.run PV.upperCase "month" + |> expectErr PV.InvalidCharacter + ] + , describe "Possibly qualified upper" + [ test "Unqualified" <| \_ -> + Parser.run PV.foreignUpper "Upper" + |> Expect.equal (Ok (PV.Unqualified "Upper")) + , test "Qualified" <| \_ -> + Parser.run PV.foreignUpper "My.Upper" + |> Expect.equal (Ok (PV.Qualified { module_ = "My", name = "Upper" })) + , test "Qualified (2)" <| \_ -> + Parser.run PV.foreignUpper "My.Nested.Upper" + |> Expect.equal (Ok (PV.Qualified { module_ = "My.Nested", name = "Upper" })) + ] + ] + + +expectErr : PV.Error -> Result (Array (Parser.DeadEnd c PV.Error)) String -> Expectation +expectErr expected result = + when result is + Ok _ -> + Expect.fail "Expected error" + + Err problems -> + when Array.first problems is + Just firstProblem -> + Expect.equal expected firstProblem.problem + + Nothing -> + Expect.fail "Failed, but with no problems..." diff --git a/tests/src/Test/String/EditDistance.gren b/tests/src/Test/String/EditDistance.gren index 36d9da8..867ec39 100644 --- a/tests/src/Test/String/EditDistance.gren +++ b/tests/src/Test/String/EditDistance.gren @@ -1,5 +1,4 @@ -module Test.String.EditDistance exposing - ( tests ) +module Test.String.EditDistance exposing ( tests ) import Expect exposing (Expectation) import Test exposing (Test, describe, test)