summaryrefslogtreecommitdiff
path: root/tests
diff options
context:
space:
mode:
authorPhilFreeman <>2017-06-05 01:48:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2017-06-05 01:48:00 (GMT)
commit365104aef9239bb6b25980ffbeba1a1b5682ba78 (patch)
treebe7808de4b20ecf3d1390ad2ce42dab3847908ef /tests
parentdfc751175a388290a125b6eb4dcde53a2795e7ab (diff)
version 0.11.50.11.5
Diffstat (limited to 'tests')
-rw-r--r--tests/Language/PureScript/Ide/CompletionSpec.hs34
-rw-r--r--tests/Language/PureScript/Ide/FilterSpec.hs51
-rw-r--r--tests/Language/PureScript/Ide/ImportsSpec.hs38
-rw-r--r--tests/Language/PureScript/Ide/RebuildSpec.hs3
-rw-r--r--tests/Language/PureScript/Ide/ReexportsSpec.hs9
-rw-r--r--tests/Language/PureScript/Ide/SourceFileSpec.hs26
-rw-r--r--tests/Language/PureScript/Ide/Test.hs18
-rw-r--r--tests/TestCompiler.hs81
-rw-r--r--tests/TestDocs.hs4
-rw-r--r--tests/TestPsci/CompletionTest.hs26
-rw-r--r--tests/TestUtils.hs144
-rw-r--r--tests/support/bower.json2
12 files changed, 225 insertions, 211 deletions
diff --git a/tests/Language/PureScript/Ide/CompletionSpec.hs b/tests/Language/PureScript/Ide/CompletionSpec.hs
new file mode 100644
index 0000000..623a58e
--- /dev/null
+++ b/tests/Language/PureScript/Ide/CompletionSpec.hs
@@ -0,0 +1,34 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+module Language.PureScript.Ide.CompletionSpec where
+
+import Protolude
+
+import Language.PureScript as P
+import Language.PureScript.Ide.Completion
+import Language.PureScript.Ide.Test
+import Language.PureScript.Ide.Types
+import Test.Hspec
+
+reexportMatches :: [Match IdeDeclarationAnn]
+reexportMatches =
+ map (\d -> Match (mn "A", d)) moduleA
+ ++ map (\d -> Match (mn "B", d)) moduleB
+ where
+ moduleA = [ideKind "Kind"]
+ moduleB = [ideKind "Kind" `annExp` "A"]
+
+matches :: [(Match IdeDeclarationAnn, [P.ModuleName])]
+matches = map (\d -> (Match (mn "Main", d), [mn "Main"])) [ ideKind "Kind", ideType "Type" Nothing ]
+
+spec :: Spec
+spec = describe "Applying completion options" $ do
+ it "keeps all matches if maxResults is not specified" $ do
+ applyCompletionOptions (defaultCompletionOptions { coMaxResults = Nothing })
+ (map fst matches) `shouldMatchList` matches
+ it "keeps only the specified amount of maxResults" $ do
+ applyCompletionOptions (defaultCompletionOptions { coMaxResults = Just 1 })
+ (map fst matches) `shouldMatchList` take 1 matches
+ it "groups reexports for a single identifier" $ do
+ applyCompletionOptions (defaultCompletionOptions { coGroupReexports = True })
+ reexportMatches `shouldBe` [(Match (mn "A", ideKind "Kind"), [mn "A", mn "B"])]
diff --git a/tests/Language/PureScript/Ide/FilterSpec.hs b/tests/Language/PureScript/Ide/FilterSpec.hs
index f129b18..2e1c8f9 100644
--- a/tests/Language/PureScript/Ide/FilterSpec.hs
+++ b/tests/Language/PureScript/Ide/FilterSpec.hs
@@ -3,19 +3,20 @@
module Language.PureScript.Ide.FilterSpec where
import Protolude
+import Data.List.NonEmpty
import Language.PureScript.Ide.Filter
import Language.PureScript.Ide.Types
+import Language.PureScript.Ide.Test as T
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))
-
-moduleA, moduleB :: Module
-moduleA = (P.moduleNameFromString "Module.A", [value "function1"])
-moduleB = (P.moduleNameFromString "Module.B", [value "data1"])
+moduleA, moduleB, moduleC, moduleD :: Module
+moduleA = (P.moduleNameFromString "Module.A", [T.ideValue "function1" Nothing])
+moduleB = (P.moduleNameFromString "Module.B", [T.ideValue "data1" Nothing])
+moduleC = (P.moduleNameFromString "Module.C", [T.ideType "List" Nothing])
+moduleD = (P.moduleNameFromString "Module.D", [T.ideKind "kind1"])
modules :: [Module]
modules = [moduleA, moduleB]
@@ -29,6 +30,9 @@ runPrefix s = applyFilters [prefixFilter s] modules
runModule :: [P.ModuleName] -> [Module]
runModule ms = applyFilters [moduleFilter ms] modules
+runNamespace :: NonEmpty IdeNamespace -> [Module] -> [Module]
+runNamespace namespaces = applyFilters [namespaceFilter namespaces]
+
spec :: Spec
spec = do
describe "equality Filter" $ do
@@ -52,3 +56,38 @@ spec = do
runModule [P.moduleNameFromString "Module.A"] `shouldBe` [moduleA]
it "ignores modules that are not in scope" $
runModule (P.moduleNameFromString <$> ["Module.A", "Unknown"]) `shouldBe` [moduleA]
+ describe "namespaceFilter" $ do
+ it "extracts modules by filtering `value` namespaces" $
+ runNamespace (fromList [IdeNSValue])
+ [moduleA, moduleB, moduleD] `shouldBe` [moduleA, moduleB]
+ it "extracts no modules by filtering `value` namespaces" $
+ runNamespace (fromList [IdeNSValue])
+ [moduleD] `shouldBe` []
+ it "extracts modules by filtering `type` namespaces" $
+ runNamespace (fromList [IdeNSType])
+ [moduleA, moduleB, moduleC] `shouldBe` [moduleC]
+ it "extracts no modules by filtering `type` namespaces" $
+ runNamespace (fromList [IdeNSType])
+ [moduleA, moduleB] `shouldBe` []
+ it "extracts modules by filtering `kind` namespaces" $
+ runNamespace (fromList [IdeNSKind])
+ [moduleA, moduleB, moduleD] `shouldBe` [moduleD]
+ it "extracts no modules by filtering `kind` namespaces" $
+ runNamespace (fromList [IdeNSKind])
+ [moduleA, moduleB] `shouldBe` []
+ it "extracts modules by filtering `value` and `type` namespaces" $
+ runNamespace (fromList [ IdeNSValue, IdeNSType])
+ [moduleA, moduleB, moduleC, moduleD]
+ `shouldBe` [moduleA, moduleB, moduleC]
+ it "extracts modules by filtering `value` and `kind` namespaces" $
+ runNamespace (fromList [ IdeNSValue, IdeNSKind])
+ [moduleA, moduleB, moduleC, moduleD]
+ `shouldBe` [moduleA, moduleB, moduleD]
+ it "extracts modules by filtering `type` and `kind` namespaces" $
+ runNamespace (fromList [ IdeNSType, IdeNSKind])
+ [moduleA, moduleB, moduleC, moduleD]
+ `shouldBe` [moduleC, moduleD]
+ it "extracts modules by filtering `value`, `type` and `kind` namespaces" $
+ runNamespace (fromList [ IdeNSValue, IdeNSType, IdeNSKind])
+ [moduleA, moduleB, moduleC, moduleD]
+ `shouldBe` [moduleA, moduleB, moduleC, moduleD]
diff --git a/tests/Language/PureScript/Ide/ImportsSpec.hs b/tests/Language/PureScript/Ide/ImportsSpec.hs
index bb67e7d..908531b 100644
--- a/tests/Language/PureScript/Ide/ImportsSpec.hs
+++ b/tests/Language/PureScript/Ide/ImportsSpec.hs
@@ -44,7 +44,7 @@ splitSimpleFile = fromRight (sliceImportSection simpleFile)
withImports :: [Text] -> [Text]
withImports is =
- take 2 simpleFile ++ is ++ drop 2 simpleFile
+ take 2 simpleFile ++ [""] ++ is ++ drop 2 simpleFile
testParseImport :: Text -> Import
testParseImport = fromJust . parseImport
@@ -108,6 +108,8 @@ spec = do
prettyPrintImportSection (addExplicitImport' (_idaDeclaration (Test.ideDtor i t Nothing)) mn is)
addTypeImport i mn is =
prettyPrintImportSection (addExplicitImport' (_idaDeclaration (Test.ideType i Nothing)) mn is)
+ addKindImport i mn is =
+ prettyPrintImportSection (addExplicitImport' (_idaDeclaration (Test.ideKind i)) mn is)
it "adds an implicit unqualified import to a file without any imports" $
shouldBe
(addImplicitImport' [] (P.moduleNameFromString "Data.Map"))
@@ -115,8 +117,15 @@ spec = do
it "adds an implicit unqualified import" $
shouldBe
(addImplicitImport' simpleFileImports (P.moduleNameFromString "Data.Map"))
+ [ "import Data.Map"
+ , "import Prelude"
+ ]
+ it "adds a qualified import" $
+ shouldBe
+ (addQualifiedImport' simpleFileImports (Test.mn "Data.Map") (Test.mn "Map"))
[ "import Prelude"
- , "import Data.Map"
+ , ""
+ , "import Data.Map as Map"
]
it "adds an explicit unqualified import to a file without any imports" $
shouldBe
@@ -126,6 +135,7 @@ spec = do
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" $
@@ -137,24 +147,35 @@ spec = do
shouldBe
(addValueImport "head" (P.moduleNameFromString "Data.Array") explicitImports)
[ "import Prelude"
+ , ""
, "import Data.Array (head, tail)"
]
+ it "adds a kind to an explicit import list" $
+ shouldBe
+ (addKindImport "Effect" (P.moduleNameFromString "Control.Monad.Eff") simpleFileImports)
+ [ "import Prelude"
+ , ""
+ , "import Control.Monad.Eff (kind Effect)"
+ ]
it "adds an operator to an explicit import list" $
shouldBe
(addOpImport "<~>" (P.moduleNameFromString "Data.Array") explicitImports)
[ "import Prelude"
+ , ""
, "import Data.Array (tail, (<~>))"
]
it "adds a type with constructors without automatically adding an open import of said constructors " $
shouldBe
(addTypeImport "Maybe" (P.moduleNameFromString "Data.Maybe") simpleFileImports)
[ "import Prelude"
+ , ""
, "import Data.Maybe (Maybe)"
]
it "adds the type for a given DataConstructor" $
shouldBe
(addDtorImport "Just" "Maybe" (P.moduleNameFromString "Data.Maybe") simpleFileImports)
[ "import Prelude"
+ , ""
, "import Data.Maybe (Maybe(..))"
]
it "adds a dataconstructor to an existing type import" $ do
@@ -162,6 +183,7 @@ spec = do
shouldBe
(addDtorImport "Just" "Maybe" (P.moduleNameFromString "Data.Maybe") typeImports)
[ "import Prelude"
+ , ""
, "import Data.Maybe (Maybe(..))"
]
it "doesn't add a dataconstructor to an existing type import with open dtors" $ do
@@ -169,12 +191,14 @@ spec = do
shouldBe
(addDtorImport "Just" "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)"
]
@@ -195,23 +219,23 @@ spec = do
[expected]
it "sorts class" $
expectSorted (map classImport ["Applicative", "Bind"])
- ["import Prelude", "import Control.Monad (class Applicative, class Bind, ap)"]
+ ["import Prelude", "", "import Control.Monad (class Applicative, class Bind, ap)"]
it "sorts value" $
expectSorted (map valueImport ["unless", "where"])
- ["import Prelude", "import Control.Monad (ap, unless, where)"]
+ ["import Prelude", "", "import Control.Monad (ap, unless, where)"]
it "sorts type, value" $
expectSorted
((map valueImport ["unless", "where"]) ++ (map typeImport ["Foo", "Bar"]))
- ["import Prelude", "import Control.Monad (Bar, Foo, ap, unless, where)"]
+ ["import Prelude", "", "import Control.Monad (Bar, Foo, ap, unless, where)"]
it "sorts class, type, value" $
expectSorted
((map valueImport ["unless", "where"]) ++ (map typeImport ["Foo", "Bar"]) ++ (map classImport ["Applicative", "Bind"]))
- ["import Prelude", "import Control.Monad (class Applicative, class Bind, Bar, Foo, ap, unless, where)"]
+ ["import Prelude", "", "import Control.Monad (class Applicative, class Bind, Bar, Foo, ap, unless, where)"]
it "sorts types with constructors, using open imports for the constructors" $
expectSorted
-- 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)"]
+ ["import Prelude", "", "import Control.Monad (Maybe(..), SomeDataType(..), ap)"]
describe "importing from a loaded IdeState" importFromIdeState
implImport :: Text -> Command
diff --git a/tests/Language/PureScript/Ide/RebuildSpec.hs b/tests/Language/PureScript/Ide/RebuildSpec.hs
index 801c3b6..9c00312 100644
--- a/tests/Language/PureScript/Ide/RebuildSpec.hs
+++ b/tests/Language/PureScript/Ide/RebuildSpec.hs
@@ -5,6 +5,7 @@ module Language.PureScript.Ide.RebuildSpec where
import Protolude
import Language.PureScript.Ide.Command
+import Language.PureScript.Ide.Completion
import Language.PureScript.Ide.Matcher
import Language.PureScript.Ide.Types
import qualified Language.PureScript.Ide.Test as Test
@@ -57,5 +58,5 @@ spec = describe "Rebuilding single modules" $ do
it "completes a hidden identifier after rebuilding" $ do
([_, (Right (CompletionResult [ result ]))], _) <- Test.inProject $
Test.runIde [ rebuildSync "RebuildSpecWithHiddenIdent.purs"
- , Complete [] (flexMatcher "hid") (Just (Test.mn "RebuildSpecWithHiddenIdent"))]
+ , Complete [] (flexMatcher "hid") (Just (Test.mn "RebuildSpecWithHiddenIdent")) defaultCompletionOptions]
complIdentifier result `shouldBe` "hidden"
diff --git a/tests/Language/PureScript/Ide/ReexportsSpec.hs b/tests/Language/PureScript/Ide/ReexportsSpec.hs
index 198a08f..2a6952e 100644
--- a/tests/Language/PureScript/Ide/ReexportsSpec.hs
+++ b/tests/Language/PureScript/Ide/ReexportsSpec.hs
@@ -11,16 +11,18 @@ import Language.PureScript.Ide.Test
import qualified Language.PureScript as P
import Test.Hspec
-valueA, typeA, classA, dtorA1, dtorA2 :: IdeDeclarationAnn
+valueA, typeA, synonymA, classA, dtorA1, dtorA2, kindA :: IdeDeclarationAnn
valueA = ideValue "valueA" Nothing
typeA = ideType "TypeA" Nothing
+synonymA = ideSynonym "SynonymA" Nothing Nothing
classA = ideTypeClass "ClassA" P.kindType []
dtorA1 = ideDtor "DtorA1" "TypeA" Nothing
dtorA2 = ideDtor "DtorA2" "TypeA" Nothing
+kindA = ideKind "KindA"
env :: ModuleMap [IdeDeclarationAnn]
env = Map.fromList
- [ (mn "A", [valueA, typeA, classA, dtorA1, dtorA2])
+ [ (mn "A", [valueA, typeA, synonymA, classA, dtorA1, dtorA2, kindA])
]
type Refs = [(P.ModuleName, P.DeclarationRef)]
@@ -32,7 +34,10 @@ succTestCases =
, [(mn "A", P.TypeRef (P.ProperName "TypeA") (Just [P.ProperName "DtorA1"]))], [typeA `annExp` "A", dtorA1 `annExp` "A"])
, ("resolves a type reexport with implicit data constructors"
, [(mn "A", P.TypeRef (P.ProperName "TypeA") Nothing)], map (`annExp` "A") [typeA, dtorA1, dtorA2])
+ , ("resolves a synonym reexport"
+ , [(mn "A", P.TypeRef (P.ProperName "SynonymA") Nothing)], [synonymA `annExp` "A"])
, ("resolves a class reexport", [(mn "A", P.TypeClassRef (P.ProperName "ClassA"))], [classA `annExp` "A"])
+ , ("resolves a kind reexport", [(mn "A", P.KindRef (P.ProperName "KindA"))], [kindA `annExp` "A"])
]
failTestCases :: [(Text, Refs)]
diff --git a/tests/Language/PureScript/Ide/SourceFileSpec.hs b/tests/Language/PureScript/Ide/SourceFileSpec.hs
index 50db451..7937c0f 100644
--- a/tests/Language/PureScript/Ide/SourceFileSpec.hs
+++ b/tests/Language/PureScript/Ide/SourceFileSpec.hs
@@ -44,27 +44,27 @@ spec :: Spec
spec = do
describe "Extracting Spans" $ do
it "extracts a span for a value declaration" $
- extractSpans span0 (P.PositionedDeclaration span1 [] value1) `shouldBe` [(IdeNSValue "value1", span1)]
+ extractSpans span0 (P.PositionedDeclaration span1 [] value1) `shouldBe` [(IdeNamespaced IdeNSValue "value1", span1)]
it "extracts a span for a type synonym declaration" $
- extractSpans span0 (P.PositionedDeclaration span1 [] synonym1) `shouldBe` [(IdeNSType "Synonym1", span1)]
+ extractSpans span0 (P.PositionedDeclaration span1 [] synonym1) `shouldBe` [(IdeNamespaced IdeNSType "Synonym1", span1)]
it "extracts a span for a typeclass declaration" $
- extractSpans span0 (P.PositionedDeclaration span1 [] class1) `shouldBe` [(IdeNSType "Class1", span1)]
+ extractSpans span0 (P.PositionedDeclaration span1 [] class1) `shouldBe` [(IdeNamespaced IdeNSType "Class1", span1)]
it "extracts spans for a typeclass declaration and its members" $
- extractSpans span0 (P.PositionedDeclaration span1 [] class2) `shouldBe` [(IdeNSType "Class2", span1), (IdeNSValue "member1", span2)]
+ extractSpans span0 (P.PositionedDeclaration span1 [] class2) `shouldBe` [(IdeNamespaced IdeNSType "Class2", span1), (IdeNamespaced IdeNSValue "member1", span2)]
it "extracts a span for a data declaration" $
- extractSpans span0 (P.PositionedDeclaration span1 [] data1) `shouldBe` [(IdeNSType "Data1", span1)]
+ extractSpans span0 (P.PositionedDeclaration span1 [] data1) `shouldBe` [(IdeNamespaced 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)]
+ extractSpans span0 (P.PositionedDeclaration span1 [] data2) `shouldBe` [(IdeNamespaced IdeNSType "Data2", span1), (IdeNamespaced IdeNSValue "Cons1", span1)]
it "extracts a span for a value operator fixity declaration" $
- extractSpans span0 (P.PositionedDeclaration span1 [] valueFixity) `shouldBe` [(IdeNSValue "<$>", span1)]
+ extractSpans span0 (P.PositionedDeclaration span1 [] valueFixity) `shouldBe` [(IdeNamespaced IdeNSValue "<$>", span1)]
it "extracts a span for a type operator fixity declaration" $
- extractSpans span0 (P.PositionedDeclaration span1 [] typeFixity) `shouldBe` [(IdeNSType "~>", span1)]
+ extractSpans span0 (P.PositionedDeclaration span1 [] typeFixity) `shouldBe` [(IdeNamespaced IdeNSType "~>", span1)]
it "extracts a span for a foreign declaration" $
- extractSpans span0 (P.PositionedDeclaration span1 [] foreign1) `shouldBe` [(IdeNSValue "foreign1", span1)]
+ extractSpans span0 (P.PositionedDeclaration span1 [] foreign1) `shouldBe` [(IdeNamespaced IdeNSValue "foreign1", span1)]
it "extracts a span for a data foreign declaration" $
- extractSpans span0 (P.PositionedDeclaration span1 [] foreign2) `shouldBe` [(IdeNSType "Foreign2", span1)]
+ extractSpans span0 (P.PositionedDeclaration span1 [] foreign2) `shouldBe` [(IdeNamespaced IdeNSType "Foreign2", span1)]
it "extracts a span for a foreign kind declaration" $
- extractSpans span0 (P.PositionedDeclaration span1 [] foreign3) `shouldBe` [(IdeNSKind "Foreign3", span1)]
+ extractSpans span0 (P.PositionedDeclaration span1 [] foreign3) `shouldBe` [(IdeNamespaced IdeNSKind "Foreign3", span1)]
describe "Type annotations" $ do
it "extracts a type annotation" $
extractTypeAnnotations [typeAnnotation1] `shouldBe` [(P.Ident "value1", P.REmpty)]
@@ -94,10 +94,10 @@ getLocation s = do
runIde' defConfig ideState [Type s [] Nothing]
pure (complLocation c)
where
- ideState = emptyIdeState `s3`
+ ideState = emptyIdeState `volatileState`
[ ("Test",
[ ideValue "sfValue" Nothing `annLoc` valueSS
- , ideSynonym "SFType" P.tyString P.kindType `annLoc` synonymSS
+ , ideSynonym "SFType" Nothing Nothing `annLoc` synonymSS
, ideType "SFData" Nothing `annLoc` typeSS
, ideDtor "SFOne" "SFData" Nothing `annLoc` typeSS
, ideDtor "SFTwo" "SFData" Nothing `annLoc` typeSS
diff --git a/tests/Language/PureScript/Ide/Test.hs b/tests/Language/PureScript/Ide/Test.hs
index ba5908f..8cb8d3e 100644
--- a/tests/Language/PureScript/Ide/Test.hs
+++ b/tests/Language/PureScript/Ide/Test.hs
@@ -17,14 +17,14 @@ import System.Process
import qualified Language.PureScript as P
-defConfig :: Configuration
+defConfig :: IdeConfiguration
defConfig =
- Configuration { confLogLevel = LogNone
+ IdeConfiguration { confLogLevel = LogNone
, confOutputPath = "output/"
, confGlobs = ["src/*.purs"]
}
-runIde' :: Configuration -> IdeState -> [Command] -> IO ([Either IdeError Success], IdeState)
+runIde' :: IdeConfiguration -> IdeState -> [Command] -> IO ([Either IdeError Success], IdeState)
runIde' conf s cs = do
stateVar <- newTVarIO s
let env' = IdeEnvironment {ideStateVar = stateVar, ideConfiguration = conf}
@@ -35,11 +35,11 @@ runIde' conf s cs = do
runIde :: [Command] -> IO ([Either IdeError Success], IdeState)
runIde = runIde' defConfig emptyIdeState
-s3 :: IdeState -> [(Text, [IdeDeclarationAnn])] -> IdeState
-s3 s ds =
- s {ideStage3 = stage3}
+volatileState :: IdeState -> [(Text, [IdeDeclarationAnn])] -> IdeState
+volatileState s ds =
+ s {ideVolatileState = vs}
where
- stage3 = Stage3 (Map.fromList decls) Nothing
+ vs = IdeVolatileState (AstData Map.empty) (Map.fromList decls) Nothing
decls = map (first P.moduleNameFromString) ds
-- | Adding Annotations to IdeDeclarations
@@ -66,8 +66,8 @@ 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 -> P.Kind -> IdeDeclarationAnn
-ideSynonym pn ty kind = ida (IdeDeclTypeSynonym (IdeTypeSynonym (P.ProperName pn) ty kind))
+ideSynonym :: Text -> Maybe P.Type -> Maybe P.Kind -> IdeDeclarationAnn
+ideSynonym pn ty kind = ida (IdeDeclTypeSynonym (IdeTypeSynonym (P.ProperName pn) (fromMaybe P.tyString ty) (fromMaybe P.kindType kind)))
ideTypeClass :: Text -> P.Kind -> [IdeInstance] -> IdeDeclarationAnn
ideTypeClass pn kind instances = ida (IdeDeclTypeClass (IdeTypeClass (P.ProperName pn) kind instances))
diff --git a/tests/TestCompiler.hs b/tests/TestCompiler.hs
index 86a6ef3..de8f19f 100644
--- a/tests/TestCompiler.hs
+++ b/tests/TestCompiler.hs
@@ -61,26 +61,23 @@ main = hspec spec
spec :: Spec
spec = do
- (supportExterns, supportForeigns, passingTestCases, warningTestCases, failingTestCases) <- runIO $ do
+ (supportModules, supportExterns, supportForeigns, passingTestCases, warningTestCases, failingTestCases) <- runIO $ do
cwd <- getCurrentDirectory
let passing = cwd </> "examples" </> "passing"
let warning = cwd </> "examples" </> "warning"
let failing = cwd </> "examples" </> "failing"
- let supportDir = cwd </> "tests" </> "support" </> "bower_components"
- let supportFiles ext = Glob.globDir1 (Glob.compile ("purescript-*/src/**/*." ++ ext)) supportDir
passingFiles <- getTestFiles passing <$> testGlob passing
warningFiles <- getTestFiles warning <$> testGlob warning
failingFiles <- getTestFiles failing <$> testGlob failing
- supportPurs <- supportFiles "purs"
- supportPursFiles <- readInput supportPurs
+ ms <- getSupportModuleTuples
+ let modules = map snd ms
supportExterns <- runExceptT $ do
- modules <- ExceptT . return $ P.parseModulesFromFiles id supportPursFiles
- foreigns <- inferForeignModules modules
- externs <- ExceptT . fmap fst . runTest $ P.make (makeActions foreigns) (map snd modules)
- return (zip (map snd modules) externs, foreigns)
+ foreigns <- inferForeignModules ms
+ externs <- ExceptT . fmap fst . runTest $ P.make (makeActions modules foreigns) modules
+ return (externs, foreigns)
case supportExterns of
Left errs -> fail (P.prettyPrintMultipleErrors P.defaultPPEOptions errs)
- Right (externs, foreigns) -> return (externs, foreigns, passingFiles, warningFiles, failingFiles)
+ Right (externs, foreigns) -> return (modules, externs, foreigns, passingFiles, warningFiles, failingFiles)
outputFile <- runIO $ do
tmp <- getTemporaryDirectory
@@ -90,21 +87,21 @@ spec = do
context "Passing examples" $
forM_ passingTestCases $ \testPurs ->
it ("'" <> takeFileName (getTestMain testPurs) <> "' should compile and run without error") $
- assertCompiles supportExterns supportForeigns testPurs outputFile
+ assertCompiles supportModules supportExterns supportForeigns testPurs outputFile
context "Warning examples" $
forM_ warningTestCases $ \testPurs -> do
let mainPath = getTestMain testPurs
expectedWarnings <- runIO $ getShouldWarnWith mainPath
it ("'" <> takeFileName mainPath <> "' should compile with warning(s) '" <> intercalate "', '" expectedWarnings <> "'") $
- assertCompilesWithWarnings supportExterns supportForeigns testPurs expectedWarnings
+ assertCompilesWithWarnings supportModules supportExterns supportForeigns testPurs expectedWarnings
context "Failing examples" $
forM_ failingTestCases $ \testPurs -> do
let mainPath = getTestMain testPurs
expectedFailures <- runIO $ getShouldFailWith mainPath
it ("'" <> takeFileName mainPath <> "' should fail with '" <> intercalate "', '" expectedFailures <> "'") $
- assertDoesNotCompile supportExterns supportForeigns testPurs expectedFailures
+ assertDoesNotCompile supportModules supportExterns supportForeigns testPurs expectedFailures
where
@@ -168,18 +165,18 @@ trim = dropWhile isSpace >>> reverse >>> dropWhile isSpace >>> reverse
modulesDir :: FilePath
modulesDir = ".test_modules" </> "node_modules"
-makeActions :: M.Map P.ModuleName FilePath -> P.MakeActions P.Make
-makeActions foreigns = (P.buildMakeActions modulesDir (P.internalError "makeActions: input file map was read.") foreigns False)
- { P.getInputTimestamp = getInputTimestamp
- , P.getOutputTimestamp = getOutputTimestamp
- }
+makeActions :: [P.Module] -> M.Map P.ModuleName FilePath -> P.MakeActions P.Make
+makeActions modules foreigns = (P.buildMakeActions modulesDir (P.internalError "makeActions: input file map was read.") foreigns False)
+ { P.getInputTimestamp = getInputTimestamp
+ , P.getOutputTimestamp = getOutputTimestamp
+ }
where
getInputTimestamp :: P.ModuleName -> P.Make (Either P.RebuildPolicy (Maybe UTCTime))
getInputTimestamp mn
- | isSupportModule (T.unpack (P.runModuleName mn)) = return (Left P.RebuildNever)
+ | isSupportModule (P.runModuleName mn) = return (Left P.RebuildNever)
| otherwise = return (Left P.RebuildAlways)
where
- isSupportModule = flip elem supportModules
+ isSupportModule = flip elem (map (P.runModuleName . P.getModuleName) modules)
getOutputTimestamp :: P.ModuleName -> P.Make (Maybe UTCTime)
getOutputTimestamp mn = do
@@ -187,39 +184,36 @@ makeActions foreigns = (P.buildMakeActions modulesDir (P.internalError "makeActi
exists <- liftIO $ doesDirectoryExist filePath
return (if exists then Just (P.internalError "getOutputTimestamp: read timestamp") else Nothing)
-readInput :: [FilePath] -> IO [(FilePath, T.Text)]
-readInput inputFiles = forM inputFiles $ \inputFile -> do
- text <- readUTF8FileT inputFile
- return (inputFile, text)
-
runTest :: P.Make a -> IO (Either P.MultipleErrors a, P.MultipleErrors)
runTest = P.runMake P.defaultOptions
compile
- :: [(P.Module, P.ExternsFile)]
+ :: [P.Module]
+ -> [P.ExternsFile]
-> M.Map P.ModuleName FilePath
-> [FilePath]
-> ([P.Module] -> IO ())
-> IO (Either P.MultipleErrors [P.ExternsFile], P.MultipleErrors)
-compile supportExterns supportForeigns inputFiles check = silence $ runTest $ do
+compile supportModules supportExterns supportForeigns inputFiles check = silence $ runTest $ do
fs <- liftIO $ readInput inputFiles
ms <- P.parseModulesFromFiles id fs
foreigns <- inferForeignModules ms
liftIO (check (map snd ms))
- let actions = makeActions (foreigns `M.union` supportForeigns)
+ let actions = makeActions supportModules (foreigns `M.union` supportForeigns)
case ms of
- [singleModule] -> pure <$> P.rebuildModule actions (map snd supportExterns) (snd singleModule)
- _ -> P.make actions (map fst supportExterns ++ map snd ms)
+ [singleModule] -> pure <$> P.rebuildModule actions supportExterns (snd singleModule)
+ _ -> P.make actions (supportModules ++ map snd ms)
assert
- :: [(P.Module, P.ExternsFile)]
+ :: [P.Module]
+ -> [P.ExternsFile]
-> M.Map P.ModuleName FilePath
-> [FilePath]
-> ([P.Module] -> IO ())
-> (Either P.MultipleErrors P.MultipleErrors -> IO (Maybe String))
-> Expectation
-assert supportExterns supportForeigns inputFiles check f = do
- (e, w) <- compile supportExterns supportForeigns inputFiles check
+assert supportModules supportExterns supportForeigns inputFiles check f = do
+ (e, w) <- compile supportModules supportExterns supportForeigns inputFiles check
maybeErr <- f (const w <$> e)
maybe (return ()) expectationFailure maybeErr
@@ -236,13 +230,14 @@ checkShouldFailWith expected errs =
else Just $ "Expected these errors: " ++ show expected ++ ", but got these: " ++ show actual
assertCompiles
- :: [(P.Module, P.ExternsFile)]
+ :: [P.Module]
+ -> [P.ExternsFile]
-> M.Map P.ModuleName FilePath
-> [FilePath]
-> Handle
-> Expectation
-assertCompiles supportExterns supportForeigns inputFiles outputFile =
- assert supportExterns supportForeigns inputFiles checkMain $ \e ->
+assertCompiles supportModules supportExterns supportForeigns inputFiles outputFile =
+ assert supportModules supportExterns supportForeigns inputFiles checkMain $ \e ->
case e of
Left errs -> return . Just . P.prettyPrintMultipleErrors P.defaultPPEOptions $ errs
Right _ -> do
@@ -262,13 +257,14 @@ assertCompiles supportExterns supportForeigns inputFiles outputFile =
Nothing -> return $ Just "Couldn't find node.js executable"
assertCompilesWithWarnings
- :: [(P.Module, P.ExternsFile)]
+ :: [P.Module]
+ -> [P.ExternsFile]
-> M.Map P.ModuleName FilePath
-> [FilePath]
-> [String]
-> Expectation
-assertCompilesWithWarnings supportExterns supportForeigns inputFiles shouldWarnWith =
- assert supportExterns supportForeigns inputFiles checkMain $ \e ->
+assertCompilesWithWarnings supportModules supportExterns supportForeigns inputFiles shouldWarnWith =
+ assert supportModules supportExterns supportForeigns inputFiles checkMain $ \e ->
case e of
Left errs ->
return . Just . P.prettyPrintMultipleErrors P.defaultPPEOptions $ errs
@@ -282,13 +278,14 @@ assertCompilesWithWarnings supportExterns supportForeigns inputFiles shouldWarnW
(<> "\n\n" <> P.prettyPrintMultipleErrors P.defaultPPEOptions warnings)
assertDoesNotCompile
- :: [(P.Module, P.ExternsFile)]
+ :: [P.Module]
+ -> [P.ExternsFile]
-> M.Map P.ModuleName FilePath
-> [FilePath]
-> [String]
-> Expectation
-assertDoesNotCompile supportExterns supportForeigns inputFiles shouldFailWith =
- assert supportExterns supportForeigns inputFiles noPreCheck $ \e ->
+assertDoesNotCompile supportModules supportExterns supportForeigns inputFiles shouldFailWith =
+ assert supportModules supportExterns supportForeigns inputFiles noPreCheck $ \e ->
case e of
Left errs ->
return $ if null shouldFailWith
diff --git a/tests/TestDocs.hs b/tests/TestDocs.hs
index 788ef88..0237bfe 100644
--- a/tests/TestDocs.hs
+++ b/tests/TestDocs.hs
@@ -402,6 +402,10 @@ testCases =
, ("TypeLevelString",
[ ShouldBeDocumented (n "TypeLevelString") "Foo" ["fooBar"]
])
+
+ , ("Desugar",
+ [ ValueShouldHaveTypeSignature (n "Desugar") "test" (renderedType "forall a b. X (a -> b) a -> b")
+ ])
]
where
diff --git a/tests/TestPsci/CompletionTest.hs b/tests/TestPsci/CompletionTest.hs
index 47f57ca..fef5f7b 100644
--- a/tests/TestPsci/CompletionTest.hs
+++ b/tests/TestPsci/CompletionTest.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE OverloadedStrings #-}
module TestPsci.CompletionTest where
import Prelude ()
@@ -13,17 +14,18 @@ import qualified Language.PureScript as P
import Language.PureScript.Interactive
import System.Console.Haskeline
import TestPsci.TestEnv (initTestPSCiEnv)
-import TestUtils (supportModules)
+import TestUtils (getSupportModuleNames)
completionTests :: Spec
-completionTests = context "completionTests" $
- mapM_ assertCompletedOk completionTestData
+completionTests = context "completionTests" $ do
+ mns <- runIO $ getSupportModuleNames
+ mapM_ assertCompletedOk (completionTestData mns)
-- If the cursor is at the right end of the line, with the 1st element of the
-- pair as the text in the line, then pressing tab should offer all the
-- elements of the list (which is the 2nd element) as completions.
-completionTestData :: [(String, [String])]
-completionTestData =
+completionTestData :: [T.Text] -> [(String, [String])]
+completionTestData supportModuleNames =
-- basic directives
[ (":h", [":help"])
, (":r", [":reload"])
@@ -32,12 +34,12 @@ completionTestData =
, (":b", [":browse"])
-- :browse should complete module names
- , (":b Control.Monad.E", map (":b Control.Monad.Eff" ++) ["", ".Unsafe", ".Class", ".Console"])
- , (":b Control.Monad.Eff.", map (":b Control.Monad.Eff" ++) [".Unsafe", ".Class", ".Console"])
+ , (":b Control.Monad.E", map (":b Control.Monad.Eff" ++) ["", ".Unsafe", ".Class", ".Console", ".Uncurried"])
+ , (":b Control.Monad.Eff.", map (":b Control.Monad.Eff" ++) [".Unsafe", ".Class", ".Console", ".Uncurried"])
-- import should complete module names
- , ("import Control.Monad.E", map ("import Control.Monad.Eff" ++) ["", ".Unsafe", ".Class", ".Console"])
- , ("import Control.Monad.Eff.", map ("import Control.Monad.Eff" ++) [".Unsafe", ".Class", ".Console"])
+ , ("import Control.Monad.E", map ("import Control.Monad.Eff" ++) ["", ".Unsafe", ".Class", ".Console", ".Uncurried"])
+ , ("import Control.Monad.Eff.", map ("import Control.Monad.Eff" ++) [".Unsafe", ".Class", ".Console", ".Uncurried"])
-- :quit, :help, :reload, :clear should not complete
, (":help ", [])
@@ -65,7 +67,7 @@ completionTestData =
-- a few other import tests
, ("impor", ["import"])
- , ("import ", map ("import " ++) supportModules)
+ , ("import ", map (T.unpack . mappend "import ") supportModuleNames)
, ("import Prelude ", [])
-- String and number literals should not be completed
@@ -99,10 +101,10 @@ runCM act = do
getPSCiStateForCompletion :: IO PSCiState
getPSCiStateForCompletion = do
(PSCiState _ bs es, _) <- initTestPSCiEnv
- let imports = [controlMonadSTasST, (P.ModuleName [P.ProperName (T.pack "Prelude")], P.Implicit, Nothing)]
+ let imports = [controlMonadSTasST, (P.ModuleName [P.ProperName "Prelude"], P.Implicit, Nothing)]
return $ PSCiState imports bs es
controlMonadSTasST :: ImportedModule
controlMonadSTasST = (s "Control.Monad.ST", P.Implicit, Just (s "ST"))
where
- s = P.moduleNameFromString . T.pack
+ s = P.moduleNameFromString
diff --git a/tests/TestUtils.hs b/tests/TestUtils.hs
index 86a99f6..9c3a692 100644
--- a/tests/TestUtils.hs
+++ b/tests/TestUtils.hs
@@ -5,14 +5,21 @@ module TestUtils where
import Prelude ()
import Prelude.Compat
+import qualified Language.PureScript as P
+
import Control.Monad
+import Control.Monad.Trans.Except
import Control.Monad.Trans.Maybe
import Control.Exception
-
+import Data.List (sort)
+import qualified Data.Text as T
import System.Process
import System.Directory
import System.Info
+import System.IO.UTF8 (readUTF8FileT)
import System.Exit (exitFailure)
+import System.FilePath ((</>))
+import qualified System.FilePath.Glob as Glob
import System.IO (stderr, hPutStrLn)
findNodeProcess :: IO (Maybe String)
@@ -47,127 +54,28 @@ updateSupportCode = do
hPutStrLn stderr "Cannot find node (or nodejs) executable"
exitFailure
+readInput :: [FilePath] -> IO [(FilePath, T.Text)]
+readInput inputFiles = forM inputFiles $ \inputFile -> do
+ text <- readUTF8FileT inputFile
+ return (inputFile, text)
+
-- |
-- The support modules that should be cached between test cases, to avoid
-- excessive rebuilding.
--
-supportModules :: [String]
-supportModules =
- [ "Control.Alt"
- , "Control.Alternative"
- , "Control.Applicative"
- , "Control.Apply"
- , "Control.Biapplicative"
- , "Control.Biapply"
- , "Control.Bind"
- , "Control.Category"
- , "Control.Comonad"
- , "Control.Extend"
- , "Control.Lazy"
- , "Control.Monad"
- , "Control.Monad.Eff"
- , "Control.Monad.Eff.Class"
- , "Control.Monad.Eff.Console"
- , "Control.Monad.Eff.Unsafe"
- , "Control.Monad.Rec.Class"
- , "Control.Monad.ST"
- , "Control.MonadPlus"
- , "Control.MonadZero"
- , "Control.Plus"
- , "Control.Semigroupoid"
- , "Data.Array"
- , "Data.Array.Partial"
- , "Data.Array.ST"
- , "Data.Array.ST.Iterator"
- , "Data.Bifoldable"
- , "Data.Bifunctor"
- , "Data.Bifunctor.Clown"
- , "Data.Bifunctor.Flip"
- , "Data.Bifunctor.Join"
- , "Data.Bifunctor.Joker"
- , "Data.Bifunctor.Product"
- , "Data.Bifunctor.Wrap"
- , "Data.Bitraversable"
- , "Data.Boolean"
- , "Data.BooleanAlgebra"
- , "Data.Bounded"
- , "Data.Char"
- , "Data.CommutativeRing"
- , "Data.Either"
- , "Data.Either.Nested"
- , "Data.Eq"
- , "Data.EuclideanRing"
- , "Data.Field"
- , "Data.Foldable"
- , "Data.Function"
- , "Data.Function.Uncurried"
- , "Data.Functor"
- , "Data.Functor.Invariant"
- , "Data.Generic"
- , "Data.Generic.Rep"
- , "Data.Generic.Rep.Bounded"
- , "Data.Generic.Rep.Eq"
- , "Data.Generic.Rep.Monoid"
- , "Data.Generic.Rep.Ord"
- , "Data.Generic.Rep.Semigroup"
- , "Data.Generic.Rep.Show"
- , "Data.HeytingAlgebra"
- , "Data.Identity"
- , "Data.Lazy"
- , "Data.List"
- , "Data.List.Lazy"
- , "Data.List.Lazy.NonEmpty"
- , "Data.List.Lazy.Types"
- , "Data.List.NonEmpty"
- , "Data.List.Partial"
- , "Data.List.Types"
- , "Data.List.ZipList"
- , "Data.Maybe"
- , "Data.Maybe.First"
- , "Data.Maybe.Last"
- , "Data.Monoid"
- , "Data.Monoid.Additive"
- , "Data.Monoid.Alternate"
- , "Data.Monoid.Conj"
- , "Data.Monoid.Disj"
- , "Data.Monoid.Dual"
- , "Data.Monoid.Endo"
- , "Data.Monoid.Multiplicative"
- , "Data.NaturalTransformation"
- , "Data.Newtype"
- , "Data.NonEmpty"
- , "Data.Ord"
- , "Data.Ord.Unsafe"
- , "Data.Ordering"
- , "Data.Ring"
- , "Data.Semigroup"
- , "Data.Semiring"
- , "Data.Show"
- , "Data.String"
- , "Data.String.CaseInsensitive"
- , "Data.String.Regex"
- , "Data.String.Regex.Flags"
- , "Data.String.Regex.Unsafe"
- , "Data.String.Unsafe"
- , "Data.Symbol"
- , "Data.Traversable"
- , "Data.Tuple"
- , "Data.Tuple.Nested"
- , "Data.Unfoldable"
- , "Data.Unit"
- , "Data.Void"
- , "PSCI.Support"
- , "Partial"
- , "Partial.Unsafe"
- , "Prelude"
- , "Test.Assert"
- , "Type.Data.Ordering"
- , "Type.Data.Symbol"
- , "Type.Equality"
- , "Type.Prelude"
- , "Type.Proxy"
- , "Unsafe.Coerce"
- ]
+getSupportModuleTuples :: IO [(FilePath, P.Module)]
+getSupportModuleTuples = do
+ cd <- getCurrentDirectory
+ let supportDir = cd </> "tests" </> "support" </> "bower_components"
+ supportPurs <- Glob.globDir1 (Glob.compile "purescript-*/src/**/*.purs") supportDir
+ supportPursFiles <- readInput supportPurs
+ modules <- runExceptT $ ExceptT . return $ P.parseModulesFromFiles id supportPursFiles
+ case modules of
+ Right ms -> return ms
+ Left errs -> fail (P.prettyPrintMultipleErrors P.defaultPPEOptions errs)
+
+getSupportModuleNames :: IO [T.Text]
+getSupportModuleNames = sort . map (P.runModuleName . P.getModuleName . snd) <$> getSupportModuleTuples
pushd :: forall a. FilePath -> IO a -> IO a
pushd dir act = do
diff --git a/tests/support/bower.json b/tests/support/bower.json
index bdee017..6b67afd 100644
--- a/tests/support/bower.json
+++ b/tests/support/bower.json
@@ -4,7 +4,7 @@
"purescript-arrays": "4.0.0",
"purescript-assert": "3.0.0",
"purescript-console": "3.0.0",
- "purescript-eff": "3.0.0",
+ "purescript-eff": "3.1.0",
"purescript-functions": "3.0.0",
"purescript-generics": "4.0.0",
"purescript-generics-rep": "5.0.0",