Remove withCurrentDirctory ".." hack

...from bowtie tests.

Also change style.

bowtie-blueprint/src/Bowtie/Blueprint.hs

@@ -77,7 +77,7 @@ parseBlueprint =
 programTypesParser :: Parse.Parser [Item]
 programTypesParser = do
   res <-
-    many $ Mega.try $ do
+    many $ Mega.try do
       _ <- Lexer.indentGuard Parse.spacesOrNewlines EQ Mega.pos1
       parseOne
   _ <- Lexer.indentGuard Parse.spacesOrNewlines EQ Mega.pos1

bowtie-blueprint/test/Test.hs

@@ -18,17 +18,17 @@ main :: IO ()
 main = do
   blueprintExamples <- getBlueprintExamples
 
-  hspec $ do
+  hspec do
     describe "blueprint" $
       for_ blueprintExamples g
 
   where
     g :: FilePath -> Spec
     g path =
-      it path $ do
+      it path do
         src <- TIO.readFile (dir </> path)
         case blueprint src of
-          Left e -> do
+          Left e ->
             expectationFailure (Text.unpack e)
 
           Right _ ->

bowtie-js/test/Test.hs

@@ -14,7 +14,7 @@ import qualified Data.Text.IO as TIO
 
 main :: IO ()
 main =
-  hspec $ do
+  hspec do
     describe
       "well-typed-examples"
       (for_ Bowtie.Example.wellTyped runWellTyped)
@@ -25,7 +25,7 @@ main =
 
 runWellTyped :: (FilePath, Text) -> Spec
 runWellTyped (name, src) =
-  it name $ do
+  it name do
     js <- case transpile src of
             Left e ->
               exitWithError (prettyError e)
@@ -39,7 +39,7 @@ runWellTyped (name, src) =
 
 testApps :: Spec
 testApps =
-  it "lunar-lander" $ do
+  it "lunar-lander" do
     appSource <- TIO.readFile "../example-app/lunar-lander.bowtie"
     libFiles <- readDirectoryFiles "../example-lib" -- TODO: wasted work
     -- TODO: get rid of ..

bowtie-visualize/src/Bowtie/Visualize.hs

@@ -66,9 +66,10 @@ solutionSteps :: (MonadState Int m, MonadError SolveError m) => Constraints -> m
 solutionSteps cs = do
   case next cs of
     Nothing ->
-      if Constraints.isEmpty cs
-        then pure mempty
-        else throwError SolveStuck
+      if Constraints.isEmpty cs then
+        pure mempty
+      else
+        throwError SolveStuck
 
     Just (c, rest) -> do
       (_sub, rest2) <- mapError SolveUnifyError (solveConstraint c rest)

bowtie/src/Bowtie/Infer/Solve.hs

@@ -21,9 +21,10 @@ solve :: (MonadState Int m, MonadError SolveError m) => Constraints -> m Substit
 solve cs = do
   case next cs of
     Nothing ->
-      if Constraints.isEmpty cs
-        then pure mempty
-        else throwError SolveStuck
+      if Constraints.isEmpty cs then
+        pure mempty
+      else
+        throwError SolveStuck
 
     Just (c, rest) -> do
       (sub, rest2) <- mapError SolveUnifyError (solveConstraint c rest)

bowtie/src/Bowtie/Infer/Unify.hs

@@ -44,36 +44,32 @@ unify t1 t2 =
   -- 5. It returns the composition of these, substituting Int for 1,
   -- followed by Int for 0.
 
-  if t1 == t2
-    then
-      Right mempty
+  if t1 == t2 then
+    Right mempty
+  else
+    case (t1, t2) of
+      (TVariable id, _) ->
+        unifyVariable id t2
 
-    else
-      case (t1, t2) of
-        (TVariable id, _) ->
-          unifyVariable id t2
+      (_, TVariable id) ->
+        unifyVariable id t1
 
-        (_, TVariable id) ->
-          unifyVariable id t1
+      (TArrow arg1 res1, TArrow arg2 res2) -> do
+        s1 <- unify arg1 arg2
+        s2 <- unify (substType s1 res1) (substType s1 res2)
+        Right (s1 <> s2)
 
-        (TArrow arg1 res1, TArrow arg2 res2) -> do
-          s1 <- unify arg1 arg2
-          s2 <- unify (substType s1 res1) (substType s1 res2)
-          Right (s1 <> s2)
+      (TypeApp a1 b1, TypeApp a2 b2) -> do
+        s1 <- unify a1 a2
+        s2 <- unify (substType s1 b1) (substType s1 b2)
+        Right (s1 <> s2)
 
