Add golden tests for layout

Author: natefaubion

package.yaml

@@ -99,11 +99,15 @@ executables:
 
 tests:
   purescript-cst-test:
-    main:                Spec.hs
+    main:                Main.hs
     source-dirs:         test
     ghc-options:
     - -threaded
     - -rtsopts
     - -with-rtsopts=-N
     dependencies:
     - purescript-cst
+    - bytestring
+    - filepath
+    - tasty
+    - tasty-golden

purescript-cst.cabal

@@ -2,7 +2,7 @@
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: 1e42d1d28abc402cc9e87fa2aea472ed5adbe23f1624e524fd3945c2d3a034bf
+-- hash: 4628a2ef8808b8d6029e3a9c0b0a82502e9e834abfc57edc206691a00bac1d64
 
 name:           purescript-cst
 version:        0.1.0.0
@@ -90,7 +90,7 @@ executable purescript-cst-exe
 
 test-suite purescript-cst-test
   type: exitcode-stdio-1.0
-  main-is: Spec.hs
+  main-is: Main.hs
   other-modules:
       Paths_purescript_cst
   hs-source-dirs:
@@ -102,16 +102,20 @@ test-suite purescript-cst-test
     , array
     , async
     , base >=4.7 && <5
+    , bytestring
     , containers
     , criterion
     , deepseq
     , dlist
+    , filepath
     , megaparsec ==7.0.4
     , mtl
     , pretty-simple
     , prettyprinter ==1.2.1
     , purescript ==0.12.2
     , purescript-cst
     , scientific
+    , tasty
+    , tasty-golden
     , text
   default-language: Haskell2010

test/Main.hs

@@ -0,0 +1,34 @@
+import Prelude
+
+import qualified Data.ByteString.Lazy as BS
+import qualified Data.Text as Text
+import qualified Data.Text.Encoding as Text
+import qualified Data.Text.IO as Text
+import Test.Tasty (defaultMain, TestTree, testGroup)
+import Test.Tasty.Golden (goldenVsString, findByExtension)
+import Language.PureScript.CST.Errors as CST
+import Language.PureScript.CST.Lexer as CST
+import Language.PureScript.CST.Print as CST
+import System.FilePath (takeBaseName, replaceExtension)
+
+main :: IO ()
+main = defaultMain =<< layoutTests
+
+layoutTests :: IO TestTree
+layoutTests = do
+  pursFiles <- findByExtension [".purs"] "./test/layout"
+  return $ testGroup "Layout golden tests" $ do
+    file <- pursFiles
+    pure $ goldenVsString
+      (takeBaseName file)
+      (replaceExtension file ".out")
+      (BS.fromStrict . Text.encodeUtf8 <$> runLexer file)
+
+  where
+  runLexer file = do
+    src <- Text.readFile file
+    case CST.lex src of
+      Left errs ->
+        pure $ Text.pack $ unlines $ CST.prettyPrintError <$> errs
+      Right toks -> do
+        pure $ CST.printTokens toks

test/Spec.hs

@@ -0,0 +1,8 @@
+module Test where{
+
+test = ado{
+  baz;
+  let {foo = bar}}
+   in bar;
+
+test = ado {}in foo}

test/layout/AdoIn.out

@@ -0,0 +1,8 @@
+module Test where
+
+test = ado
+  baz
+  let foo = bar
+   in bar
+
+test = ado in foo

test/layout/AdoIn.purs

@@ -0,0 +1,52 @@
+module Test where{
+
+-- Including data because of `|` masking
+data Foo
+ = Foo
+ | Bar
+ | Baz;
+
+test =
+  case foo of{
+    a | b, c ->
+      d;
+    a | b, c -> d};
+
+test = case a, b of{
+  c, d
+   | e ->
+     case e of{
+       f | true -> bar
+         | false -> baz}
+   | f -> g};
+
+test a
+  | false =
+      case false of{
+        true | a > 12 -> true}
+  | otherwise = true;
+
+test = case a of {foo | foo \a -> a -> true};
+
+test = a `case _ of {x | unit # \_ -> true, true -> const}` b;
+
+test = case a of{
+  12 | do {that;
+          that   }-> this
+     | otherwise -> this};
+
+test a b = [ case _ of{
+  12 | case a, b of{
+         _, 42 -> b;
+         _, 12 -> false}, b -> true
+     | case a, b of{
+         _, 42 -> b;
+         _, 12 -> false}, b -> true}, false ];
+
+test a
+  | case a, b of{
+         _, 42 -> b;
+         _, 12 -> false}, b = true
+  | case a, b of{
+         _, 42 -> b;
+         _, 12 -> false}, b = true}

test/layout/CaseGuards.out

@@ -0,0 +1,53 @@
+module Test where
+
+-- Including data because of `|` masking
+data Foo
+ = Foo
+ | Bar
+ | Baz
+
+test =
+  case foo of
+    a | b, c ->
+      d
+    a | b, c -> d
+
+test = case a, b of
+  c, d
+   | e ->
+     case e of
+       f | true -> bar
+         | false -> baz
+   | f -> g
+
+test a
+  | false =
+      case false of
+        true | a > 12 -> true
+  | otherwise = true
+
+test = case a of foo | foo \a -> a -> true
+
+test = a `case _ of x | unit # \_ -> true, true -> const` b
+
+test = case a of
+  12 | do that
+          that   -> this
+     | otherwise -> this
+
+test a b = [ case _ of
+  12 | case a, b of
+         _, 42 -> b
+         _, 12 -> false, b -> true
+     | case a, b of
+         _, 42 -> b
+         _, 12 -> false, b -> true, false ]
+
+test a
+  | case a, b of
+         _, 42 -> b
+         _, 12 -> false, b = true
+  | case a, b of
+         _, 42 -> b
+         _, 12 -> false, b = true
+

test/layout/CaseGuards.purs

@@ -0,0 +1,12 @@
+module Test where{
+
+test = case foo of{
+  Nothing -> a
+    where {a = 12};
+  Just a -> do{
+    what}}
+  where{
+    foo = bar};
+
+test = case f of {Foo -> do {that}
+                        where {foo = 12}}}

test/layout/CaseWhere.out

@@ -0,0 +1,12 @@
+module Test where
+
+test = case foo of
+  Nothing -> a
+    where a = 12
+  Just a -> do
+    what
+  where
+    foo = bar
+
+test = case f of Foo -> do that
+                        where foo = 12