summaryrefslogtreecommitdiff
path: root/tests
diff options
context:
space:
mode:
authorPhilFreeman <>2016-07-11 15:26:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2016-07-11 15:26:00 (GMT)
commit72ab68866f2cbf61810e650b8c4025cca1eab66c (patch)
treec953e7a0354e707ae88801784ec29c35fc8531a9 /tests
parent0f4090890a1b18cff078fbd427318c6848097703 (diff)
version 0.9.20.9.2
Diffstat (limited to 'tests')
-rw-r--r--tests/Language/PureScript/Ide/FilterSpec.hs53
-rw-r--r--tests/Language/PureScript/Ide/Imports/IntegrationSpec.hs39
-rw-r--r--tests/Language/PureScript/Ide/ImportsSpec.hs18
-rw-r--r--tests/Language/PureScript/Ide/Integration.hs150
-rw-r--r--tests/Language/PureScript/Ide/MatcherSpec.hs33
-rw-r--r--tests/Language/PureScript/Ide/RebuildSpec.hs16
-rw-r--r--tests/Language/PureScript/Ide/ReexportsSpec.hs125
-rw-r--r--tests/Language/PureScript/Ide/SourceFile/IntegrationSpec.hs36
-rw-r--r--tests/Language/PureScript/Ide/SourceFileSpec.hs46
-rw-r--r--tests/Language/PureScript/IdeSpec.hs35
-rw-r--r--tests/TestUtils.hs11
-rw-r--r--tests/support/pscide/src/ImportsSpec.purs4
-rw-r--r--tests/support/pscide/src/MatcherSpec.purs (renamed from tests/support/pscide/src/Main.purs)2
-rw-r--r--tests/support/pscide/src/RebuildSpecSingleModule.purs2
-rw-r--r--tests/support/pscide/src/RebuildSpecWithForeign.js2
-rw-r--r--tests/support/pscide/src/SourceFileSpec.purs10
16 files changed, 302 insertions, 280 deletions
diff --git a/tests/Language/PureScript/Ide/FilterSpec.hs b/tests/Language/PureScript/Ide/FilterSpec.hs
index 6415ec0..cc705f8 100644
--- a/tests/Language/PureScript/Ide/FilterSpec.hs
+++ b/tests/Language/PureScript/Ide/FilterSpec.hs
@@ -1,32 +1,31 @@
{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE NoImplicitPrelude #-}
module Language.PureScript.Ide.FilterSpec where
-import Data.Text (Text)
+import Protolude
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 $ P.SourceSpan "" (P.SourcePos 0 0) (P.SourcePos 0 0)
+value :: Text -> IdeDeclarationAnn
+value s = IdeDeclarationAnn emptyAnn (IdeValue (P.Ident (toS s)) P.REmpty)
+
+moduleA, moduleB :: Module
+moduleA = (P.moduleNameFromString "Module.A", [value "function1"])
+moduleB = (P.moduleNameFromString "Module.B", [value "data1"])
modules :: [Module]
-modules =
- [
- ("Module.A", [value "function1"]),
- ("Module.B", [value "data1"]),
- ("Module.C", [ModuleDecl "Module.C" []]),
- ("Module.D", [Dependency "Module.C" [] Nothing, value "asd"])
- ]
+modules = [moduleA, moduleB]
runEq :: Text -> [Module]
-runEq s = runFilter (equalityFilter s) modules
+runEq s = applyFilters [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
+runPrefix s = applyFilters [prefixFilter s] modules
+
+runModule :: [P.ModuleName] -> [Module]
+runModule ms = applyFilters [moduleFilter ms] modules
spec :: Spec
spec = do
@@ -34,30 +33,20 @@ spec = 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
+ runEq "function1" `shouldBe` [moduleA]
it "keeps data declarations that are equal" $
- runEq "data1" `shouldBe` [modules !! 1]
+ runEq "data1" `shouldBe` [moduleB]
describe "prefixFilter" $ do
it "keeps everything on empty string" $
runPrefix "" `shouldBe` modules
it "keeps functionname prefix matches" $
- runPrefix "fun" `shouldBe` [head modules]
+ runPrefix "fun" `shouldBe` [moduleA]
it "keeps data decls prefix matches" $
- runPrefix "dat" `shouldBe` [modules !! 1]
- it "keeps module decl prefix matches" $
- runPrefix "Mod" `shouldBe` [modules !! 2]
+ runPrefix "dat" `shouldBe` [moduleB]
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]
+ runModule [P.moduleNameFromString "Module.A"] `shouldBe` [moduleA]
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]
+ runModule (P.moduleNameFromString <$> ["Module.A", "Unknown"]) `shouldBe` [moduleA]
diff --git a/tests/Language/PureScript/Ide/Imports/IntegrationSpec.hs b/tests/Language/PureScript/Ide/Imports/IntegrationSpec.hs
index ef56ccb..1d7abbb 100644
--- a/tests/Language/PureScript/Ide/Imports/IntegrationSpec.hs
+++ b/tests/Language/PureScript/Ide/Imports/IntegrationSpec.hs
@@ -1,8 +1,10 @@
{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE NoImplicitPrelude #-}
module Language.PureScript.Ide.Imports.IntegrationSpec where
-import Control.Monad (void)
-import Data.Text (Text)
+
+import Protolude
+
import qualified Data.Text as T
import qualified Data.Text.IO as TIO
import qualified Language.PureScript.Ide.Integration as Integration
@@ -12,9 +14,7 @@ import System.Directory
import System.FilePath
setup :: IO ()
-setup = do
- Integration.reset
- mapM_ Integration.loadModuleWithDeps ["ImportsSpec", "ImportsSpec1"]
+setup = void (Integration.reset *> Integration.loadAll)
withSupportFiles :: (FilePath -> FilePath -> IO a) -> IO ()
withSupportFiles test = do
@@ -35,52 +35,41 @@ spec = beforeAll_ setup . describe "Adding imports" $ do
let
sourceFileSkeleton :: [Text] -> [Text]
sourceFileSkeleton importSection =
- [ "module ImportsSpec where" , ""] ++ importSection ++ [ "" , "myId = id"]
+ [ "module ImportsSpec where" , ""] ++ importSection ++ [ "" , "myId x = x"]
it "adds an implicit import" $ do
withSupportFiles (Integration.addImplicitImport "ImportsSpec1")
outputFileShouldBe (sourceFileSkeleton
[ "import ImportsSpec1"
- , "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)"
- ])
+ outputFileShouldBe (sourceFileSkeleton ["import ImportsSpec1 (MyType)"])
it "adds an explicit unqualified import (parameterized type)" $ do
withSupportFiles (Integration.addImport "MyParamType")
- outputFileShouldBe (sourceFileSkeleton [ "import ImportsSpec1 (MyParamType)"
- , "import Main (id)"
- ])
+ outputFileShouldBe (sourceFileSkeleton ["import ImportsSpec1 (MyParamType)"])
it "adds an explicit unqualified import (typeclass)" $ do
withSupportFiles (Integration.addImport "ATypeClass")
- outputFileShouldBe (sourceFileSkeleton [ "import ImportsSpec1 (class ATypeClass)"
- , "import Main (id)"])
+ outputFileShouldBe (sourceFileSkeleton ["import ImportsSpec1 (class ATypeClass)"])
it "adds an explicit unqualified import (dataconstructor)" $ do
withSupportFiles (Integration.addImport "MyJust")
- outputFileShouldBe (sourceFileSkeleton [ "import ImportsSpec1 (MyMaybe(MyJust))"
- , "import Main (id)"])
+ outputFileShouldBe (sourceFileSkeleton ["import ImportsSpec1 (MyMaybe(MyJust))"])
it "adds an explicit unqualified import (newtype)" $ do
withSupportFiles (Integration.addImport "MyNewtype")
- outputFileShouldBe (sourceFileSkeleton [ "import ImportsSpec1 (MyNewtype(MyNewtype))"
- , "import Main (id)"])
+ outputFileShouldBe (sourceFileSkeleton ["import ImportsSpec1 (MyNewtype(MyNewtype))"])
it "adds an explicit unqualified import (typeclass member function)" $ do
withSupportFiles (Integration.addImport "typeClassFun")
- outputFileShouldBe (sourceFileSkeleton [ "import ImportsSpec1 (typeClassFun)"
- , "import Main (id)"])
+ outputFileShouldBe (sourceFileSkeleton ["import ImportsSpec1 (typeClassFun)"])
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)"])
+ outputFileShouldBe (sourceFileSkeleton ["import ImportsSpec1 (OnlyTypeExported)"])
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)"])
+ outputFileShouldBe (sourceFileSkeleton [])
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
diff --git a/tests/Language/PureScript/Ide/ImportsSpec.hs b/tests/Language/PureScript/Ide/ImportsSpec.hs
index e78fcb9..5b5ba32 100644
--- a/tests/Language/PureScript/Ide/ImportsSpec.hs
+++ b/tests/Language/PureScript/Ide/ImportsSpec.hs
@@ -1,8 +1,10 @@
{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE NoImplicitPrelude #-}
module Language.PureScript.Ide.ImportsSpec where
-import Data.Maybe (fromJust)
-import Data.Text (Text)
+import Protolude
+import Unsafe (fromJust)
+
import qualified Language.PureScript as P
import Language.PureScript.Ide.Imports
import Language.PureScript.Ide.Types
@@ -17,11 +19,9 @@ simpleFile =
]
splitSimpleFile :: (P.ModuleName, [Text], [Import], [Text])
-splitSimpleFile = fromRight $ sliceImportSection simpleFile
+splitSimpleFile = fromRight (sliceImportSection simpleFile)
where
- fromRight (Right r) = r
- fromRight (Left _) = error "fromRight"
-
+ fromRight = fromJust . rightToMaybe
withImports :: [Text] -> [Text]
withImports is =
take 2 simpleFile ++ is ++ drop 2 simpleFile
@@ -68,11 +68,11 @@ spec = do
describe "import commands" $ do
let simpleFileImports = let (_, _, i, _) = splitSimpleFile in i
addValueImport i mn is =
- prettyPrintImportSection (addExplicitImport' (ValueDeclaration i wildcard) mn is)
+ prettyPrintImportSection (addExplicitImport' (IdeValue (P.Ident i) wildcard) mn is)
addOpImport op mn is =
- prettyPrintImportSection (addExplicitImport' (ValueOperator op "" 2 P.Infix) mn is)
+ prettyPrintImportSection (addExplicitImport' (IdeValueOperator op "" 2 P.Infix) mn is)
addDtorImport i t mn is =
- prettyPrintImportSection (addExplicitImport' (DataConstructor i t wildcard) mn is)
+ prettyPrintImportSection (addExplicitImport' (IdeDataConstructor (P.ProperName i) t wildcard) mn is)
it "adds an implicit unqualified import" $
shouldBe
(addImplicitImport' simpleFileImports (P.moduleNameFromString "Data.Map"))
diff --git a/tests/Language/PureScript/Ide/Integration.hs b/tests/Language/PureScript/Ide/Integration.hs
index 876eb21..4f55441 100644
--- a/tests/Language/PureScript/Ide/Integration.hs
+++ b/tests/Language/PureScript/Ide/Integration.hs
@@ -14,6 +14,7 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE NoImplicitPrelude #-}
module Language.PureScript.Ide.Integration
(
-- managing the server process
@@ -29,33 +30,33 @@ module Language.PureScript.Ide.Integration
-- sending commands
, addImport
, addImplicitImport
+ , loadAll
, loadModule
- , loadModuleWithDeps
+ , loadModules
, getCwd
, getFlexCompletions
, getFlexCompletionsInModule
, getType
+ , getInfo
, rebuildModule
, reset
-- checking results
, resultIsSuccess
, parseCompletions
+ , parseInfo
, parseTextResult
) where
-import Control.Concurrent (threadDelay)
-import Control.Exception
-import Control.Monad (join, when)
+import Protolude
+import Unsafe (fromJust)
+
import Data.Aeson
import Data.Aeson.Types
-import qualified Data.ByteString.Lazy.UTF8 as BSL
-import Data.Either (isRight)
-import Data.Maybe (fromJust, isNothing, fromMaybe)
import qualified Data.Text as T
import qualified Data.Vector as V
import Language.PureScript.Ide.Util
+import qualified Language.PureScript as P
import System.Directory
-import System.Exit
import System.FilePath
import System.IO.Error (mkIOError, userErrorType)
import System.Process
@@ -70,8 +71,8 @@ startServer = do
pdir <- projectDirectory
-- Turn off filewatching since it creates race condition in a testing environment
(_, _, _, procHandle) <- createProcess $
- (shell "psc-ide-server --no-watch") {cwd = Just pdir}
- threadDelay 500000 -- give the server 500ms to start up
+ (shell "psc-ide-server --no-watch src/*.purs") {cwd = Just pdir}
+ threadDelay 2000000 -- give the server 2s to start up
return procHandle
stopServer :: ProcessHandle -> IO ()
@@ -80,26 +81,20 @@ stopServer = terminateProcess
withServer :: IO a -> IO a
withServer s = do
_ <- startServer
- started <- tryNTimes 5 (shush <$> (try getCwd :: IO (Either SomeException String)))
+ started <- tryNTimes 5 (rightToMaybe <$> (try getCwd :: IO (Either SomeException Text)))
when (isNothing started) $
throwIO (mkIOError userErrorType "psc-ide-server didn't start in time" Nothing Nothing)
r <- s
quitServer
pure r
-shush :: Either a b -> Maybe b
-shush = either (const Nothing) Just
-
-- project management utils
compileTestProject :: IO Bool
compileTestProject = do
pdir <- projectDirectory
(_, _, _, procHandle) <- createProcess $
- (shell $ "psc " ++ fileGlob) { cwd = Just pdir
- , std_out = CreatePipe
- , std_err = CreatePipe
- }
+ (shell . toS $ "psc " <> fileGlob) { cwd = Just pdir }
r <- tryNTimes 5 (getProcessExitCode procHandle)
pure (fromMaybe False (isSuccess <$> r))
@@ -121,24 +116,17 @@ deleteOutputFolder = do
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\""
- ]
+fileGlob :: Text
+fileGlob = "\"src/**/*.purs\""
-- Integration Testing API
-sendCommand :: Value -> IO String
-sendCommand v = readCreateProcess
+sendCommand :: Value -> IO Text
+sendCommand v = toS <$> readCreateProcess
((shell "psc-ide-client") { std_out=CreatePipe
, std_err=CreatePipe
})
@@ -146,65 +134,71 @@ sendCommand v = readCreateProcess
quitServer :: IO ()
quitServer = do
- let quitCommand = object ["command" .= ("quit" :: String)]
- _ <- try $ sendCommand quitCommand :: IO (Either SomeException String)
+ let quitCommand = object ["command" .= ("quit" :: Text)]
+ _ <- try $ sendCommand quitCommand :: IO (Either SomeException Text)
return ()
reset :: IO ()
reset = do
- let resetCommand = object ["command" .= ("reset" :: String)]
- _ <- try $ sendCommand resetCommand :: IO (Either SomeException String)
+ let resetCommand = object ["command" .= ("reset" :: Text)]
+ _ <- try $ sendCommand resetCommand :: IO (Either SomeException Text)
return ()
-getCwd :: IO String
+getCwd :: IO Text
getCwd = do
- let cwdCommand = object ["command" .= ("cwd" :: String)]
+ let cwdCommand = object ["command" .= ("cwd" :: Text)]
sendCommand cwdCommand
-loadModuleWithDeps :: String -> IO String
-loadModuleWithDeps m = sendCommand $ load [] [m]
+loadModule :: Text -> IO Text
+loadModule m = loadModules [m]
+
+loadModules :: [Text] -> IO Text
+loadModules = sendCommand . load
-loadModule :: String -> IO String
-loadModule m = sendCommand $ load [m] []
+loadAll :: IO Text
+loadAll = sendCommand (load [])
-getFlexCompletions :: String -> IO [(String, String, String)]
+getFlexCompletions :: Text -> IO [(Text, Text, Text)]
getFlexCompletions q = parseCompletions <$> sendCommand (completion [] (Just (flexMatcher q)) Nothing)
-getFlexCompletionsInModule :: String -> String -> IO [(String, String, String)]
+getFlexCompletionsInModule :: Text -> Text -> IO [(Text, Text, Text)]
getFlexCompletionsInModule q m = parseCompletions <$> sendCommand (completion [] (Just (flexMatcher q)) (Just m))
-getType :: String -> IO [(String, String, String)]
+getType :: Text -> IO [(Text, Text, Text)]
getType q = parseCompletions <$> sendCommand (typeC q [])
-addImport :: String -> FilePath -> FilePath -> IO String
+getInfo :: Text -> IO [P.SourceSpan]
+getInfo q = parseInfo <$> sendCommand (typeC q [])
+
+addImport :: Text -> FilePath -> FilePath -> IO Text
addImport identifier fp outfp = sendCommand (addImportC identifier fp outfp)
-addImplicitImport :: String -> FilePath -> FilePath -> IO String
+addImplicitImport :: Text -> FilePath -> FilePath -> IO Text
addImplicitImport mn fp outfp = sendCommand (addImplicitImportC mn fp outfp)
-rebuildModule :: FilePath -> IO String
+rebuildModule :: FilePath -> IO Text
rebuildModule m = sendCommand (rebuildC m Nothing)
-- Command Encoding
-commandWrapper :: String -> Value -> Value
+commandWrapper :: Text -> Value -> Value
commandWrapper c p = object ["command" .= c, "params" .= p]
-load :: [String] -> [String] -> Value
-load ms ds = commandWrapper "load" (object ["modules" .= ms, "dependencies" .= ds])
+load :: [Text] -> Value
+load ms = commandWrapper "load" (object ["modules" .= ms])
-typeC :: String -> [Value] -> Value
+typeC :: Text -> [Value] -> Value
typeC q filters = commandWrapper "type" (object ["search" .= q, "filters" .= filters])
-addImportC :: String -> FilePath -> FilePath -> Value
+addImportC :: Text -> FilePath -> FilePath -> Value
addImportC identifier = addImportW $
- object [ "importCommand" .= ("addImport" :: String)
+ object [ "importCommand" .= ("addImport" :: Text)
, "identifier" .= identifier
]
-addImplicitImportC :: String -> FilePath -> FilePath -> Value
+addImplicitImportC :: Text -> FilePath -> FilePath -> Value
addImplicitImportC mn = addImportW $
- object [ "importCommand" .= ("addImplicitImport" :: String)
+ object [ "importCommand" .= ("addImplicitImport" :: Text)
, "module" .= mn
]
@@ -222,7 +216,7 @@ addImportW importCommand fp outfp =
])
-completion :: [Value] -> Maybe Value -> Maybe String -> Value
+completion :: [Value] -> Maybe Value -> Maybe Text -> Value
completion filters matcher currentModule =
let
matcher' = case matcher of
@@ -234,16 +228,16 @@ completion filters matcher currentModule =
in
commandWrapper "complete" (object $ "filters" .= filters : matcher' ++ currentModule' )
-flexMatcher :: String -> Value
-flexMatcher q = object [ "matcher" .= ("flex" :: String)
+flexMatcher :: Text -> Value
+flexMatcher q = object [ "matcher" .= ("flex" :: Text)
, "params" .= object ["search" .= q]
]
-- Result parsing
-unwrapResult :: Value -> Parser (Either String Value)
+unwrapResult :: Value -> Parser (Either Text Value)
unwrapResult = withObject "result" $ \o -> do
- (rt :: String) <- o .: "resultType"
+ (rt :: Text) <- o .: "resultType"
case rt of
"error" -> do
res <- o .: "result"
@@ -251,16 +245,16 @@ unwrapResult = withObject "result" $ \o -> do
"success" -> do
res <- o .: "result"
pure (Right res)
- _ -> fail "lol"
+ _ -> mzero
-withResult :: (Value -> Parser a) -> Value -> Parser (Either String a)
+withResult :: (Value -> Parser a) -> Value -> Parser (Either Text 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 :: Value -> Parser [(Text, Text, Text)]
completionParser = withArray "res" $ \cs ->
mapM (withObject "completion" $ \o -> do
ident <- o .: "identifier"
@@ -268,22 +262,24 @@ completionParser = withArray "res" $ \cs ->
ty <- o .: "type"
pure (module', ident, ty)) (V.toList cs)
-valueFromString :: String -> Value
-valueFromString = fromJust . decode . BSL.fromString
+infoParser :: Value -> Parser [P.SourceSpan]
+infoParser = withArray "res" $ \cs ->
+ mapM (withObject "info" $ \o -> o .: "definedAt") (V.toList cs)
-resultIsSuccess :: String -> Bool
-resultIsSuccess = isRight . join . parseEither unwrapResult . valueFromString
+valueFromText :: Text -> Value
+valueFromText = fromJust . decode . toS
-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'
+resultIsSuccess :: Text -> Bool
+resultIsSuccess = isRight . join . first toS . parseEither unwrapResult . valueFromText
-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')
+parseCompletions :: Text -> [(Text, Text, Text)]
+parseCompletions s =
+ fromJust $ join (rightToMaybe <$> parseMaybe (withResult completionParser) (valueFromText s))
+
+parseInfo :: Text -> [P.SourceSpan]
+parseInfo s =
+ fromJust $ join (rightToMaybe <$> parseMaybe (withResult infoParser) (valueFromText s))
+
+parseTextResult :: Text -> Text
+parseTextResult s =
+ fromJust $ join (rightToMaybe <$> parseMaybe (withResult (withText "tr" pure)) (valueFromText s))
diff --git a/tests/Language/PureScript/Ide/MatcherSpec.hs b/tests/Language/PureScript/Ide/MatcherSpec.hs
index 954ded1..04d0ae5 100644
--- a/tests/Language/PureScript/Ide/MatcherSpec.hs
+++ b/tests/Language/PureScript/Ide/MatcherSpec.hs
@@ -1,33 +1,32 @@
{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE NoImplicitPrelude #-}
module Language.PureScript.Ide.MatcherSpec where
-import Control.Monad (void)
-import Data.Text (Text)
+import Protolude
+
import qualified Language.PureScript as P
import Language.PureScript.Ide.Integration
import Language.PureScript.Ide.Matcher
import Language.PureScript.Ide.Types
import Test.Hspec
-value :: Text -> ExternDecl
-value s = ValueDeclaration s $ P.TypeWildcard $ P.SourceSpan "" (P.SourcePos 0 0) (P.SourcePos 0 0)
+value :: Text -> IdeDeclaration
+value s = IdeValue (P.Ident (toS s)) P.REmpty
-completions :: [Match]
-completions =
- [ Match "" (value "firstResult")
- , Match "" (value "secondResult")
- , Match "" (value "fiult")
- ]
+firstResult, secondResult, fiult :: Match IdeDeclaration
+firstResult = Match (P.moduleNameFromString "Match", value "firstResult")
+secondResult = Match (P.moduleNameFromString "Match", value "secondResult")
+fiult = Match (P.moduleNameFromString "Match", value "fiult")
-mkResult :: [Int] -> [Match]
-mkResult = map (completions !!)
+completions :: [Match IdeDeclaration]
+completions = [firstResult, secondResult, fiult]
-runFlex :: Text -> [Match]
+runFlex :: Text -> [Match IdeDeclaration]
runFlex s = runMatcher (flexMatcher s) completions
setup :: IO ()
-setup = reset *> void (loadModuleWithDeps "Main")
+setup = reset *> void loadAll
spec :: Spec
spec = do
@@ -35,9 +34,9 @@ spec = do
it "doesn't match on an empty string" $
runFlex "" `shouldBe` []
it "matches on equality" $
- runFlex "firstResult" `shouldBe` mkResult [0]
+ runFlex "firstResult" `shouldBe` [firstResult]
it "scores short matches higher and sorts accordingly" $
- runFlex "filt" `shouldBe` mkResult [2, 0]
+ runFlex "filt" `shouldBe` [fiult, firstResult]
beforeAll_ setup . describe "Integration Tests: Flex Matcher" $ do
it "doesn't match on an empty string" $ do
@@ -45,4 +44,4 @@ spec = do
cs `shouldBe` []
it "matches on equality" $ do
cs <- getFlexCompletions "const"
- cs `shouldBe` [("Main", "const", "forall a b. a -> b -> a")]
+ cs `shouldBe` [("MatcherSpec", "const", "forall a b. a -> b -> a")]
diff --git a/tests/Language/PureScript/Ide/RebuildSpec.hs b/tests/Language/PureScript/Ide/RebuildSpec.hs
index f78cd1b..f924190 100644
--- a/tests/Language/PureScript/Ide/RebuildSpec.hs
+++ b/tests/Language/PureScript/Ide/RebuildSpec.hs
@@ -1,19 +1,23 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE OverloadedStrings #-}
module Language.PureScript.Ide.RebuildSpec where
+import Protolude
+
import qualified Language.PureScript.Ide.Integration as Integration
import System.FilePath
import Test.Hspec
-shouldBeSuccess :: String -> IO ()
+shouldBeSuccess :: Text -> IO ()
shouldBeSuccess = shouldBe True . Integration.resultIsSuccess
-shouldBeFailure :: String -> IO ()
+shouldBeFailure :: Text -> IO ()
shouldBeFailure = shouldBe False . Integration.resultIsSuccess
spec :: Spec
spec = before_ Integration.reset . describe "Rebuilding single modules" $ do
it "rebuilds a correct module without dependencies successfully" $ do
- _ <- Integration.loadModuleWithDeps "RebuildSpecSingleModule"
+ _ <- Integration.loadModule "RebuildSpecSingleModule"
pdir <- Integration.projectDirectory
let file = pdir </> "src" </> "RebuildSpecSingleModule.purs"
Integration.rebuildModule file >>= shouldBeSuccess
@@ -22,12 +26,12 @@ spec = before_ Integration.reset . describe "Rebuilding single modules" $ do
let file = pdir </> "src" </> "RebuildSpecSingleModule.fail"
Integration.rebuildModule file >>= shouldBeFailure
it "rebuilds a correct module with its dependencies successfully" $ do
- _ <- Integration.loadModuleWithDeps "RebuildSpecWithDeps"
+ _ <- Integration.loadModules ["RebuildSpecWithDeps", "RebuildSpecDep"]
pdir <- Integration.projectDirectory
let file = pdir </> "src" </> "RebuildSpecWithDeps.purs"
Integration.rebuildModule file >>= shouldBeSuccess
it "rebuilds a correct module that has reverse dependencies" $ do
- _ <- Integration.loadModuleWithDeps "RebuildSpecWithDeps"
+ _ <- Integration.loadModule "RebuildSpecWithDeps"
pdir <- Integration.projectDirectory
let file = pdir </> "src" </> "RebuildSpecDep.purs"
Integration.rebuildModule file >>= shouldBeSuccess
@@ -37,7 +41,7 @@ spec = before_ Integration.reset . describe "Rebuilding single modules" $ do
let file = pdir </> "src" </> "RebuildSpecWithDeps.purs"
Integration.rebuildModule file >>= shouldBeFailure
it "rebuilds a correct module with a foreign file" $ do
- _ <- Integration.loadModuleWithDeps "RebuildSpecWithForeign"
+ _ <- Integration.loadModule "RebuildSpecWithForeign"
pdir <- Integration.projectDirectory
let file = pdir </> "src" </> "RebuildSpecWithForeign.purs"
Integration.rebuildModule file >>= shouldBeSuccess
diff --git a/tests/Language/PureScript/Ide/ReexportsSpec.hs b/tests/Language/PureScript/Ide/ReexportsSpec.hs
index 5633d60..c9a59ff 100644
--- a/tests/Language/PureScript/Ide/ReexportsSpec.hs
+++ b/tests/Language/PureScript/Ide/ReexportsSpec.hs
@@ -1,81 +1,64 @@
{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE NoImplicitPrelude #-}
module Language.PureScript.Ide.ReexportsSpec where
-import Control.Exception (evaluate)
-import Data.List (sort)
-import qualified Data.Map as Map
+import qualified Prelude as Prelude
+import Protolude
+
+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
-wildcard :: P.Type
-wildcard = P.TypeWildcard $ P.SourceSpan "" (P.SourcePos 0 0) (P.SourcePos 0 0)
-
-decl1 :: ExternDecl
-decl1 = ValueDeclaration "filter" wildcard
-decl2 :: ExternDecl
-decl2 = ValueDeclaration "map" wildcard
-decl3 :: ExternDecl
-decl3 = ValueDeclaration "catMaybe" wildcard
-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)
+m :: Prelude.String -> P.ModuleName
+m = P.moduleNameFromString
+
+d :: IdeDeclaration -> IdeDeclarationAnn
+d = IdeDeclarationAnn emptyAnn
+
+valueA, typeA, classA, dtorA1, dtorA2 :: IdeDeclarationAnn
+valueA = d (IdeValue (P.Ident "valueA") P.REmpty)
+typeA = d (IdeType (P.ProperName "TypeA") P.Star)
+classA = d (IdeTypeClass (P.ProperName "ClassA"))
+dtorA1 = d (IdeDataConstructor (P.ProperName "DtorA1") (P.ProperName "TypeA") P.REmpty)
+dtorA2 = d (IdeDataConstructor (P.ProperName "DtorA2") (P.ProperName "TypeA") P.REmpty)
+
+env :: Map P.ModuleName [IdeDeclarationAnn]
+env = Map.fromList
+ [ (m "A", [valueA, typeA, classA, dtorA1, dtorA2])
+ ]
+
+type Refs = [(P.ModuleName, P.DeclarationRef)]
+
+succTestCases :: [(Text, Module, Refs, Module)]
+succTestCases =
+ [ ("resolves a value reexport", (m "C", []), [(m "A", P.ValueRef (P.Ident "valueA"))], (m "C", [valueA]))
+ , ("resolves a type reexport with explicit data constructors"
+ , (m "C", []), [(m "A", P.TypeRef (P.ProperName "TypeA") (Just [P.ProperName "DtorA1"]))], (m "C", [typeA, dtorA1]))
+ , ("resolves a type reexport with implicit data constructors"
+ , (m "C", []), [(m "A", P.TypeRef (P.ProperName "TypeA") Nothing)], (m "C", [typeA, dtorA1, dtorA2]))
+ , ("resolves a class reexport", (m "C", []), [(m "A", P.TypeClassRef (P.ProperName "ClassA"))], (m "C", [classA]))
+ ]
+
+failTestCases :: [(Text, Module, Refs)]
+failTestCases =
+ [ ("fails to resolve a non existing value", (m "C", []), [(m "A", P.ValueRef (P.Ident "valueB"))])
+ , ("fails to resolve a non existing type reexport" , (m "C", []), [(m "A", P.TypeRef (P.ProperName "TypeB") Nothing)])
+ , ("fails to resolve a non existing class reexport", (m "C", []), [(m "A", P.TypeClassRef (P.ProperName "ClassB"))])
+ ]
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"]
+spec = do
+ describe "Successful Reexports" $
+ for_ succTestCases $ \(desc, initial, refs, result) ->
+ it (toS desc) $ do
+ let reResult = resolveReexports env (initial, refs)
+ reResolved reResult `shouldBe` result
+ reResult `shouldSatisfy` not . reexportHasFailures
+ describe "Failed Reexports" $
+ for_ failTestCases $ \(desc, initial, refs) ->
+ it (toS desc) $ do
+ let reResult = resolveReexports env (initial, refs)
+ reFailed reResult `shouldBe` refs
+ reResult `shouldSatisfy` reexportHasFailures
diff --git a/tests/Language/PureScript/Ide/SourceFile/IntegrationSpec.hs b/tests/Language/PureScript/Ide/SourceFile/IntegrationSpec.hs
new file mode 100644
index 0000000..a16a9b5
--- /dev/null
+++ b/tests/Language/PureScript/Ide/SourceFile/IntegrationSpec.hs
@@ -0,0 +1,36 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+module Language.PureScript.Ide.SourceFile.IntegrationSpec where
+
+
+import Protolude
+
+import qualified Data.Text as T
+import qualified Language.PureScript.Ide.Integration as Integration
+import qualified Language.PureScript as P
+import Test.Hspec
+
+setup :: IO ()
+setup = void (Integration.reset *> Integration.loadAll)
+
+spec :: Spec
+spec = beforeAll_ setup $ do
+ describe "Sourcefile Integration" $ do
+ it "finds a value declaration" $ do
+ testCase "sfValue" (3, 1)
+ it "finds a type declaration" $ do
+ testCase "SFType" (5, 1)
+ it "finds a data declaration" $ do
+ testCase "SFData" (7, 1)
+ it "finds a data constructor" $ do
+ testCase "SFOne" (7, 1)
+ it "finds a typeclass" $ do
+ testCase "SFClass" (9, 1)
+ it "finds a typeclass member" $ do
+ testCase "sfShow" (10, 3)
+
+testCase :: Text -> (Int, Int) -> IO ()
+testCase s (x, y) = do
+ (P.SourceSpan f (P.SourcePos l c) _):_ <- Integration.getInfo s
+ toS f `shouldSatisfy` T.isSuffixOf "SourceFileSpec.purs"
+ (l, c) `shouldBe` (x, y)
diff --git a/tests/Language/PureScript/Ide/SourceFileSpec.hs b/tests/Language/PureScript/Ide/SourceFileSpec.hs
new file mode 100644
index 0000000..26a2dba
--- /dev/null
+++ b/tests/Language/PureScript/Ide/SourceFileSpec.hs
@@ -0,0 +1,46 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE OverloadedStrings #-}
+module Language.PureScript.Ide.SourceFileSpec where
+
+import Protolude
+
+import qualified Language.PureScript as P
+import Language.PureScript.Ide.SourceFile
+import Test.Hspec
+
+span0, span1, span2 :: P.SourceSpan
+span0 = P.SourceSpan "ModuleLevel" (P.SourcePos 0 0) (P.SourcePos 1 1)
+span1 = P.SourceSpan "" (P.SourcePos 1 1) (P.SourcePos 2 2)
+span2 = P.SourceSpan "" (P.SourcePos 2 2) (P.SourcePos 3 3)
+
+value1, synonym1, class1, class2, data1, data2, foreign1, foreign2, member1 :: P.Declaration
+value1 = P.ValueDeclaration (P.Ident "value1") P.Public [] (Left [])
+synonym1 = P.TypeSynonymDeclaration (P.ProperName "Synonym1") [] P.REmpty
+class1 = P.TypeClassDeclaration (P.ProperName "Class1") [] [] []
+class2 = P.TypeClassDeclaration (P.ProperName "Class2") [] []
+ [P.PositionedDeclaration span2 [] member1]
+data1 = P.DataDeclaration P.Newtype (P.ProperName "Data1") [] []
+data2 = P.DataDeclaration P.Data (P.ProperName "Data2") [] [(P.ProperName "Cons1", [])]
+foreign1 = P.ExternDeclaration (P.Ident "foreign1") P.REmpty
+foreign2 = P.ExternDataDeclaration (P.ProperName "Foreign2") P.Star
+member1 = P.TypeDeclaration (P.Ident "member1") P.REmpty
+
+spec :: Spec
+spec = do
+ describe "Extracting Spans" $ do
+ it "extracts a span for a value declaration" $
+ extractSpans span0 (P.PositionedDeclaration span1 [] value1) `shouldBe` [(Left "value1", span1)]
+ it "extracts a span for a type synonym declaration" $
+ extractSpans span0 (P.PositionedDeclaration span1 [] synonym1) `shouldBe` [(Right "Synonym1", span1)]
+ it "extracts a span for a typeclass declaration" $
+ extractSpans span0 (P.PositionedDeclaration span1 [] class1) `shouldBe` [(Right "Class1", span1)]
+ it "extracts spans for a typeclass declaration and its members" $
+ extractSpans span0 (P.PositionedDeclaration span1 [] class2) `shouldBe` [(Right "Class2", span1), (Left "member1", span2)]
+ it "extracts a span for a data declaration" $
+ extractSpans span0 (P.PositionedDeclaration span1 [] data1) `shouldBe` [(Right "Data1", span1)]
+ it "extracts spans for a data declaration and its constructors" $
+ extractSpans span0 (P.PositionedDeclaration span1 [] data2) `shouldBe` [(Right "Data2", span1), (Left "Cons1", span1)]
+ it "extracts a span for a foreign declaration" $
+ extractSpans span0 (P.PositionedDeclaration span1 [] foreign1) `shouldBe` [(Left "foreign1", span1)]
+ it "extracts a span for a data foreign declaration" $
+ extractSpans span0 (P.PositionedDeclaration span1 [] foreign2) `shouldBe` [(Right "Foreign2", span1)]
diff --git a/tests/Language/PureScript/IdeSpec.hs b/tests/Language/PureScript/IdeSpec.hs
deleted file mode 100644
index 8ceedb1..0000000
--- a/tests/Language/PureScript/IdeSpec.hs
+++ /dev/null
@@ -1,35 +0,0 @@
-{-# 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 Nothing
-
-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/TestUtils.hs b/tests/TestUtils.hs
index 1f01d03..49e9c2a 100644
--- a/tests/TestUtils.hs
+++ b/tests/TestUtils.hs
@@ -12,6 +12,8 @@ import Control.Exception
import System.Process
import System.Directory
import System.Info
+import System.Exit (exitFailure)
+import System.IO (stderr, hPutStrLn)
findNodeProcess :: IO (Maybe String)
findNodeProcess = runMaybeT . msum $ map (MaybeT . findExecutable) names
@@ -33,10 +35,17 @@ updateSupportCode = do
then callProcess "setup-win.cmd" []
else do
callProcess "npm" ["install"]
+ -- bower uses shebang "/usr/bin/env node", but we might have nodejs
+ node <- maybe cannotFindNode pure =<< findNodeProcess
-- Sometimes we run as a root (e.g. in simple docker containers)
-- And we are non-interactive: https://github.com/bower/bower/issues/1162
- callProcess "node_modules/.bin/bower" ["--allow-root", "install", "--config.interactive=false"]
+ callProcess node ["node_modules/.bin/bower", "--allow-root", "install", "--config.interactive=false"]
setCurrentDirectory "../.."
+ where
+ cannotFindNode :: IO a
+ cannotFindNode = do
+ hPutStrLn stderr "Cannot find node (or nodejs) executable"
+ exitFailure
-- |
-- The support modules that should be cached between test cases, to avoid
diff --git a/tests/support/pscide/src/ImportsSpec.purs b/tests/support/pscide/src/ImportsSpec.purs
index 04a7227..b48e246 100644
--- a/tests/support/pscide/src/ImportsSpec.purs
+++ b/tests/support/pscide/src/ImportsSpec.purs
@@ -1,5 +1,3 @@
module ImportsSpec where
-import Main (id)
-
-myId = id
+myId x = x
diff --git a/tests/support/pscide/src/Main.purs b/tests/support/pscide/src/MatcherSpec.purs
index ca67938..b9fbe0e 100644
--- a/tests/support/pscide/src/Main.purs
+++ b/tests/support/pscide/src/MatcherSpec.purs
@@ -1,4 +1,4 @@
-module Main where
+module MatcherSpec where
id :: forall a. a -> a
id x = x
diff --git a/tests/support/pscide/src/RebuildSpecSingleModule.purs b/tests/support/pscide/src/RebuildSpecSingleModule.purs
index 4059629..9a1fe7e 100644
--- a/tests/support/pscide/src/RebuildSpecSingleModule.purs
+++ b/tests/support/pscide/src/RebuildSpecSingleModule.purs
@@ -1,4 +1,4 @@
module RebuildSpecSingleModule where
id x = x
-const x y = x
+lulz x y = x
diff --git a/tests/support/pscide/src/RebuildSpecWithForeign.js b/tests/support/pscide/src/RebuildSpecWithForeign.js
index 7c82dc8..8ea453f 100644
--- a/tests/support/pscide/src/RebuildSpecWithForeign.js
+++ b/tests/support/pscide/src/RebuildSpecWithForeign.js
@@ -1,3 +1 @@
-// module RebuildSpecWithForeign
-
exports.f = 5;
diff --git a/tests/support/pscide/src/SourceFileSpec.purs b/tests/support/pscide/src/SourceFileSpec.purs
new file mode 100644
index 0000000..e3484fa
--- /dev/null
+++ b/tests/support/pscide/src/SourceFileSpec.purs
@@ -0,0 +1,10 @@
+module SourceFileSpec where
+
+sfValue = "sfValue"
+
+type SFType = String
+
+data SFData = SFOne | SFTwo | SFThree
+
+class SFClass a where
+ sfShow :: a -> String