use abstraction to make operators easier to use, add more tests, and …

…add some comments.
Haskell-Things · May 19, 2018 · 2ff0313 · 2ff0313
1 parent 556b451
commit 2ff0313
Show file tree

Hide file tree

Showing 3 changed files with 103 additions and 59 deletions.
diff --git a/tests/ParserSpec/Expr.hs b/tests/ParserSpec/Expr.hs
@@ -4,19 +4,31 @@
 
 module ParserSpec.Expr (exprSpec) where
 
-import Test.Hspec
-import Graphics.Implicit.ExtOpenScad.Definitions
-import Graphics.Implicit.ExtOpenScad.Parser.Expr
-import Graphics.Implicit.ExtOpenScad.Parser.Statement
-import ParserSpec.Util
-import Text.ParserCombinators.Parsec hiding (State)
-import Data.Either
+-- Be explicit about what we import.
+import Prelude (String, Bool(True, False), ($), (<*), )
 
+-- Hspec, for writing specs.
+import Test.Hspec (describe, Expectation, Spec, it, shouldBe, pendingWith, specify)
+
+-- parsed expression components.
+import Graphics.Implicit.ExtOpenScad.Definitions (Expr(Var, ListE, (:$)) )
+
+-- the expression parser entry point.
+import Graphics.Implicit.ExtOpenScad.Parser.Expr (expr0)
+
+import ParserSpec.Util (fapp, num, bool, plus, minus, mult, modulo, power, divide, negate, and, or, gt, lt, ternary, append, index, parseWithLeftOver)
+
+import Data.Either (Either(Right))
+
+import Text.ParserCombinators.Parsec (parse, eof)
+
+-- An operator for expressions for "the left side should parse to the right side."
 infixr 1 -->
 (-->) :: String -> Expr -> Expectation
 (-->) source expr =
-  parseExpr source `shouldBe` Right expr
+  parse (expr0 <* eof) "<expr>" source `shouldBe` Right expr
 
+-- An operator for expressions for "the left side should parse to the right side, and some should be left over.
 infixr 1 -->+
 (-->+) :: String -> (Expr, String) -> Expectation
 (-->+) source (result, leftover) =
@@ -25,22 +37,28 @@ infixr 1 -->+
 ternaryIssue :: Expectation -> Expectation
 ternaryIssue _ = pendingWith "parser doesn't handle ternary operator correctly"
 
+negationIssue :: Expectation -> Expectation
+negationIssue _ = pendingWith "parser doesn't handle negation operator correctly"
+
 logicalSpec :: Spec
 logicalSpec = do
-  it "handles not" $ "!foo" --> app' "!" [Var "foo"]
+  describe "not" $ do
+    specify "single" $ "!foo" --> negate [Var "foo"]
+    specify "multiple" $
+      negationIssue $ "!!!foo" --> negate [negate [negate [Var "foo"]]]
   it "handles and/or" $ do
-    "foo && bar" --> app' "&&" [Var "foo", Var "bar"]
-    "foo || bar" --> app' "||" [Var "foo", Var "bar"]
+    "foo && bar" --> and [Var "foo", Var "bar"]
+    "foo || bar" --> or [Var "foo", Var "bar"]
   describe "ternary operator" $ do
     specify "with primitive expressions" $
-      "x ? 2 : 3" --> app' "?" [Var "x", num 2, num 3]
+      "x ? 2 : 3" --> ternary [Var "x", num 2, num 3]
     specify "with parenthesized comparison" $
-      "(1 > 0) ? 5 : -5" --> app' "?" [app' ">" [num 1, num 0], num 5, num (-5)]
+      "(1 > 0) ? 5 : -5" --> ternary [gt [num 1, num 0], num 5, num (-5)]
     specify "with comparison in head position" $
-      ternaryIssue $ "1 > 0 ? 5 : -5" --> app' "?" [app' ">" [num 1, num 0], num 5, num (-5)]
+      ternaryIssue $ "1 > 0 ? 5 : -5" --> ternary [gt [num 1, num 0], num 5, num (-5)]
     specify "with comparison in head position, and addition in tail" $
       ternaryIssue $ "1 > 0 ? 5 : 1 + 2" -->
-      app' "?" [app' ">" [num 1, num 0], num 5, app "+" [num 1, num 2]]
+        ternary [gt [num 1, num 0], num 5, plus [num 1, num 2]]
 
 literalSpec :: Spec
 literalSpec = do
@@ -59,7 +77,6 @@ exprSpec = do
     it "accepts valid variable names" $ do
       "foo" --> Var "foo"
       "foo_bar" --> Var "foo_bar"
-  describe "literals" literalSpec
   describe "grouping" $ do
     it "allows parens" $
       "( false )" -->  bool False
