From 9d1f0385945e926e7084e60fc72fe5846e7139b2 Mon Sep 17 00:00:00 2001
From: Eugen Wissner <belka@caraus.de>
Date: Tue, 23 Jul 2024 22:44:42 +0200
Subject: [PATCH] Split in lib and tests

---
 elna.cabal                        |  52 ++++--
 lib/Language/Elna/AST.hs          | 170 +++++++++++++++++++
 lib/Language/Elna/Parser.hs       | 107 ++++++++++++
 src/Language/Elna/AST.hs          | 268 ------------------------------
 src/Language/Elna/Parser.hs       |  37 -----
 tests/Language/Elna/ParserSpec.hs |  58 +++++++
 tests/Spec.hs                     |   1 +
 7 files changed, 377 insertions(+), 316 deletions(-)
 create mode 100644 lib/Language/Elna/AST.hs
 create mode 100644 lib/Language/Elna/Parser.hs
 delete mode 100644 src/Language/Elna/AST.hs
 delete mode 100644 src/Language/Elna/Parser.hs
 create mode 100644 tests/Language/Elna/ParserSpec.hs
 create mode 100644 tests/Spec.hs

diff --git a/elna.cabal b/elna.cabal
index 7c27cbb..9b37122 100644
--- a/elna.cabal
+++ b/elna.cabal
@@ -15,19 +15,49 @@ build-type: Simple
 extra-doc-files: TODO README
 
 common warnings
-    ghc-options: -Wall
-
-executable elna
-    import:           warnings
-    main-is:          Main.hs
-    other-modules:
-        Language.Elna.AST
-        Language.Elna.Parser
-    default-extensions:
-        OverloadedStrings
     build-depends:
         base ^>=4.17.2.1,
         megaparsec ^>= 9.6,
         text ^>= 2.0
-    hs-source-dirs:   src
+    ghc-options: -Wall
+    default-extensions:
+        ExplicitForAll,
+        OverloadedStrings
+
+library elna-internal
+    import: warnings
+    exposed-modules:
+        Language.Elna.AST
+        Language.Elna.Parser
+    build-depends:
+        vector >= 0.12 && < 0.14
+    hs-source-dirs: lib
+
+executable elna
+    import: warnings
+    main-is: Main.hs
+    build-depends:
+        elna-internal
+    hs-source-dirs: src
+    default-language: GHC2021
+
+test-suite elna-test
+    import: warnings
+    type: exitcode-stdio-1.0
+    main-is: Spec.hs
+    other-modules:
+        Language.Elna.ParserSpec
+    hs-source-dirs:
+        tests
+    ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall
+
+    build-depends:
+        elna-internal,
+        hspec >= 2.10.9 && < 2.12,
+        hspec-expectations ^>= 0.8.2,
+        hspec-megaparsec ^>= 2.2.0,
+        text,
+        vector
+    build-tool-depends:
+        hspec-discover:hspec-discover
     default-language: GHC2021
