Implement printing of cases, parens, fill in operators (js)

Author: raquelxmoss

src/JavaScriptSyntax.hs

@@ -3,11 +3,19 @@ module JavaScriptSyntax
   ) where
 
 import Data.List (intercalate)
+import Data.List.NonEmpty (toList)
 import Language
 
+indent :: Int -> String -> String
+indent level str =
+  intercalate "\n" $ map (\line -> replicate level ' ' ++ line) (lines str)
+
+indent2 :: String -> String
+indent2 = indent 2
+
 printModule :: Module -> String
 printModule (Module topLevels) =
-  intercalate "\n\n" $ map printTopLevel topLevels
+  (intercalate "\n\n" $ map printTopLevel topLevels) ++ "\n"
 
 printTopLevel :: TopLevel -> String
 printTopLevel topLevel =
@@ -19,9 +27,9 @@ printDeclaration :: Declaration -> String
 printDeclaration (Declaration _ name args expression) =
   "function " ++
   s name ++
-  "(" ++ printedArgs ++ ") { return " ++ printExpression expression ++ " }"
+  printedArgs ++ " {\n  return " ++ printExpression expression ++ "\n}"
   where
-    printedArgs = intercalate ", " $ map s args
+    printedArgs = parens $ intercalate ", " $ map s args
 
 printExpression :: Expression -> String
 printExpression expression =
@@ -34,11 +42,28 @@ printExpression expression =
         [printExpression a, printOperator operator, printExpression b]
     String' string -> show string
     Call name args ->
-      s name ++ "(" ++ intercalate ", " (map printExpression args) ++ ")"
+      s name ++ parens (intercalate ", " (map printExpression args))
+    BetweenParens expression -> parens $ printExpression expression
+    Case expression branches ->
+      "switch " ++
+      parens (printExpression expression) ++
+      " {\n" ++ indent 4 (printBranches branches) ++ "\n  }"
     _ -> error $ "not implemented " ++ show expression
+  where
+    printBranches branches =
+      intercalate "\n" $ toList $ fmap printBranch branches
+    printBranch (condition, body) =
+      "case " ++
+      printExpression condition ++ ":\n" ++ indent2 (printExpression body)
 
 printOperator :: OperatorExpr -> String
 printOperator operator =
   case operator of
     Add -> "+"
-    _ -> undefined
+    Subtract -> "-"
+    Divide -> "/"
+    Multiply -> "*"
+    StringAdd -> "++"
+
+parens :: String -> String
+parens s = "(" ++ s ++ ")"

test/JavaScriptSyntaxSpec.hs

@@ -8,6 +8,7 @@ module JavaScriptSyntaxSpec
 
 import Control.Monad
 import qualified Data.List.NonEmpty as NE
+import Debug.Trace
 import System.Exit
 import System.IO.Temp
 import System.Process
@@ -24,23 +25,12 @@ javaScriptSyntaxSpecs :: SpecWith ()
 javaScriptSyntaxSpecs =
   describe "Forest JavaScript syntax" $ do
     it "prints a simple program" $ do
+      expected <- readFixture "js/simple"
       let code =
             Module [Function $ Declaration Nothing (ne "test") [] (Number 1)]
-          expected = "function test() { return 1 }"
-       in printModule code `shouldBe` expected
-    it "prints a function with an argument" $ do
-      let code =
-            Module
-              [ Function $
-                Declaration
-                  Nothing
-                  (ne "test")
-                  [ne "num"]
-                  (Identifier (ne "num"))
-              ]
-          expected = "function test(num) { return num }"
        in printModule code `shouldBe` expected
     it "prints a function with many arguments" $ do
+      expected <- readFixture "js/arguments"
       let code =
             Module
               [ Function $
@@ -50,15 +40,15 @@ javaScriptSyntaxSpecs =
                   [ne "a", ne "b"]
                   (Infix Add (Identifier (ne "a")) (Identifier (ne "b")))
               ]
-          expected = "function test(a, b) { return a + b }"
        in printModule code `shouldBe` expected
     it "prints a function that returns a string" $ do
+      expected <- readFixture "js/string"
       let code =
             Module
               [Function $ Declaration Nothing (ne "test") [] (String' "hey")]
-          expected = "function test() { return \"hey\" }"
        in printModule code `shouldBe` expected
     it "prints a function call with arguments" $ do
+      expected <- readFixture "js/call-with-arguments"
       let code =
             Module
               [ Function $
@@ -70,7 +60,30 @@ javaScriptSyntaxSpecs =
                      (ne "func")
                      [(Identifier (ne "a")), (Identifier (ne "b"))])
               ]
-          expected = "function test(a, b) { return func(a, b) }"
+       in printModule code `shouldBe` expected
+    it "prints a function with an expression inside of parens" $ do
+      expected <- readFixture "js/parens"
+      let code =
+            Module
+              [ Function $
+                Declaration Nothing (ne "test") [] (BetweenParens (Number 1))
+              ]
+       in printModule code `shouldBe` expected
+    it "prints a function with a case" $ do
+      expected <- readFixture "js/case"
+      let code =
+            Module
+              [ Function $
+                Declaration
+                  Nothing
+                  (ne "test")
+                  [ne "a"]
+                  (Case
+                     (Identifier (ne "a"))
+                     [ (String' "Foo", String' "Bar")
+                     , (String' "Ahh", String' "Woo")
+                     ])
+              ]
        in printModule code `shouldBe` expected
 
 ne :: String -> Ident

test/fixtures/js/arguments.tree

@@ -0,0 +1,3 @@
+function test(a, b) {
+  return a + b
+}

test/fixtures/js/call-with-arguments.tree

@@ -0,0 +1,3 @@
+function test(a, b) {
+  return func(a, b)
+}

test/fixtures/js/case.tree

@@ -0,0 +1,8 @@
+function test(a) {
+  return switch (a) {
+    case "Foo":
+      "Bar"
+    case "Ahh":
+      "Woo"
+  }
+}

test/fixtures/js/parens.tree

@@ -0,0 +1,3 @@
+function test() {
+  return (1)
+}

test/fixtures/js/simple.tree

@@ -0,0 +1,3 @@
+function test() {
+  return 1
+}

test/fixtures/js/string.tree

@@ -0,0 +1,3 @@
+function test() {
+  return "hey"
+}