@@ -69,38 +86,44 @@ exprSpec = do
       "( 1, 2, 3 )" -->  ListE [num 1, num 2, num 3]
     it "handles generators" $
       "[ a : 1 : b + 10 ]" -->
-      app "list_gen" [Var "a", num 1, app "+" [Var "b", num 10]]
+      fapp "list_gen" [Var "a", num 1, plus [Var "b", num 10]]
     it "handles indexing" $
-      "foo[23]" --> Var "index" :$ [Var "foo", num 23]
+      "foo[23]" --> index [Var "foo", num 23]
   describe "arithmetic" $ do
     it "handles unary +/-" $ do
       "-42" --> num (-42)
       "+42" -->  num 42
     it "handles +" $ do
-      "1 + 2" --> app "+" [num 1, num 2]
-      "1 + 2 + 3" --> app "+" [num 1, num 2, num 3]
+      "1 + 2" --> plus [num 1, num 2]
+      "1 + 2 + 3" --> plus [num 1, num 2, num 3]
     it "handles -" $ do
-      "1 - 2" --> app' "-" [num 1, num 2]
-      "1 - 2 - 3" --> app' "-" [app' "-" [num 1, num 2], num 3]
+      "1 - 2" --> minus [num 1, num 2]
+      "1 - 2 - 3" --> minus [minus [num 1, num 2], num 3]
     it "handles +/- in combination" $ do
