{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TypeFamilies #-}
module Nirum.ParserSpec where

import Control.Monad (forM_)
import Data.Either
import Data.List (isSuffixOf)
import Data.Maybe (fromJust)
import System.Directory (getDirectoryContents)

import qualified Data.ByteString as B
import qualified Data.List.NonEmpty as NE
import Data.String.QQ (s)
import qualified Data.Text as T
import qualified Data.Text.Encoding as E
import Test.Hspec.Meta
import Text.Megaparsec (eof, runParser)
import Text.Megaparsec.Char (string)
import Text.Megaparsec.Error (errorPos, parseErrorPretty)
import Text.Megaparsec.Pos (Pos, SourcePos (sourceColumn, sourceLine), mkPos)

import qualified Nirum.Parser as P
import Nirum.Parser (Parser, ParseError)
import Nirum.Constructs (Construct (toCode))
import Nirum.Constructs.Annotation as A
import Nirum.Constructs.Annotation.Internal hiding (Text)
import qualified Nirum.Constructs.Annotation.Internal as AI
import Nirum.Constructs.Docs (Docs (Docs))
import Nirum.Constructs.DeclarationSet (DeclarationSet)
import Nirum.Constructs.DeclarationSetSpec (SampleDecl (..))
import Nirum.Constructs.Identifier (Identifier, fromText)
import Nirum.Constructs.Module (Module (Module))
import Nirum.Constructs.Name (Name (..))
import Nirum.Constructs.Service ( Method (Method)
                                , Parameter (Parameter)
                                , Service (Service)
                                )
import Nirum.Constructs.TypeDeclaration as TD hiding (tags)
import Nirum.Constructs.TypeExpression ( TypeExpression ( ListModifier
                                                        , MapModifier
                                                        , OptionModifier
                                                        , SetModifier
                                                        , TypeIdentifier
                                                        )
                                       )
import Util (singleDocs)

shouldBeRight :: (Eq l, Eq r, Show l, Show r) => Either l r -> r -> Expectation
shouldBeRight actual expected = actual `shouldBe` Right expected

erroredPos :: Either ParseError a -> (Pos, Pos)
erroredPos left =
    (sourceLine pos, sourceColumn pos)
  where
    error' = head $ lefts [left] :: ParseError
    pos = NE.head (errorPos error') :: SourcePos

helperFuncs :: (Show a)
            => Parser a
            -> ( T.Text -> Either ParseError a
               , T.Text -> Int -> Int -> Expectation
               )
helperFuncs parser =
    (parse', expectError)
  where
    parserAndEof = do
        r <- parser
        eof
        return r
    parse' = runParser parserAndEof ""
    expectError inputString line col = do
        let parseResult = parse' inputString
            line' = mkPos line
            col' = mkPos col
        parseResult `shouldSatisfy` isLeft
        let Left parseError = parseResult
            msg = parseErrorPretty parseError
        -- msg is just for debug print
        (erroredPos parseResult, msg) `shouldBe` ((line', col'), msg)


fooAnnotationSet :: AnnotationSet
fooAnnotationSet = A.singleton $ Annotation "foo" [("v", AI.Text "bar")]

bazAnnotationSet :: AnnotationSet
bazAnnotationSet = A.singleton $ Annotation "baz" []


spec :: Spec
spec = do
    describe "identifier" $ do
        let (parse', expectError) = helperFuncs P.identifier
        it "fails to parse an empty string" $
            expectError "" 1 1
        it "fails to parse an identifier starting with hyphen/underscore" $ do
            expectError "-ident" 1 1
            expectError "-ident-ifier" 1 1
            expectError "_ident" 1 1
            expectError "_ident_ifier" 1 1
            expectError "_ident-ifier" 1 1
            expectError "-ident_ifier" 1 1
        it "fails to parse an identifier ending with hyphen/underscore" $ do
            expectError "ident-" 1 7
            expectError "ident-ifier-" 1 13
            expectError "ident_" 1 7
            expectError "ident_ifier_" 1 13
            expectError "ident_ifier-" 1 13
            expectError "ident-ifier_" 1 13
        it "fails to parse an identifier with double hyphens/underscores" $ do
            expectError "ident--ifier" 1 7
            expectError "ident__ifier" 1 7
            expectError "ident-_ifier" 1 7
            expectError "ident_-ifier" 1 7
        it "fails to parse an identifier containing disallowed chars" $ do
            expectError "\xbb34\xd6a8\xd55c-\xc2dd\xbcc4\xc790" 1 1
            expectError "invalid-\xc2dd\xbcc4\xc790" 1 9
        let keywords = [ "enum", "record", "type", "unboxed", "union"
                       , "Enum", "rEcord", "tyPE", "UNBOXED", "unioN"
                       ] :: [T.Text]
        it "fails to parse bare identifier if it's a reserved keyword" $
            forM_ keywords $ \ kwd ->
                expectError kwd 1 1
        let identifier' = fromJust . fromText
        it "emits Identifier if succeeded to parse" $ do
            parse' "identifier" `shouldBeRight` identifier' "identifier"
            parse' "valid-identifier" `shouldBeRight`
                identifier' "valid-identifier"
            parse' "valid_identifier" `shouldBeRight`
                identifier' "valid_identifier"
        it "can parse even if a keyword is a prefix of identifier" $ do
            parse' "enumeration" `shouldBeRight` identifier' "enumeration"
            parse' "types" `shouldBeRight` identifier' "types"
        it "can parse reserved keywords iff they are quoted" $
            forM_ keywords $ \ kwd ->
                parse' ('`' `T.cons` kwd `T.snoc` '`') `shouldBeRight`
                    identifier' kwd

    describe "name" $ do
        let (parse', expectError) = helperFuncs P.name
        it "fails to parse an empty string" $
            expectError "" 1 1
        it "fails to parse if the name is not a valid identifier" $ do
            expectError "-ident" 1 1
            expectError "-ident-ifier" 1 1
            expectError "ident-" 1 7
            expectError "ident-ifier-" 1 13
            expectError "ident--ifier" 1 7
            expectError "ident__ifier" 1 7
            expectError "\xbb34\xd6a8\xd55c-\xc2dd\xbcc4\xc790" 1 1
            expectError "invalid-\xc2dd\xbcc4\xc790" 1 9
        it "fails to parse if the facial name is not a valid identifier" $ do
            expectError "-ident/valid" 1 1
            expectError "-ident-ifier/valid" 1 1
            expectError "ident-/valid" 1 7
            expectError "ident-ifier-/valid" 1 13
            expectError "ident--ifier/valid" 1 7
            expectError "ident__ifier/valid" 1 7
            expectError "\xbb34\xd6a8\xd55c-\xc2dd\xbcc4\xc790/valid" 1 1
            expectError "invalid-\xc2dd\xbcc4\xc790/valid" 1 9
        it "fails to parse if the behind name is not a valid identifier" $ do
            expectError "valid/-ident" 1 6
            expectError "valid/-ident-ifier" 1 6
            expectError "valid/ident-" 1 6
            expectError "valid/ident-ifier-" 1 6
            expectError "valid/ident--ifier" 1 6
            expectError "valid/ident__ifier" 1 6
            expectError "valid/\xbb34\xd6a8\xd55c-\xc2dd\xbcc4\xc790" 1 6
            expectError "valid/invalid-\xc2dd\xbcc4\xc790" 1 6
        it "emits Name if succeeded to parse" $ do
            parse' "name" `shouldBeRight` Name "name" "name"
            parse' "`enum`" `shouldBeRight` Name "enum" "enum"
            parse' "facial/behind" `shouldBeRight` Name "facial" "behind"
            parse' "facial / behind" `shouldBeRight` Name "facial" "behind"
            parse' "`enum`/`unboxed`" `shouldBeRight` Name "enum" "unboxed"
            parse' "`enum` / `unboxed`" `shouldBeRight` Name "enum" "unboxed"

    describe "annotation" $ do
        let (parse', expectError) = helperFuncs P.annotation
        context "with single argument" $ do
            let rightAnnotaiton =
                    Annotation "name-abc" [("foo", AI.Text "wo\"rld")]
            let rightIntAnnotation =
                    Annotation "name-abc" [("foo", Integer 1)]
            it "success" $ do
                parse' "@name-abc(foo=\"wo\\\"rld\")"
                    `shouldBeRight` rightAnnotaiton
                parse' "@name-abc( foo=\"wo\\\"rld\")"
                    `shouldBeRight` rightAnnotaiton
                parse' "@name-abc(foo=\"wo\\\"rld\" )"
                    `shouldBeRight` rightAnnotaiton
                parse' "@name-abc( foo=\"wo\\\"rld\" )"
                    `shouldBeRight` rightAnnotaiton
                parse' "@ name-abc ( foo=\"wo\\\"rld\")"
                    `shouldBeRight` rightAnnotaiton
                parse' "@name-abc ( foo=\"wo\\\"rld\")"
                    `shouldBeRight` rightAnnotaiton
                parse' "@name-abc(foo=\"wo\\\"rld\\n\")" `shouldBeRight`
                    Annotation "name-abc" [("foo", AI.Text "wo\"rld\n")]
                parse' "@name-abc(foo=1)" `shouldBeRight` rightIntAnnotation
                parse' "@name-abc( foo=1)" `shouldBeRight` rightIntAnnotation
                parse' "@name-abc(foo=1 )" `shouldBeRight` rightIntAnnotation
                parse' "@name-abc( foo=1 )" `shouldBeRight` rightIntAnnotation
            it "fails to parse if annotation name start with hyphen" $ do
                expectError "@-abc(v=\"helloworld\")" 1 2
                expectError "@-abc-d(v = \"helloworld\")" 1 2
            it "fails to parse without parentheses" $
                expectError "@foobar \"helloworld\"" 1 9
            it "fails to parse arguments without names" $
                expectError "@foobar(\"helloworld\")" 1 9
            it "fails to parse arguments without double quotes" $
                expectError "@foobar(v=helloworld)" 1 11
        context "without arguments" $ do
            let rightAnnotaiton = Annotation "name-abc" []
            it "success" $ do
                parse' "@name-abc" `shouldBeRight` rightAnnotaiton
                parse' "@name-abc " `shouldBeRight` rightAnnotaiton
                parse' "@ name-abc" `shouldBeRight` rightAnnotaiton
                parse' "@name-abc()" `shouldBeRight` rightAnnotaiton
                parse' "@name-abc ( )" `shouldBeRight` rightAnnotaiton
                parse' "@ name-abc ( )" `shouldBeRight` rightAnnotaiton
            it "fails to parse if annotation name start with hyphen" $ do
                expectError "@-abc" 1 2
                expectError "@-abc-d" 1 2

    describe "annotationSet" $ do
        let (parse', expectError) = helperFuncs P.annotationSet
            Right annotationSet = fromList
                [ Annotation "a" [("arg", AI.Text "b")]
                , Annotation "c" []
                ]
        it "success" $ do
            parse' "@a(arg=\"b\")@c" `shouldBeRight` annotationSet
            parse' "@a(arg=\"b\") @c" `shouldBeRight` annotationSet
            parse' "@a(arg=\"b\") @c() " `shouldBeRight` annotationSet
        it "fails to parse if has duplicated name" $
            expectError "@a(arg=\"b\")@a" 1 14

    describe "typeIdentifier" $ do
        let (parse', expectError) = helperFuncs P.typeIdentifier
        it "fails to parse if the input is not a valid identifier" $
            expectError "-invalid-type-identifier" 1 1
        it "emits TypeIdentifier if succeeded to parse" $ do
            parse' "text" `shouldBeRight` TypeIdentifier "text"
            parse' "uuid" `shouldBeRight` TypeIdentifier "uuid"

    describe "optionModifier" $ do
        let (_, expectError') = helperFuncs P.optionModifier
        it "fails to parse if the input lacks a question mark" $
            expectError' "lacks-qmark" 1 12
        let parsers = [ P.optionModifier
                      , P.typeExpression
                      ] :: [Parser TypeExpression]
        forM_ parsers $ \ parser' -> do
            let (parse', expectError) = helperFuncs parser'
            it "cannot append two or more option modifiers" $ do
                expectError "text??" 1 6
                expectError "text???" 1 6
                expectError "text????" 1 6
            it "emits OptionModifier if succeeded to parse" $ do
                parse' "text?" `shouldBeRight`
                    OptionModifier (TypeIdentifier "text")
                parse' "uuid ?" `shouldBeRight`
                    OptionModifier (TypeIdentifier "uuid")
                parse' "{text}?" `shouldBeRight`
                    OptionModifier (SetModifier $ TypeIdentifier "text")
            it "can be appended to set modifier" $
                parse' "{text}?" `shouldBeRight`
                    OptionModifier (SetModifier $ TypeIdentifier "text")

    describe "setModifier" $ do
        let parsers = [ (1, P.setModifier)
                      , (29, P.typeExpression)
                      ] :: [(Int, Parser TypeExpression)]
        forM_ parsers $ \ (beginErrorPos, parser') -> do
            let (parse', expectError) = helperFuncs parser'
            it "fails to parse if input doesn't start with a curly bracket" $
                expectError "not-start-with-curly-bracket}" 1 beginErrorPos
            it "fails to parse if input doesn't end with a curly bracket" $
                expectError "{not-end-with-curly-bracket" 1 28
            it "emits SetModifier if succeeded to parse" $ do
                parse' "{text}" `shouldBeRight`
                    SetModifier (TypeIdentifier "text")
                parse' "{ uuid }" `shouldBeRight`
                    SetModifier (TypeIdentifier "uuid")
            it "can be nested to represent 2d set" $ do
                parse' "{{text}}" `shouldBeRight`
                    SetModifier (SetModifier $ TypeIdentifier "text")
                parse' "{[text]}" `shouldBeRight`
                    SetModifier (ListModifier $ TypeIdentifier "text")
            it "can consist of optional elements" $
                parse' "{uuid?}" `shouldBeRight`
                    SetModifier (OptionModifier $ TypeIdentifier "uuid")

    describe "listModifier" $ do
        let parsers = [ (1, P.listModifier)
                      , (30, P.typeExpression)
                      ] :: [(Int, Parser TypeExpression)]
        forM_ parsers $ \ (beginErrorPos, parser') -> do
            let (parse', expectError) = helperFuncs parser'
            it "fails to parse if input doesn't start with a square bracket" $
                expectError "not-start-with-square-bracket]" 1 beginErrorPos
            it "fails to parse if input doesn't end with a square bracket" $
                expectError "[not-end-with-square-bracket" 1 29
            it "emits ListModifier if succeeded to parse" $ do
                parse' "[text]" `shouldBeRight`
                    ListModifier (TypeIdentifier "text")
                parse' "[ uuid ]" `shouldBeRight`
                    ListModifier (TypeIdentifier "uuid")
            it "can be nested to represent 2d list" $ do
                parse' "[[text]]" `shouldBeRight`
                    ListModifier (ListModifier $ TypeIdentifier "text")
                parse' "[{text}]" `shouldBeRight`
                    ListModifier (SetModifier $ TypeIdentifier "text")
            it "can consist of optional elements" $
                parse' "[uuid?]" `shouldBeRight`
                    ListModifier (OptionModifier $ TypeIdentifier "uuid")

    describe "mapModifier" $ do
        let parsers = [ (1, P.mapModifier)
                      , (15, P.typeExpression)
                      ] :: [(Int, Parser TypeExpression)]
        forM_ parsers $ \ (beginErrorPos, parser') -> do
            let (parse', expectError) = helperFuncs parser'
            it "fails to parse if input doesn't start with a curly bracket" $
                expectError "not-start-with: curly-bracket}" 1 beginErrorPos
            it "fails to parse if input doesn't end with a curly bracket" $
                expectError "{not-end-with: curly-bracket" 1 29
            it "emits MapModifier if succeeded to parse" $ do
                parse' "{uuid: text}" `shouldBeRight`
                    MapModifier (TypeIdentifier "uuid") (TypeIdentifier "text")
                parse' "{ text : uuid }" `shouldBeRight`
                    MapModifier (TypeIdentifier "text") (TypeIdentifier "uuid")
            it "can be nested to represent 2d map" $ do
                parse' "{uuid: {uuid: text}}" `shouldBeRight`
                    MapModifier (TypeIdentifier "uuid")
                                (MapModifier (TypeIdentifier "uuid")
                                             (TypeIdentifier "text"))
                parse' "{uuid: [text]}" `shouldBeRight`
                    MapModifier (TypeIdentifier "uuid")
                                (ListModifier $ TypeIdentifier "text")

    describe "typeExpression" $ do
        let (_, expectError) = helperFuncs P.typeExpression
        it "cannot append two or more option modifiers" $ do
            expectError "text??" 1 6
            expectError "text???" 1 6
            expectError "text????" 1 6

    describe "docs" $ do
        let (parse', expectError) = helperFuncs P.docs
        it "emits Docs if succeeded to parse" $ do
            parse' "#docs" `shouldBeRight` Docs "docs\n"
            parse' "#docs\n#docs..." `shouldBeRight` Docs "docs\ndocs...\n"
        it "may ignore a leading space" $ do
            parse' "# docs" `shouldBeRight` Docs "docs\n"
            parse' "# docs\n# docs..." `shouldBeRight` Docs "docs\ndocs...\n"
            parse' "#  docs" `shouldBeRight` Docs " docs\n"
            parse' "#  docs\n#  docs..." `shouldBeRight`
                Docs " docs\n docs...\n"
        it "may be mixed with whitespaces" $ do
            parse' "# docs\n\n# docs..." `shouldBeRight` Docs "docs\ndocs...\n"
            parse' "# docs\n    # docs..." `shouldBeRight`
                Docs "docs\ndocs...\n"
        it "differs from comment" $
            expectError "// comment" 1 1

    let descTypeDecl label parser spec' =
            let parsers =
                    [ (label, parser)
                    , (label ++ " (typeDescription)", P.typeDeclaration)
                    ] :: [(String, [Identifier] -> Parser TypeDeclaration)]
            in forM_ parsers $ \ (label', parser') ->
                describe label' $
                    spec' $ helperFuncs $ parser' []

    describe "handleNameDuplication" $ do
        let cont dset = do
                _ <- string "a"
                return dset :: Parser (DeclarationSet SampleDecl)
        it "fails if there are any duplication on facial names" $ do
            let ds = [ "a"
                     , "b"
                     , SampleDecl (Name "b" "c") A.empty
                     ] :: [SampleDecl]
                p = P.handleNameDuplication "LABEL" ds cont
                (parse', expectError) = helperFuncs p
            expectError "a" 1 1
            let (Left e) = parse' "a"
            parseErrorPretty e `shouldBe`
                "1:1:\nthe facial LABEL name `b` is duplicated\n"
        it "fails if there are any duplication on behind names" $ do
            let ds = [ "a"
                     , "b"
                     , SampleDecl (Name "c" "b") A.empty
                     ] :: [SampleDecl]
                p = P.handleNameDuplication "LABEL" ds cont
                (parse', expectError) = helperFuncs p
            expectError "a" 1 1
            let (Left e) = parse' "a"
            parseErrorPretty e `shouldBe`
                "1:1:\nthe behind LABEL name `b` is duplicated\n"
        it "continues using the given DeclarationSet if there are no dups" $ do
            let ds = ["a", "b", "c"] :: [SampleDecl]
                p = P.handleNameDuplication "LABEL" ds cont
                (parse', _) = helperFuncs p
            parse' "a" `shouldBeRight`
                (["a", "b", "c"] :: DeclarationSet SampleDecl)

    descTypeDecl "aliasTypeDeclaration" P.aliasTypeDeclaration $ \ helpers -> do
        let (parse', expectError) = helpers
        it "emits (TypeDeclaration (Alias ...)) if succeeded to parse" $ do
            parse' "type path = text;" `shouldBeRight`
                TypeDeclaration "path" (Alias "text") empty
            parse' "type path = text;\n# docs" `shouldBeRight`
                TypeDeclaration "path" (Alias "text")
                                (singleDocs "docs\n")
            parse' "type path = text;\n# docs\n# docs..." `shouldBeRight`
                TypeDeclaration "path" (Alias "text")
                                (singleDocs "docs\ndocs...\n")
            parse' "@foo ( v = \"bar\" ) type path = text;\n# docs\n# docs..."
                `shouldBeRight`
                TypeDeclaration "path" (Alias "text")
                                (A.union (singleDocs "docs\ndocs...\n")
                                         fooAnnotationSet)
            parse' "@baz  type path = text;\n# docs\n# docs..."
                `shouldBeRight`
                TypeDeclaration "path" (Alias "text")
                                (A.union (singleDocs "docs\ndocs...\n")
                                         bazAnnotationSet)
        specify ("its name can't have behind name since " ++
                 "its canonical type's behind name would be used instead") $
            expectError "type path/error = text;" 1 10
        it "fails to parse if trailing semicolon is missing" $ do
            let (_, expectErr) = helperFuncs P.module'
            expectErr "type a = text;\ntype b = text\ntype c = text;" 3 1
            expectErr "unboxed a (text);\ntype b = text\nunboxed c (text);" 3 1
            expectErr "type a = text;\nunboxed b (text)\ntype c = text;" 3 1

    descTypeDecl "unboxedTypeDeclaration"
                 P.unboxedTypeDeclaration $ \ funs -> do
        let (parse', expectError) = funs
        it "emits (TypeDeclaration (UnboxedType ..)) if succeeded to parse" $ do
            parse' "unboxed offset (float64);" `shouldBeRight`
                TypeDeclaration "offset" (UnboxedType "float64") empty
            parse' "unboxed offset (float64);\n# docs" `shouldBeRight`
                TypeDeclaration "offset" (UnboxedType "float64")
                                (singleDocs "docs\n")
            parse' "unboxed offset (float64);\n# docs\n# docs..."
                `shouldBeRight`
                    TypeDeclaration "offset" (UnboxedType "float64")
                                    (singleDocs "docs\ndocs...\n")
            parse' "@foo(v=\"bar\")\nunboxed offset (float64);\n# docs\n\
                   \# docs..."
                `shouldBeRight`
                    TypeDeclaration "offset" (UnboxedType "float64")
                                    (A.union (singleDocs "docs\ndocs...\n")
                                             fooAnnotationSet)
            parse' "@baz\nunboxed offset (float64);\n# docs\n# docs..."
                `shouldBeRight`
                    TypeDeclaration "offset" (UnboxedType "float64")
                                    (A.union (singleDocs "docs\ndocs...\n")
                                             bazAnnotationSet)
            expectError "unboxed offset/behind (float64);" 1 15
        it "fails to parse if trailing semicolon is missing" $ do
            let (_, expectErr) = helperFuncs P.module'
            expectErr "unboxed a (text);\nunboxed b (text)\nunboxed c (text);"
                      3 1
            expectErr "type a = text;\nunboxed b (text)\ntype c = text;" 3 1
            expectErr "unboxed a (text);\ntype b = text\nunboxed c (text);" 3 1

    descTypeDecl "enumTypeDeclaration" P.enumTypeDeclaration $ \ helpers -> do
        let (parse', expectError) = helpers
        it "emits (TypeDeclaration (EnumType ...)) if succeeded to parse" $ do
            let members' = [ "male"
                           , "female"
                           , "unknown"
                           ] :: DeclarationSet EnumMember
                membersWithDocs = [ EnumMember "male" (singleDocs "docs\n")
                                  , "female"
                                  , EnumMember "unknown" (singleDocs "docs2\n")
                                  ] :: DeclarationSet EnumMember
                membersWithAnnots = [ EnumMember "male" fooAnnotationSet
                                    , "female"
                                    , "unknown"
                                    ] :: DeclarationSet EnumMember
                expected = TypeDeclaration "gender" (EnumType members') empty
            parse' "enum gender = male | female | unknown;"
                `shouldBeRight` expected
            parse' "enum gender=male|female|unknown;" `shouldBeRight` expected
            -- forward docs of enum type
            parse' "enum gender\n# gender type\n= male | female | unknown;"
                `shouldBeRight`
                    expected { typeAnnotations = singleDocs "gender type\n" }
            -- backward docs of enum type
            parse' "enum gender =\n# gender type\nmale | female | unknown;"
                `shouldBeRight`
                    expected { typeAnnotations = singleDocs "gender type\n" }
            parse' "enum gender = male # docs\n| female | unknown # docs2\n;"
                `shouldBeRight` TypeDeclaration "gender"
                                                (EnumType membersWithDocs)
                                                empty
            parse' "@foo (v = \"bar\")\nenum gender=male|female|unknown;"
                `shouldBeRight`
                    TypeDeclaration "gender" (EnumType members')
                                    fooAnnotationSet
            parse' "@baz\nenum gender=male|female|unknown;"
                `shouldBeRight`
                    TypeDeclaration "gender" (EnumType members')
                                    bazAnnotationSet
            parse' "@baz\nenum gender=\n@foo (v=\"bar\")\nmale|female|unknown;"
                `shouldBeRight`
                    TypeDeclaration "gender" (EnumType membersWithAnnots)
                                    bazAnnotationSet
        it "fails to parse if there are duplicated facial names" $
            expectError [s|
enum dup = a/b
         | b/c
         | a/d
         ;|] 4 10
        it "fails to parse if there are duplicated behind names" $
            expectError [s|
enum dup = a/b
         | b/c
         | c/b
         ;|] 4 10
        it "fails to parse if trailing semicolon is missing" $ do
            let (_, expectErr) = helperFuncs P.module'
            expectErr "enum a = a1 | a2;\nenum b = b1 | y\nenum c = c1 | c2;"
                      3 1
            expectErr "unboxed a (text);\nenum b = x | y\nunboxed c (text);" 3 1
            expectErr "enum a = x | y;\nunboxed b (text)\nenum c = c1 | c2;" 3 1

    descTypeDecl "recordTypeDeclaration"
                 P.recordTypeDeclaration $ \ helpers -> do
        let (parse', expectError) = helpers
        it "emits (TypeDeclaration (RecordType ...)) if succeeded to parse" $ do
            let nameF = Field "name" "text" empty
                dobF = Field "dob" "date" (singleDocs "date of birth")
                genderF = Field "gender" "gender" empty
                fields' = [nameF, dobF, genderF] :: DeclarationSet Field
                record = RecordType fields'
                a = TypeDeclaration "person" record empty
                b = a { typeAnnotations = singleDocs "person record type" }
            -- without docs, last field with trailing comma
            parse' [s|
record person (
    text name,
    date dob,
    # date of birth
    gender gender,
);|] `shouldBeRight` a
            -- without docs, last field without trailing comma
            parse' [s|
record person (
    text name,
    date dob,
    # date of birth
    gender gender
);|] `shouldBeRight` a
            -- with docs, last field with trailing comma
            parse' [s|
record person (
    # person record type

    text name,
    date dob,
    # date of birth
    gender gender,
);|] `shouldBeRight` b
            -- with docs, last field without trailing comma
            parse' [s|
record person (
    # person record type

    text name,
    date dob,
    # date of birth
    gender gender
);|] `shouldBeRight` b
            -- without docs, last field with trailing comma,
            -- with annotation with single argument
            parse' [s|
@foo(v = "bar")
record person (
    text name,
    date dob,
    # date of birth
    gender gender,
);|] `shouldBeRight`
                TypeDeclaration "person" record fooAnnotationSet
            -- without docs, last field with trailing comma,
            -- with annotation without arguments
            parse' [s|
@baz
record person (
    text name,
    date dob,
    # date of birth
    gender gender,
);|] `shouldBeRight`
                TypeDeclaration "person" record bazAnnotationSet
            -- with docs, last field with trailing comma,
            -- and annotation without arguments
            parse' [s|
@baz
record person (
    # person record type

    text name,
    date dob,
    # date of birth
    gender gender,
);|] `shouldBeRight`
                    TypeDeclaration "person" record
                        (union bazAnnotationSet $
                                singleDocs "person record type")
            -- without docs, last field with trailing comma,
            -- and annotations on fields
            parse' [s|
record person (
    text name,
    @foo (v = "bar")
    date dob,
    # date of birth
    @baz
    gender gender,
);|] `shouldBeRight`
                    TypeDeclaration "person" (RecordType
                        [ nameF
                        , dobF { fieldAnnotations = union fooAnnotationSet $
                                     singleDocs "date of birth"
                               }
                        , genderF { fieldAnnotations = bazAnnotationSet }
                        ]) empty
        it "should have one or more fields" $ do
            expectError "record unit ();" 1 14
            expectError "record unit (\n# docs\n);" 3 1
        it "fails to parse if there are duplicated facial names" $
            expectError [s|
record dup (
    text a/b,
    text b/c,
    text a/d,
);|] 5 1
        it "fails to parse if there are duplicated behind names" $
            expectError [s|
record dup (
    text a/b,
    text b/c,
    text c/b,
);|] 5 1
        it "fails to parse if there's no space between field type and name" $ do
            expectError "record a (texta);" 1 16
            expectError "record a (textb\n#docs\n);" 2 1
        it "fails to parse if trailing semicolon is missing" $ do
            let (_, expectErr) = helperFuncs P.module'
            expectErr
                "record a (text x);\nrecord b (text y)\nrecord c (text z);"
                3 1
            expectErr "type a = text;\nrecord b (text x)\ntype c = text;" 3 1
            expectErr "record a (text x);\ntype b = text\nrecord c (text y);"
                      3 1

    descTypeDecl "unionTypeDeclaration" P.unionTypeDeclaration $ \ helpers -> do
        let (parse', expectError) = helpers
        it "has defaultTag" $ do
            let cOriginF = Field "origin" "point" empty
                cRadiusF = Field "radius" "offset" empty
                circleFields = [cOriginF, cRadiusF]
                rUpperLeftF = Field "upper-left" "point" empty
                rLowerRightF = Field "lower-right" "point" empty
                rectangleFields = [rUpperLeftF, rLowerRightF]
                circleTag = Tag "circle" circleFields empty
                rectTag = Tag "rectangle" rectangleFields empty
                tags' = [circleTag]
                Right union' = unionType tags' $ Just rectTag
                a = TypeDeclaration "shape" union' empty
            parse' [s|
union shape
    = circle (point origin, offset radius,)
    | default rectangle (point upper-left, point lower-right,)
    ;|] `shouldBeRight` a
        it "emits (TypeDeclaration (UnionType ...)) if succeeded to parse" $ do
            let cOriginF = Field "origin" "point" empty
                cRadiusF = Field "radius" "offset" empty
                circleFields = [cOriginF, cRadiusF]
                rUpperLeftF = Field "upper-left" "point" empty
                rLowerRightF = Field "lower-right" "point" empty
                rectangleFields = [rUpperLeftF, rLowerRightF]
                circleTag = Tag "circle" circleFields empty
                rectTag = Tag "rectangle" rectangleFields empty
                noneTag = Tag "none" [] empty
                tags' = [circleTag, rectTag, noneTag]
                Right union' = unionType tags' Nothing
                a = TypeDeclaration "shape" union' empty
                b = a { typeAnnotations = singleDocs "shape type" }
            parse' [s|
union shape
    = circle (point origin, offset radius,)
    | rectangle (point upper-left, point lower-right,)
    | none
    ;|] `shouldBeRight` a
            parse' [s|
union shape
    = circle (
        point origin,
        offset radius,
      )
    | rectangle (
        point upper-left,
        point lower-right,
      )
    | none
    ;|] `shouldBeRight` a
            parse' [s|
union shape
    # shape type
    = circle (point origin, offset radius,)
    | rectangle (point upper-left, point lower-right,)
    | none
    ;|] `shouldBeRight` b
            parse' [s|
@docs (docs = "shape type\n")
union shape
    = circle (point origin, offset radius,)
    | rectangle (point upper-left, point lower-right,)
    | none
    ;|] `shouldBeRight` b
            let Right union3 = unionType
                    [circleTag, rectTag, Tag "none" [] fooAnnotationSet]
                    Nothing
            parse' [s|
union shape
    = circle (point origin, offset radius,)
    | rectangle (point upper-left, point lower-right,)
    | @foo (v = "bar") none
    ;|] `shouldBeRight` a { type' = union3 }
            let Right union4 = unionType
                    [ circleTag { tagAnnotations = singleDocs "tag docs" }
                    , rectTag { tagAnnotations = singleDocs "front docs" }
                    , noneTag
                    ]
                    Nothing
            parse' [s|
union shape
    = circle (point origin, offset radius,)
    # tag docs
    | rectangle (
          # front docs
          point upper-left, point lower-right,
      )
    | none
    ;|] `shouldBeRight` a { type' = union4 }
            let Right union5 = unionType
                    [ circleTag, rectTag
                    , noneTag { tagAnnotations = singleDocs "tag docs" }
                    ]
                    Nothing
            parse' [s|
union shape
    = circle (point origin, offset radius,)
    | rectangle (point upper-left, point lower-right,)
    | none  # tag docs
    ;|] `shouldBeRight` a { type' = union5 }
            let Right union6 = unionType
                    [ circleTag
                          { tagFields =
                                 [ cOriginF
                                 , cRadiusF
                                       { fieldAnnotations = bazAnnotationSet }
                                 ]
                          }
                    , rectTag
                          { tagFields =
                                [ rUpperLeftF
                                , rLowerRightF
                                      { fieldAnnotations = fooAnnotationSet }
                                ]
                          }
                    , noneTag
                    ]
                    Nothing
            parse' [s|
union shape
    = circle (point origin, @baz offset radius,)
    | rectangle (point upper-left, @foo (v = "bar") point lower-right,)
    | none
    ;|] `shouldBeRight` a { type' = union6 }
        it "fails to parse if there are duplicated facial names" $ do
            expectError [s|
union dup
    = a/b
    | b/c
    | a/d
    ;|] 5 6
            expectError [s|
union dup
    = a (text a/b, text b/c, text a/d)
    | b
    ;|] 2 38
        it "fails to parse if there are duplicated behind names" $ do
            expectError [s|
union dup
    = a/b
    | b/c
    | c/b
    ;|] 5 6
            expectError [s|
union dup
    = a (text a/b, text b/c, text c/b)
    | b
    ;|] 2 38
        it "fails to parse if trailing semicolon is missing" $ do
            let (_, expectErr) = helperFuncs P.module'
            expectErr
                "union a = a1 | a2;\nunion b = b1 | b2\nunion c = c1 | c2;"
                3 1
            expectErr "unboxed a (text);\nunion b = x | y\nunboxed c (text);"
                      3 1
            expectErr "union a = a1 | a2;\nunboxed b (text)\nunion c = c1 | c2;"
                      3 1
        it "failed to parse union with more than 1 default keyword." $ do
            let (_, expectErr) = helperFuncs P.module'
            expectErr [s|
union shape
    = default circle (point origin, offset radius,)
    | default rectangle (point upper-left, point lower-right,)
    ;|] 4 6
    describe "method" $ do
        let (parse', expectError) = helperFuncs P.method
            httpGetAnnotation = singleton $ Annotation "http"
                [ ("method", AI.Text "GET")
                , ("path", AI.Text "/get-name/")
                ]
        it "emits Method if succeeded to parse" $ do
            parse' "text get-name()" `shouldBeRight`
                Method "get-name" [] (Just "text") Nothing empty
            parse' "text get-name (person user)" `shouldBeRight`
                Method "get-name" [Parameter "user" "person" empty]
                       (Just "text") Nothing empty
            parse' "text get-name (person user,text `default`)" `shouldBeRight`
                Method "get-name"
                       [ Parameter "user" "person" empty
                       , Parameter "default" "text" empty
                       ]
                       (Just "text") Nothing empty
            parse' "@http(method = \"GET\", path = \"/get-name/\") \
                   \text get-name (person user,text `default`)" `shouldBeRight`
                Method "get-name"
                       [ Parameter "user" "person" empty
                       , Parameter "default" "text" empty
                       ]
                       (Just "text") Nothing httpGetAnnotation
            parse' "text get-name() throws name-error" `shouldBeRight`
                Method "get-name" [] (Just "text") (Just "name-error") empty
            parse' [s|
text get-name  ( person user,text `default` )
               throws get-name-error|] `shouldBeRight`
                Method "get-name"
                       [ Parameter "user" "person" empty
                       , Parameter "default" "text" empty
                       ]
                       (Just "text") (Just "get-name-error") empty
            parse' [s|
@http(method = "GET", path = "/get-name/")
text get-name  ( person user,text `default` )
               throws get-name-error|] `shouldBeRight`
                Method "get-name"
                       [ Parameter "user" "person" empty
                       , Parameter "default" "text" empty
                       ]
                       (Just "text") (Just "get-name-error")
                       httpGetAnnotation
            parse' "get-name()" `shouldBeRight`
                Method "get-name" [] Nothing Nothing empty
            parse' "get-name() throws name-error" `shouldBeRight`
                Method "get-name" [] Nothing (Just "name-error") empty
        it "can have docs" $ do
            parse' [s|
text get-name (
  # Gets the name.
)|] `shouldBeRight`
                Method "get-name" [] (Just "text")
                       Nothing (singleDocs "Gets the name.")
            parse' [s|
text get-name (
  # Gets the name.
)throws name-error  |] `shouldBeRight`
                Method "get-name" [] (Just "text")
                       (Just "name-error")
                       (singleDocs "Gets the name.")
            parse' [s|
text get-name (
  # Gets the name of the user.
  person user,
)|] `shouldBeRight`
                Method "get-name"
                       [Parameter "user" "person" empty]
                       (Just "text")
                       Nothing
                       (singleDocs "Gets the name of the user.")
            parse' [s|
text get-name (
  # Gets the name of the user.
  person user,
) throws get-name-error|] `shouldBeRight`
                Method "get-name"
                       [Parameter "user" "person" empty]
                       (Just "text")
                       (Just "get-name-error")
                       (singleDocs "Gets the name of the user.")
            let expectedUserPDocs = "The person to find their name."
                expectedDefaultPDocs =
                    "The default name used when the user has no name."
                expectedMethod =
                    Method "get-name"
                           [ Parameter "user" "person" $
                                       singleDocs expectedUserPDocs
                           , Parameter "default" "text" $
                                       singleDocs expectedDefaultPDocs
                           ]
                           (Just "text")
                           Nothing
                           (singleDocs "Gets the name of the user.")
            parse' [s|
text get-name (
  # Gets the name of the user.
  person user,
  # The person to find their name.
  text `default`
  # The default name used when the user has no name.
)|] `shouldBeRight` expectedMethod
        it "fails to parse if there are parameters of the same facial name" $ do
            expectError "bool pred(text a, text a/b)" 1 11
            expectError "bool pred(text a/b, text a)" 1 11
            expectError "bool pred(text c/a, text c/b)" 1 11
        it "fails to parse if there are parameters of the same behind name" $ do
            expectError "bool pred(text a, text b/a)" 1 11
            expectError "bool pred(text a/b, text b)" 1 11
            expectError "bool pred(text a/c, text b/c)" 1 11

    describe "serviceDeclaration" $ do
        let (parse', expectError) = helperFuncs $ P.serviceDeclaration []
            getUserD = singleDocs "Gets an user by its id."
            createUserD = singleDocs "Creates a new user"
            noMethodsD = singleDocs "Service having no methods."
            oneMethodD = singleDocs "Service having only one method."
            multiMethodsD = singleDocs "Service having multiple methods."
            userIdD = singleDocs "The unique user identifier."
        it "emits ServiceDeclaration if succeeded to parse" $ do
            parse' "service null-service();" `shouldBeRight`
                ServiceDeclaration "null-service" (Service []) empty
            parse' [s|
service null-service (
  # Service having no methods.
);|] `shouldBeRight`
                ServiceDeclaration "null-service" (Service []) noMethodsD
            parse' [s|
service one-method-service(
  user get-user(uuid user-id)
);|] `shouldBeRight`
                ServiceDeclaration
                    "one-method-service"
                    (Service [ Method "get-user"
                                      [Parameter "user-id" "uuid" empty]
                                      (Just "user")
                                      Nothing
                                      empty
                             ])
                    empty
            parse' [s|
service one-method-service (
  # Service having only one method.
  user get-user (
    # Gets an user by its id.
    uuid user-id
  ) throws get-user-error,
);|] `shouldBeRight`
                ServiceDeclaration
                    "one-method-service"
                    (Service [ Method "get-user"
                                      [Parameter "user-id" "uuid" empty]
                                      (Just "user")
                                      (Just "get-user-error")
                                      getUserD
                             ])
                    oneMethodD
            parse' [s|
service user-service (
  # Service having multiple methods.
  user create-user (
    # Creates a new user
    user user
  ),
  user get-user (
    # Gets an user by its id.
    uuid user-id
  ),
);|] `shouldBeRight`
                ServiceDeclaration
                    "user-service"
                    (Service [ Method "create-user"
                                      [Parameter "user" "user" empty]
                                      (Just "user")
                                      Nothing
                                      createUserD
                             , Method "get-user"
                                      [Parameter "user-id" "uuid" empty]
                                      (Just "user")
                                      Nothing
                                      getUserD
                             ])
                    multiMethodsD
            parse' [s|
@foo(v = "bar")
service null-service (
  # Service having no methods.
);|] `shouldBeRight`
                ServiceDeclaration "null-service"
                                   (Service [])
                                   (A.union noMethodsD fooAnnotationSet)
            parse' [s|
@baz
service null-service (
  # Service having no methods.
);|] `shouldBeRight`
                ServiceDeclaration "null-service"
                                   (Service [])
                                   (A.union noMethodsD bazAnnotationSet)
            parse' [s|
service user-service (
  @docs (docs = "Creates a new user\n")
  user create-user (
    user user
  ),
  @docs (docs = "Gets an user by its id.\n")
  user get-user (
    uuid user-id
  ),
);|] `shouldBeRight`
                ServiceDeclaration
                    "user-service"
                    (Service [ Method "create-user"
                                      [Parameter "user" "user" empty]
                                      (Just "user")
                                      Nothing
                                      createUserD
                             , Method "get-user"
                                      [Parameter "user-id" "uuid" empty]
                                      (Just "user")
                                      Nothing
                                      getUserD
                             ])
                    empty
            parse' [s|
service user-service (
  user get-user (
    @baz
    uuid user-id
    # The unique user identifier.
  ),
);|] `shouldBeRight`
                ServiceDeclaration
                    "user-service"
                    (Service [ Method "get-user"
                                      [ Parameter "user-id" "uuid" $
                                            A.union bazAnnotationSet userIdD
                                      ]
                                      (Just "user")
                                      Nothing
                                      empty
                             ])
                    empty
        it "fails to parse if there are methods of the same facial name" $ do
            expectError [s|
service method-dups (
  bool same-name ()
  text same-name (uuid id)
);|] 3 3
            expectError [s|
service method-dups (
  bool same-name ()
  text same-name/different-behind-name (uuid id)
);|] 3 3
            expectError [s|
service method-dups (
  bool same-name/unique-behind-name ()
  text same-name/different-behind-name (uuid id)
);|] 3 3
        it "fails to parse if there are methods of the same behind name" $ do
            expectError [s|
service method-dups (
  bool same-name ()
  text same-name (uuid id)
);|] 3 3
            expectError [s|
service method-dups (
  bool same-name ()
  text unique-name/same-name (uuid id)
);|] 3 3
            expectError [s|
service method-dups (
  bool unique-name/same-name ()
  text different-facial-name/same-name (uuid id)
);|] 3 3
        it "fails to parse if trailing semicolon is missing" $ do
            let (_, expectErr) = helperFuncs P.module'
            expectErr "service a ();\nservice b ()\nservice c ();" 3 1
            expectErr "type a = text;\nservice b ()\ntype c = text;" 3 1
            expectErr "service a ();\ntype b = text\nservice c ();" 3 1
    let moduleParsers = [ ("module'", P.module')
                        , ("file", P.file)
                        ] :: [(String, Parser Module)]
    forM_ moduleParsers $ \ (label, parser') ->
        describe label $ do
            let (parse', expectError) = helperFuncs parser'
            it "emits Module if succeeded to parse" $ do
                let decls = [ TypeDeclaration "path" (Alias "text") empty
                            , TypeDeclaration "offset"
                                              (UnboxedType "float64") empty
                            ]
                parse' "type path = text; unboxed offset (float64);"
                    `shouldBeRight` Module decls Nothing
                parse'
                    "#docs\n#...\ntype path = text; unboxed offset (float64);"
                        `shouldBeRight` Module decls (Just "docs\n...")
            it "may have no type declarations" $ do
                parse' "" `shouldBeRight` Module [] Nothing
                parse' "# docs" `shouldBeRight` Module [] (Just "docs")
            it "errors if there are any duplicated facial names" $
                expectError "type a = text;\ntype a/b = text;" 2 6
            it "errors if there are any duplicated behind names" $
                expectError "type b = text;\ntype a/b = text;" 2 7

    describe "modulePath" $ do
        let (parse', expectError) = helperFuncs P.modulePath
        it "emits ModulePath if succeeded to parse" $ do
            parse' "foo" `shouldBeRight` ["foo"]
            parse' "foo.bar" `shouldBeRight` ["foo", "bar"]
            parse' "foo.bar.baz" `shouldBeRight` ["foo", "bar", "baz"]
        it "errors if it's empty" $
            expectError "" 1 1
        it "errors if it starts with period" $ do
            expectError "." 1 1
            expectError ".foo" 1 1
            expectError ".foo.bar" 1 1
            expectError ".foo.bar.baz" 1 1
        it "errors if it ends with period" $ do
            expectError "." 1 1
            expectError "foo." 1 5
            expectError "foo.bar." 1 9
            expectError "foo.bar.baz." 1 13

    describe "imports" $ do
        let (parse', expectError) = helperFuncs $ P.imports []
        it "can single import name w/o trailing comma" $ do
            parse' "import foo.bar (a);" `shouldBeRight`
                [Import ["foo", "bar"] "a" "a" empty]
            parse' "import foo.bar (a as qux);" `shouldBeRight`
                [Import ["foo", "bar"] "qux" "a" empty]
        it "can single import name w/ trailing comma" $ do
            parse' "import foo.bar (a,);" `shouldBeRight`
                [Import ["foo", "bar"] "a" "a" empty]
            parse' "import foo.bar (a as qux,);" `shouldBeRight`
                [Import ["foo", "bar"] "qux" "a" empty]
        it "emits Import values if succeeded to parse" $ do
            parse' "import foo.bar (a, b);" `shouldBeRight`
                [ Import ["foo", "bar"] "a" "a" empty
                , Import ["foo", "bar"] "b" "b" empty
                ]
            parse' "import foo.bar (a as foo, b as bar);" `shouldBeRight`
                [ Import ["foo", "bar"] "foo" "a" empty
                , Import ["foo", "bar"] "bar" "b" empty
                ]
        it "can be annotated" $ do
            parse' "import foo.bar (@foo (v = \"bar\") a, @baz b);"
                `shouldBeRight`
                    [ Import ["foo", "bar"] "a" "a" fooAnnotationSet
                    , Import ["foo", "bar"] "b" "b" bazAnnotationSet
                    ]
            parse' "import foo.bar (@foo (v = \"bar\") @baz a, b);"
                `shouldBeRight`
                    [ Import ["foo", "bar"] "a" "a" $
                             union fooAnnotationSet bazAnnotationSet
                    , Import ["foo", "bar"] "b" "b" empty
                    ]
            parse'
                "import foo.bar (@foo (v = \"bar\") a as foo, @baz b as bar);"
                `shouldBeRight`
                    [ Import ["foo", "bar"] "foo" "a" fooAnnotationSet
                    , Import ["foo", "bar"] "bar" "b" bazAnnotationSet
                    ]
            parse'
                "import foo.bar (@foo (v = \"bar\") @baz a as foo, b as bar);"
                `shouldBeRight`
                    [ Import ["foo", "bar"] "foo" "a" $
                             union fooAnnotationSet bazAnnotationSet
                    , Import ["foo", "bar"] "bar" "b" empty
                    ]
        specify "import names can have a trailing comma" $ do
            parse' "import foo.bar (a, b,);" `shouldBeRight`
                [ Import ["foo", "bar"] "a" "a" empty
                , Import ["foo", "bar"] "b" "b" empty
                ]
            parse' "import foo.bar (a as foo, b as bar,);" `shouldBeRight`
                [ Import ["foo", "bar"] "foo" "a" empty
                , Import ["foo", "bar"] "bar" "b" empty
                ]
        specify "import names in parentheses can be multiline" $ do
            -- without a trailing comma
            parse' "import foo.bar (\n  a,\n  b\n);" `shouldBeRight`
                [ Import ["foo", "bar"] "a" "a" empty
                , Import ["foo", "bar"] "b" "b" empty
                ]
            parse' "import foo.bar (\n  a as foo,\n  b as bar\n);"
                `shouldBeRight`
                    [ Import ["foo", "bar"] "foo" "a" empty
                    , Import ["foo", "bar"] "bar" "b" empty
                    ]
            -- with a trailing comma
            parse' "import foo.bar (\n  c,\n  d,\n);"
                `shouldBeRight`
                    [ Import ["foo", "bar"] "c" "c" empty
                    , Import ["foo", "bar"] "d" "d" empty
                    ]
            parse' "import foo.bar (\n  c as foo,\n  d as bar,\n);"
                `shouldBeRight`
                    [ Import ["foo", "bar"] "foo" "c" empty
                    , Import ["foo", "bar"] "bar" "d" empty
                    ]

        it "errors if parentheses have nothing" $
            expectError "import foo.bar ();" 1 17
        it "disallows when there are duplicated alias names" $
            expectError "import foo.bar (lorem as yolo, ipsum as yolo);" 1 41

    describe "module'" $ do
        context "handling name duplications" $ do
            let (_, expectError) = helperFuncs P.module'
            let examples =
                    -- Vertical alignment of `dup` is an intention; it purposes
                    -- to generate the same error offsets.
                    [ "type       dup = text;"
                    , "unboxed    dup (text);"
                    , "record     dup (text a);"
                    , "enum       dup = m1 | m2;"
                    , "enum e1 =  dup | foo;"
                    , "union      dup = t1 | t2;"
                    , "union u1 = dup | foo;"
                    , "service    dup (text ping ());"
                    ]
            let importExample = "import foo (dup);"
            let shiftDigit = \ case
                    '1' -> '3'
                    '2' -> '4'
                    c -> c
            let inputs = [ (a, if a == b then T.map shiftDigit b else b)
                         | a <- importExample : examples
                         , b <- examples
                         ]
            forM_ inputs $ \ (forward, shadowing) ->
                let input = T.concat [forward, "\n", shadowing]
                in
                    specify (T.unpack input) $ expectError input 2 12
        specify "allows import duplicated source name when it use alias" $ do
            let (parse', _) = helperFuncs P.module'
            parse' "import foo.bar (a);\n import lorem.ipsum (a as dolor);"
                `shouldBeRight`
                    Module [ Import ["foo", "bar"] "a" "a" empty
                           , Import ["lorem", "ipsum"] "dolor" "a" empty
                           ] Nothing

    specify "parse & parseFile" $ do
        files <- getDirectoryContents "examples"
        let examples = map ("examples/" ++) $ filter (isSuffixOf ".nrm") files
        forM_ examples $ \ filePath -> do
            sourceCode <- B.readFile filePath
            let parseResult = P.parse (filePath ++ " (text)")
                                      (E.decodeUtf8 sourceCode)
            parseResult `shouldSatisfy` isRight
            let Right module' = parseResult
            P.parse (filePath ++ " (text inverse)") (toCode module')
                `shouldBeRight` module'
            parseFileResult <- P.parseFile filePath
            parseFileResult `shouldSatisfy` isRight
            parseFileResult `shouldBe` parseResult
