summaryrefslogtreecommitdiff
path: root/tests
diff options
context:
space:
mode:
authorPhilFreeman <>2016-04-06 19:56:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2016-04-06 19:56:00 (GMT)
commiteedee6382a33ad7ca6c1fe36c7c02798f20e2086 (patch)
tree2075e8f57d7fc299005f5b28ec550679f934608e /tests
parent6bc83edfdc50ee74921ae3e0e751a764c8a618fa (diff)
version 0.8.4.00.8.4.0
Diffstat (limited to 'tests')
-rw-r--r--tests/Language/PureScript/Ide/FilterSpec.hs63
-rw-r--r--tests/Language/PureScript/Ide/Imports/IntegrationSpec.hs101
-rw-r--r--tests/Language/PureScript/Ide/ImportsSpec.hs125
-rw-r--r--tests/Language/PureScript/Ide/Integration.hs238
-rw-r--r--tests/Language/PureScript/Ide/MatcherSpec.hs56
-rw-r--r--tests/Language/PureScript/Ide/ReexportsSpec.hs78
-rw-r--r--tests/Language/PureScript/IdeSpec.hs35
-rw-r--r--tests/TestDocs.hs30
-rw-r--r--tests/support/pscide/src/ImportsSpec.purs5
-rw-r--r--tests/support/pscide/src/ImportsSpec1.purs32
-rw-r--r--tests/support/pscide/src/Main.purs7
11 files changed, 770 insertions, 0 deletions
diff --git a/tests/Language/PureScript/Ide/FilterSpec.hs b/tests/Language/PureScript/Ide/FilterSpec.hs
new file mode 100644
index 0000000..700e30e
--- /dev/null
+++ b/tests/Language/PureScript/Ide/FilterSpec.hs
@@ -0,0 +1,63 @@
+{-# LANGUAGE OverloadedStrings #-}
+module Language.PureScript.Ide.FilterSpec where
+
+import Data.Text (Text)
+import Language.PureScript.Ide.Filter
+import Language.PureScript.Ide.Types
+import qualified Language.PureScript as P
+import Test.Hspec
+
+value :: Text -> ExternDecl
+value s = ValueDeclaration s P.TypeWildcard
+
+modules :: [Module]
+modules =
+ [
+ ("Module.A", [value "function1"]),
+ ("Module.B", [value "data1"]),
+ ("Module.C", [ModuleDecl "Module.C" []]),
+ ("Module.D", [Dependency "Module.C" [] Nothing, value "asd"])
+ ]
+
+runEq :: Text -> [Module]
+runEq s = runFilter (equalityFilter s) modules
+runPrefix :: Text -> [Module]
+runPrefix s = runFilter (prefixFilter s) modules
+runModule :: [ModuleIdent] -> [Module]
+runModule ms = runFilter (moduleFilter ms) modules
+runDependency :: [ModuleIdent] -> [Module]
+runDependency ms = runFilter (dependencyFilter ms) modules
+
+spec :: Spec
+spec = do
+ describe "equality Filter" $ do
+ it "removes empty modules" $
+ runEq "test" `shouldBe` []
+ it "keeps function declarations that are equal" $
+ runEq "function1" `shouldBe` [head modules]
+ -- TODO: It would be more sensible to match Constructors
+ it "keeps data declarations that are equal" $
+ runEq "data1" `shouldBe` [modules !! 1]
+ describe "prefixFilter" $ do
+ it "keeps everything on empty string" $
+ runPrefix "" `shouldBe` modules
+ it "keeps functionname prefix matches" $
+ runPrefix "fun" `shouldBe` [head modules]
+ it "keeps data decls prefix matches" $
+ runPrefix "dat" `shouldBe` [modules !! 1]
+ it "keeps module decl prefix matches" $
+ runPrefix "Mod" `shouldBe` [modules !! 2]
+ describe "moduleFilter" $ do
+ it "removes everything on empty input" $
+ runModule [] `shouldBe` []
+ it "only keeps the specified modules" $
+ runModule ["Module.A", "Module.C"] `shouldBe` [head modules, modules !! 2]
+ it "ignores modules that are not in scope" $
+ runModule ["Module.A", "Module.C", "Unknown"] `shouldBe` [head modules, modules !! 2]
+ describe "dependencyFilter" $ do
+ it "removes everything on empty input" $
+ runDependency [] `shouldBe` []
+ it "only keeps the specified modules if they have no imports" $
+ runDependency ["Module.A", "Module.B"] `shouldBe` [head modules, modules !! 1]
+ it "keeps the specified modules and their imports" $
+ runDependency ["Module.A", "Module.D"] `shouldBe` [head modules, modules !! 2, modules !! 3]
diff --git a/tests/Language/PureScript/Ide/Imports/IntegrationSpec.hs b/tests/Language/PureScript/Ide/Imports/IntegrationSpec.hs
new file mode 100644
index 0000000..9992819
--- /dev/null
+++ b/tests/Language/PureScript/Ide/Imports/IntegrationSpec.hs
@@ -0,0 +1,101 @@
+{-# LANGUAGE OverloadedStrings #-}
+module Language.PureScript.Ide.Imports.IntegrationSpec where
+
+import Control.Monad
+import Data.Text (Text)
+import qualified Data.Text as T
+import qualified Data.Text.IO as TIO
+import qualified Language.PureScript.Ide.Integration as Integration
+import Test.Hspec
+
+import System.Directory
+import System.FilePath
+
+setup :: IO ()
+setup = do
+ Integration.deleteOutputFolder
+ s <- Integration.compileTestProject
+ unless s $ fail "Failed to compile .purs sources"
+ Integration.quitServer -- kill a eventually running psc-ide-server instance
+ _ <- Integration.startServer
+ mapM_ Integration.loadModuleWithDeps ["ImportsSpec", "ImportsSpec1"]
+
+teardown :: IO ()
+teardown = Integration.quitServer
+
+withSupportFiles :: (FilePath -> FilePath -> IO a) -> IO ()
+withSupportFiles test = do
+ pdir <- Integration.projectDirectory
+ let sourceFp = pdir </> "src" </> "ImportsSpec.purs"
+ outFp = pdir </> "src" </> "ImportsSpecOut.tmp"
+ Integration.deleteFileIfExists outFp
+ void $ test sourceFp outFp
+
+outputFileShouldBe :: [Text] -> IO ()
+outputFileShouldBe expectation = do
+ outFp <- (</> "src" </> "ImportsSpecOut.tmp") <$> Integration.projectDirectory
+ outRes <- TIO.readFile outFp
+ shouldBe (T.lines outRes) expectation
+
+spec :: Spec
+spec = beforeAll_ setup $ afterAll_ teardown $ describe "Adding imports" $ do
+ let
+ sourceFileSkeleton :: [Text] -> [Text]
+ sourceFileSkeleton importSection =
+ [ "module ImportsSpec where" , ""] ++ importSection ++ [ "" , "myId = id"]
+ it "adds an implicit import" $ do
+ withSupportFiles (Integration.addImplicitImport "Prelude")
+ outputFileShouldBe (sourceFileSkeleton
+ [ "import Prelude"
+ , "import Main (id)"
+ ])
+ it "adds an explicit unqualified import" $ do
+ withSupportFiles (Integration.addImport "exportedFunction")
+ outputFileShouldBe (sourceFileSkeleton
+ [ "import ImportsSpec1 (exportedFunction)"
+ , "import Main (id)"
+ ])
+ it "adds an explicit unqualified import (type)" $ do
+ withSupportFiles (Integration.addImport "MyType")
+ outputFileShouldBe (sourceFileSkeleton [ "import ImportsSpec1 (MyType)"
+ , "import Main (id)"
+ ])
+ it "adds an explicit unqualified import (parameterized type)" $ do
+ withSupportFiles (Integration.addImport "MyParamType")
+ outputFileShouldBe (sourceFileSkeleton [ "import ImportsSpec1 (MyParamType)"
+ , "import Main (id)"
+ ])
+ it "adds an explicit unqualified import (typeclass)" $ do
+ withSupportFiles (Integration.addImport "ATypeClass")
+ outputFileShouldBe (sourceFileSkeleton [ "import ImportsSpec1 (class ATypeClass)"
+ , "import Main (id)"])
+ it "adds an explicit unqualified import (dataconstructor)" $ do
+ withSupportFiles (Integration.addImport "MyJust")
+ outputFileShouldBe (sourceFileSkeleton [ "import ImportsSpec1 (MyMaybe(MyJust))"
+ , "import Main (id)"])
+ it "adds an explicit unqualified import (newtype)" $ do
+ withSupportFiles (Integration.addImport "MyNewtype")
+ outputFileShouldBe (sourceFileSkeleton [ "import ImportsSpec1 (MyNewtype(MyNewtype))"
+ , "import Main (id)"])
+ it "adds an explicit unqualified import (typeclass member function)" $ do
+ withSupportFiles (Integration.addImport "typeClassFun")
+ outputFileShouldBe (sourceFileSkeleton [ "import ImportsSpec1 (typeClassFun)"
+ , "import Main (id)"])
+ it "doesn't add a newtypes constructor if only the type is exported" $ do
+ withSupportFiles (Integration.addImport "OnlyTypeExported")
+ outputFileShouldBe (sourceFileSkeleton [ "import ImportsSpec1 (OnlyTypeExported)"
+ , "import Main (id)"])
+ it "doesn't add an import if the identifier is defined in the module itself" $ do
+ withSupportFiles (Integration.addImport "myId")
+ outputFileShouldBe (sourceFileSkeleton [ "import Main (id)"])
+ it "responds with an error if it's undecidable whether we want a type or constructor" $
+ withSupportFiles (\sourceFp outFp -> do
+ r <- Integration.addImport "SpecialCase" sourceFp outFp
+ shouldBe False (Integration.resultIsSuccess r)
+ shouldBe False =<< doesFileExist outFp)
+ it "responds with an error if the identifier cannot be found and doesn't \
+ \write to the output file" $
+ withSupportFiles (\sourceFp outFp -> do
+ r <- Integration.addImport "doesntExist" sourceFp outFp
+ shouldBe False (Integration.resultIsSuccess r)
+ shouldBe False =<< doesFileExist outFp)
diff --git a/tests/Language/PureScript/Ide/ImportsSpec.hs b/tests/Language/PureScript/Ide/ImportsSpec.hs
new file mode 100644
index 0000000..36cbe25
--- /dev/null
+++ b/tests/Language/PureScript/Ide/ImportsSpec.hs
@@ -0,0 +1,125 @@
+{-# LANGUAGE OverloadedStrings #-}
+module Language.PureScript.Ide.ImportsSpec where
+
+import Data.Maybe (fromJust)
+import Data.Text (Text)
+import qualified Language.PureScript as P
+import Language.PureScript.Ide.Imports
+import Language.PureScript.Ide.Types
+import Test.Hspec
+
+simpleFile :: [Text]
+simpleFile =
+ [ "module Main where"
+ , "import Prelude"
+ , ""
+ , "myFunc x y = x + y"
+ ]
+
+splitSimpleFile :: (P.ModuleName, [Text], [Import], [Text])
+splitSimpleFile = fromRight $ sliceImportSection simpleFile
+ where
+ fromRight (Right r) = r
+ fromRight (Left _) = error "fromRight"
+
+withImports :: [Text] -> [Text]
+withImports is =
+ take 2 simpleFile ++ is ++ drop 2 simpleFile
+
+testParseImport :: Text -> Import
+testParseImport = fromJust . parseImport
+
+preludeImport, arrayImport, listImport, consoleImport, maybeImport :: Import
+preludeImport = testParseImport "import Prelude"
+arrayImport = testParseImport "import Data.Array (head, cons)"
+listImport = testParseImport "import Data.List as List"
+consoleImport = testParseImport "import Control.Monad.Eff.Console (log) as Console"
+maybeImport = testParseImport "import Data.Maybe (Maybe(Just))"
+
+spec :: Spec
+spec = do
+ describe "determining the importsection" $ do
+ let moduleSkeleton imports =
+ Right (P.moduleNameFromString "Main", take 1 simpleFile, imports, drop 2 simpleFile)
+ it "finds a simple import" $
+ shouldBe (sliceImportSection simpleFile) (moduleSkeleton [preludeImport])
+
+ it "allows multiline import statements" $
+ shouldBe
+ (sliceImportSection (withImports [ "import Data.Array (head,"
+ , " cons)"
+ ]))
+ (moduleSkeleton [preludeImport, arrayImport])
+ describe "pretty printing imports" $ do
+ it "pretty prints a simple import" $
+ shouldBe (prettyPrintImport' preludeImport) "import Prelude"
+ it "pretty prints an explicit import" $
+ shouldBe (prettyPrintImport' arrayImport) "import Data.Array (head, cons)"
+ it "pretty prints a qualified import" $
+ shouldBe (prettyPrintImport' listImport) "import Data.List as List"
+ it "pretty prints a qualified explicit import" $
+ shouldBe (prettyPrintImport' consoleImport) "import Control.Monad.Eff.Console (log) as Console"
+ it "pretty prints an import with a datatype (and PositionedRef's for the dtors)" $
+ shouldBe (prettyPrintImport' maybeImport) "import Data.Maybe (Maybe(Just))"
+
+ describe "import commands" $ do
+ let simpleFileImports = let (_, _, i, _) = splitSimpleFile in i
+ addValueImport i mn is =
+ prettyPrintImportSection (addExplicitImport' (ValueDeclaration i P.TypeWildcard) mn is)
+ addDtorImport i t mn is =
+ prettyPrintImportSection (addExplicitImport' (DataConstructor i t P.TypeWildcard) mn is)
+ it "adds an implicit unqualified import" $
+ shouldBe
+ (addImplicitImport' simpleFileImports (P.moduleNameFromString "Data.Map"))
+ [ "import Prelude"
+ , "import Data.Map"
+ ]
+ it "adds an explicit unqualified import" $
+ shouldBe
+ (addValueImport "head" (P.moduleNameFromString "Data.Array") simpleFileImports)
+ [ "import Prelude"
+ , "import Data.Array (head)"
+ ]
+ it "doesn't add an import if the containing module is imported implicitly" $
+ shouldBe
+ (addValueImport "const" (P.moduleNameFromString "Prelude") simpleFileImports)
+ ["import Prelude"]
+ let Right (_, _, explicitImports, _) = sliceImportSection (withImports ["import Data.Array (tail)"])
+ it "adds an identifier to an explicit import list" $
+ shouldBe
+ (addValueImport "head" (P.moduleNameFromString "Data.Array") explicitImports)
+ [ "import Prelude"
+ , "import Data.Array (head, tail)"
+ ]
+ it "adds an operator to an explicit import list" $
+ shouldBe
+ (addValueImport "<~>" (P.moduleNameFromString "Data.Array") explicitImports)
+ [ "import Prelude"
+ , "import Data.Array ((<~>), tail)"
+ ]
+ it "adds the type for a given DataConstructor" $
+ shouldBe
+ (addDtorImport "Just" (P.ProperName "Maybe") (P.moduleNameFromString "Data.Maybe") simpleFileImports)
+ [ "import Prelude"
+ , "import Data.Maybe (Maybe(Just))"
+ ]
+ it "adds a dataconstructor to an existing type import" $ do
+ let Right (_, _, typeImports, _) = sliceImportSection (withImports ["import Data.Maybe (Maybe)"])
+ shouldBe
+ (addDtorImport "Just" (P.ProperName "Maybe") (P.moduleNameFromString "Data.Maybe") typeImports)
+ [ "import Prelude"
+ , "import Data.Maybe (Maybe(Just))"
+ ]
+ it "doesn't add a dataconstructor to an existing type import with open dtors" $ do
+ let Right (_, _, typeImports, _) = sliceImportSection (withImports ["import Data.Maybe (Maybe(..))"])
+ shouldBe
+ (addDtorImport "Just" (P.ProperName "Maybe") (P.moduleNameFromString "Data.Maybe") typeImports)
+ [ "import Prelude"
+ , "import Data.Maybe (Maybe(..))"
+ ]
+ it "doesn't add an identifier to an explicit import list if it's already imported" $
+ shouldBe
+ (addValueImport "tail" (P.moduleNameFromString "Data.Array") explicitImports)
+ [ "import Prelude"
+ , "import Data.Array (tail)"
+ ]
diff --git a/tests/Language/PureScript/Ide/Integration.hs b/tests/Language/PureScript/Ide/Integration.hs
new file mode 100644
index 0000000..7a57662
--- /dev/null
+++ b/tests/Language/PureScript/Ide/Integration.hs
@@ -0,0 +1,238 @@
+-----------------------------------------------------------------------------
+--
+-- Module : Language.PureScript.Ide.Integration
+-- Description : A psc-ide client for use in integration tests
+-- Copyright : Christoph Hegemann 2016
+-- License : MIT (http://opensource.org/licenses/MIT)
+--
+-- Maintainer : Christoph Hegemann <christoph.hegemann1337@gmail.com>
+-- Stability : experimental
+--
+-- |
+-- A psc-ide client for use in integration tests
+-----------------------------------------------------------------------------
+
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+module Language.PureScript.Ide.Integration
+ (
+ -- managing the server process
+ startServer
+ , withServer
+ , stopServer
+ , quitServer
+ -- util
+ , compileTestProject
+ , deleteOutputFolder
+ , projectDirectory
+ , deleteFileIfExists
+ -- sending commands
+ , loadModuleWithDeps
+ , getFlexCompletions
+ , getType
+ , addImport
+ , addImplicitImport
+ -- checking results
+ , resultIsSuccess
+ , parseCompletions
+ , parseTextResult
+ ) where
+
+import Control.Concurrent (threadDelay)
+import Control.Exception
+import Control.Monad (join, when)
+import Data.Aeson
+import Data.Aeson.Types
+import qualified Data.ByteString.Lazy.UTF8 as BSL
+import Data.Either (isRight)
+import Data.Maybe (fromJust)
+import qualified Data.Text as T
+import qualified Data.Vector as V
+import Language.PureScript.Ide.Util
+import System.Directory
+import System.Exit
+import System.FilePath
+import System.Process
+
+projectDirectory :: IO FilePath
+projectDirectory = do
+ cd <- getCurrentDirectory
+ return $ cd </> "tests" </> "support" </> "pscide"
+
+startServer :: IO ProcessHandle
+startServer = do
+ pdir <- projectDirectory
+ (_, _, _, procHandle) <- createProcess $ (shell "psc-ide-server") {cwd=Just pdir}
+ threadDelay 500000 -- give the server 500ms to start up
+ return procHandle
+
+stopServer :: ProcessHandle -> IO ()
+stopServer = terminateProcess
+
+withServer :: IO a -> IO a
+withServer s = do
+ _ <- startServer
+ r <- s
+ quitServer
+ return r
+
+-- project management utils
+
+compileTestProject :: IO Bool
+compileTestProject = do
+ pdir <- projectDirectory
+ (_, _, _, procHandle) <- createProcess $
+ (shell $ "psc " ++ fileGlob) {cwd=Just pdir
+ ,std_out=CreatePipe
+ ,std_err=CreatePipe
+ }
+ isSuccess <$> waitForProcess procHandle
+
+deleteOutputFolder :: IO ()
+deleteOutputFolder = do
+ odir <- fmap (</> "output") projectDirectory
+ whenM (doesDirectoryExist odir) (removeDirectoryRecursive odir)
+
+deleteFileIfExists :: FilePath -> IO ()
+deleteFileIfExists fp = whenM (doesFileExist fp) (removeFile fp)
+
+whenM :: Monad m => m Bool -> m () -> m ()
+whenM p f = do
+ x <- p
+ when x f
+
+isSuccess :: ExitCode -> Bool
+isSuccess ExitSuccess = True
+isSuccess (ExitFailure _) = False
+
+fileGlob :: String
+fileGlob = unwords
+ [ "\"src/**/*.purs\""
+ , "\"src/**/*.js\""
+ , "\"bower_components/purescript-*/**/*.purs\""
+ , "\"bower_components/purescript-*/**/*.js\""
+ ]
+
+-- Integration Testing API
+
+sendCommand :: Value -> IO String
+sendCommand v = readCreateProcess
+ ((shell "psc-ide-client") { std_out=CreatePipe
+ , std_err=CreatePipe
+ })
+ (T.unpack (encodeT v))
+
+quitServer :: IO ()
+quitServer = do
+ let quitCommand = object ["command" .= ("quit" :: String)]
+ _ <- try $ sendCommand quitCommand :: IO (Either SomeException String)
+ return ()
+
+loadModuleWithDeps :: String -> IO String
+loadModuleWithDeps m = sendCommand $ load [] [m]
+
+getFlexCompletions :: String -> IO [(String, String, String)]
+getFlexCompletions q = parseCompletions <$> sendCommand (completion [] (Just (flexMatcher q)))
+
+getType :: String -> IO [(String, String, String)]
+getType q = parseCompletions <$> sendCommand (typeC q [])
+
+addImport :: String -> FilePath -> FilePath -> IO String
+addImport identifier fp outfp = sendCommand (addImportC identifier fp outfp)
+
+addImplicitImport :: String -> FilePath -> FilePath -> IO String
+addImplicitImport mn fp outfp = sendCommand (addImplicitImportC mn fp outfp)
+
+-- Command Encoding
+
+commandWrapper :: String -> Value -> Value
+commandWrapper c p = object ["command" .= c, "params" .= p]
+
+load :: [String] -> [String] -> Value
+load ms ds = commandWrapper "load" (object ["modules" .= ms, "dependencies" .= ds])
+
+typeC :: String -> [Value] -> Value
+typeC q filters = commandWrapper "type" (object ["search" .= q, "filters" .= filters])
+
+addImportC :: String -> FilePath -> FilePath -> Value
+addImportC identifier = addImportW $
+ object [ "importCommand" .= ("addImport" :: String)
+ , "identifier" .= identifier
+ ]
+
+addImplicitImportC :: String -> FilePath -> FilePath -> Value
+addImplicitImportC mn = addImportW $
+ object [ "importCommand" .= ("addImplicitImport" :: String)
+ , "module" .= mn
+ ]
+
+addImportW :: Value -> FilePath -> FilePath -> Value
+addImportW importCommand fp outfp =
+ commandWrapper "import" (object [ "file" .= fp
+ , "outfile" .= outfp
+ , "importCommand" .= importCommand
+ ])
+
+
+completion :: [Value] -> Maybe Value -> Value
+completion filters matcher =
+ let
+ matcher' = case matcher of
+ Nothing -> []
+ Just m -> ["matcher" .= m]
+ in
+ commandWrapper "complete" (object $ "filters" .= filters : matcher')
+
+flexMatcher :: String -> Value
+flexMatcher q = object [ "matcher" .= ("flex" :: String)
+ , "params" .= object ["search" .= q]
+ ]
+
+-- Result parsing
+
+unwrapResult :: Value -> Parser (Either String Value)
+unwrapResult = withObject "result" $ \o -> do
+ (rt :: String) <- o .: "resultType"
+ case rt of
+ "error" -> do
+ res <- o .: "result"
+ pure (Left res)
+ "success" -> do
+ res <- o .: "result"
+ pure (Right res)
+ _ -> fail "lol"
+
+withResult :: (Value -> Parser a) -> Value -> Parser (Either String a)
+withResult p v = do
+ r <- unwrapResult v
+ case r of
+ Left err -> pure (Left err)
+ Right res -> Right <$> p res
+
+completionParser :: Value -> Parser [(String, String, String)]
+completionParser = withArray "res" $ \cs ->
+ mapM (withObject "completion" $ \o -> do
+ ident <- o .: "identifier"
+ module' <- o .: "module"
+ ty <- o .: "type"
+ pure (module', ident, ty)) (V.toList cs)
+
+valueFromString :: String -> Value
+valueFromString = fromJust . decode . BSL.fromString
+
+resultIsSuccess :: String -> Bool
+resultIsSuccess = isRight . join . parseEither unwrapResult . valueFromString
+
+parseCompletions :: String -> [(String, String, String)]
+parseCompletions s = fromJust $ do
+ cs <- parseMaybe (withResult completionParser) (valueFromString s)
+ case cs of
+ Left _ -> error "Failed to parse completions"
+ Right cs' -> pure cs'
+
+parseTextResult :: String -> String
+parseTextResult s = fromJust $ do
+ r <- parseMaybe (withResult (withText "tr" pure)) (valueFromString s)
+ case r of
+ Left _ -> error "Failed to parse textResult"
+ Right r' -> pure (T.unpack r')
diff --git a/tests/Language/PureScript/Ide/MatcherSpec.hs b/tests/Language/PureScript/Ide/MatcherSpec.hs
new file mode 100644
index 0000000..13cef33
--- /dev/null
+++ b/tests/Language/PureScript/Ide/MatcherSpec.hs
@@ -0,0 +1,56 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Language.PureScript.Ide.MatcherSpec where
+
+import Data.Text (Text)
+import Language.PureScript.Ide.Integration
+import Language.PureScript.Ide.Matcher
+import Language.PureScript.Ide.Types
+import qualified Language.PureScript as P
+import Test.Hspec
+
+value :: Text -> ExternDecl
+value s = ValueDeclaration s P.TypeWildcard
+
+completions :: [Match]
+completions = [
+ Match "" $ value "firstResult",
+ Match "" $ value "secondResult",
+ Match "" $ value "fiult"
+ ]
+
+mkResult :: [Int] -> [Match]
+mkResult = map (completions !!)
+
+runFlex :: Text -> [Match]
+runFlex s = runMatcher (flexMatcher s) completions
+
+setup :: IO ()
+setup = do
+ deleteOutputFolder
+ _ <- compileTestProject
+ _ <- startServer
+ _ <- loadModuleWithDeps "Main"
+ return ()
+
+teardown :: IO ()
+teardown = quitServer
+
+spec :: Spec
+spec = do
+ describe "Flex Matcher" $ do
+ it "doesn't match on an empty string" $
+ runFlex "" `shouldBe` []
+ it "matches on equality" $
+ runFlex "firstResult" `shouldBe` mkResult [0]
+ it "scores short matches higher and sorts accordingly" $
+ runFlex "filt" `shouldBe` mkResult [2, 0]
+
+ beforeAll_ setup $ afterAll_ teardown $
+ describe "Integration Tests: Flex Matcher" $ do
+ it "doesn't match on an empty string" $ do
+ cs <- getFlexCompletions ""
+ cs `shouldBe` []
+ it "matches on equality" $ do
+ cs <- getFlexCompletions "const"
+ cs `shouldBe` [("Main", "const", "forall a b. a -> b -> a")]
diff --git a/tests/Language/PureScript/Ide/ReexportsSpec.hs b/tests/Language/PureScript/Ide/ReexportsSpec.hs
new file mode 100644
index 0000000..42d28f0
--- /dev/null
+++ b/tests/Language/PureScript/Ide/ReexportsSpec.hs
@@ -0,0 +1,78 @@
+{-# LANGUAGE OverloadedStrings #-}
+module Language.PureScript.Ide.ReexportsSpec where
+
+import Control.Exception (evaluate)
+import Data.List (sort)
+import qualified Data.Map as Map
+import Language.PureScript.Ide.Reexports
+import Language.PureScript.Ide.Types
+import qualified Language.PureScript as P
+import Test.Hspec
+
+decl1 :: ExternDecl
+decl1 = ValueDeclaration "filter" P.TypeWildcard
+decl2 :: ExternDecl
+decl2 = ValueDeclaration "map" P.TypeWildcard
+decl3 :: ExternDecl
+decl3 = ValueDeclaration "catMaybe" P.TypeWildcard
+dep1 :: ExternDecl
+dep1 = Dependency "Test.Foo" [] (Just "T")
+dep2 :: ExternDecl
+dep2 = Dependency "Test.Bar" [] (Just "T")
+
+circularModule :: Module
+circularModule = ("Circular", [Export "Circular"])
+
+module1 :: Module
+module1 = ("Module1", [Export "Module2", Export "Module3", decl1])
+
+module2 :: Module
+module2 = ("Module2", [decl2])
+
+module3 :: Module
+module3 = ("Module3", [decl3])
+
+module4 :: Module
+module4 = ("Module4", [Export "T", decl1, dep1, dep2])
+
+result :: Module
+result = ("Module1", [decl1, decl2, Export "Module3"])
+
+db :: Map.Map ModuleIdent [ExternDecl]
+db = Map.fromList [module1, module2, module3]
+
+shouldBeEqualSorted :: Module -> Module -> Expectation
+shouldBeEqualSorted (n1, d1) (n2, d2) = (n1, sort d1) `shouldBe` (n2, sort d2)
+
+spec :: Spec
+spec =
+ describe "Reexports" $ do
+ it "finds all reexports" $
+ getReexports module1 `shouldBe` [Export "Module2", Export "Module3"]
+
+ it "replaces a reexport with another module" $
+ replaceReexport (Export "Module2") module1 module2 `shouldBeEqualSorted` result
+
+ it "adds another module even if there is no export statement" $
+ replaceReexport (Export "Module2") ("Module1", [decl1, Export "Module3"]) module2
+ `shouldBeEqualSorted` result
+
+ it "only adds a declaration once" $
+ let replaced = replaceReexport (Export "Module2") module1 module2
+ in replaceReexport (Export "Module2") replaced module2 `shouldBeEqualSorted` result
+
+ it "should error when given a non-Export to replace" $
+ evaluate (replaceReexport decl1 module1 module2)
+ `shouldThrow` errorCall "Should only get Exports here."
+ it "replaces all Exports with their corresponding declarations" $
+ replaceReexports module1 db `shouldBe` ("Module1", [decl1, decl2, decl3])
+
+ it "does not list itself as a reexport" $
+ getReexports circularModule `shouldBe` []
+
+ it "does not include circular references when replacing reexports" $
+ replaceReexports circularModule (uncurry Map.singleton circularModule )
+ `shouldBe` ("Circular", [])
+
+ it "replaces exported aliases with imported module" $
+ getReexports module4 `shouldBe` [Export "Test.Foo", Export "Test.Bar"]
diff --git a/tests/Language/PureScript/IdeSpec.hs b/tests/Language/PureScript/IdeSpec.hs
new file mode 100644
index 0000000..83533f1
--- /dev/null
+++ b/tests/Language/PureScript/IdeSpec.hs
@@ -0,0 +1,35 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Language.PureScript.IdeSpec where
+
+import Control.Concurrent.STM
+import Control.Monad.Reader
+import Data.List
+import qualified Data.Map as Map
+import Language.PureScript.Ide
+import Language.PureScript.Ide.Types
+import Test.Hspec
+
+testState :: PscIdeState
+testState = PscIdeState (Map.fromList [("Data.Array", []), ("Control.Monad.Eff", [])]) Map.empty
+
+defaultConfig :: Configuration
+defaultConfig =
+ Configuration
+ {
+ confOutputPath = "output/"
+ , confDebug = False
+ }
+
+spec :: SpecWith ()
+spec =
+ describe "list" $
+ describe "loadedModules" $ do
+ it "returns an empty list when no modules are loaded" $ do
+ st <- newTVarIO emptyPscIdeState
+ result <- runReaderT printModules (PscIdeEnvironment st defaultConfig)
+ result `shouldBe` ModuleList []
+ it "returns the list of loaded modules" $ do
+ st <- newTVarIO testState
+ ModuleList result <- runReaderT printModules (PscIdeEnvironment st defaultConfig)
+ sort result `shouldBe` sort ["Data.Array", "Control.Monad.Eff"]
diff --git a/tests/TestDocs.hs b/tests/TestDocs.hs
index 91bdf52..1af8bd4 100644
--- a/tests/TestDocs.hs
+++ b/tests/TestDocs.hs
@@ -17,6 +17,7 @@ import System.Exit
import qualified Language.PureScript as P
import qualified Language.PureScript.Docs as Docs
+import Language.PureScript.Docs.AsMarkdown (codeToString)
import qualified Language.PureScript.Publish as Publish
import qualified Language.PureScript.Publish.ErrorsWarnings as Publish
@@ -59,6 +60,10 @@ data Assertion
-- | Assert that a particular value declaration exists, and its type
-- satisfies the given predicate.
| ValueShouldHaveTypeSignature P.ModuleName String (ShowFn (P.Type -> Bool))
+ -- | Assert that a particular type alias exists, and its corresponding
+ -- type, when rendered, matches a given string exactly
+ -- fields: module, type synonym name, expected type
+ | TypeSynonymShouldRenderAs P.ModuleName String String
deriving (Show)
newtype ShowFn a = ShowFn a
@@ -85,6 +90,9 @@ data AssertionFailure
-- should have been.
-- Fields: module name, declaration name, actual type.
| ValueDeclarationWrongType P.ModuleName String P.Type
+ -- | A Type synonym has been rendered in an unexpected format
+ -- Fields: module name, declaration name, expected rendering, actual rendering
+ | TypeSynonymMismatch P.ModuleName String String String
deriving (Show)
data AssertionResult
@@ -149,6 +157,21 @@ runAssertion assertion Docs.Module{..} =
Fail (WrongDeclarationType mn decl "value"
(Docs.declInfoToString declInfo))
+ TypeSynonymShouldRenderAs mn decl expected ->
+ case find ((==) decl . Docs.declTitle) (declarationsFor mn) of
+ Nothing ->
+ Fail (NotDocumented mn decl)
+ Just Docs.Declaration{..} ->
+ case declInfo of
+ Docs.TypeSynonymDeclaration [] ty ->
+ let actual = codeToString (Docs.renderType ty) in
+ if actual == expected
+ then Pass
+ else Fail (TypeSynonymMismatch mn decl expected actual)
+ _ ->
+ Fail (WrongDeclarationType mn decl "synonym"
+ (Docs.declInfoToString declInfo))
+
where
declarationsFor mn =
if mn == modName
@@ -261,6 +284,13 @@ testCases =
, ValueShouldHaveTypeSignature (n "ExplicitTypeSignatures") "anInt" (ShowFn (P.tyInt ==))
, ValueShouldHaveTypeSignature (n "ExplicitTypeSignatures") "aNumber" (ShowFn (P.tyNumber ==))
])
+
+ , ("ConstrainedArgument",
+ [ TypeSynonymShouldRenderAs (n "ConstrainedArgument") "WithoutArgs" "forall a. (Partial => a) -> a"
+ , TypeSynonymShouldRenderAs (n "ConstrainedArgument") "WithArgs" "forall a. (Foo a => a) -> a"
+ , TypeSynonymShouldRenderAs (n "ConstrainedArgument") "MultiWithoutArgs" "forall a. ((Partial, Partial) => a) -> a"
+ , TypeSynonymShouldRenderAs (n "ConstrainedArgument") "MultiWithArgs" "forall a b. ((Foo a, Foo b) => a) -> a"
+ ])
]
where
diff --git a/tests/support/pscide/src/ImportsSpec.purs b/tests/support/pscide/src/ImportsSpec.purs
new file mode 100644
index 0000000..04a7227
--- /dev/null
+++ b/tests/support/pscide/src/ImportsSpec.purs
@@ -0,0 +1,5 @@
+module ImportsSpec where
+
+import Main (id)
+
+myId = id
diff --git a/tests/support/pscide/src/ImportsSpec1.purs b/tests/support/pscide/src/ImportsSpec1.purs
new file mode 100644
index 0000000..098a55d
--- /dev/null
+++ b/tests/support/pscide/src/ImportsSpec1.purs
@@ -0,0 +1,32 @@
+module ImportsSpec1
+ ( exportedFunction
+ , MyType
+ , MyParamType
+ , MyNewtype(..)
+ , MyMaybe(..)
+ , SpecialCase
+ , X(..)
+ , class ATypeClass
+ , typeClassFun
+ , OnlyTypeExported
+ )
+ where
+
+exportedFunction ∷ ∀ a. a → a
+exportedFunction x = x
+
+type MyType = String
+
+type MyParamType a = Array a
+
+newtype MyNewtype = MyNewtype String
+
+data MyMaybe a = MyJust a | MyNothing
+
+data SpecialCase
+data X = SpecialCase
+
+newtype OnlyTypeExported = OnlyTypeExported String
+
+class ATypeClass a where
+ typeClassFun ∷ a -> a
diff --git a/tests/support/pscide/src/Main.purs b/tests/support/pscide/src/Main.purs
new file mode 100644
index 0000000..ca67938
--- /dev/null
+++ b/tests/support/pscide/src/Main.purs
@@ -0,0 +1,7 @@
+module Main where
+
+id :: forall a. a -> a
+id x = x
+
+const :: forall a b. a -> b -> a
+const x _ = x