-      "1 + 2 - 3" --> app "+" [num 1, app' "-" [num 2, num 3]]
-      "2 - 3 + 4" --> app "+" [app' "-" [num 2, num 3], num 4]
-      "1 + 2 - 3 + 4" --> app "+" [num 1, app' "-" [num 2, num 3], num 4]
-      "1 + 2 - 3 + 4 - 5 - 6" --> app "+" [num 1,
-                                           app' "-" [num 2, num 3],
-                                           app' "-" [app' "-" [num 4, num 5],
+      "1 + 2 - 3" --> plus [num 1, minus [num 2, num 3]]
+      "2 - 3 + 4" --> plus [minus [num 2, num 3], num 4]
+      "1 + 2 - 3 + 4" --> plus [num 1, minus [num 2, num 3], num 4]
+      "1 + 2 - 3 + 4 - 5 - 6" --> plus [num 1,
+                                           minus [num 2, num 3],
+                                           minus [minus [num 4, num 5],
                                                      num 6]]
     it "handles exponentiation" $
-      "x ^ y" -->  app' "^" [Var "x", Var "y"]
+      "x ^ y" -->  power [Var "x", Var "y"]
     it "handles *" $ do
-      "3 * 4" -->  app "*" [num 3, num 4]
-      "3 * 4 * 5" -->  app "*" [num 3, num 4, num 5]
+      "3 * 4" -->  mult [num 3, num 4]
+      "3 * 4 * 5" -->  mult [num 3, num 4, num 5]
     it "handles /" $
-      "4.2 / 2.3" -->  app' "/" [num 4.2, num 2.3]
+      "4.2 / 2.3" -->  divide [num 4.2, num 2.3]
     it "handles precedence" $
-      parseExpr "1 + 2 / 3 * 5" `shouldBe`
-      (Right $ app "+" [num 1, app "*" [app' "/" [num 2, num 3], num 5]])
+      "1 + 2 / 3 * 5" --> plus [num 1, mult [divide [num 2, num 3], num 5]]
     it "handles append" $
-      parseExpr "foo ++ bar ++ baz" `shouldBe`
-      (Right $ app "++" [Var "foo", Var "bar", Var "baz"])
+      "foo ++ bar ++ baz" --> append [Var "foo", Var "bar", Var "baz"]
   describe "logical operators" logicalSpec
+  describe "application" $ do
+    specify "base case" $ "foo(x)" --> Var "foo" :$ [Var "x"]
+    specify "multiple arguments" $
+      "foo(x, 1, 2)" --> Var "foo" :$ [Var "x", num 1, num 2]
+    specify "multiple" $
+      "foo(x, 1, 2)(5)(y)" --> ((Var "foo" :$ [Var "x", num 1, num 2]) :$ [num 5]) :$ [Var "y"]
+    specify "multiple, with indexing" $
+      "foo(x)[0](y)" --> ((index [(Var "foo" :$ [Var "x"]), num 0]) :$ [Var "y"])
diff --git a/tests/ParserSpec/Statement.hs b/tests/ParserSpec/Statement.hs
@@ -11,7 +11,7 @@ import Test.Hspec (Spec, Expectation, shouldBe, shouldSatisfy, it, pendingWith,
 
 -- import Text.ParserCombinators.Parsec ()
 
-import ParserSpec.Util (bool, num, app, app')
+import ParserSpec.Util (bool, num, minus, mult, index)
 
 import Graphics.Implicit.ExtOpenScad.Definitions (StatementI(StatementI), Symbol, Expr(ListE, LamE, Var), Statement(NewModule, ModuleCall, If, (:=)), Pattern(Name, ListP))
 
@@ -36,32 +36,34 @@ single st = [StatementI 1 st]
 call :: Symbol -> [(Maybe Symbol, Expr)] -> [StatementI] -> StatementI
 call name args stmts = StatementI 1 (ModuleCall name args stmts)
 
+-- test a simple if block.
 ifSpec :: Spec
 ifSpec = it "parses" $
     "if (true) { a(); } else { b(); }" --> 
       single ( If (bool True) [call "a" [] []] [call "b" [] []])
 
+-- test assignments.
 assignmentSpec :: Spec
 assignmentSpec = do
   it "parses correctly" $
     "y = -5;" --> single ( Name "y" := num (-5))
   it "handles pattern matching" $
     "[x, y] = [1, 2];" --> single (ListP [Name "x", Name "y"] := ListE [num 1, num 2])
-  it "handles function definitions" $
-    "foo (x, y) = x * y;" --> single fooFunction
-  it "handles the function keyword" $
+  it "handles the function keyword and definitions" $
     "function foo(x, y) = x * y;" --> single fooFunction
   it "nested indexing" $
     "x = [y[0] - z * 2];" -->
-    single ( Name "x" := ListE [app' "-" [app' "index" [Var "y", num 0],
-                                           app "*" [Var "z", num 2]]])
+    single ( Name "x" := ListE [minus [index [Var "y", num 0],
+                                           mult [Var "z", num 2]]])
   where
+    fooFunction :: Statement st
     fooFunction = Name "foo" := LamE [Name "x", Name "y"]
-                                (app "*" [Var "x", Var "y"])
+                                (mult [Var "x", Var "y"])
 
 emptyFileIssue :: Expectation -> Expectation
 emptyFileIssue _ = pendingWith "parser should probably allow empty files"
 
+
 statementSpec :: Spec
 statementSpec = do
   describe "assignment" $ assignmentSpec

diff --git a/tests/ParserSpec/Util.hs b/tests/ParserSpec/Util.hs
@@ -10,11 +10,22 @@
 module ParserSpec.Util
        ( num
        , bool
-       , app
-       , app'
-       , parseWithEof
+       , fapp
+       , plus
+       , minus
+       , mult
+       , modulo
+       , power
+       , divide
+       , negate
+       , and
+       , or
+       , gt
+       , lt
+       , ternary
+       , append
+       , index
        , parseWithLeftOver
-       , parseExpr
        ) where
 
 -- be explicit about where we get things from.
@@ -37,27 +48,35 @@ num :: ℝ -> Expr
 num x
   -- FIXME: the parser should handle negative number literals
   -- directly, we abstract that deficiency away here
-  | x < 0 = app' "negate" [LitE $ ONum (-x)]
+  | x < 0 = oapp "negate" [LitE $ ONum (-x)]
   | otherwise = LitE $ ONum x
 
 bool :: Bool -> Expr
 bool = LitE . OBool
 
--- Operators and functions need two different kinds of applications
-app :: String -> [Expr] -> Expr
-app name args = Var name :$ [ListE args]
+plus,minus,mult,modulo,power,divide,negate,and,or,gt,lt,ternary,append,index :: [Expr] -> Expr
+minus = oapp "-"
+modulo = oapp "%"
+power = oapp "^"
+divide = oapp "/"
+and = oapp "&&"
+or = oapp "||"
+gt = oapp ">"
+lt = oapp "<"
+ternary = oapp "?"
+negate = oapp "!"
+index = oapp "index"
+plus = fapp "+"
+mult = fapp "*"
+append = fapp "++"
 
-app' :: Symbol -> [Expr] -> Expr
-app' name args = Var name :$ args
+-- we need two different kinds of application functions
+oapp,fapp :: String -> [Expr] -> Expr
+oapp name args = Var name :$ args
+fapp name args = Var name :$ [ListE args]
 
 parseWithLeftOver :: Parser a -> String -> Either ParseError (a, String)
 parseWithLeftOver p = parse ((,) <$> p <*> leftOver) ""
   where
     leftOver :: Parser String
     leftOver = manyTill anyChar eof
-
-parseWithEof :: Parser a -> String -> String -> Either ParseError a
-parseWithEof p = parse (p <* eof)
-
-parseExpr :: String -> Either ParseError Expr
-parseExpr = parseWithEof expr0 "expr"