diff --git a/parser-initial/parser-initial.cabal b/parser-initial/parser-initial.cabal index b8bcc97..79efce3 100644 --- a/parser-initial/parser-initial.cabal +++ b/parser-initial/parser-initial.cabal @@ -24,3 +24,18 @@ library hs-source-dirs: src default-language: Haskell2010 exposed-modules: Parser + +test-suite parser-initial-test + type: exitcode-stdio-1.0 + main-is: Driver.hs + hs-source-dirs: test + build-depends: base ^>=4.14.3.0, + HUnit, + hspec, + megaparsec, + parser-initial, + tasty, + tasty-discover, + tasty-hspec, + text + other-modules: Test.ParserTest diff --git a/parser-initial/src/Parser.hs b/parser-initial/src/Parser.hs index 7cddf56..f684fda 100644 --- a/parser-initial/src/Parser.hs +++ b/parser-initial/src/Parser.hs @@ -3,7 +3,9 @@ {-# LANGUAGE OverloadedStrings #-} module Parser -( eval +( Expr(..) +, Parser +, eval , memConsExpr , mulPassExpr , naiveExpr @@ -42,7 +44,7 @@ data Expr | ESub Expr Expr | EAnd Expr Expr | EOr Expr Expr - deriving (Show) + deriving (Eq, Show) eval :: Expr -> Either Text Expr eval e@(EInt _) = pure e diff --git a/parser-initial/test/Driver.hs b/parser-initial/test/Driver.hs new file mode 100644 index 0000000..327adf4 --- /dev/null +++ b/parser-initial/test/Driver.hs @@ -0,0 +1 @@ +{-# OPTIONS_GHC -F -pgmF tasty-discover -optF --tree-display #-} diff --git a/parser-initial/test/Test/ParserTest.hs b/parser-initial/test/Test/ParserTest.hs new file mode 100644 index 0000000..354bdf6 --- /dev/null +++ b/parser-initial/test/Test/ParserTest.hs @@ -0,0 +1,67 @@ +{-# LANGUAGE BlockArguments #-} +{-# LANGUAGE ExplicitForAll #-} +{-# LANGUAGE OverloadedStrings #-} + +module Test.ParserTest +( spec_parser, +) where + +import qualified Text.Megaparsec as M + +import Data.Text (Text, pack) +import Parser +import Test.Hspec (Expectation, Spec, describe, it, shouldBe) + +runParser :: Parser Expr -> Text -> IO (Either Text Expr) +runParser m input = pure case M.parse (m <* M.eof) "ParserTest" input of + Left e -> Left . pack $ M.errorBundlePretty e + Right a -> eval a + +runParsers :: Text -> IO [Either Text Expr] +runParsers input = + mapM (`runParser` input) [naiveExpr, mulPassExpr, memConsExpr] + +allEqual :: forall a. Eq a => [a] -> Bool +allEqual [] = True +allEqual [x] = True +allEqual [x, y] = x == y +allEqual (x:y:xs) = x == y && allEqual (y : xs) + +shouldParse :: Text -> Expr -> Expectation +shouldParse input expected = do + res@(x : _) <- runParsers input + shouldBe x $ Right expected + shouldBe True $ allEqual res + +shouldNotParse :: Text -> Text -> Expectation +shouldNotParse input expected = do + res@(x : _) <- runParsers input + shouldBe x $ Left expected + +spec_parser :: Spec +spec_parser = do + describe "literals" do + it "1" do + shouldParse "1" (EInt 1) + it "true" do + shouldParse "true" (EBool True) + it "false" do + shouldParse "false" (EBool False) + describe "addition/subtraction" do + it "binary" do + shouldParse "1 + 1" (EInt 2) + it "left associative" do + shouldParse "1 - 3 + 4" (EInt 2) + it "precedence" do + shouldParse "1 - (3 + 4)" (EInt (-6)) + describe "conjunction/disjunction" do + it "binary" do + shouldParse "true && false" (EBool False) + shouldParse "true && true" (EBool True) + shouldParse "true || true" (EBool True) + shouldParse "true || false" (EBool True) + shouldParse "false || false" (EBool False) + describe "invalid types" do + it "mismatch" do + shouldNotParse "true && 1" "Expected two booleans." + shouldNotParse "1 + true" "Expected two integers."