diff --git a/lib/Language/Elna/AST.hs b/lib/Language/Elna/AST.hs
new file mode 100644
index 0000000..fc4b264
--- /dev/null
+++ b/lib/Language/Elna/AST.hs
@@ -0,0 +1,170 @@
+module Language.Elna.AST
+    ( Declaration(..)
+    , Expression(..)
+    , Identifier(..)
+    , Literal(..)
+    , Parameter(..)
+    , Program(..)
+    , Statement(..)
+    , VariableDeclaration(..)
+    , TypeExpression(..)
+    ) where
+
+import Data.Int (Int32)
+import Data.List (intercalate)
+import Data.Word (Word8)
+import Data.Text (Text)
+import qualified Data.Text as Text
+import Data.Char (chr)
+import Data.String (IsString(..))
+
+newtype Identifier = Identifier { unIdentifier :: Text }
+    deriving Eq
+
+instance Show Identifier
+  where
+    show (Identifier identifier) = Text.unpack identifier
+
+instance IsString Identifier
+  where
+    fromString = Identifier . Text.pack
+
+data TypeExpression
+    = NamedType Identifier
+    | ArrayType TypeExpression Int32
+    deriving Eq
+
+instance Show TypeExpression
+  where
+    show (NamedType typeName) = show typeName
+    show (ArrayType typeName elementCount) = concat
+        [show typeName, "[", show elementCount, "]"]
+
+data Literal
+    = IntegerLiteral Int32
+    | HexadecimalLiteral Int32
+    | CharacterLiteral Word8
+    | BooleanLiteral Bool
+    deriving Eq
+
+instance Show Literal
+  where
+    show (IntegerLiteral integer) = show integer
+    show (HexadecimalLiteral integer) = show integer
+    show (CharacterLiteral character) =
+        '\'' : chr (fromEnum character) : ['\'']
+    show (BooleanLiteral boolean)
+        | boolean = "true"
+        | otherwise = "false"
+
+data Expression
+    = VariableExpression Identifier
+    | LiteralExpression Literal
+    | NegationExpression Expression
+    | NotExpression Expression
+    | ReferenceExpression Expression
+    | DereferenceExpression Expression
+    | SumExpression Expression Expression
+    | SubtractionExpression Expression Expression
+    | ProductExpression Expression Expression
+    | DivisionExpression Expression Expression
+    | EqualExpression Expression Expression
+    | NonEqualExpression Expression Expression
+    | LessExpression Expression Expression
+    | GreaterExpression Expression Expression
+    | LessOrEqualExpression Expression Expression
+    | GreaterOrEqualExpression Expression Expression
+    | FieldExpression Expression Identifier
+    deriving Eq
+
+instance Show Expression
+  where
+    show (VariableExpression variable) = show variable
+    show (LiteralExpression literal) = show literal
+    show (NegationExpression negation) = '-' : show negation
+    show (NotExpression negation) = "not " <> show negation
+    show (ReferenceExpression reference) = '@' : show reference
+    show (DereferenceExpression dereference) = show dereference <> "^"
+    show (SumExpression lhs rhs) = concat [show lhs, " + ", show rhs]
+    show (SubtractionExpression lhs rhs) = concat [show lhs, " - ", show rhs]
+    show (ProductExpression lhs rhs) = concat [show lhs, " * ", show rhs]
+    show (DivisionExpression lhs rhs) = concat [show lhs, " / ", show rhs]
+    show (EqualExpression lhs rhs) = concat [show lhs, " = ", show rhs]
+    show (NonEqualExpression lhs rhs) = concat [show lhs, " /= ", show rhs]
+    show (LessExpression lhs rhs) = concat [show lhs, " < ", show rhs]
+    show (GreaterExpression lhs rhs) = concat [show lhs, " > ", show rhs]
+    show (LessOrEqualExpression lhs rhs) = concat [show lhs, " <= ", show rhs]
+    show (GreaterOrEqualExpression lhs rhs) = concat [show lhs, " >= ", show rhs]
+    show (FieldExpression fieldExpression identifier) =
+        show fieldExpression <> "." <> show identifier
+
+data Statement
+    = EmptyStatement
+    | AssignmentStatement Expression Expression
+    | IfStatement Expression Statement (Maybe Statement)
+    | WhileStatement Expression Statement
+    | CompoundStatement [Statement]
+    | CallStatement Identifier [Expression]
+    deriving Eq
+
+instance Show Statement
+  where
+    show EmptyStatement = ";"
+    show (AssignmentStatement lhs rhs) =
+        concat [show lhs, " := ", show rhs, show rhs, ";"]
+    show (IfStatement condition if' else') = concat
+        [ "if (", show condition, ") "
+        , show if'
+        , maybe "" ((<> " else ") . show) else'
+        , ";"
+        ]
+    show (WhileStatement expression statement) =
+        concat [ "while (", show expression, ") ", show statement, ";"]
+    show (CompoundStatement statements) = "begin "
+        <> intercalate "; " (show <$> statements) <> " end"
+    show (CallStatement name parameters) = show name <> "("
+        <> intercalate ", " (show <$> parameters) <> ")"
+
+data Parameter = Parameter Identifier TypeExpression Bool
+    deriving Eq
+
+instance Show Parameter
+  where
+    show (Parameter identifier typeName ref) = concat
+        [ if ref then "ref " else ""
+        , show identifier, ": ", show typeName
+        ]
+
+data VariableDeclaration =
+    VariableDeclaration Identifier TypeExpression
+    deriving Eq
+
+instance Show VariableDeclaration
+  where
+    show (VariableDeclaration identifier typeExpression) =
+        concat [" var ", show identifier, ": " <> show typeExpression, ";"]
+
+data Declaration
+    = TypeDefinition Identifier TypeExpression
+    | ProcedureDefinition Identifier [Parameter] [VariableDeclaration] [Statement]
+    deriving Eq
+
+instance Show Declaration
+  where
+    show (TypeDefinition identifier typeExpression) =
+        concat ["type ", show identifier, " = ", show typeExpression]
+    show (ProcedureDefinition procedureName parameters variables body)
+        = "proc " <> show procedureName <> showParameters parameters <> ";"
+        <> unlines (show <$> variables)
+        <> unlines (show <$> body) <> ";"
+
+newtype Program = Program [Declaration]
+    deriving Eq
+
+instance Show Program
+  where
+    show (Program declarations) = unlines (show <$> declarations)
+
+showParameters :: [Parameter] -> String
+showParameters parameters =
+    "(" <> intercalate ", " (show <$> parameters) <> ")"
diff --git a/lib/Language/Elna/Parser.hs b/lib/Language/Elna/Parser.hs
new file mode 100644
index 0000000..cd8f927
--- /dev/null
+++ b/lib/Language/Elna/Parser.hs
@@ -0,0 +1,107 @@
+module Language.Elna.Parser
+    ( Parser
+    , programP
+    ) where
+
+import Control.Monad (void)
+import Data.Text (Text)
+import qualified Data.Text as Text
+import Data.Void (Void)
+import Language.Elna.AST
+    ( Declaration(..)
+    , Identifier(..)
+    , Parameter(..)
+    , Program(..)
+    , TypeExpression(..)
+    , VariableDeclaration(..)
+    )
+import Text.Megaparsec (Parsec, (<?>), optional, between, sepBy)
+import Text.Megaparsec.Char (alphaNumChar, letterChar, space1)
+import qualified Text.Megaparsec.Char.Lexer as Lexer
+import Control.Applicative (Alternative(..))
+import Data.Maybe (isJust)
+
+type Parser = Parsec Void Text
+
+space :: Parser ()
+space = Lexer.space space1 (Lexer.skipLineComment "//")
+    $ Lexer.skipBlockComment "/*" "*/"
+
+lexeme :: forall a. Parser a -> Parser a
+lexeme = Lexer.lexeme space
+
+symbol :: Text -> Parser Text
+symbol = Lexer.symbol space
+
+blockP :: forall a. Parser a -> Parser a
+blockP = between (symbol "{") (symbol "}")
+
+procedureP :: Parser ()
+procedureP = void $ symbol "proc"
+
+parensP :: forall a. Parser a -> Parser a
+parensP = between (symbol "(")  (symbol ")")
+
+openBracketP :: Parser ()
+openBracketP = void $ symbol "["
+
+closingBracketP :: Parser ()
+closingBracketP = void $ symbol "]"
+
+colonP :: Parser ()
+colonP = void $ symbol ":"
+
+semicolonP :: Parser ()
+semicolonP = void $ symbol ";"
+
+identifierP :: Parser Identifier
+identifierP =
+    let wordParser = (:) <$> letterChar <*> many alphaNumChar <?> "identifier"
+     in fmap Identifier $ lexeme $ Text.pack <$> wordParser
+
+typeExpressionP :: Parser TypeExpression
+typeExpressionP = arrayTypeExpression
+    <|> NamedType <$> identifierP
+    <?> "type expression"
+  where
+    arrayTypeExpression = flip ArrayType
+        <$> (symbol "array" *> openBracketP *> lexeme Lexer.decimal <* closingBracketP)
+        <*> (symbol "of" *> typeExpressionP)
+
+typeDefinitionP :: Parser Declaration
+typeDefinitionP = TypeDefinition
+    <$> (symbol "type" *> identifierP)
+    <*> (symbol "=" *> typeExpressionP)
+    <?> "type definition"
+
+variableDeclarationP :: Parser VariableDeclaration
+variableDeclarationP = VariableDeclaration
+    <$> (symbol "var" *> identifierP)
+    <*> (colonP *> typeExpressionP)
+    <* semicolonP
+    <?> "variable declaration"
+
+parameterP :: Parser Parameter
+parameterP = paramCons
+    <$> optional (symbol "ref")
+    <*> identifierP
+    <*> (colonP *> typeExpressionP)
+  where
+    paramCons ref name typeName = Parameter name typeName (isJust ref)
+
+parametersP :: Parser [Parameter]
+parametersP = parensP $ sepBy parameterP (symbol ",")
+
+procedureDefinitionP :: Parser Declaration
+procedureDefinitionP = ProcedureDefinition
+    <$> (procedureP *> identifierP)
+    <*> parametersP
+    <*> blockP (many variableDeclarationP)
+    <*> pure mempty -- TODO
+    <?> "procedure definition"
+
+declarationP :: Parser Declaration
+declarationP = typeDefinitionP <|> procedureDefinitionP
+
+programP :: Parser Program
+programP = Program <$> many declarationP
diff --git a/src/Language/Elna/AST.hs b/src/Language/Elna/AST.hs
deleted file mode 100644
index 0ac8eb5..0000000
--- a/src/Language/Elna/AST.hs
+++ /dev/null
@@ -1,268 +0,0 @@
-module Language.Elna.AST
-    ( ConstantDefinition(..)
-    , Declaration(..)
-    , Expression(..)
-    , Identifier(..)
-    , Literal(..)
-    , ProcedureDeclaration(..)
-    , Program(..)
-    , Statement(..)
-    , VariableDeclaration(..)
-    , TypeDefinition(..)
-    , TypeName(..)
-    ) where
-
-import Data.Int (Int32)
-import Data.List (intercalate)
-import Data.List.NonEmpty (NonEmpty(..))
-import qualified Data.List.NonEmpty as NonEmpty
-import Data.Word (Word8)
-import Data.Text (Text)
-import qualified Data.Text as Text
-import Data.Char (chr)
-
-newtype Identifier = Identifier { unIdentifier :: Text }
-    deriving Eq
-
-instance Show Identifier
-  where
-    show (Identifier identifier) = Text.unpack identifier
-
-data TypeName
-    = NamedType Identifier
-    | PointerType TypeName
-    | ArrayType TypeName Int32
-    | ProcedureType [Parameter]
-    deriving Eq
-
-instance Show TypeName
-  where
-    show (NamedType typeName) = show typeName
-    show (PointerType typeName) = '^' : show typeName
-    show (ArrayType typeName elementCount) = concat
-        [show typeName, "[", show elementCount, "]"]
-    show (ProcedureType parameters) = "proc" <> showParameters parameters
-
-data Literal
-    = StringLiteral Text
-    | IntegerLiteral Int32
-    | ByteLiteral Word8
-    | CharacterLiteral Word8
-    | BooleanLiteral Bool
-    | RecordLiteral (NonEmpty Argument)
-    | VariantLiteral (NonEmpty Argument)
-    | EnumLiteral Identifier
-    deriving Eq
-
-instance Show Literal
-  where
-    show (StringLiteral string) = Text.unpack
-        $ "\"" <> string <> "\""
-    show (IntegerLiteral integer) = show integer
-    show (ByteLiteral word) = show word
-    show (CharacterLiteral character) =
-        '\'' : chr (fromEnum character) : ['\'']
-    show (BooleanLiteral boolean)
-        | boolean = "true"
-        | otherwise = "false"
-    show (RecordLiteral arguments) = showArguments arguments
-    show (VariantLiteral arguments) = showArguments arguments
-    show (EnumLiteral identifier) = show identifier
-
-data Expression
-    = VariableExpression Identifier
-    | LiteralExpression Literal
-    | NegationExpression Expression
-    | NotExpression Expression
-    | ReferenceExpression Expression
-    | DereferenceExpression Expression
-    | SumExpression Expression Expression
-    | SubtractionExpression Expression Expression
-    | ProductExpression Expression Expression
-    | DivisionExpression Expression Expression
-    | EqualExpression Expression Expression
-    | NonEqualExpression Expression Expression
-    | LessExpression Expression Expression
-    | GreaterExpression Expression Expression
-    | LessOrEqualExpression Expression Expression
-    | GreaterOrEqualExpression Expression Expression
-    | IfExpression Expression Statement Statement
-    | LoopExpression Identifier Expression Statement
-    | FieldExpression Expression Identifier
-    deriving Eq
-
-instance Show Expression
-  where
-    show (VariableExpression variable) = show variable
-    show (LiteralExpression literal) = show literal
-    show (NegationExpression negation) = '-' : show negation
-    show (NotExpression negation) = "not " <> show negation
-    show (ReferenceExpression reference) = '@' : show reference
-    show (DereferenceExpression dereference) = show dereference <> "^"
-    show (SumExpression lhs rhs) = concat [show lhs, " + ", show rhs]
-    show (SubtractionExpression lhs rhs) = concat [show lhs, " - ", show rhs]
-    show (ProductExpression lhs rhs) = concat [show lhs, " * ", show rhs]
-    show (DivisionExpression lhs rhs) = concat [show lhs, " / ", show rhs]
-    show (EqualExpression lhs rhs) = concat [show lhs, " = ", show rhs]
-    show (NonEqualExpression lhs rhs) = concat [show lhs, " /= ", show rhs]
-    show (LessExpression lhs rhs) = concat [show lhs, " < ", show rhs]
-    show (GreaterExpression lhs rhs) = concat [show lhs, " > ", show rhs]
-    show (LessOrEqualExpression lhs rhs) = concat [show lhs, " <= ", show rhs]
-    show (GreaterOrEqualExpression lhs rhs) = concat [show lhs, " >= ", show rhs]
-    show (IfExpression condition if' else') = concat
-        [ "if ", show condition
-        , " then ", show if'
-        , " else ", show else'
-        ]
-    show (LoopExpression identifier accumulator iteration) = concat
-        [ "loop ", show identifier
-        , " := ", show accumulator
-        , " do ", show iteration
-        ]
-    show (FieldExpression fieldExpression identifier) =
-        show fieldExpression <> "." <> show identifier
-
-data Statement
-    = LetStatement Identifier TypeName Expression
-    | CompoundStatement [Statement]
-    | CallStatement Identifier [Expression]
-    | ExpressionStatement Expression
-    | BreakStatement Expression
-    | ContinueStatement Expression
-    deriving Eq
-
-instance Show Statement
-  where
-    show (LetStatement identifier typeName definition) = concat
-        ["let ", show identifier, ": ", show typeName, " := ", show definition]
-    show (CompoundStatement statements) = "begin "
-        <> intercalate "; " (show <$> statements) <> " end"
-    show (CallStatement name parameters) = show name <> "("
-        <> intercalate ", " (show <$> parameters) <> ")"
-    show (ExpressionStatement expression) = show expression
-    show (BreakStatement break') = "break " <> show break'
-    show (ContinueStatement continue') = "continue " <> show continue'
-
-data ConstantDefinition =
-    ConstantDefinition Identifier TypeName Literal
-    deriving Eq
-
-instance Show ConstantDefinition
-  where
-    show (ConstantDefinition identifier typeName definition) = concat
-        [show identifier, ": ", show typeName, " := ", show definition, ";"]
-
-data Parameter = Parameter Identifier TypeName
-    deriving Eq
-
-instance Show Parameter
-  where
-    show (Parameter identifier typeName) =
-        show identifier <> ": " <> show typeName
-
-data Argument = Argument Identifier Literal
-    deriving Eq
-
-instance Show Argument
-  where
-    show (Argument identifier value) =
-        concat [show identifier, ": ", show value]
-
-data ProcedureDeclaration
-    = ExternProcedureDeclaration Identifier [Parameter]
-    | ProcedureDefinition Identifier [Parameter] Bool [ConstantDefinition] Statement
-    deriving Eq
-
-instance Show ProcedureDeclaration
-  where
-    show (ExternProcedureDeclaration procedureName parameters) =
-        "proc " <> show procedureName <> showParameters parameters <> "; extern;"
-    show (ProcedureDefinition procedureName parameters exports constants body)
-        = "proc " <> show procedureName <> showParameters parameters <> ";"
-        <> showAttributes exports
-        <> showConstants constants
-        <> show body <> ";"
-
-data VariableDeclaration
-    = ExternVariableDeclaration Identifier TypeName
-    | VariableDefinition Identifier TypeName (Maybe Literal) Bool
-    deriving Eq
-
-instance Show VariableDeclaration
-  where
-    show (ExternVariableDeclaration identifier typeName)
-        = show identifier <> ": " <> show typeName <> "; extern;"
-    show (VariableDefinition identifier typeName initialValue exports)
-        = show identifier <> ": " <> show typeName
-        <> maybe "" ((" = " <>) . show) initialValue <> ";"
-        <> showAttributes exports
-
-data TypeDefinition
-    = RecordDefinition Identifier (NonEmpty Parameter)
-    | VariantDefinition Identifier (NonEmpty Parameter)
-    | EnumerationDefinition Identifier (NonEmpty Identifier)
-    deriving Eq
-
-instance Show TypeDefinition
-  where
-    show (RecordDefinition identifier fields) = show identifier
-        <> " = record " <> intercalate "; " (NonEmpty.toList $ show <$> fields)
-        <> " end;"
-    show (VariantDefinition identifier fields) = show identifier
-        <> " = variant " <> intercalate "; " (NonEmpty.toList $ show <$> fields)
-        <> " end;"
-    show (EnumerationDefinition identifier members) = show identifier <> " = ("
-        <> intercalate ", " (NonEmpty.toList $ show <$> members) <> ");"
-
-data Declaration
-    = TypeDeclaration TypeDefinition
-    | ConstantDeclaration ConstantDefinition
-    | VariableDeclaration VariableDeclaration
-    | ProcedureDeclaration ProcedureDeclaration
-    deriving Eq
-
-instance Show Declaration
-  where
-    show (TypeDeclaration typeDefinition) = show typeDefinition
-    show (ConstantDeclaration constantDefinition) = show constantDefinition
-    show (VariableDeclaration variableDeclaration) = show variableDeclaration
-    show (ProcedureDeclaration procedureDeclaration) = show procedureDeclaration
-
-data Program = Program [Declaration] Statement
-    deriving Eq
-
-instance Show Program
-  where
-    show (Program declarations body) =
-        let declarations' = foldr showDeclaration ("", []) declarations
-         in unlines (snd declarations') <> show body <> "."
-      where
-        showDeclaration :: Declaration -> (String, [String]) -> (String, [String])
-        showDeclaration (TypeDeclaration typeDeclaration) (previous, accumulator)
-            | previous == "type" = ("type", show typeDeclaration : accumulator)
-            | otherwise = ("type", "type " <> show typeDeclaration : accumulator)
-        showDeclaration (ConstantDeclaration constantDeclaration) (previous, accumulator)
-            | previous == "const" = ("const", show constantDeclaration : accumulator)
-            | otherwise = ("const", "const " <> show constantDeclaration : accumulator)
-        showDeclaration (VariableDeclaration variableDeclaration) (previous, accumulator)
-            | previous == "var" = ("var", show variableDeclaration : accumulator)
-            | otherwise = ("var", "var " <> show variableDeclaration : accumulator)
-        showDeclaration (ProcedureDeclaration procedureDeclaration) (_previous, accumulator) =
-            ("proc", show procedureDeclaration : accumulator)
-
-showAttributes :: Bool -> String
-showAttributes True = " export;"
-showAttributes False = ""
-
-showParameters :: [Parameter] -> String
-showParameters parameters =
-    "(" <> intercalate ", " (show <$> parameters) <> ")"
-
-showArguments :: NonEmpty Argument -> String
-showArguments arguments =
-    "(" <> intercalate "; " (NonEmpty.toList $ show <$> arguments) <> ")"
-
-showConstants :: [ConstantDefinition] -> String
-showConstants constants
-    | null constants = ""
-    | otherwise = " const " <> unwords (show <$> constants) <> "\n"
diff --git a/src/Language/Elna/Parser.hs b/src/Language/Elna/Parser.hs
deleted file mode 100644
index 87ebc44..0000000
--- a/src/Language/Elna/Parser.hs
+++ /dev/null
@@ -1,37 +0,0 @@
-module Language.Elna.Parser
-    ( Parser
-    , programP
-    ) where
-
-import Control.Monad (void)
-import Data.Text (Text)
-import Data.Void (Void)
-import Language.Elna.AST
-    ( Statement(..)
-    , Program(..)
-    )
-import Text.Megaparsec (Parsec)
-import Text.Megaparsec.Char (space1)
-import qualified Text.Megaparsec.Char.Lexer as Lexer
-
-type Parser = Parsec Void Text
-
-space :: Parser ()
-space = Lexer.space space1 (Lexer.skipLineComment "//")
-    $ Lexer.skipBlockComment "{" "}"
-
-lexeme :: forall a. Parser a -> Parser a
-lexeme = Lexer.lexeme space
-
-symbol :: Text -> Parser Text
-symbol = Lexer.symbol space
-
-beginP :: Parser ()
-beginP = void $ symbol "begin"
-
-endP :: Parser ()
-endP = void $ symbol  "end"
-
-programP :: Parser Program
-programP = beginP >> endP >> symbol "."
-    >> pure (Program mempty $ CompoundStatement mempty)
diff --git a/tests/Language/Elna/ParserSpec.hs b/tests/Language/Elna/ParserSpec.hs
new file mode 100644
index 0000000..11907ab
--- /dev/null
+++ b/tests/Language/Elna/ParserSpec.hs
@@ -0,0 +1,58 @@
+module Language.Elna.ParserSpec
+    ( spec
+    ) where
+
+import Test.Hspec (Spec, describe, it, pendingWith, xit)
+import Test.Hspec.Megaparsec (shouldParse, shouldSucceedOn, parseSatisfies)
+import Language.Elna.Parser (programP)
+import Text.Megaparsec (parse)
+import Language.Elna.AST
+    ( Declaration(..)
+    , Parameter(..)
+    , Program(..)
+    , TypeExpression(..)
+    )
+
+spec :: Spec
+spec =
+    describe "programP" $ do
+        it "parses an empty main function" $
+            parse programP "" `shouldSucceedOn` "proc main() {}"
+
+        it "parses type definition for a type starting like array" $
+            let expected = Program [TypeDefinition "t" $ NamedType "arr"]
+                actual = parse programP "" "type t = arr"
+             in actual `shouldParse` expected
+
+        it "parses array type definition" $
+            let expected = Program [TypeDefinition "t" $ ArrayType (NamedType "integer") 10]
+                actual = parse programP "" "type t = array[10] of integer"
+             in actual `shouldParse` expected
+
+        it "parses parameters" $
+            let given = "proc main(x: integer) {}"
+                parameters = [Parameter "x" (NamedType "integer") False]
+                expected = Program [ProcedureDefinition "main" parameters [] []]
+                actual = parse programP "" given
+             in actual `shouldParse` expected
+
+        it "parses ref parameters" $
+            let given = "proc main(x: integer, ref y: boolean) {}"
+                parameters =
+                    [ Parameter "x" (NamedType "integer") False
+                    , Parameter "y" (NamedType "boolean") True
+                    ]
+                expected = Program [ProcedureDefinition "main" parameters [] []]
+                actual = parse programP "" given
+             in actual `shouldParse` expected
+
+        it "parses variable declaration" $
+            let given = "proc main() { var x: integer; }"
+                expected (Program [ProcedureDefinition _ _ variables _]) =
+                    not $ null variables
+                expected _ = False
+                actual = parse programP "" given
+             in actual `parseSatisfies` expected
+
+        it "parses procedure body statements" $
+            pendingWith "Not implemented"
diff --git a/tests/Spec.hs b/tests/Spec.hs
new file mode 100644
index 0000000..a824f8c
--- /dev/null
+++ b/tests/Spec.hs
@@ -0,0 +1 @@
+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}