summaryrefslogtreecommitdiff
path: root/tests
diff options
context:
space:
mode:
authorPhilFreeman <>2017-01-02 06:19:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2017-01-02 06:19:00 (GMT)
commitdfc92b2cabaa9529df644929982e90166ffdea4d (patch)
tree1c11edbd2d2d5c27b40182bf17d44959b53b83b5 /tests
parent79948f219fa19b886408053ae2e9ec97d28ccf45 (diff)
version 0.10.40.10.4
Diffstat (limited to 'tests')
-rw-r--r--tests/Language/PureScript/Ide/Imports/IntegrationSpec.hs2
-rw-r--r--tests/Language/PureScript/Ide/ImportsSpec.hs4
-rw-r--r--tests/Language/PureScript/Ide/ReexportsSpec.hs2
-rw-r--r--tests/Language/PureScript/Ide/SourceFileSpec.hs24
-rw-r--r--tests/Language/PureScript/Ide/StateSpec.hs4
-rw-r--r--tests/Main.hs2
-rw-r--r--tests/TestCompiler.hs39
-rw-r--r--tests/TestDocs.hs180
-rw-r--r--tests/TestPrimDocs.hs30
-rw-r--r--tests/TestPscPublish.hs12
-rw-r--r--tests/TestUtils.hs27
-rw-r--r--tests/support/bower.json21
12 files changed, 220 insertions, 127 deletions
diff --git a/tests/Language/PureScript/Ide/Imports/IntegrationSpec.hs b/tests/Language/PureScript/Ide/Imports/IntegrationSpec.hs
index 61021cc..01f474a 100644
--- a/tests/Language/PureScript/Ide/Imports/IntegrationSpec.hs
+++ b/tests/Language/PureScript/Ide/Imports/IntegrationSpec.hs
@@ -28,7 +28,7 @@ outputFileShouldBe :: [Text] -> IO ()
outputFileShouldBe expectation = do
outFp <- (</> "src" </> "ImportsSpecOut.tmp") <$> Integration.projectDirectory
outRes <- readUTF8FileT outFp
- shouldBe (T.lines outRes) expectation
+ shouldBe (T.strip <$> T.lines outRes) expectation
spec :: Spec
spec = beforeAll_ setup . describe "Adding imports" $ do
diff --git a/tests/Language/PureScript/Ide/ImportsSpec.hs b/tests/Language/PureScript/Ide/ImportsSpec.hs
index bba7441..e830ed0 100644
--- a/tests/Language/PureScript/Ide/ImportsSpec.hs
+++ b/tests/Language/PureScript/Ide/ImportsSpec.hs
@@ -74,7 +74,7 @@ spec = do
addDtorImport i t mn is =
prettyPrintImportSection (addExplicitImport' (IdeDeclDataConstructor (IdeDataConstructor (P.ProperName i) t wildcard)) mn is)
addTypeImport i mn is =
- prettyPrintImportSection (addExplicitImport' (IdeDeclType (IdeType (P.ProperName i) P.Star)) mn is)
+ prettyPrintImportSection (addExplicitImport' (IdeDeclType (IdeType (P.ProperName i) P.kindType)) mn is)
it "adds an implicit unqualified import" $
shouldBe
(addImplicitImport' simpleFileImports (P.moduleNameFromString "Data.Map"))
@@ -143,7 +143,7 @@ spec = do
moduleName = (P.moduleNameFromString "Control.Monad")
addImport imports import' = addExplicitImport' import' moduleName imports
valueImport ident = (IdeDeclValue (IdeValue (P.Ident ident) wildcard))
- typeImport name = (IdeDeclType (IdeType (P.ProperName name) P.Star))
+ typeImport name = (IdeDeclType (IdeType (P.ProperName name) P.kindType))
classImport name = (IdeDeclTypeClass (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
diff --git a/tests/Language/PureScript/Ide/ReexportsSpec.hs b/tests/Language/PureScript/Ide/ReexportsSpec.hs
index d5d394c..adbdc74 100644
--- a/tests/Language/PureScript/Ide/ReexportsSpec.hs
+++ b/tests/Language/PureScript/Ide/ReexportsSpec.hs
@@ -18,7 +18,7 @@ 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.Star))
+typeA = d (IdeDeclType (IdeType(P.ProperName "TypeA") P.kindType))
classA = d (IdeDeclTypeClass (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))
diff --git a/tests/Language/PureScript/Ide/SourceFileSpec.hs b/tests/Language/PureScript/Ide/SourceFileSpec.hs
index ac53dde..eae3de7 100644
--- a/tests/Language/PureScript/Ide/SourceFileSpec.hs
+++ b/tests/Language/PureScript/Ide/SourceFileSpec.hs
@@ -6,6 +6,7 @@ import Protolude
import qualified Language.PureScript as P
import Language.PureScript.Ide.SourceFile
+import Language.PureScript.Ide.Types
import Test.Hspec
span0, span1, span2 :: P.SourceSpan
@@ -13,7 +14,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, member1 :: P.Declaration
+typeAnnotation1, value1, synonym1, class1, class2, data1, data2, 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,28 +24,31 @@ class2 = P.TypeClassDeclaration (P.ProperName "Class2") [] [] []
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
+foreign2 = P.ExternDataDeclaration (P.ProperName "Foreign2") P.kindType
+foreign3 = P.ExternKindDeclaration (P.ProperName "Foreign3")
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)]
+ extractSpans span0 (P.PositionedDeclaration span1 [] value1) `shouldBe` [(IdeNSValue "value1", span1)]
it "extracts a span for a type synonym declaration" $
- extractSpans span0 (P.PositionedDeclaration span1 [] synonym1) `shouldBe` [(Right "Synonym1", span1)]
+ extractSpans span0 (P.PositionedDeclaration span1 [] synonym1) `shouldBe` [(IdeNSType "Synonym1", span1)]
it "extracts a span for a typeclass declaration" $
- extractSpans span0 (P.PositionedDeclaration span1 [] class1) `shouldBe` [(Right "Class1", span1)]
+ extractSpans span0 (P.PositionedDeclaration span1 [] class1) `shouldBe` [(IdeNSType "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)]
+ extractSpans span0 (P.PositionedDeclaration span1 [] class2) `shouldBe` [(IdeNSType "Class2", span1), (IdeNSValue "member1", span2)]
it "extracts a span for a data declaration" $
- extractSpans span0 (P.PositionedDeclaration span1 [] data1) `shouldBe` [(Right "Data1", span1)]
+ 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` [(Right "Data2", span1), (Left "Cons1", span1)]
+ extractSpans span0 (P.PositionedDeclaration span1 [] data2) `shouldBe` [(IdeNSType "Data2", span1), (IdeNSValue "Cons1", span1)]
it "extracts a span for a foreign declaration" $
- extractSpans span0 (P.PositionedDeclaration span1 [] foreign1) `shouldBe` [(Left "foreign1", span1)]
+ extractSpans span0 (P.PositionedDeclaration span1 [] foreign1) `shouldBe` [(IdeNSValue "foreign1", span1)]
it "extracts a span for a data foreign declaration" $
- extractSpans span0 (P.PositionedDeclaration span1 [] foreign2) `shouldBe` [(Right "Foreign2", span1)]
+ extractSpans span0 (P.PositionedDeclaration span1 [] foreign2) `shouldBe` [(IdeNSType "Foreign2", span1)]
+ it "extracts a span for a foreign kind declaration" $
+ extractSpans span0 (P.PositionedDeclaration span1 [] foreign3) `shouldBe` [(IdeNSKind "Foreign3", span1)]
describe "Type annotations" $ do
it "extracts a type annotation" $
extractTypeAnnotations [typeAnnotation1] `shouldBe` [(P.Ident "value1", P.REmpty)]
diff --git a/tests/Language/PureScript/Ide/StateSpec.hs b/tests/Language/PureScript/Ide/StateSpec.hs
index 2779662..5126fe2 100644
--- a/tests/Language/PureScript/Ide/StateSpec.hs
+++ b/tests/Language/PureScript/Ide/StateSpec.hs
@@ -24,7 +24,7 @@ typeOperator =
testModule :: Module
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.Star))
+ , d (IdeDeclType (IdeType (P.ProperName "List") P.kindType))
, valueOperator Nothing
, ctorOperator Nothing
, typeOperator Nothing
@@ -48,4 +48,4 @@ spec = describe "resolving operators" $ do
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.Star))
+ resolveOperatorsForModule testState (snd testModule) `shouldSatisfy` elem (typeOperator (Just P.kindType))
diff --git a/tests/Main.hs b/tests/Main.hs
index 61d1824..acfce36 100644
--- a/tests/Main.hs
+++ b/tests/Main.hs
@@ -13,6 +13,7 @@ import qualified TestDocs
import qualified TestPsci
import qualified TestPscIde
import qualified TestPscPublish
+import qualified TestPrimDocs
import qualified TestUtils
import System.IO (hSetEncoding, stdout, stderr, utf8)
@@ -28,6 +29,7 @@ main = do
TestCompiler.main
heading "Documentation test suite"
TestDocs.main
+ TestPrimDocs.main
heading "psc-publish test suite"
TestPscPublish.main
heading "psci test suite"
diff --git a/tests/TestCompiler.hs b/tests/TestCompiler.hs
index 4fc8552..86a6ef3 100644
--- a/tests/TestCompiler.hs
+++ b/tests/TestCompiler.hs
@@ -61,13 +61,13 @@ main = hspec spec
spec :: Spec
spec = do
- (supportExterns, passingTestCases, warningTestCases, failingTestCases) <- runIO $ do
+ (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-*/**/*." ++ ext)) supportDir
+ 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
@@ -77,10 +77,10 @@ spec = 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)
+ return (zip (map snd modules) externs, foreigns)
case supportExterns of
Left errs -> fail (P.prettyPrintMultipleErrors P.defaultPPEOptions errs)
- Right externs -> return (externs, passingFiles, warningFiles, failingFiles)
+ Right (externs, foreigns) -> return (externs, foreigns, passingFiles, warningFiles, failingFiles)
outputFile <- runIO $ do
tmp <- getTemporaryDirectory
@@ -90,21 +90,21 @@ spec = do
context "Passing examples" $
forM_ passingTestCases $ \testPurs ->
it ("'" <> takeFileName (getTestMain testPurs) <> "' should compile and run without error") $
- assertCompiles supportExterns testPurs outputFile
+ assertCompiles 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 testPurs expectedWarnings
+ assertCompilesWithWarnings 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 testPurs expectedFailures
+ assertDoesNotCompile supportExterns supportForeigns testPurs expectedFailures
where
@@ -197,27 +197,29 @@ runTest = P.runMake P.defaultOptions
compile
:: [(P.Module, P.ExternsFile)]
+ -> M.Map P.ModuleName FilePath
-> [FilePath]
-> ([P.Module] -> IO ())
-> IO (Either P.MultipleErrors [P.ExternsFile], P.MultipleErrors)
-compile supportExterns inputFiles check = silence $ runTest $ do
+compile 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
+ let actions = makeActions (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)
assert
:: [(P.Module, P.ExternsFile)]
+ -> M.Map P.ModuleName FilePath
-> [FilePath]
-> ([P.Module] -> IO ())
-> (Either P.MultipleErrors P.MultipleErrors -> IO (Maybe String))
-> Expectation
-assert supportExterns inputFiles check f = do
- (e, w) <- compile supportExterns inputFiles check
+assert supportExterns supportForeigns inputFiles check f = do
+ (e, w) <- compile supportExterns supportForeigns inputFiles check
maybeErr <- f (const w <$> e)
maybe (return ()) expectationFailure maybeErr
@@ -235,11 +237,12 @@ checkShouldFailWith expected errs =
assertCompiles
:: [(P.Module, P.ExternsFile)]
+ -> M.Map P.ModuleName FilePath
-> [FilePath]
-> Handle
-> Expectation
-assertCompiles supportExterns inputFiles outputFile =
- assert supportExterns inputFiles checkMain $ \e ->
+assertCompiles supportExterns supportForeigns inputFiles outputFile =
+ assert supportExterns supportForeigns inputFiles checkMain $ \e ->
case e of
Left errs -> return . Just . P.prettyPrintMultipleErrors P.defaultPPEOptions $ errs
Right _ -> do
@@ -260,11 +263,12 @@ assertCompiles supportExterns inputFiles outputFile =
assertCompilesWithWarnings
:: [(P.Module, P.ExternsFile)]
+ -> M.Map P.ModuleName FilePath
-> [FilePath]
-> [String]
-> Expectation
-assertCompilesWithWarnings supportExterns inputFiles shouldWarnWith =
- assert supportExterns inputFiles checkMain $ \e ->
+assertCompilesWithWarnings supportExterns supportForeigns inputFiles shouldWarnWith =
+ assert supportExterns supportForeigns inputFiles checkMain $ \e ->
case e of
Left errs ->
return . Just . P.prettyPrintMultipleErrors P.defaultPPEOptions $ errs
@@ -279,11 +283,12 @@ assertCompilesWithWarnings supportExterns inputFiles shouldWarnWith =
assertDoesNotCompile
:: [(P.Module, P.ExternsFile)]
+ -> M.Map P.ModuleName FilePath
-> [FilePath]
-> [String]
-> Expectation
-assertDoesNotCompile supportExterns inputFiles shouldFailWith =
- assert supportExterns inputFiles noPreCheck $ \e ->
+assertDoesNotCompile supportExterns supportForeigns inputFiles shouldFailWith =
+ assert 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 c689437..c995336 100644
--- a/tests/TestDocs.hs
+++ b/tests/TestDocs.hs
@@ -1,18 +1,21 @@
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE OverloadedStrings #-}
module TestDocs where
import Prelude ()
import Prelude.Compat
-import Data.Version (Version(..))
+import Control.Arrow (first)
+import Data.Version (Version(..))
import Data.Monoid
import Data.Maybe (fromMaybe)
import Data.List ((\\))
import Data.Foldable
+import Data.Text (Text)
import qualified Data.Text as T
import System.Exit
@@ -22,6 +25,8 @@ import Language.PureScript.Docs.AsMarkdown (codeToString)
import qualified Language.PureScript.Publish as Publish
import qualified Language.PureScript.Publish.ErrorsWarnings as Publish
+import Web.Bower.PackageMeta (parsePackageName)
+
import TestUtils
publishOpts :: Publish.PublishOptions
@@ -37,7 +42,7 @@ main = pushd "examples/docs" $ do
case res of
Left e -> Publish.printErrorToStdout e >> exitFailure
Right Docs.Package{..} ->
- forM_ testCases $ \(P.moduleNameFromString . T.pack -> mn, pragmas) ->
+ forM_ testCases $ \(P.moduleNameFromString -> mn, pragmas) ->
let mdl = takeJust ("module not found in docs: " ++ T.unpack (P.runModuleName mn))
(find ((==) mn . Docs.modName) pkgModules)
in forM_ pragmas (`runAssertionIO` mdl)
@@ -49,25 +54,31 @@ takeJust msg = fromMaybe (error msg)
data Assertion
-- | Assert that a particular declaration is documented with the given
-- children
- = ShouldBeDocumented P.ModuleName String [String]
+ = ShouldBeDocumented P.ModuleName Text [Text]
-- | Assert that a particular declaration is not documented
- | ShouldNotBeDocumented P.ModuleName String
+ | ShouldNotBeDocumented P.ModuleName Text
-- | Assert that a particular declaration exists, but without a particular
-- child.
- | ChildShouldNotBeDocumented P.ModuleName String String
+ | ChildShouldNotBeDocumented P.ModuleName Text Text
-- | Assert that a particular declaration has a particular type class
-- constraint.
- | ShouldBeConstrained P.ModuleName String String
+ | ShouldBeConstrained P.ModuleName Text Text
-- | Assert that a particular typeclass declaration has a functional
-- dependency list.
- | ShouldHaveFunDeps P.ModuleName String [([String],[String])]
+ | ShouldHaveFunDeps P.ModuleName Text [([Text],[Text])]
-- | Assert that a particular value declaration exists, and its type
-- satisfies the given predicate.
- | ValueShouldHaveTypeSignature P.ModuleName String (ShowFn (P.Type -> Bool))
+ | ValueShouldHaveTypeSignature P.ModuleName Text (ShowFn (P.Type -> Bool))
-- | Assert that a particular type alias exists, and its corresponding
-- type, when rendered, matches a given string exactly
-- fields: module, type synonym name, expected type
- | TypeSynonymShouldRenderAs P.ModuleName String String
+ | TypeSynonymShouldRenderAs P.ModuleName Text Text
+ -- | Assert that a documented declaration includes a documentation comment
+ -- containing a particular string
+ | ShouldHaveDocComment P.ModuleName Text Text
+ -- | Assert that there should be some declarations re-exported from a
+ -- particular module in a particular package.
+ | ShouldHaveReExport (Docs.InPackage P.ModuleName)
deriving (Show)
newtype ShowFn a = ShowFn a
@@ -77,28 +88,34 @@ instance Show (ShowFn a) where
data AssertionFailure
-- | A declaration was not documented, but should have been
- = NotDocumented P.ModuleName String
+ = NotDocumented P.ModuleName Text
-- | A child declaration was not documented, but should have been
- | ChildrenNotDocumented P.ModuleName String [String]
+ | ChildrenNotDocumented P.ModuleName Text [Text]
-- | A declaration was documented, but should not have been
- | Documented P.ModuleName String
+ | Documented P.ModuleName Text
-- | A child declaration was documented, but should not have been
- | ChildDocumented P.ModuleName String String
+ | ChildDocumented P.ModuleName Text Text
-- | A constraint was missing.
- | ConstraintMissing P.ModuleName String String
+ | ConstraintMissing P.ModuleName Text Text
-- | A functional dependency was missing.
- | FunDepMissing P.ModuleName String [([String], [String])]
+ | FunDepMissing P.ModuleName Text [([Text], [Text])]
-- | A declaration had the wrong "type" (ie, value, type, type class)
-- Fields: declaration title, expected "type", actual "type".
- | WrongDeclarationType P.ModuleName String String String
+ | WrongDeclarationType P.ModuleName Text Text Text
-- | A value declaration had the wrong type (in the sense of "type
-- checking"), eg, because the inferred type was used when the explicit type
-- should have been.
-- Fields: module name, declaration name, actual type.
- | ValueDeclarationWrongType P.ModuleName String P.Type
+ | ValueDeclarationWrongType P.ModuleName Text P.Type
-- | A Type synonym has been rendered in an unexpected format
-- Fields: module name, declaration name, expected rendering, actual rendering
- | TypeSynonymMismatch P.ModuleName String String String
+ | TypeSynonymMismatch P.ModuleName Text Text Text
+ -- | A doc comment was not found or did not match what was expected
+ -- Fields: module name, expected substring, actual comments
+ | DocCommentMissing P.ModuleName Text (Maybe Text)
+ -- | A module was missing re-exports from a particular module.
+ -- Fields: module name, expected re-export, actual re-exports.
+ | ReExportMissing P.ModuleName (Docs.InPackage P.ModuleName) [Docs.InPackage P.ModuleName]
deriving (Show)
data AssertionResult
@@ -135,75 +152,84 @@ runAssertion assertion Docs.Module{..} =
Fail (NotDocumented mn decl)
ShouldBeConstrained mn decl tyClass ->
- case find ((==) decl . Docs.declTitle) (declarationsFor mn) of
- Nothing ->
- Fail (NotDocumented mn decl)
- Just Docs.Declaration{..} ->
- case declInfo of
- Docs.ValueDeclaration ty ->
- if checkConstrained ty tyClass
- then Pass
- else Fail (ConstraintMissing mn decl tyClass)
- _ ->
- Fail (WrongDeclarationType mn decl "value"
- (Docs.declInfoToString declInfo))
+ findDecl mn decl $ \Docs.Declaration{..} ->
+ case declInfo of
+ Docs.ValueDeclaration ty ->
+ if checkConstrained ty tyClass
+ then Pass
+ else Fail (ConstraintMissing mn decl tyClass)
+ _ ->
+ Fail (WrongDeclarationType mn decl "value"
+ (Docs.declInfoToString declInfo))
ShouldHaveFunDeps mn decl fds ->
- case find ((==) decl . Docs.declTitle) (declarationsFor mn) of
- Nothing ->
- Fail (NotDocumented mn decl)
- Just Docs.Declaration{..} ->
- case declInfo of
- Docs.TypeClassDeclaration _ _ fundeps ->
- if fundeps == fds
- then Pass
- else Fail (FunDepMissing mn decl fds)
- _ ->
- Fail (WrongDeclarationType mn decl "value"
- (Docs.declInfoToString declInfo))
+ findDecl mn decl $ \Docs.Declaration{..} ->
+ case declInfo of
+ Docs.TypeClassDeclaration _ _ fundeps ->
+ if fundeps == fds
+ then Pass
+ else Fail (FunDepMissing mn decl fds)
+ _ ->
+ Fail (WrongDeclarationType mn decl "value"
+ (Docs.declInfoToString declInfo))
ValueShouldHaveTypeSignature mn decl (ShowFn tyPredicate) ->
- case find ((==) decl . Docs.declTitle) (declarationsFor mn) of
- Nothing ->
- Fail (NotDocumented mn decl)
- Just Docs.Declaration{..} ->
- case declInfo of
- Docs.ValueDeclaration ty ->
- if tyPredicate ty
- then Pass
- else Fail
- (ValueDeclarationWrongType mn decl ty)
- _ ->
- Fail (WrongDeclarationType mn decl "value"
- (Docs.declInfoToString declInfo))
+ findDecl mn decl $ \Docs.Declaration{..} ->
+ case declInfo of
+ Docs.ValueDeclaration ty ->
+ if tyPredicate ty
+ then Pass
+ else Fail
+ (ValueDeclarationWrongType mn decl ty)
+ _ ->
+ Fail (WrongDeclarationType mn decl "value"
+ (Docs.declInfoToString declInfo))
TypeSynonymShouldRenderAs mn decl expected ->
- case find ((==) decl . Docs.declTitle) (declarationsFor mn) of
- Nothing ->
- Fail (NotDocumented mn decl)
- Just Docs.Declaration{..} ->
- case declInfo of
- Docs.TypeSynonymDeclaration [] ty ->
- let actual = codeToString (Docs.renderType ty) in
- if actual == expected
- then Pass
- else Fail (TypeSynonymMismatch mn decl expected actual)
- _ ->
- Fail (WrongDeclarationType mn decl "synonym"
- (Docs.declInfoToString declInfo))
+ findDecl mn decl $ \Docs.Declaration{..} ->
+ case declInfo of
+ Docs.TypeSynonymDeclaration [] ty ->
+ let actual = codeToString (Docs.renderType ty) in
+ if actual == expected
+ then Pass
+ else Fail (TypeSynonymMismatch mn decl expected actual)
+ _ ->
+ Fail (WrongDeclarationType mn decl "synonym"
+ (Docs.declInfoToString declInfo))
+
+ ShouldHaveDocComment mn decl expected ->
+ findDecl mn decl $ \Docs.Declaration{..} ->
+ if maybe False (expected `T.isInfixOf`) declComments
+ then Pass
+ else Fail (DocCommentMissing mn decl declComments)
+
+ ShouldHaveReExport reExp ->
+ let
+ reExps = map fst modReExports
+ in
+ if reExp `elem` reExps
+ then Pass
+ else Fail (ReExportMissing modName reExp reExps)
where
declarationsFor mn =
if mn == modName
then modDeclarations
- else fromMaybe [] (lookup mn modReExports)
+ else fromMaybe [] (lookup mn (map (first Docs.ignorePackage) modReExports))
findChildren title =
fmap childrenTitles . find ((==) title . Docs.declTitle)
+ findDecl mn title f =
+ case find ((==) title . Docs.declTitle) (declarationsFor mn) of
+ Nothing ->
+ Fail (NotDocumented mn title)
+ Just decl ->
+ f decl
+
childrenTitles = map Docs.cdeclTitle . Docs.declChildren
-checkConstrained :: P.Type -> String -> Bool
+checkConstrained :: P.Type -> Text -> Bool
checkConstrained ty tyClass =
-- Note that we don't recurse on ConstrainedType if none of the constraints
-- match; this is by design, as constraints should be moved to the front
@@ -217,7 +243,7 @@ checkConstrained ty tyClass =
False
where
matches className =
- (==) className . T.unpack . P.runProperName . P.disqualify . P.constraintClass
+ (==) className . P.runProperName . P.disqualify . P.constraintClass
runAssertionIO :: Assertion -> Docs.Module -> IO ()
runAssertionIO assertion mdl = do
@@ -228,7 +254,7 @@ runAssertionIO assertion mdl = do
putStrLn ("Failed: " <> show reason)
exitFailure
-testCases :: [(String, [Assertion])]
+testCases :: [(Text, [Assertion])]
testCases =
[ ("Example",
[ -- From dependencies
@@ -238,7 +264,12 @@ testCases =
-- From local files
, ShouldBeDocumented (n "Example2") "one" []
, ShouldNotBeDocumented (n "Example2") "two"
+
+ -- Re-exports
+ , ShouldHaveReExport (Docs.FromDep (pkg "purescript-prelude") (n "Prelude"))
+ , ShouldHaveReExport (Docs.Local (n "Example2"))
])
+
, ("Example2",
[ ShouldBeDocumented (n "Example2") "one" []
, ShouldBeDocumented (n "Example2") "two" []
@@ -319,10 +350,15 @@ testCases =
, ValueShouldHaveTypeSignature (n "TypeOpAliases") "test4" (renderedType "forall a b c d. ((a ~> b) ~> c) ~> d")
, ValueShouldHaveTypeSignature (n "TypeOpAliases") "third" (renderedType "forall a b c. a × b × c -> c")
])
+
+ , ("DocComments",
+ [ ShouldHaveDocComment (n "DocComments") "example" " example == 0"
+ ])
]
where
n = P.moduleNameFromString . T.pack
+ pkg str = let Right p = parsePackageName str in p
hasTypeVar varName =
getAny . P.everythingOnTypes (<>) (Any . isVar varName)
diff --git a/tests/TestPrimDocs.hs b/tests/TestPrimDocs.hs
new file mode 100644
index 0000000..9309684
--- /dev/null
+++ b/tests/TestPrimDocs.hs
@@ -0,0 +1,30 @@
+module TestPrimDocs where
+
+import Control.Monad
+import Data.List ((\\))
+import qualified Data.Map as Map
+import qualified Data.Set as Set
+import qualified Language.PureScript as P
+import qualified Language.PureScript.Docs as D
+import qualified Language.PureScript.Docs.AsMarkdown as D
+
+main :: IO ()
+main = do
+ putStrLn "Test that there are no bottoms hiding in primDocsModule"
+ seq (D.runDocs (D.modulesAsMarkdown [D.primDocsModule])) (return ())
+
+ putStrLn "Test that Prim is fully documented"
+ let actualPrimNames =
+ -- note that prim type classes are listed in P.primTypes
+ (map (P.runProperName . P.disqualify . fst) $ Map.toList P.primTypes) ++
+ (map (P.runProperName . P.disqualify) $ Set.toList P.primKinds)
+ let documentedPrimNames = map D.declTitle (D.modDeclarations D.primDocsModule)
+
+ let undocumentedNames = actualPrimNames \\ documentedPrimNames
+ let extraNames = documentedPrimNames \\ actualPrimNames
+
+ when (not (null undocumentedNames)) $
+ error $ "Undocumented Prim names: " ++ show undocumentedNames
+
+ when (not (null extraNames)) $
+ error $ "Extra Prim names: " ++ show undocumentedNames
diff --git a/tests/TestPscPublish.hs b/tests/TestPscPublish.hs
index 05c082f..14bd037 100644
--- a/tests/TestPscPublish.hs
+++ b/tests/TestPscPublish.hs
@@ -1,20 +1,12 @@
{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
-{-# OPTIONS_GHC -fno-warn-unused-imports #-}
{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE OverloadedStrings #-}
module TestPscPublish where
-import Control.Monad
-import Control.Applicative
-import Control.Exception
-import System.Process
-import System.Directory
-import System.IO
-import System.Exit
-import qualified Data.ByteString.Lazy as BL
+import System.Exit (exitFailure)
import Data.ByteString.Lazy (ByteString)
import qualified Data.Aeson as A
-import Data.Aeson.BetterErrors
import Data.Version
import Language.PureScript.Docs
diff --git a/tests/TestUtils.hs b/tests/TestUtils.hs
index cf67a38..67e3fbf 100644
--- a/tests/TestUtils.hs
+++ b/tests/TestUtils.hs
@@ -57,6 +57,8 @@ supportModules =
, "Control.Alternative"
, "Control.Applicative"
, "Control.Apply"
+ , "Control.Biapplicative"
+ , "Control.Biapply"
, "Control.Bind"
, "Control.Category"
, "Control.Comonad"
@@ -72,6 +74,15 @@ supportModules =
, "Control.MonadZero"
, "Control.Plus"
, "Control.Semigroupoid"
+ , "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"
@@ -79,18 +90,24 @@ supportModules =
, "Data.Eq"
, "Data.EuclideanRing"
, "Data.Field"
+ , "Data.Foldable"
, "Data.Function"
, "Data.Function.Uncurried"
, "Data.Functor"
, "Data.Functor.Invariant"
, "Data.Generic.Rep"
- , "Data.Generic.Rep.Monoid"
, "Data.Generic.Rep.Eq"
+ , "Data.Generic.Rep.Monoid"
, "Data.Generic.Rep.Ord"
, "Data.Generic.Rep.Semigroup"
+ , "Data.Generic.Rep.Show"
, "Data.HeytingAlgebra"
+ , "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"
@@ -104,8 +121,9 @@ supportModules =
, "Data.Ring"
, "Data.Semigroup"
, "Data.Semiring"
- , "Data.Symbol"
, "Data.Show"
+ , "Data.Symbol"
+ , "Data.Traversable"
, "Data.Unit"
, "Data.Void"
, "Partial"
@@ -113,6 +131,11 @@ supportModules =
, "Prelude"
, "Test.Assert"
, "Test.Main"
+ , "Type.Data.Ordering"
+ , "Type.Data.Symbol"
+ , "Type.Equality"
+ , "Type.Prelude"
+ , "Type.Proxy"
, "Unsafe.Coerce"
]
diff --git a/tests/support/bower.json b/tests/support/bower.json
index 2de10e8..c6a7173 100644
--- a/tests/support/bower.json
+++ b/tests/support/bower.json
@@ -1,16 +1,17 @@
{
"name": "purescript-test-suite-support",
"dependencies": {
- "purescript-assert": "1.0.0-rc.1",
- "purescript-console": "1.0.0-rc.1",
- "purescript-eff": "1.0.0-rc.1",
- "purescript-functions": "1.0.0-rc.1",
- "purescript-prelude": "1.1.0",
- "purescript-st": "1.0.0-rc.1",
+ "purescript-assert": "2.0.0",
+ "purescript-console": "2.0.0",
+ "purescript-eff": "2.0.0",
+ "purescript-functions": "2.0.0",
+ "purescript-prelude": "2.1.0",
+ "purescript-st": "2.0.0",
"purescript-partial": "1.1.2",
- "purescript-newtype": "0.1.0",
- "purescript-generics-rep": "2.0.0",
- "purescript-symbols": "^1.0.1",
- "purescript-unsafe-coerce": "^1.0.0"
+ "purescript-newtype": "1.1.0",
+ "purescript-generics-rep": "4.0.0",
+ "purescript-symbols": "^2.0.0",
+ "purescript-typelevel-prelude": "https://github.com/purescript/purescript-typelevel-prelude.git#29a7123a0c29c85d4b923fcf4a7df8e45ebf9bac",
+ "purescript-unsafe-coerce": "^2.0.0"
}
}