version 0.10.30.10.3

6 files changed, 67 insertions, 22 deletions

diff --git a/tests/Language/PureScript/Ide/ReexportsSpec.hs b/tests/Language/PureScript/Ide/ReexportsSpec.hs
index f273938..d5d394c 100644
--- a/tests/Language/PureScript/Ide/ReexportsSpec.hs
+++ b/tests/Language/PureScript/Ide/ReexportsSpec.hs
@@ -2,7 +2,6 @@
 {-# LANGUAGE NoImplicitPrelude #-}
 module Language.PureScript.Ide.ReexportsSpec where
 
-import qualified Prelude
 import           Protolude
 
 import qualified Data.Map as Map
@@ -11,7 +10,7 @@ import           Language.PureScript.Ide.Types
 import qualified Language.PureScript as P
 import           Test.Hspec
 
-m :: Prelude.String -> P.ModuleName
+m :: Text -> P.ModuleName
 m = P.moduleNameFromString
 
 d :: IdeDeclaration -> IdeDeclarationAnn
diff --git a/tests/TestCompiler.hs b/tests/TestCompiler.hs
index a11babe..4fc8552 100644
--- a/tests/TestCompiler.hs
+++ b/tests/TestCompiler.hs
@@ -2,6 +2,7 @@
 {-# LANGUAGE DoAndIfThenElse #-}
 {-# LANGUAGE TupleSections #-}
 {-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE OverloadedStrings #-}
 
 module TestCompiler where
 
@@ -30,8 +31,8 @@ import Data.Function (on)
 import Data.List (sort, stripPrefix, intercalate, groupBy, sortBy, minimumBy)
 import Data.Maybe (mapMaybe)
 import Data.Time.Clock (UTCTime())
-import Data.Tuple (swap)
 import qualified Data.Text as T
+import Data.Tuple (swap)
 
 import qualified Data.Map as M
 
@@ -46,6 +47,7 @@ import System.Exit
 import System.Process hiding (cwd)
 import System.FilePath
 import System.Directory
+import System.IO
 import System.IO.UTF8
 import System.IO.Silently
 import qualified System.FilePath.Glob as Glob
@@ -72,7 +74,7 @@ spec = do
     supportPurs <- supportFiles "purs"
     supportPursFiles <- readInput supportPurs
     supportExterns <- runExceptT $ do
-      modules <- ExceptT . return $ P.parseModulesFromFiles id (map (fmap T.pack) supportPursFiles)
+      modules <- ExceptT . return $ P.parseModulesFromFiles id supportPursFiles
       foreigns <- inferForeignModules modules
       externs <- ExceptT . fmap fst . runTest $ P.make (makeActions foreigns) (map snd modules)
       return (zip (map snd modules) externs)
@@ -80,10 +82,15 @@ spec = do
       Left errs -> fail (P.prettyPrintMultipleErrors P.defaultPPEOptions errs)
       Right externs -> return (externs, passingFiles, warningFiles, failingFiles)
 
+  outputFile <- runIO $ do
+    tmp <- getTemporaryDirectory
+    createDirectoryIfMissing False (tmp </> logpath)
+    openFile (tmp </> logpath </> logfile) WriteMode
+
   context "Passing examples" $
     forM_ passingTestCases $ \testPurs ->
       it ("'" <> takeFileName (getTestMain testPurs) <> "' should compile and run without error") $
-        assertCompiles supportExterns testPurs
+        assertCompiles supportExterns testPurs outputFile
 
   context "Warning examples" $
     forM_ warningTestCases $ \testPurs -> do
@@ -169,20 +176,20 @@ makeActions foreigns = (P.buildMakeActions modulesDir (P.internalError "makeActi
   where
   getInputTimestamp :: P.ModuleName -> P.Make (Either P.RebuildPolicy (Maybe UTCTime))
   getInputTimestamp mn
-    | isSupportModule (P.runModuleName mn) = return (Left P.RebuildNever)
+    | isSupportModule (T.unpack (P.runModuleName mn)) = return (Left P.RebuildNever)
     | otherwise = return (Left P.RebuildAlways)
     where
     isSupportModule = flip elem supportModules
 
   getOutputTimestamp :: P.ModuleName -> P.Make (Maybe UTCTime)
   getOutputTimestamp mn = do
-    let filePath = modulesDir </> P.runModuleName mn
+    let filePath = modulesDir </> T.unpack (P.runModuleName mn)
     exists <- liftIO $ doesDirectoryExist filePath
     return (if exists then Just (P.internalError "getOutputTimestamp: read timestamp") else Nothing)
 
-readInput :: [FilePath] -> IO [(FilePath, String)]
+readInput :: [FilePath] -> IO [(FilePath, T.Text)]
 readInput inputFiles = forM inputFiles $ \inputFile -> do
-  text <- readUTF8File inputFile
+  text <- readUTF8FileT inputFile
   return (inputFile, text)
 
 runTest :: P.Make a -> IO (Either P.MultipleErrors a, P.MultipleErrors)
@@ -195,7 +202,7 @@ compile
   -> IO (Either P.MultipleErrors [P.ExternsFile], P.MultipleErrors)
 compile supportExterns inputFiles check = silence $ runTest $ do
   fs <- liftIO $ readInput inputFiles
-  ms <- P.parseModulesFromFiles id (map (fmap T.pack) fs)
+  ms <- P.parseModulesFromFiles id fs
   foreigns <- inferForeignModules ms
   liftIO (check (map snd ms))
   let actions = makeActions foreigns
@@ -222,15 +229,16 @@ checkMain ms =
 checkShouldFailWith :: [String] -> P.MultipleErrors -> Maybe String
 checkShouldFailWith expected errs =
   let actual = map P.errorCode $ P.runMultipleErrors errs
-  in if sort expected == sort actual
+  in if sort expected == sort (map T.unpack actual)
     then Nothing
     else Just $ "Expected these errors: " ++ show expected ++ ", but got these: " ++ show actual
 
 assertCompiles
   :: [(P.Module, P.ExternsFile)]
   -> [FilePath]
+  -> Handle
   -> Expectation
-assertCompiles supportExterns inputFiles =
+assertCompiles supportExterns inputFiles outputFile =
   assert supportExterns inputFiles checkMain $ \e ->
     case e of
       Left errs -> return . Just . P.prettyPrintMultipleErrors P.defaultPPEOptions $ errs
@@ -239,10 +247,13 @@ assertCompiles supportExterns inputFiles =
         let entryPoint = modulesDir </> "index.js"
         writeFile entryPoint "require('Main').main()"
         result <- traverse (\node -> readProcessWithExitCode node [entryPoint] "") process
+        hPutStrLn outputFile $ "\n" <> takeFileName (last inputFiles) <> ":"
         case result of
           Just (ExitSuccess, out, err)
             | not (null err) -> return $ Just $ "Test wrote to stderr:\n\n" <> err
-            | not (null out) && trim (last (lines out)) == "Done" -> return Nothing
+            | not (null out) && trim (last (lines out)) == "Done" -> do
+                hPutStr outputFile out
+                return Nothing
             | otherwise -> return $ Just $ "Test did not finish with 'Done':\n\n" <> out
           Just (ExitFailure _, _, err) -> return $ Just err
           Nothing -> return $ Just "Couldn't find node.js executable"
@@ -285,3 +296,9 @@ assertDoesNotCompile supportExterns inputFiles shouldFailWith =
 
   where
   noPreCheck = const (return ())
+
+logpath :: FilePath
+logpath = "purescript-output"
+
+logfile :: FilePath
+logfile = "psc-tests.out"
diff --git a/tests/TestDocs.hs b/tests/TestDocs.hs
index 1d56293..c689437 100644
--- a/tests/TestDocs.hs
+++ b/tests/TestDocs.hs
@@ -13,6 +13,7 @@ import Data.Monoid
 import Data.Maybe (fromMaybe)
 import Data.List ((\\))
 import Data.Foldable
+import qualified Data.Text as T
 import System.Exit
 
 import qualified Language.PureScript as P
@@ -36,8 +37,8 @@ main = pushd "examples/docs" $ do
   case res of
     Left e -> Publish.printErrorToStdout e >> exitFailure
     Right Docs.Package{..} ->
-      forM_ testCases $ \(P.moduleNameFromString -> mn, pragmas) ->
-        let mdl = takeJust ("module not found in docs: " ++ P.runModuleName mn)
+      forM_ testCases $ \(P.moduleNameFromString . T.pack -> mn, pragmas) ->
+        let mdl = takeJust ("module not found in docs: " ++ T.unpack (P.runModuleName mn))
                           (find ((==) mn . Docs.modName) pkgModules)
         in forM_ pragmas (`runAssertionIO` mdl)
 
@@ -57,6 +58,9 @@ data Assertion
   -- | Assert that a particular declaration has a particular type class
   -- constraint.
   | ShouldBeConstrained P.ModuleName String String
+  -- | Assert that a particular typeclass declaration has a functional
+  -- dependency list.
+  | ShouldHaveFunDeps P.ModuleName String [([String],[String])]
   -- | Assert that a particular value declaration exists, and its type
   -- satisfies the given predicate.
   | ValueShouldHaveTypeSignature P.ModuleName String (ShowFn (P.Type -> Bool))
@@ -82,6 +86,8 @@ data AssertionFailure
   | ChildDocumented P.ModuleName String String
   -- | A constraint was missing.
   | ConstraintMissing P.ModuleName String String
+  -- | A functional dependency was missing.
+  | FunDepMissing P.ModuleName String [([String], [String])]
   -- | A declaration had the wrong "type" (ie, value, type, type class)
   -- Fields: declaration title, expected "type", actual "type".
   | WrongDeclarationType P.ModuleName String String String
@@ -142,6 +148,20 @@ runAssertion assertion Docs.Module{..} =
               Fail (WrongDeclarationType mn decl "value"
                      (Docs.declInfoToString declInfo))
 
+    ShouldHaveFunDeps mn decl fds ->
+      case find ((==) decl . Docs.declTitle) (declarationsFor mn) of
+        Nothing ->
+          Fail (NotDocumented mn decl)
+        Just Docs.Declaration{..} ->
+          case declInfo of
+            Docs.TypeClassDeclaration _ _ fundeps ->
+              if fundeps == fds
+                then Pass
+                else Fail (FunDepMissing mn decl fds)
+            _ ->
+              Fail (WrongDeclarationType mn decl "value"
+                     (Docs.declInfoToString declInfo))
+
     ValueShouldHaveTypeSignature mn decl (ShowFn tyPredicate) ->
       case find ((==) decl . Docs.declTitle) (declarationsFor mn) of
         Nothing ->
@@ -197,11 +217,11 @@ checkConstrained ty tyClass =
       False
   where
   matches className =
-    (==) className . P.runProperName . P.disqualify . P.constraintClass
+    (==) className . T.unpack . P.runProperName . P.disqualify . P.constraintClass
 
 runAssertionIO :: Assertion -> Docs.Module -> IO ()
 runAssertionIO assertion mdl = do
-  putStrLn ("In " ++ P.runModuleName (Docs.modName mdl) ++ ": " ++ show assertion)
+  putStrLn ("In " ++ T.unpack (P.runModuleName (Docs.modName mdl)) ++ ": " ++ show assertion)
   case runAssertion assertion mdl of
     Pass -> pure ()
     Fail reason -> do
@@ -270,6 +290,10 @@ testCases =
       , ChildShouldNotBeDocumented (n "TypeClassWithoutMembersIntermediate") "SomeClass" "member"
       ])
 
+  , ("TypeClassWithFunDeps",
+      [ ShouldHaveFunDeps          (n "TypeClassWithFunDeps") "TypeClassWithFunDeps" [(["a","b"], ["c"]), (["c"], ["d","e"])]
+      ])
+
   , ("NewOperators",
       [ ShouldBeDocumented (n "NewOperators2") "(>>>)" []
       ])
@@ -298,12 +322,12 @@ testCases =
   ]
 
   where
-  n = P.moduleNameFromString
+  n = P.moduleNameFromString . T.pack
 
   hasTypeVar varName =
     getAny . P.everythingOnTypes (<>) (Any . isVar varName)
 
-  isVar varName (P.TypeVar name) | varName == name = True
+  isVar varName (P.TypeVar name) | varName == T.unpack name = True
   isVar _ _ = False
 
   renderedType expected =
diff --git a/tests/TestPsci.hs b/tests/TestPsci.hs
index 19eb961..f758acb 100644
--- a/tests/TestPsci.hs
+++ b/tests/TestPsci.hs
@@ -10,6 +10,7 @@ import Control.Monad.Trans.State.Strict (evalStateT)
 import Control.Monad (when)
 
 import Data.List (sort)
+import qualified Data.Text as T
 
 import System.Exit (exitFailure)
 import System.Console.Haskeline
@@ -127,11 +128,11 @@ getPSCiState = do
     Left err ->
       print err >> exitFailure
     Right modules ->
-      let imports = [controlMonadSTasST, (P.ModuleName [P.ProperName "Prelude"], P.Implicit, Nothing)]
+      let imports = [controlMonadSTasST, (P.ModuleName [P.ProperName (T.pack "Prelude")], P.Implicit, Nothing)]
           dummyExterns = P.internalError "TestPsci: dummyExterns should not be used"
       in  return (PSCiState imports [] (zip (map snd modules) (repeat dummyExterns)))
 
 controlMonadSTasST :: ImportedModule
 controlMonadSTasST = (s "Control.Monad.ST", P.Implicit, Just (s "ST"))
   where
-  s = P.moduleNameFromString
+  s = P.moduleNameFromString . T.pack
diff --git a/tests/TestUtils.hs b/tests/TestUtils.hs
index 6c8e099..cf67a38 100644
--- a/tests/TestUtils.hs
+++ b/tests/TestUtils.hs
@@ -104,6 +104,7 @@ supportModules =
   , "Data.Ring"
   , "Data.Semigroup"
   , "Data.Semiring"
+  , "Data.Symbol"
   , "Data.Show"
   , "Data.Unit"
   , "Data.Void"
@@ -112,6 +113,7 @@ supportModules =
   , "Prelude"
   , "Test.Assert"
   , "Test.Main"
+  , "Unsafe.Coerce"
   ]
 
 pushd :: forall a. FilePath -> IO a -> IO a
diff --git a/tests/support/bower.json b/tests/support/bower.json
index d2f01dd..2de10e8 100644
--- a/tests/support/bower.json
+++ b/tests/support/bower.json
@@ -9,6 +9,8 @@
     "purescript-st": "1.0.0-rc.1",
     "purescript-partial": "1.1.2",
     "purescript-newtype": "0.1.0",
-    "purescript-generics-rep": "2.0.0"
+    "purescript-generics-rep": "2.0.0",
+    "purescript-symbols": "^1.0.1",
+    "purescript-unsafe-coerce": "^1.0.0"
   }
 }