-        (TypeApp a1 b1, TypeApp a2 b2) -> do
-          s1 <- unify a1 a2
-          s2 <- unify (substType s1 b1) (substType s1 b2)
-          Right (s1 <> s2)
-
-        _ ->
-          Left (UnifyError t1 t2)
+      _ ->
+        Left (UnifyError t1 t2)
   where
     unifyVariable :: Id -> Type -> Either UnifyError Substitution
     unifyVariable id typ =
-      if Set.member id (freeVars typ)
-        then
-          Left (OccursCheckFailed id typ)
-
-        else
-          Right (singleSub id typ)
+      if Set.member id (freeVars typ) then
+        Left (OccursCheckFailed id typ)
+      else
+        Right (singleSub id typ)

bowtie/src/Bowtie/Surface/Infer.hs

@@ -67,9 +67,10 @@ gatherConstraints env expr = do
     remaining :: Set Id
     remaining =
       Set.difference (Assumptions.keys a) (Environment.keys env)
-  if Set.null remaining
-    then pure ()
-    else throwError (AssumptionsRemain a)
+  if Set.null remaining then
+    pure ()
+  else
+    throwError (AssumptionsRemain a)
 
   pure (c <> explicitConstraintOnSet env a, t)
 

bowtie/test/Test.hs

@@ -14,41 +14,35 @@ import qualified Data.Text as Text
 import qualified Data.Text.IO as TIO
 import qualified Text.Megaparsec as Mega
 
-dir :: FilePath
-dir =
-  "example-app"
-
 main :: IO ()
 main = do
-  -- hack, because changing dir to "../app" makes listDirectory fail.
-  withCurrentDirectory ".." do
-    appExamples <- (fmap.fmap) (\p -> dir </> p) getAppExamples
-    hspec do
-      describe
-        "valid-syntax-examples"
-        (for_ Bowtie.Example.validSyntax run)
-
-      describe
-        "invalid-syntax-examples"
-        (for_ Bowtie.Example.invalidSyntax runInvalidSyntax)
-
-      describe
-        "well-typed-examples"
-        (for_ Bowtie.Example.wellTyped run)
-
-      describe
-        "ill-typed-examples"
-        (for_ Bowtie.Example.illTyped runIllTyped)
-
-      Bowtie.Surface.InferSpec.spec
-
-      describe "example-app" $
-        for_ appExamples f
+  appExamples <- getAppExamples
+  hspec do
+    describe
+      "valid-syntax-examples"
+      (for_ Bowtie.Example.validSyntax run)
+
+    describe
+      "invalid-syntax-examples"
+      (for_ Bowtie.Example.invalidSyntax runInvalidSyntax)
+
+    describe
+      "well-typed-examples"
+      (for_ Bowtie.Example.wellTyped run)
+
+    describe
+      "ill-typed-examples"
+      (for_ Bowtie.Example.illTyped runIllTyped)
+
+    Bowtie.Surface.InferSpec.spec
+
+    describe "example-app" $
+      for_ appExamples f
   where
     f :: FilePath -> Spec
     f path =
       it path do
-        libFiles <- readDirectoryFiles "example-lib" -- TODO: wasted work
+        libFiles <- readDirectoryFiles "../example-lib" -- TODO: wasted work
         appSource <- TIO.readFile path
         case Interpret.interpretProgram libFiles (path, appSource) of
           Left e ->
@@ -67,7 +61,7 @@ runInvalidSyntax (name, src) =
     case Surface.Parse.parse name src of
       Left e ->
         TIO.writeFile
-          ("bowtie" </> "test" </> "invalid-syntax-examples" </> name)
+          ("test" </> "invalid-syntax-examples" </> name)
           (Text.pack (Mega.errorBundlePretty e))
 
       Right _ ->
@@ -89,15 +83,15 @@ runIllTyped (name, src) =
 
           Interpret.TypeError e ->
             TIO.writeFile
-              ("bowtie" </> "test" </> "ill-typed-examples" </> name)
+              ("test" </> "ill-typed-examples" </> name)
               (show e)
 
       Right _ ->
         expectationFailure "Unexpected Right"
 
 getAppExamples :: IO [FilePath]
 getAppExamples = do
-  appPaths <- listDirectory dir
+  appPaths <- (fmap.fmap) ("../example-app" </>) (listDirectory "../example-app")
   let
     (langs, other) =
       List.partition (\path -> takeExtension path == ".bowtie") appPaths