From 2e7688d4313c0d4bc2a3a03497a5131e5ec35a24 Mon Sep 17 00:00:00 2001 From: waddlaw Date: Sat, 9 Nov 2019 16:28:00 +0900 Subject: [PATCH 1/2] Add dependencies (megaparsec, hspec-megaparsec) --- package.yaml | 3 +++ stack.yaml | 1 + stack.yaml.lock | 7 +++++++ 3 files changed, 11 insertions(+) diff --git a/package.yaml b/package.yaml index 64d6ccfdc..75f700ac9 100644 --- a/package.yaml +++ b/package.yaml @@ -69,6 +69,7 @@ library: - http-client - http-conduit - lens-family-core + - megaparsec >=7.0 && <8.0 - mtl - network-uri - open-browser @@ -166,6 +167,8 @@ tests: - containers - directory - extra + - hspec-megaparsec >=2.0 && <2.1 + - megaparsec >=7.0 && <8.0 - process - QuickCheck - spago diff --git a/stack.yaml b/stack.yaml index 4bf65b630..25f66bb0d 100644 --- a/stack.yaml +++ b/stack.yaml @@ -37,6 +37,7 @@ extra-deps: - base-orphans-0.8.1@sha256:defd0057b5db93257528d89b5b01a0fee9738e878c121c686948ac4aa5dded63 - typed-process-0.2.6.0@sha256:c901c13d491441830eb23132ad6968243a56b98161629d260a26c0b13c735fcd - unliftio-0.2.12@sha256:b089fbc2ff2628a963c2c4b12143f2020874e3e5144ffd6c62b25639a0ca1483 +- hspec-megaparsec-2.0.1@sha256:7f26ab334eaa653054766110cf259c31314d1c2ec170270e56101e344ce65ef9,2163 allow-newer: true nix: packages: [zlib] diff --git a/stack.yaml.lock b/stack.yaml.lock index 468782719..626235c4e 100644 --- a/stack.yaml.lock +++ b/stack.yaml.lock @@ -249,6 +249,13 @@ packages: sha256: 4971b43f3d473eff868eb1a0c359729b49f1779e78c462ba45ef0d1eda677699 original: hackage: unliftio-0.2.12@sha256:b089fbc2ff2628a963c2c4b12143f2020874e3e5144ffd6c62b25639a0ca1483 +- completed: + hackage: hspec-megaparsec-2.0.1@sha256:7f26ab334eaa653054766110cf259c31314d1c2ec170270e56101e344ce65ef9,2163 + pantry-tree: + size: 385 + sha256: fb4b022bc9076c0e2486b0267a3702e8029f5eaf04683428592919d606cc9b7c + original: + hackage: hspec-megaparsec-2.0.1@sha256:7f26ab334eaa653054766110cf259c31314d1c2ec170270e56101e344ce65ef9,2163 snapshots: - completed: size: 508406 From 3f8beb35b09375c2ec177c6e3705125e4d7ee4d2 Mon Sep 17 00:00:00 2001 From: waddlaw Date: Sat, 9 Nov 2019 16:29:40 +0900 Subject: [PATCH 2/2] Fix test error when there are no tests --- src/Spago/Build.hs | 16 ++++++- src/Spago/Build/Parser.hs | 82 ++++++++++++++++++++++++++++++++++ test/Spago/Build/ParserSpec.hs | 58 ++++++++++++++++++++++++ 3 files changed, 154 insertions(+), 2 deletions(-) create mode 100644 src/Spago/Build/Parser.hs create mode 100644 test/Spago/Build/ParserSpec.hs diff --git a/src/Spago/Build.hs b/src/Spago/Build.hs index b0eae60fd..caceda108 100644 --- a/src/Spago/Build.hs +++ b/src/Spago/Build.hs @@ -38,6 +38,7 @@ import qualified System.IO.Temp as Temp import qualified Turtle import qualified Web.Browser as Browser +import qualified Spago.Build.Parser as Parse import qualified Spago.Config as Config import qualified Spago.Dhall as Dhall import qualified Spago.FetchPackage as Fetch @@ -187,8 +188,19 @@ repl cacheFlag newPackages sourcePaths pursArgs depsOnly = do -- (or the provided module name) with node test :: Maybe Purs.ModuleName -> BuildOptions -> [Purs.ExtraArg] -> Spago () test maybeModuleName buildOpts extraArgs = do - Config.Config { alternateBackend } <- Config.ensureConfig - runBackend alternateBackend (Purs.ModuleName "Test.Main") (Just "Tests succeeded.") "Tests failed: " maybeModuleName buildOpts extraArgs + logDebug $ displayShow $ sourcePaths buildOpts + liftIO (Glob.glob "test/**/*.purs") >>= \case + [] -> logInfo "succeed (0/0 tests passed)" + paths -> do + logDebug $ displayShow paths + results <- forM paths $ \path -> do + content <- readFileBinary path + return $ Parse.checkExistTestModule content + if or results then do + Config.Config { alternateBackend } <- Config.ensureConfig + runBackend alternateBackend (Purs.ModuleName "Test.Main") (Just "Tests succeeded.") "Tests failed: " maybeModuleName buildOpts extraArgs + else + logInfo "succeed (0/0 tests passed)" -- | Run the project: compile and run "Main" -- (or the provided module name) with node diff --git a/src/Spago/Build/Parser.hs b/src/Spago/Build/Parser.hs new file mode 100644 index 000000000..25640852a --- /dev/null +++ b/src/Spago/Build/Parser.hs @@ -0,0 +1,82 @@ +module Spago.Build.Parser + ( ModuleExportType (..) + , PsModule (..) + , pModule + , checkExistTestModule + ) where + +import Spago.Prelude hiding (many, try) +import qualified RIO.ByteString as B +import qualified RIO.NonEmpty.Partial as NE' + +import Text.Megaparsec +import Text.Megaparsec.Byte +import qualified Text.Megaparsec.Byte.Lexer as L + +type Parser = Parsec Void ByteString + +data PsModule = PsModule + { psModuleName :: ByteString + , psModuleExportList :: Maybe (NonEmpty ModuleExportType) + } deriving (Eq, Show) + +data ModuleExportType + = ExportModule ByteString + | ExportFunction ByteString + | ExportClass ByteString + deriving (Eq, Show) + +pModule :: Parser PsModule +pModule = between (space *> symbol "module") (symbol "where") $ PsModule + <$> lexeme pModuleFullName + <*> optional (lexeme (between (symbol "(") (symbol ")") pModuleExportList)) + +pModuleFullName :: Parser ByteString +pModuleFullName = do + res <- sepBy pModuleName (symbol ".") + return (B.intercalate "." res) + +pModuleName :: Parser ByteString +pModuleName = fmap B.pack ((:) <$> upperChar <*> many letterChar) + +pModuleExportList :: Parser (NonEmpty ModuleExportType) +pModuleExportList = do + let exportP = choice [pExportClassOrModule, pExportFunc] + exports <- sepBy exportP (symbol ",") + if null exports then + fail "Invalid syntax: export list" + else + return $ NE'.fromList exports + +pExportFunc :: Parser ModuleExportType +pExportFunc = do + name <- B.pack <$> lexeme (many letterChar) + if B.null name then + fail "no input" + else + return $ ExportFunction name + +pExportClassOrModule :: Parser ModuleExportType +pExportClassOrModule = ($) + <$> choice [ ExportModule <$ string "module" + , ExportClass <$ string "class" + ] + <* space1 + <*> pModuleFullName + +lexeme :: Parser a -> Parser a +lexeme = L.lexeme sc + +symbol :: ByteString -> Parser ByteString +symbol = L.symbol sc + +sc :: Parser () +sc = L.space + space1 + (L.skipLineComment "//") + (L.skipBlockComment "{-" "-}") + +checkExistTestModule :: ByteString -> Bool +checkExistTestModule content = case parse pModule "" content of + Left _ -> False + Right (PsModule name _) -> name == "Test.Main" \ No newline at end of file diff --git a/test/Spago/Build/ParserSpec.hs b/test/Spago/Build/ParserSpec.hs new file mode 100644 index 000000000..be5f809f0 --- /dev/null +++ b/test/Spago/Build/ParserSpec.hs @@ -0,0 +1,58 @@ +module Spago.Build.ParserSpec (spec) where + +import Prelude +import Test.Hspec +import Text.Megaparsec +import Test.Hspec.Megaparsec +import Data.List.NonEmpty + +import Spago.Build.Parser + +spec :: Spec +spec = do + describe "PureScript Module Parser" $ do + it "pModule (fail)" $ do + let p = parse pModule "" + + p `shouldFailOn` "module Test.Main () where" + p `shouldFailOn` "module Test.Main (,) where" + + it "pModule (success)" $ do + let p = parse pModule "" + + p "module Test where" + `shouldParse` + PsModule "Test" Nothing + + p "module Test.Main where" + `shouldParse` + PsModule "Test.Main" Nothing + + p "module Test.Main (main) where" + `shouldParse` + PsModule "Test.Main" (Just $ fromList [ExportFunction "main"]) + + p "module Test.Main (main, test) where" + `shouldParse` + PsModule "Test.Main" (Just $ fromList [ExportFunction"main", ExportFunction "test"]) + + p "module A (module B) where" + `shouldParse` + PsModule "A" (Just $ fromList [ExportModule "B"]) + + p "module A (module B.C) where" + `shouldParse` + PsModule "A" (Just $ fromList [ExportModule "B.C"]) + + p "module A (module A, module B) where" + `shouldParse` + PsModule "A" (Just $ fromList [ExportModule "A", ExportModule "B"]) + + p "module Test (class Foldable, foldr, foldl, foldMap) where" + `shouldParse` + PsModule "Test" (Just $ fromList $ [ ExportClass "Foldable" + , ExportFunction "foldr" + , ExportFunction "foldl" + , ExportFunction "foldMap" + ] + ) \ No newline at end of file