summaryrefslogtreecommitdiff
path: root/tests
diff options
context:
space:
mode:
authorPhilFreeman <>2017-02-07 03:28:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2017-02-07 03:28:00 (GMT)
commitc46fd8243f86cc697fd14c94b2db85ed5067580c (patch)
tree08f31d8fe691471112c123a9d18e4ce90cd1cae4 /tests
parent393ecc8ee0178ccac2b9ae81e74708f0d17b2ca5 (diff)
version 0.10.60.10.6
Diffstat (limited to 'tests')
-rw-r--r--tests/Language/PureScript/Ide/FilterSpec.hs2
-rw-r--r--tests/Language/PureScript/Ide/Imports/IntegrationSpec.hs83
-rw-r--r--tests/Language/PureScript/Ide/ImportsSpec.hs67
-rw-r--r--tests/Language/PureScript/Ide/Integration.hs273
-rw-r--r--tests/Language/PureScript/Ide/MatcherSpec.hs13
-rw-r--r--tests/Language/PureScript/Ide/RebuildSpec.hs78
-rw-r--r--tests/Language/PureScript/Ide/ReexportsSpec.hs28
-rw-r--r--tests/Language/PureScript/Ide/SourceFile/IntegrationSpec.hs41
-rw-r--r--tests/Language/PureScript/Ide/SourceFileSpec.hs70
-rw-r--r--tests/Language/PureScript/Ide/StateSpec.hs66
-rw-r--r--tests/Language/PureScript/Ide/Test.hs135
-rw-r--r--tests/TestDocs.hs12
-rw-r--r--tests/TestPscIde.hs8
-rw-r--r--tests/TestPscPublish.hs12
-rw-r--r--tests/TestUtils.hs1
-rw-r--r--tests/support/pscide/src/SourceFileSpec.purs10
16 files changed, 395 insertions, 504 deletions
diff --git a/tests/Language/PureScript/Ide/FilterSpec.hs b/tests/Language/PureScript/Ide/FilterSpec.hs
index 3b4cfc2..f129b18 100644
--- a/tests/Language/PureScript/Ide/FilterSpec.hs
+++ b/tests/Language/PureScript/Ide/FilterSpec.hs
@@ -8,6 +8,8 @@ import Language.PureScript.Ide.Types
import qualified Language.PureScript as P
import Test.Hspec
+type Module = (P.ModuleName, [IdeDeclarationAnn])
+
value :: Text -> IdeDeclarationAnn
value s = IdeDeclarationAnn emptyAnn (IdeDeclValue (IdeValue (P.Ident (toS s)) P.REmpty))
diff --git a/tests/Language/PureScript/Ide/Imports/IntegrationSpec.hs b/tests/Language/PureScript/Ide/Imports/IntegrationSpec.hs
deleted file mode 100644
index 01f474a..0000000
--- a/tests/Language/PureScript/Ide/Imports/IntegrationSpec.hs
+++ /dev/null
@@ -1,83 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE NoImplicitPrelude #-}
-module Language.PureScript.Ide.Imports.IntegrationSpec where
-
-
-import Protolude
-
-import qualified Data.Text as T
-import qualified Language.PureScript.Ide.Integration as Integration
-import Test.Hspec
-
-import System.Directory
-import System.FilePath
-import System.IO.UTF8 (readUTF8FileT)
-
-setup :: IO ()
-setup = void (Integration.reset *> Integration.loadAll)
-
-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 <- readUTF8FileT outFp
- shouldBe (T.strip <$> T.lines outRes) expectation
-
-spec :: Spec
-spec = beforeAll_ setup . describe "Adding imports" $ do
- let
- sourceFileSkeleton :: [Text] -> [Text]
- sourceFileSkeleton importSection =
- [ "module ImportsSpec where" , ""] ++ importSection ++ [ "" , "myId x = x"]
- it "adds an implicit import" $ do
- withSupportFiles (Integration.addImplicitImport "ImportsSpec1")
- outputFileShouldBe (sourceFileSkeleton
- [ "import ImportsSpec1"
- ])
- it "adds an explicit unqualified import" $ do
- withSupportFiles (Integration.addImport "exportedFunction")
- outputFileShouldBe (sourceFileSkeleton
- [ "import ImportsSpec1 (exportedFunction)"
- ])
- it "adds an explicit unqualified import (type)" $ do
- withSupportFiles (Integration.addImport "MyType")
- outputFileShouldBe (sourceFileSkeleton ["import ImportsSpec1 (MyType)"])
- it "adds an explicit unqualified import (parameterized type)" $ do
- withSupportFiles (Integration.addImport "MyParamType")
- outputFileShouldBe (sourceFileSkeleton ["import ImportsSpec1 (MyParamType)"])
- it "adds an explicit unqualified import (typeclass)" $ do
- withSupportFiles (Integration.addImport "ATypeClass")
- outputFileShouldBe (sourceFileSkeleton ["import ImportsSpec1 (class ATypeClass)"])
- it "adds an explicit unqualified import (dataconstructor)" $ do
- withSupportFiles (Integration.addImport "MyJust")
- outputFileShouldBe (sourceFileSkeleton ["import ImportsSpec1 (MyMaybe(..))"])
- it "adds an explicit unqualified import (newtype)" $ do
- withSupportFiles (Integration.addImport "MyNewtype")
- outputFileShouldBe (sourceFileSkeleton ["import ImportsSpec1 (MyNewtype(..))"])
- it "adds an explicit unqualified import (typeclass member function)" $ do
- withSupportFiles (Integration.addImport "typeClassFun")
- 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)"])
- it "doesn't add an import if the identifier is defined in the module itself" $ do
- withSupportFiles (Integration.addImport "myId")
- 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
- 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
index e830ed0..ce90f93 100644
--- a/tests/Language/PureScript/Ide/ImportsSpec.hs
+++ b/tests/Language/PureScript/Ide/ImportsSpec.hs
@@ -6,8 +6,12 @@ import Protolude
import Data.Maybe (fromJust)
import qualified Language.PureScript as P
+import Language.PureScript.Ide.Command as Command
+import Language.PureScript.Ide.Error
import Language.PureScript.Ide.Imports
+import qualified Language.PureScript.Ide.Test as Test
import Language.PureScript.Ide.Types
+import System.FilePath
import Test.Hspec
simpleFile :: [Text]
@@ -22,6 +26,7 @@ splitSimpleFile :: (P.ModuleName, [Text], [Import], [Text])
splitSimpleFile = fromRight (sliceImportSection simpleFile)
where
fromRight = fromJust . rightToMaybe
+
withImports :: [Text] -> [Text]
withImports is =
take 2 simpleFile ++ is ++ drop 2 simpleFile
@@ -144,7 +149,7 @@ spec = do
addImport imports import' = addExplicitImport' import' moduleName imports
valueImport ident = (IdeDeclValue (IdeValue (P.Ident ident) wildcard))
typeImport name = (IdeDeclType (IdeType (P.ProperName name) P.kindType))
- classImport name = (IdeDeclTypeClass (P.ProperName name))
+ classImport name = (IdeDeclTypeClass (IdeTypeClass (P.ProperName name) []))
dtorImport name typeName = (IdeDeclDataConstructor (IdeDataConstructor (P.ProperName name) (P.ProperName typeName) wildcard))
-- expect any list of provided identifiers, when imported, to come out as specified
expectSorted imports expected = shouldBe
@@ -171,3 +176,63 @@ spec = do
-- the imported names don't actually have to exist!
(map (uncurry dtorImport) [("Just", "Maybe"), ("Nothing", "Maybe"), ("SomeOtherConstructor", "SomeDataType")])
["import Prelude", "import Control.Monad (Maybe(..), SomeDataType(..), ap)"]
+ describe "importing from a loaded IdeState" importFromIdeState
+
+implImport :: Text -> Command
+implImport mn =
+ Command.Import ("src" </> "ImportsSpec.purs") Nothing [] (Command.AddImplicitImport (Test.mn mn))
+
+addExplicitImport :: Text -> Command
+addExplicitImport i =
+ Command.Import ("src" </> "ImportsSpec.purs") Nothing [] (Command.AddImportForIdentifier i)
+
+importShouldBe :: [Text] -> [Text] -> Expectation
+importShouldBe res importSection =
+ res `shouldBe` [ "module ImportsSpec where" , ""] ++ importSection ++ [ "" , "myId x = x"]
+
+runIdeLoaded :: Command -> IO (Either IdeError Success)
+runIdeLoaded c = do
+ ([_, result], _) <- Test.inProject $ Test.runIde [Command.LoadSync [] , c]
+ pure result
+
+importFromIdeState :: Spec
+importFromIdeState = do
+ it "adds an implicit import" $ do
+ Right (MultilineTextResult result) <-
+ runIdeLoaded (implImport "ImportsSpec1")
+ result `importShouldBe` [ "import ImportsSpec1" ]
+ it "adds an explicit unqualified import" $ do
+ Right (MultilineTextResult result) <- runIdeLoaded (addExplicitImport "exportedFunction")
+ result `importShouldBe` [ "import ImportsSpec1 (exportedFunction)" ]
+ it "adds an explicit unqualified import (type)" $ do
+ Right (MultilineTextResult result) <- runIdeLoaded (addExplicitImport "MyType")
+ result `importShouldBe` [ "import ImportsSpec1 (MyType)" ]
+ it "adds an explicit unqualified import (parameterized type)" $ do
+ Right (MultilineTextResult result) <- runIdeLoaded (addExplicitImport "MyParamType")
+ result `importShouldBe` [ "import ImportsSpec1 (MyParamType)" ]
+ it "adds an explicit unqualified import (typeclass)" $ do
+ Right (MultilineTextResult result) <- runIdeLoaded (addExplicitImport "ATypeClass")
+ result `importShouldBe` [ "import ImportsSpec1 (class ATypeClass)" ]
+ it "adds an explicit unqualified import (dataconstructor)" $ do
+ Right (MultilineTextResult result) <- runIdeLoaded (addExplicitImport "MyJust")
+ result `importShouldBe` [ "import ImportsSpec1 (MyMaybe(..))" ]
+ it "adds an explicit unqualified import (newtype)" $ do
+ Right (MultilineTextResult result) <- runIdeLoaded (addExplicitImport "MyNewtype")
+ result `importShouldBe` [ "import ImportsSpec1 (MyNewtype(..))" ]
+ it "adds an explicit unqualified import (typeclass member function)" $ do
+ Right (MultilineTextResult result) <- runIdeLoaded (addExplicitImport "typeClassFun")
+ result `importShouldBe` [ "import ImportsSpec1 (typeClassFun)" ]
+ it "doesn't add a newtypes constructor if only the type is exported" $ do
+ Right (MultilineTextResult result) <-
+ runIdeLoaded (addExplicitImport "OnlyTypeExported")
+ result `importShouldBe` [ "import ImportsSpec1 (OnlyTypeExported)" ]
+ it "doesn't add an import if the identifier is defined in the module itself" $ do
+ Right (MultilineTextResult result) <- runIdeLoaded (addExplicitImport "myId")
+ result `importShouldBe` []
+ it "responds with an error if it's undecidable whether we want a type or constructor" $ do
+ result <- runIdeLoaded (addExplicitImport "SpecialCase")
+ result `shouldSatisfy` isLeft
+ it "responds with an error if the identifier cannot be found and doesn't \
+ \write to the output file" $ do
+ result <- runIdeLoaded (addExplicitImport "doesnExist")
+ result `shouldSatisfy` isLeft
diff --git a/tests/Language/PureScript/Ide/Integration.hs b/tests/Language/PureScript/Ide/Integration.hs
deleted file mode 100644
index 92569d0..0000000
--- a/tests/Language/PureScript/Ide/Integration.hs
+++ /dev/null
@@ -1,273 +0,0 @@
------------------------------------------------------------------------------
---
--- 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 #-}
-{-# LANGUAGE NoImplicitPrelude #-}
-module Language.PureScript.Ide.Integration
- (
- -- managing the server process
- startServer
- , withServer
- , stopServer
- , quitServer
- -- util
- , compileTestProject
- , deleteOutputFolder
- , projectDirectory
- , deleteFileIfExists
- -- sending commands
- , addImport
- , addImplicitImport
- , loadAll
- , loadModule
- , loadModules
- , getCwd
- , getFlexCompletions
- , getFlexCompletionsInModule
- , getType
- , rebuildModule
- , reset
- -- checking results
- , resultIsSuccess
- , parseCompletions
- , parseTextResult
- ) where
-
-import Protolude
-import Data.Maybe (fromJust)
-
-import Data.Aeson
-import Data.Aeson.Types
-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.FilePath
-import System.IO.Error (mkIOError, userErrorType)
-import System.Process
-
-projectDirectory :: IO FilePath
-projectDirectory = do
- cd <- getCurrentDirectory
- return $ cd </> "tests" </> "support" </> "pscide"
-
-startServer :: IO ProcessHandle
-startServer = do
- pdir <- projectDirectory
- -- Turn off filewatching since it creates race condition in a testing environment
- (_, _, _, procHandle) <- createProcess $
- (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 ()
-stopServer = terminateProcess
-
-withServer :: IO a -> IO a
-withServer s = do
- _ <- startServer
- 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
-
--- project management utils
-
-compileTestProject :: IO Bool
-compileTestProject = do
- pdir <- projectDirectory
- (_, _, _, procHandle) <- createProcess $
- (shell . toS $ "psc " <> fileGlob) { cwd = Just pdir }
- r <- tryNTimes 10 (getProcessExitCode procHandle)
- pure (fromMaybe False (isSuccess <$> r))
-
-tryNTimes :: Int -> IO (Maybe a) -> IO (Maybe a)
-tryNTimes 0 _ = pure Nothing
-tryNTimes n action = do
- r <- action
- case r of
- Nothing -> do
- threadDelay 500000
- tryNTimes (n - 1) action
- Just a -> pure (Just a)
-
-deleteOutputFolder :: IO ()
-deleteOutputFolder = do
- odir <- fmap (</> "output") projectDirectory
- whenM (doesDirectoryExist odir) (removeDirectoryRecursive odir)
-
-deleteFileIfExists :: FilePath -> IO ()
-deleteFileIfExists fp = whenM (doesFileExist fp) (removeFile fp)
-
-isSuccess :: ExitCode -> Bool
-isSuccess ExitSuccess = True
-isSuccess (ExitFailure _) = False
-
-fileGlob :: Text
-fileGlob = "\"src/**/*.purs\""
-
--- Integration Testing API
-
-sendCommand :: Value -> IO Text
-sendCommand v = toS <$> readCreateProcess
- ((shell "psc-ide-client") { std_out=CreatePipe
- , std_err=CreatePipe
- })
- (T.unpack (encodeT v))
-
-quitServer :: IO ()
-quitServer = do
- let quitCommand = object ["command" .= ("quit" :: Text)]
- _ <- try $ sendCommand quitCommand :: IO (Either SomeException Text)
- return ()
-
-reset :: IO ()
-reset = do
- let resetCommand = object ["command" .= ("reset" :: Text)]
- _ <- try $ sendCommand resetCommand :: IO (Either SomeException Text)
- return ()
-
-getCwd :: IO Text
-getCwd = do
- let cwdCommand = object ["command" .= ("cwd" :: Text)]
- sendCommand cwdCommand
-
-loadModule :: Text -> IO Text
-loadModule m = loadModules [m]
-
-loadModules :: [Text] -> IO Text
-loadModules = sendCommand . load
-
-loadAll :: IO Text
-loadAll = sendCommand (load [])
-
-getFlexCompletions :: Text -> IO [(Text, Text, Text, Maybe P.SourceSpan)]
-getFlexCompletions q = parseCompletions <$> sendCommand (completion [] (Just (flexMatcher q)) Nothing)
-
-getFlexCompletionsInModule :: Text -> Text -> IO [(Text, Text, Text, Maybe P.SourceSpan)]
-getFlexCompletionsInModule q m = parseCompletions <$> sendCommand (completion [] (Just (flexMatcher q)) (Just m))
-
-getType :: Text -> IO [(Text, Text, Text, Maybe P.SourceSpan)]
-getType q = parseCompletions <$> sendCommand (typeC q [])
-
-addImport :: Text -> FilePath -> FilePath -> IO Text
-addImport identifier fp outfp = sendCommand (addImportC identifier fp outfp)
-
-addImplicitImport :: Text -> FilePath -> FilePath -> IO Text
-addImplicitImport mn fp outfp = sendCommand (addImplicitImportC mn fp outfp)
-
-rebuildModule :: FilePath -> IO Text
-rebuildModule m = sendCommand (rebuildC m Nothing)
-
--- Command Encoding
-
-commandWrapper :: Text -> Value -> Value
-commandWrapper c p = object ["command" .= c, "params" .= p]
-
-load :: [Text] -> Value
-load ms = commandWrapper "load" (object ["modules" .= ms])
-
-typeC :: Text -> [Value] -> Value
-typeC q filters = commandWrapper "type" (object ["search" .= q, "filters" .= filters])
-
-addImportC :: Text -> FilePath -> FilePath -> Value
-addImportC identifier = addImportW $
- object [ "importCommand" .= ("addImport" :: Text)
- , "identifier" .= identifier
- ]
-
-addImplicitImportC :: Text -> FilePath -> FilePath -> Value
-addImplicitImportC mn = addImportW $
- object [ "importCommand" .= ("addImplicitImport" :: Text)
- , "module" .= mn
- ]
-
-rebuildC :: FilePath -> Maybe FilePath -> Value
-rebuildC file outFile =
- commandWrapper "rebuild" (object [ "file" .= file
- , "outfile" .= outFile
- ])
-
-addImportW :: Value -> FilePath -> FilePath -> Value
-addImportW importCommand fp outfp =
- commandWrapper "import" (object [ "file" .= fp
- , "outfile" .= outfp
- , "importCommand" .= importCommand
- ])
-
-
-completion :: [Value] -> Maybe Value -> Maybe Text -> Value
-completion filters matcher currentModule =
- let
- matcher' = case matcher of
- Nothing -> []
- Just m -> ["matcher" .= m]
- currentModule' = case currentModule of
- Nothing -> []
- Just cm -> ["currentModule" .= cm]
- in
- commandWrapper "complete" (object $ "filters" .= filters : matcher' ++ currentModule' )
-
-flexMatcher :: Text -> Value
-flexMatcher q = object [ "matcher" .= ("flex" :: Text)
- , "params" .= object ["search" .= q]
- ]
-
--- Result parsing
-
-unwrapResult :: Value -> Parser (Either Text Value)
-unwrapResult = withObject "result" $ \o -> do
- (rt :: Text) <- o .: "resultType"
- case rt of
- "error" -> do
- res <- o .: "result"
- pure (Left res)
- "success" -> do
- res <- o .: "result"
- pure (Right res)
- _ -> mzero
-
-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 [(Text, Text, Text, Maybe P.SourceSpan)]
-completionParser = withArray "res" $ \cs ->
- mapM (withObject "completion" $ \o -> do
- ident <- o .: "identifier"
- module' <- o .: "module"
- ty <- o .: "type"
- ss <- o .: "definedAt"
- pure (module', ident, ty, ss)) (V.toList cs)
-
-valueFromText :: Text -> Value
-valueFromText = fromJust . decode . toS
-
-resultIsSuccess :: Text -> Bool
-resultIsSuccess = isRight . join . first toS . parseEither unwrapResult . valueFromText
-
-parseCompletions :: Text -> [(Text, Text, Text, Maybe P.SourceSpan)]
-parseCompletions s =
- fromJust $ join (rightToMaybe <$> parseMaybe (withResult completionParser) (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 f7a7f45..cfb7102 100644
--- a/tests/Language/PureScript/Ide/MatcherSpec.hs
+++ b/tests/Language/PureScript/Ide/MatcherSpec.hs
@@ -6,7 +6,6 @@ module Language.PureScript.Ide.MatcherSpec where
import Protolude
import qualified Language.PureScript as P
-import Language.PureScript.Ide.Integration
import Language.PureScript.Ide.Matcher
import Language.PureScript.Ide.Types
import Language.PureScript.Ide.Util
@@ -26,9 +25,6 @@ completions = [firstResult, secondResult, fiult]
runFlex :: Text -> [Match IdeDeclarationAnn]
runFlex s = runMatcher (flexMatcher s) completions
-setup :: IO ()
-setup = reset *> void loadAll
-
spec :: Spec
spec = do
describe "Flex Matcher" $ do
@@ -38,12 +34,3 @@ spec = do
runFlex "firstResult" `shouldBe` [firstResult]
it "scores short matches higher and sorts accordingly" $
runFlex "filt" `shouldBe` [fiult, firstResult]
-
- beforeAll_ setup . describe "Integration Tests: Flex Matcher" $ do
- it "doesn't match on an empty string" $ do
- cs <- getFlexCompletions ""
- cs `shouldBe` []
- it "matches on equality" $ do
- -- ignore any position information
- (m, i, t, _) : _ <- getFlexCompletions "const"
- (m, i, t) `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 f924190..801c3b6 100644
--- a/tests/Language/PureScript/Ide/RebuildSpec.hs
+++ b/tests/Language/PureScript/Ide/RebuildSpec.hs
@@ -4,54 +4,58 @@ module Language.PureScript.Ide.RebuildSpec where
import Protolude
-import qualified Language.PureScript.Ide.Integration as Integration
+import Language.PureScript.Ide.Command
+import Language.PureScript.Ide.Matcher
+import Language.PureScript.Ide.Types
+import qualified Language.PureScript.Ide.Test as Test
import System.FilePath
import Test.Hspec
-shouldBeSuccess :: Text -> IO ()
-shouldBeSuccess = shouldBe True . Integration.resultIsSuccess
+load :: [Text] -> Command
+load = LoadSync . map Test.mn
-shouldBeFailure :: Text -> IO ()
-shouldBeFailure = shouldBe False . Integration.resultIsSuccess
+rebuild :: FilePath -> Command
+rebuild fp = Rebuild ("src" </> fp)
+
+rebuildSync :: FilePath -> Command
+rebuildSync fp = RebuildSync ("src" </> fp)
spec :: Spec
-spec = before_ Integration.reset . describe "Rebuilding single modules" $ do
+spec = describe "Rebuilding single modules" $ do
it "rebuilds a correct module without dependencies successfully" $ do
- _ <- Integration.loadModule "RebuildSpecSingleModule"
- pdir <- Integration.projectDirectory
- let file = pdir </> "src" </> "RebuildSpecSingleModule.purs"
- Integration.rebuildModule file >>= shouldBeSuccess
+ ([_, result], _) <- Test.inProject $
+ Test.runIde [ load ["RebuildSpecSingleModule"]
+ , rebuild "RebuildSpecSingleModule.purs"
+ ]
+ result `shouldSatisfy` isRight
it "fails to rebuild an incorrect module without dependencies and returns the errors" $ do
- pdir <- Integration.projectDirectory
- let file = pdir </> "src" </> "RebuildSpecSingleModule.fail"
- Integration.rebuildModule file >>= shouldBeFailure
+ ([result], _) <- Test.inProject $
+ Test.runIde [ rebuild "RebuildSpecSingleModule.fail" ]
+ result `shouldSatisfy` isLeft
it "rebuilds a correct module with its dependencies successfully" $ do
- _ <- Integration.loadModules ["RebuildSpecWithDeps", "RebuildSpecDep"]
- pdir <- Integration.projectDirectory
- let file = pdir </> "src" </> "RebuildSpecWithDeps.purs"
- Integration.rebuildModule file >>= shouldBeSuccess
+ ([_, result], _) <- Test.inProject $
+ Test.runIde [ load ["RebuildSpecWithDeps", "RebuildSpecDep"]
+ , rebuild "RebuildSpecWithDeps.purs"
+ ]
+ result `shouldSatisfy` isRight
it "rebuilds a correct module that has reverse dependencies" $ do
- _ <- Integration.loadModule "RebuildSpecWithDeps"
- pdir <- Integration.projectDirectory
- let file = pdir </> "src" </> "RebuildSpecDep.purs"
- Integration.rebuildModule file >>= shouldBeSuccess
+ ([_, result], _) <- Test.inProject $
+ Test.runIde [ load ["RebuildSpecWithDeps"], rebuild "RebuildSpecDep.purs" ]
+ result `shouldSatisfy` isRight
it "fails to rebuild a module if its dependencies are not loaded" $ do
- _ <- Integration.loadModule "RebuildSpecWithDeps"
- pdir <- Integration.projectDirectory
- let file = pdir </> "src" </> "RebuildSpecWithDeps.purs"
- Integration.rebuildModule file >>= shouldBeFailure
+ ([_, result], _) <- Test.inProject $
+ Test.runIde [ load ["RebuildSpecWithDeps"], rebuild "RebuildSpecWithDeps.purs" ]
+ result `shouldSatisfy` isLeft
it "rebuilds a correct module with a foreign file" $ do
- _ <- Integration.loadModule "RebuildSpecWithForeign"
- pdir <- Integration.projectDirectory
- let file = pdir </> "src" </> "RebuildSpecWithForeign.purs"
- Integration.rebuildModule file >>= shouldBeSuccess
+ ([_, result], _) <- Test.inProject $
+ Test.runIde [ load ["RebuildSpecWithForeign"], rebuild "RebuildSpecWithForeign.purs" ]
+ result `shouldSatisfy` isRight
it "fails to rebuild a module with a foreign import but no file" $ do
- pdir <- Integration.projectDirectory
- let file = pdir </> "src" </> "RebuildSpecWithMissingForeign.fail"
- Integration.rebuildModule file >>= shouldBeFailure
+ ([result], _) <- Test.inProject $
+ Test.runIde [ rebuild "RebuildSpecWithMissingForeign.fail" ]
+ result `shouldSatisfy` isLeft
it "completes a hidden identifier after rebuilding" $ do
- pdir <- Integration.projectDirectory
- let file = pdir </> "src" </> "RebuildSpecWithHiddenIdent.purs"
- Integration.rebuildModule file >>= shouldBeSuccess
- res <- Integration.getFlexCompletionsInModule "hid" "RebuildSpecWithHiddenIdent"
- shouldBe False (null res)
+ ([_, (Right (CompletionResult [ result ]))], _) <- Test.inProject $
+ Test.runIde [ rebuildSync "RebuildSpecWithHiddenIdent.purs"
+ , Complete [] (flexMatcher "hid") (Just (Test.mn "RebuildSpecWithHiddenIdent"))]
+ complIdentifier result `shouldBe` "hidden"
diff --git a/tests/Language/PureScript/Ide/ReexportsSpec.hs b/tests/Language/PureScript/Ide/ReexportsSpec.hs
index adbdc74..c260c4e 100644
--- a/tests/Language/PureScript/Ide/ReexportsSpec.hs
+++ b/tests/Language/PureScript/Ide/ReexportsSpec.hs
@@ -10,6 +10,8 @@ import Language.PureScript.Ide.Types
import qualified Language.PureScript as P
import Test.Hspec
+type Module = (P.ModuleName, [IdeDeclarationAnn])
+
m :: Text -> P.ModuleName
m = P.moduleNameFromString
@@ -19,32 +21,32 @@ d = IdeDeclarationAnn emptyAnn
valueA, typeA, classA, dtorA1, dtorA2 :: IdeDeclarationAnn
valueA = d (IdeDeclValue (IdeValue (P.Ident "valueA") P.REmpty))
typeA = d (IdeDeclType (IdeType(P.ProperName "TypeA") P.kindType))
-classA = d (IdeDeclTypeClass (P.ProperName "ClassA"))
+classA = d (IdeDeclTypeClass (IdeTypeClass (P.ProperName "ClassA") []))
dtorA1 = d (IdeDeclDataConstructor (IdeDataConstructor (P.ProperName "DtorA1") (P.ProperName "TypeA") P.REmpty))
dtorA2 = d (IdeDeclDataConstructor (IdeDataConstructor (P.ProperName "DtorA2") (P.ProperName "TypeA") P.REmpty))
-env :: Map P.ModuleName [IdeDeclarationAnn]
+env :: ModuleMap [IdeDeclarationAnn]
env = Map.fromList
[ (m "A", [valueA, typeA, classA, dtorA1, dtorA2])
]
type Refs = [(P.ModuleName, P.DeclarationRef)]
-succTestCases :: [(Text, Module, Refs, Module)]
+succTestCases :: [(Text, [IdeDeclarationAnn], Refs, [IdeDeclarationAnn])]
succTestCases =
- [ ("resolves a value reexport", (m "C", []), [(m "A", P.ValueRef (P.Ident "valueA"))], (m "C", [valueA]))
+ [ ("resolves a value reexport", [], [(m "A", P.ValueRef (P.Ident "valueA"))], [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]))
+ , [], [(m "A", P.TypeRef (P.ProperName "TypeA") (Just [P.ProperName "DtorA1"]))], [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]))
+ , [], [(m "A", P.TypeRef (P.ProperName "TypeA") Nothing)], [typeA, dtorA1, dtorA2])
+ , ("resolves a class reexport", [], [(m "A", P.TypeClassRef (P.ProperName "ClassA"))], [classA])
]
-failTestCases :: [(Text, Module, Refs)]
+failTestCases :: [(Text, [IdeDeclarationAnn], 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"))])
+ [ ("fails to resolve a non existing value", [], [(m "A", P.ValueRef (P.Ident "valueB"))])
+ , ("fails to resolve a non existing type reexport" , [], [(m "A", P.TypeRef (P.ProperName "TypeB") Nothing)])
+ , ("fails to resolve a non existing class reexport", [], [(m "A", P.TypeClassRef (P.ProperName "ClassB"))])
]
spec :: Spec
@@ -52,12 +54,12 @@ spec = do
describe "Successful Reexports" $
for_ succTestCases $ \(desc, initial, refs, result) ->
it (toS desc) $ do
- let reResult = resolveReexports env (initial, refs)
+ 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)
+ 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
deleted file mode 100644
index 4fd6056..0000000
--- a/tests/Language/PureScript/Ide/SourceFile/IntegrationSpec.hs
+++ /dev/null
@@ -1,41 +0,0 @@
-{-# 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 $
- describe "Sourcefile Integration" $ do
- it "finds a value declaration" $
- testCase "sfValue" (3, 1)
- it "finds a type declaration" $
- testCase "SFType" (5, 1)
- it "finds a data declaration" $
- testCase "SFData" (7, 1)
- it "finds a data constructor" $
- testCase "SFOne" (7, 1)
- it "finds a typeclass" $
- testCase "SFClass" (9, 1)
- it "finds a typeclass member" $
- testCase "sfShow" (10, 3)
-
-testCase :: Text -> (Int, Int) -> IO ()
-testCase s (x, y) = do
- P.SourceSpan f (P.SourcePos l c) _ <- getLocation s
- toS f `shouldSatisfy` T.isSuffixOf "SourceFileSpec.purs"
- (l, c) `shouldBe` (x, y)
-
-getLocation :: Text -> IO P.SourceSpan
-getLocation s = do
- (_, _, _, Just location) : _ <- Integration.getType s
- pure location
diff --git a/tests/Language/PureScript/Ide/SourceFileSpec.hs b/tests/Language/PureScript/Ide/SourceFileSpec.hs
index eae3de7..e680c99 100644
--- a/tests/Language/PureScript/Ide/SourceFileSpec.hs
+++ b/tests/Language/PureScript/Ide/SourceFileSpec.hs
@@ -5,8 +5,10 @@ module Language.PureScript.Ide.SourceFileSpec where
import Protolude
import qualified Language.PureScript as P
+import Language.PureScript.Ide.Command
import Language.PureScript.Ide.SourceFile
import Language.PureScript.Ide.Types
+import Language.PureScript.Ide.Test
import Test.Hspec
span0, span1, span2 :: P.SourceSpan
@@ -14,7 +16,7 @@ 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)
-typeAnnotation1, value1, synonym1, class1, class2, data1, data2, foreign1, foreign2, foreign3, member1 :: P.Declaration
+typeAnnotation1, value1, synonym1, class1, class2, data1, data2, valueFixity, typeFixity, foreign1, foreign2, foreign3, member1 :: P.Declaration
typeAnnotation1 = P.TypeDeclaration (P.Ident "value1") P.REmpty
value1 = P.ValueDeclaration (P.Ident "value1") P.Public [] (Left [])
synonym1 = P.TypeSynonymDeclaration (P.ProperName "Synonym1") [] P.REmpty
@@ -23,6 +25,16 @@ 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", [])]
+valueFixity =
+ P.ValueFixityDeclaration
+ (P.Fixity P.Infix 0)
+ (P.Qualified Nothing (Left (P.Ident "")))
+ (P.OpName "<$>")
+typeFixity =
+ P.TypeFixityDeclaration
+ (P.Fixity P.Infix 0)
+ (P.Qualified Nothing (P.ProperName ""))
+ (P.OpName "~>")
foreign1 = P.ExternDeclaration (P.Ident "foreign1") P.REmpty
foreign2 = P.ExternDataDeclaration (P.ProperName "Foreign2") P.kindType
foreign3 = P.ExternKindDeclaration (P.ProperName "Foreign3")
@@ -43,6 +55,10 @@ spec = do
extractSpans span0 (P.PositionedDeclaration span1 [] data1) `shouldBe` [(IdeNSType "Data1", span1)]
it "extracts spans for a data declaration and its constructors" $
extractSpans span0 (P.PositionedDeclaration span1 [] data2) `shouldBe` [(IdeNSType "Data2", span1), (IdeNSValue "Cons1", span1)]
+ it "extracts a span for a value operator fixity declaration" $
+ extractSpans span0 (P.PositionedDeclaration span1 [] valueFixity) `shouldBe` [(IdeNSValue "<$>", span1)]
+ it "extracts a span for a type operator fixity declaration" $
+ extractSpans span0 (P.PositionedDeclaration span1 [] typeFixity) `shouldBe` [(IdeNSType "~>", span1)]
it "extracts a span for a foreign declaration" $
extractSpans span0 (P.PositionedDeclaration span1 [] foreign1) `shouldBe` [(IdeNSValue "foreign1", span1)]
it "extracts a span for a data foreign declaration" $
@@ -52,3 +68,55 @@ spec = do
describe "Type annotations" $ do
it "extracts a type annotation" $
extractTypeAnnotations [typeAnnotation1] `shouldBe` [(P.Ident "value1", P.REmpty)]
+ describe "Finding Source Spans for identifiers" $ do
+ it "finds a value declaration" $ do
+ Just r <- getLocation "sfValue"
+ r `shouldBe` valueSS
+ it "finds a synonym declaration" $ do
+ Just r <- getLocation "SFType"
+ r `shouldBe` synonymSS
+ it "finds a data declaration and its constructors" $ do
+ rs <- traverse getLocation ["SFData", "SFOne", "SFTwo", "SFThree"]
+ traverse_ (`shouldBe` (Just typeSS)) rs
+ it "finds a class declaration" $ do
+ Just r <- getLocation "SFClass"
+ r `shouldBe` classSS
+ it "finds a value operator declaration" $ do
+ Just r <- getLocation "<$>"
+ r `shouldBe` valueOpSS
+ it "finds a type operator declaration" $ do
+ Just r <- getLocation "~>"
+ r `shouldBe` typeOpSS
+
+getLocation :: Text -> IO (Maybe P.SourceSpan)
+getLocation s = do
+ ([Right (CompletionResult [c])], _) <-
+ runIde' defConfig ideState [Type s [] Nothing]
+ pure (complLocation c)
+ where
+ ideState = emptyIdeState `s3`
+ [ ("Test",
+ [ ideValue "sfValue" Nothing `annLoc` valueSS
+ , ideSynonym "SFType" P.tyString `annLoc` synonymSS
+ , ideType "SFData" Nothing `annLoc` typeSS
+ , ideDtor "SFOne" "SFData" Nothing `annLoc` typeSS
+ , ideDtor "SFTwo" "SFData" Nothing `annLoc` typeSS
+ , ideDtor "SFThree" "SFData" Nothing `annLoc` typeSS
+ , ideTypeClass "SFClass" [] `annLoc` classSS
+ , ideValueOp "<$>" (P.Qualified Nothing (Left "")) 0 Nothing Nothing
+ `annLoc` valueOpSS
+ , ideTypeOp "~>" (P.Qualified Nothing "") 0 Nothing Nothing
+ `annLoc` typeOpSS
+ ])
+ ]
+
+valueSS, synonymSS, typeSS, classSS, valueOpSS, typeOpSS :: P.SourceSpan
+valueSS = ss 3 1
+synonymSS = ss 5 1
+typeSS = ss 7 1
+classSS = ss 8 1
+valueOpSS = ss 12 1
+typeOpSS = ss 13 1
+
+ss :: Int -> Int -> P.SourceSpan
+ss x y = P.SourceSpan "Test.purs" (P.SourcePos x y) (P.SourcePos x y)
diff --git a/tests/Language/PureScript/Ide/StateSpec.hs b/tests/Language/PureScript/Ide/StateSpec.hs
index 5126fe2..a4a546a 100644
--- a/tests/Language/PureScript/Ide/StateSpec.hs
+++ b/tests/Language/PureScript/Ide/StateSpec.hs
@@ -3,6 +3,7 @@
module Language.PureScript.Ide.StateSpec where
import Protolude
+import Control.Lens hiding ((&))
import Language.PureScript.Ide.Types
import Language.PureScript.Ide.State
import qualified Language.PureScript as P
@@ -21,7 +22,7 @@ typeOperator :: Maybe P.Kind -> IdeDeclarationAnn
typeOperator =
d . IdeDeclTypeOperator . IdeTypeOperator (P.OpName ":") (P.Qualified (Just (mn "Test")) (P.ProperName "List")) 2 P.Infix
-testModule :: Module
+testModule :: (P.ModuleName, [IdeDeclarationAnn])
testModule = (mn "Test", [ d (IdeDeclValue (IdeValue (P.Ident "function") P.REmpty))
, d (IdeDeclDataConstructor (IdeDataConstructor (P.ProperName "Cons") (P.ProperName "List") (P.REmpty)))
, d (IdeDeclType (IdeType (P.ProperName "List") P.kindType))
@@ -34,18 +35,57 @@ d :: IdeDeclaration -> IdeDeclarationAnn
d = IdeDeclarationAnn emptyAnn
mn :: Text -> P.ModuleName
-mn = P.moduleNameFromString . toS
+mn = P.moduleNameFromString
-testState :: Map P.ModuleName [IdeDeclarationAnn]
-testState = Map.fromList
- [ testModule
- ]
+testState :: ModuleMap [IdeDeclarationAnn]
+testState = Map.fromList [testModule]
+
+-- The accessor fields for these data types are not exposed unfortunately
+ef :: P.ExternsFile
+ef = P.ExternsFile
+ -- { efVersion =
+ mempty
+ -- , efModuleName =
+ (mn "InstanceModule")
+ -- , efExports =
+ mempty
+ -- , efImports =
+ mempty
+ -- , efFixities =
+ mempty
+ -- , efTypeFixities =
+ mempty
+ --, efDeclarations =
+ [ P.EDInstance
+ -- { edInstanceClassName =
+ (P.Qualified (Just (mn "ClassModule")) (P.ProperName "MyClass"))
+ -- , edInstanceName =
+ (P.Ident "myClassInstance")
+ -- , edInstanceTypes =
+ mempty
+ -- , edInstanceConstraints =
+ mempty
+ -- }
+ ]
+ -- }
+
+moduleMap :: ModuleMap [IdeDeclarationAnn]
+moduleMap = Map.singleton (mn "ClassModule") [d (IdeDeclTypeClass (IdeTypeClass (P.ProperName "MyClass") []))]
+
+ideInstance :: IdeInstance
+ideInstance = IdeInstance (mn "InstanceModule") (P.Ident "myClassInstance") mempty mempty
spec :: Spec
-spec = describe "resolving operators" $ do
- it "resolves the type for a value operator" $
- resolveOperatorsForModule testState (snd testModule) `shouldSatisfy` elem (valueOperator (Just P.REmpty))
- it "resolves the type for a constructor operator" $
- resolveOperatorsForModule testState (snd testModule) `shouldSatisfy` elem (ctorOperator (Just P.REmpty))
- it "resolves the kind for a type operator" $
- resolveOperatorsForModule testState (snd testModule) `shouldSatisfy` elem (typeOperator (Just P.kindType))
+spec = do
+ describe "resolving operators" $ do
+ it "resolves the type for a value operator" $
+ resolveOperatorsForModule testState (snd testModule) `shouldSatisfy` elem (valueOperator (Just P.REmpty))
+ it "resolves the type for a constructor operator" $
+ resolveOperatorsForModule testState (snd testModule) `shouldSatisfy` elem (ctorOperator (Just P.REmpty))
+ it "resolves the kind for a type operator" $
+ resolveOperatorsForModule testState (snd testModule) `shouldSatisfy` elem (typeOperator (Just P.kindType))
+ describe "resolving instances for type classes" $ do
+ it "resolves an instance for an existing type class" $ do
+ resolveInstances (Map.singleton (mn "InstanceModule") ef) moduleMap
+ `shouldSatisfy`
+ elemOf (ix (mn "ClassModule") . ix 0 . idaDeclaration . _IdeDeclTypeClass . ideTCInstances . folded) ideInstance
diff --git a/tests/Language/PureScript/Ide/Test.hs b/tests/Language/PureScript/Ide/Test.hs
new file mode 100644
index 0000000..5d3841b
--- /dev/null
+++ b/tests/Language/PureScript/Ide/Test.hs
@@ -0,0 +1,135 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE PackageImports #-}
+module Language.PureScript.Ide.Test where
+
+import Control.Concurrent.STM
+import "monad-logger" Control.Monad.Logger
+import qualified Data.Map as Map
+import Language.PureScript.Ide
+import Language.PureScript.Ide.Command
+import Language.PureScript.Ide.Error
+import Language.PureScript.Ide.Types
+import Protolude
+import System.Directory
+import System.FilePath
+import System.Process
+
+import qualified Language.PureScript as P
+
+defConfig :: Configuration
+defConfig =
+ Configuration { confLogLevel = LogNone
+ , confOutputPath = "output/"
+ , confGlobs = ["src/*.purs"]
+ }
+
+runIde' :: Configuration -> IdeState -> [Command] -> IO ([Either IdeError Success], IdeState)
+runIde' conf s cs = do
+ stateVar <- newTVarIO s
+ let env' = IdeEnvironment {ideStateVar = stateVar, ideConfiguration = conf}
+ r <- runNoLoggingT (runReaderT (traverse (runExceptT . handleCommand) cs) env')
+ newState <- readTVarIO stateVar
+ pure (r, newState)
+
+runIde :: [Command] -> IO ([Either IdeError Success], IdeState)
+runIde = runIde' defConfig emptyIdeState
+
+s3 :: IdeState -> [(Text, [IdeDeclarationAnn])] -> IdeState
+s3 s ds =
+ s {ideStage3 = stage3}
+ where
+ stage3 = Stage3 (Map.fromList decls) Nothing
+ decls = map (first P.moduleNameFromString) ds
+
+-- | Adding Annotations to IdeDeclarations
+ann :: IdeDeclarationAnn -> Annotation -> IdeDeclarationAnn
+ann (IdeDeclarationAnn _ d) a = IdeDeclarationAnn a d
+
+annLoc :: IdeDeclarationAnn -> P.SourceSpan -> IdeDeclarationAnn
+annLoc (IdeDeclarationAnn a d) loc = IdeDeclarationAnn a {annLocation = Just loc} d
+
+annExp :: IdeDeclarationAnn -> P.ModuleName -> IdeDeclarationAnn
+annExp (IdeDeclarationAnn a d) e = IdeDeclarationAnn a {annExportedFrom = Just e} d
+
+annTyp :: IdeDeclarationAnn -> P.Type -> IdeDeclarationAnn
+annTyp (IdeDeclarationAnn a d) ta = IdeDeclarationAnn a {annTypeAnnotation = Just ta} d
+
+
+ida :: IdeDeclaration -> IdeDeclarationAnn
+ida = IdeDeclarationAnn emptyAnn
+
+-- | Builders for Ide declarations
+ideValue :: Text -> Maybe P.Type -> IdeDeclarationAnn
+ideValue i ty = ida (IdeDeclValue (IdeValue (P.Ident i) (fromMaybe P.tyString ty)))
+
+ideType :: Text -> Maybe P.Kind -> IdeDeclarationAnn
+ideType pn ki = ida (IdeDeclType (IdeType (P.ProperName pn) (fromMaybe P.kindType ki)))
+
+ideSynonym :: Text -> P.Type -> IdeDeclarationAnn
+ideSynonym pn ty = ida (IdeDeclTypeSynonym (IdeTypeSynonym (P.ProperName pn) ty))
+
+ideTypeClass :: Text -> [IdeInstance] -> IdeDeclarationAnn
+ideTypeClass pn instances = ida (IdeDeclTypeClass (IdeTypeClass (P.ProperName pn) instances))
+
+ideDtor :: Text -> Text -> Maybe P.Type -> IdeDeclarationAnn
+ideDtor pn tn ty = ida (IdeDeclDataConstructor (IdeDataConstructor (P.ProperName pn) (P.ProperName tn) (fromMaybe P.tyString ty)))
+
+ideValueOp :: Text -> P.Qualified (Either Text Text) -> Integer -> Maybe P.Associativity -> Maybe P.Type -> IdeDeclarationAnn
+ideValueOp opName ident precedence assoc t =
+ ida (IdeDeclValueOperator
+ (IdeValueOperator
+ (P.OpName opName)
+ (bimap P.Ident P.ProperName <$> ident)
+ (precedence)
+ (fromMaybe P.Infix assoc)
+ t))
+
+ideTypeOp :: Text -> P.Qualified Text -> Integer -> Maybe P.Associativity -> Maybe P.Kind -> IdeDeclarationAnn
+ideTypeOp opName ident precedence assoc k =
+ ida (IdeDeclTypeOperator
+ (IdeTypeOperator
+ (P.OpName opName)
+ (P.ProperName <$> ident)
+ (precedence)
+ (fromMaybe P.Infix assoc)
+ k))
+
+ideKind :: Text -> IdeDeclarationAnn
+ideKind pn = ida (IdeDeclKind (P.ProperName pn))
+
+mn :: Text -> P.ModuleName
+mn = P.moduleNameFromString
+
+inProject :: IO a -> IO a
+inProject f = do
+ cwd' <- getCurrentDirectory
+ setCurrentDirectory ("." </> "tests" </> "support" </> "pscide")
+ a <- f
+ setCurrentDirectory cwd'
+ pure a
+
+compileTestProject :: IO Bool
+compileTestProject = inProject $ do
+ (_, _, _, procHandle) <-
+ createProcess $ (shell $ "psc \"src/**/*.purs\"")
+ r <- tryNTimes 10 (getProcessExitCode procHandle)
+ pure (fromMaybe False (isSuccess <$> r))
+
+isSuccess :: ExitCode -> Bool
+isSuccess ExitSuccess = True
+isSuccess (ExitFailure _) = False
+
+tryNTimes :: Int -> IO (Maybe a) -> IO (Maybe a)
+tryNTimes 0 _ = pure Nothing
+tryNTimes n action = do
+ r <- action
+ case r of
+ Nothing -> do
+ threadDelay 500000
+ tryNTimes (n - 1) action
+ Just a -> pure (Just a)
+
+deleteOutputFolder :: IO ()
+deleteOutputFolder = inProject $
+ whenM (doesDirectoryExist "output") (removeDirectoryRecursive "output")
diff --git a/tests/TestDocs.hs b/tests/TestDocs.hs
index c995336..46ce23d 100644
--- a/tests/TestDocs.hs
+++ b/tests/TestDocs.hs
@@ -9,14 +9,16 @@ import Prelude ()
import Prelude.Compat
import Control.Arrow (first)
+import Control.Monad.IO.Class (liftIO)
-import Data.Version (Version(..))
-import Data.Monoid
-import Data.Maybe (fromMaybe)
-import Data.List ((\\))
import Data.Foldable
+import Data.List ((\\))
+import Data.Maybe (fromMaybe)
+import Data.Monoid
import Data.Text (Text)
import qualified Data.Text as T
+import Data.Time.Clock (getCurrentTime)
+import Data.Version (Version(..))
import System.Exit
import qualified Language.PureScript as P
@@ -32,6 +34,7 @@ import TestUtils
publishOpts :: Publish.PublishOptions
publishOpts = Publish.defaultPublishOptions
{ Publish.publishGetVersion = return testVersion
+ , Publish.publishGetTagTime = const (liftIO getCurrentTime)
, Publish.publishWorkingTreeDirty = return ()
}
where testVersion = ("v999.0.0", Version [999,0,0] [])
@@ -333,7 +336,6 @@ testCases =
[ ValueShouldHaveTypeSignature (n "ExplicitTypeSignatures") "explicit" (ShowFn (hasTypeVar "something"))
, ValueShouldHaveTypeSignature (n "ExplicitTypeSignatures") "anInt" (ShowFn (P.tyInt ==))
, ValueShouldHaveTypeSignature (n "ExplicitTypeSignatures") "aNumber" (ShowFn (P.tyNumber ==))
- , ValueShouldHaveTypeSignature (n "ExplicitTypeSignatures") "nestedForAll" (renderedType "forall c. (forall a b. c)")
])
, ("ConstrainedArgument",
diff --git a/tests/TestPscIde.hs b/tests/TestPscIde.hs
index bf9e62c..97ff41f 100644
--- a/tests/TestPscIde.hs
+++ b/tests/TestPscIde.hs
@@ -1,15 +1,13 @@
module TestPscIde where
import Control.Monad (unless)
-import Language.PureScript.Ide.Integration
import qualified PscIdeSpec
+import Language.PureScript.Ide.Test
import Test.Hspec
main :: IO ()
main = do
deleteOutputFolder
s <- compileTestProject
- unless s $ fail "Failed to compile .purs sources"
-
- quitServer -- shuts down any left over server (primarily happens during development)
- withServer (hspec PscIdeSpec.spec)
+ unless s (fail "Failed to compile .purs sources")
+ hspec PscIdeSpec.spec
diff --git a/tests/TestPscPublish.hs b/tests/TestPscPublish.hs
index 14bd037..a97ca1f 100644
--- a/tests/TestPscPublish.hs
+++ b/tests/TestPscPublish.hs
@@ -4,8 +4,10 @@
module TestPscPublish where
+import Control.Monad.IO.Class (liftIO)
import System.Exit (exitFailure)
import Data.ByteString.Lazy (ByteString)
+import Data.Time.Clock (getCurrentTime)
import qualified Data.Aeson as A
import Data.Version
@@ -38,6 +40,7 @@ roundTrip pkg =
testRunOptions :: PublishOptions
testRunOptions = defaultPublishOptions
{ publishGetVersion = return testVersion
+ , publishGetTagTime = const (liftIO getCurrentTime)
, publishWorkingTreeDirty = return ()
}
where testVersion = ("v999.0.0", Version [999,0,0] [])
@@ -58,13 +61,4 @@ testPackage dir = pushd dir $ do
print other
exitFailure
where
- preparePackageError e@(UserError BowerJSONNotFound) = do
- Publish.printErrorToStdout e
- putStrLn ""
- putStrLn "=========================================="
- putStrLn "Did you forget to update the submodules?"
- putStrLn "$ git submodule sync; git submodule update"
- putStrLn "=========================================="
- putStrLn ""
- exitFailure
preparePackageError e = Publish.printErrorToStdout e >> exitFailure
diff --git a/tests/TestUtils.hs b/tests/TestUtils.hs
index 783f0c7..ef9bbb5 100644
--- a/tests/TestUtils.hs
+++ b/tests/TestUtils.hs
@@ -78,6 +78,7 @@ supportModules =
, "Data.Array"
, "Data.Array.Partial"
, "Data.Array.ST"
+ , "Data.Array.ST.Iterator"
, "Data.Bifoldable"
, "Data.Bifunctor"
, "Data.Bifunctor.Clown"
diff --git a/tests/support/pscide/src/SourceFileSpec.purs b/tests/support/pscide/src/SourceFileSpec.purs
deleted file mode 100644
index e3484fa..0000000
--- a/tests/support/pscide/src/SourceFileSpec.purs
+++ /dev/null
@@ -1,10 +0,0 @@
-module SourceFileSpec where
-
-sfValue = "sfValue"
-
-type SFType = String
-
-data SFData = SFOne | SFTwo | SFThree
-
-class SFClass a where
- sfShow :: a -> String