From 3c8eeefa8c12b0216d2830c1811ddf574a3bddbb Mon Sep 17 00:00:00 2001 From: Daniel Marshall Date: Tue, 30 Jul 2019 10:28:24 +0100 Subject: [PATCH 1/6] Moved notUsed rule to be checked after renaming --- .../src/CodeWorld/Requirements/Checker/Eval.hs | 18 +++++++++--------- .../CodeWorld/Requirements/Checker/Types.hs | 2 +- 2 files changed, 10 insertions(+), 10 deletions(-) diff --git a/codeworld-requirements/src/CodeWorld/Requirements/Checker/Eval.hs b/codeworld-requirements/src/CodeWorld/Requirements/Checker/Eval.hs index b2d9aa391..f95e21f80 100644 --- a/codeworld-requirements/src/CodeWorld/Requirements/Checker/Eval.hs +++ b/codeworld-requirements/src/CodeWorld/Requirements/Checker/Eval.hs @@ -181,15 +181,6 @@ checkRuleParse _ m (NotDefined a) | null (allDefinitionsOf a m) = success | otherwise = failure $ "`" ++ a ++ "` should not be defined." -checkRuleParse _ m (NotUsed a) - | everything (||) (mkQ False exprUse) m - = failure $ "`" ++ a ++ "` should not be used." - | otherwise = success - where - exprUse :: HsExpr GhcPs -> Bool - exprUse (HsVar _ (L _ v)) | idName v == a = True - exprUse _ = False - checkRuleParse f m (ContainsMatch tmpl topLevel card) | hasCardinality card n = success | otherwise = failure $ "Wrong number of matches." @@ -215,6 +206,15 @@ checkRuleParse _ _ _ = abort checkRuleTypecheck :: Messages -> TcGblEnv -> Rule -> Result +checkRuleTypecheck _ e (NotUsed a) + | everything (||) (mkQ False exprUse) (tcg_rn_decls e) + = failure $ "`" ++ a ++ "` should not be used." + | otherwise = success + where + exprUse :: HsExpr GhcRn -> Bool + exprUse (HsVar _ (L _ v)) | nameString v == a = True + exprUse _ = False + checkRuleTypecheck c e (NoWarningsExcept ex) | null warns = success | otherwise = failure $ "At least one forbidden warning found." diff --git a/codeworld-requirements/src/CodeWorld/Requirements/Checker/Types.hs b/codeworld-requirements/src/CodeWorld/Requirements/Checker/Types.hs index f2c42a78b..f989ccb71 100644 --- a/codeworld-requirements/src/CodeWorld/Requirements/Checker/Types.hs +++ b/codeworld-requirements/src/CodeWorld/Requirements/Checker/Types.hs @@ -63,7 +63,7 @@ module CodeWorld.Requirements.Checker.Types where getStage (HasSimpleParams _) = Parse getStage (UsesAllParams _) = Parse getStage (NotDefined _) = Parse - getStage (NotUsed _) = Parse + getStage (NotUsed _) = Typecheck getStage (ContainsMatch{}) = Parse getStage (MatchesRegex{}) = Source getStage (OnFailure _ _) = Multiple From c8a1214915c92773b48fcfb1879f598459a96d82 Mon Sep 17 00:00:00 2001 From: Daniel Marshall Date: Wed, 31 Jul 2019 10:30:27 +0100 Subject: [PATCH 2/6] Fixed requirements checker bug where diagnostics were not being output --- .../src/CodeWorld/Requirements/Requirements.hs | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/codeworld-requirements/src/CodeWorld/Requirements/Requirements.hs b/codeworld-requirements/src/CodeWorld/Requirements/Requirements.hs index 7a6c42a06..488d92486 100644 --- a/codeworld-requirements/src/CodeWorld/Requirements/Requirements.hs +++ b/codeworld-requirements/src/CodeWorld/Requirements/Requirements.hs @@ -60,7 +60,11 @@ checkRequirements e c f m s = do "Obfuscated:\n\n XREQUIRES" ++ obfuscated ++ "\n\n" ++ concat sdiags ++ concat rdiags ++ concat results ++ " :: END REQUIREMENTS ::\n" - else Nothing + else if (not (null sdiags) || not (null rdiags)) then + Just $ "\n :: REQUIREMENTS ::\n" ++ + concat sdiags ++ concat rdiags ++ + " :: END REQUIREMENTS ::\n" + else Nothing plainPattern :: Text plainPattern = "{-+[[:space:]]*REQUIRES\\b((\n|[^-]|-[^}])*)-}" From dca44db6707346a761b952b1e298fe5026bb3bbb Mon Sep 17 00:00:00 2001 From: Daniel Marshall Date: Thu, 8 Aug 2019 14:29:43 +0100 Subject: [PATCH 3/6] Removed old requirements checker and started integration of the plugin version --- build.sh | 1 + codeworld-compiler/codeworld-compiler.cabal | 7 - codeworld-compiler/src/CodeWorld/Compile.hs | 12 +- .../src/CodeWorld/Compile/Framework.hs | 98 +----- .../src/CodeWorld/Compile/Requirements.hs | 128 -------- .../CodeWorld/Compile/Requirements/Eval.hs | 303 ------------------ .../Compile/Requirements/Language.hs | 168 ---------- .../Compile/Requirements/LegacyLanguage.hs | 151 --------- .../CodeWorld/Compile/Requirements/Matcher.hs | 223 ------------- .../CodeWorld/Compile/Requirements/Types.hs | 66 ---- .../src/CodeWorld/Compile/Stages.hs | 2 - .../codeworld-requirements.cabal | 16 +- .../Requirements/RequirementsChecker.hs | 6 + 13 files changed, 27 insertions(+), 1154 deletions(-) delete mode 100644 codeworld-compiler/src/CodeWorld/Compile/Requirements.hs delete mode 100644 codeworld-compiler/src/CodeWorld/Compile/Requirements/Eval.hs delete mode 100644 codeworld-compiler/src/CodeWorld/Compile/Requirements/Language.hs delete mode 100644 codeworld-compiler/src/CodeWorld/Compile/Requirements/LegacyLanguage.hs delete mode 100644 codeworld-compiler/src/CodeWorld/Compile/Requirements/Matcher.hs delete mode 100644 codeworld-compiler/src/CodeWorld/Compile/Requirements/Types.hs create mode 100644 codeworld-requirements/stub-src/CodeWorld/Requirements/RequirementsChecker.hs diff --git a/build.sh b/build.sh index 7449d000b..1c8195dbb 100755 --- a/build.sh +++ b/build.sh @@ -25,6 +25,7 @@ run . cabal_install --ghcjs ./codeworld-prediction \ ./codeworld-error-sanitizer \ ./codeworld-api \ ./codeworld-base \ + ./codeworld-requirements \ ./codeworld-game-api \ QuickCheck diff --git a/codeworld-compiler/codeworld-compiler.cabal b/codeworld-compiler/codeworld-compiler.cabal index a33a2b0e2..60e5486af 100644 --- a/codeworld-compiler/codeworld-compiler.cabal +++ b/codeworld-compiler/codeworld-compiler.cabal @@ -33,12 +33,6 @@ Library Other-modules: CodeWorld.Compile.Framework - CodeWorld.Compile.Requirements - CodeWorld.Compile.Requirements.Eval - CodeWorld.Compile.Requirements.Language - CodeWorld.Compile.Requirements.LegacyLanguage - CodeWorld.Compile.Requirements.Matcher - CodeWorld.Compile.Requirements.Types CodeWorld.Compile.Stages Build-depends: @@ -54,7 +48,6 @@ Library directory, exceptions, filepath, - ghc-lib-parser < 8.8, hashable, haskell-src-exts >= 1.20, megaparsec, diff --git a/codeworld-compiler/src/CodeWorld/Compile.hs b/codeworld-compiler/src/CodeWorld/Compile.hs index 31179da3d..1dc79215d 100644 --- a/codeworld-compiler/src/CodeWorld/Compile.hs +++ b/codeworld-compiler/src/CodeWorld/Compile.hs @@ -86,8 +86,7 @@ compileSource stage src err mode verbose = fromMaybe CompileAborted <$> compileStatus = CompileSuccess, compileErrors = [], compileReadSource = Nothing, - compileParsedSource = Nothing, - compileGHCParsedSource = Nothing + compileParsedSource = Nothing } timeout = case stage of GenBase _ _ _ _ -> maxBound :: Int @@ -101,7 +100,6 @@ build = do checkDangerousSource ifSucceeding checkCodeConventions ifSucceeding compileCode - ifSucceeding checkRequirements errPath <- gets compileOutputPath diags <- sort <$> gets compileErrors @@ -152,6 +150,10 @@ buildArgs "codeworld" = , "base" , "-package" , "codeworld-base" + , "-package" + , "codeworld-requirements" + , "-fplugin" + , "CodeWorld.Requirements.RequirementsChecker" , "-Wall" , "-Wdeferred-type-errors" , "-Wdeferred-out-of-scope-variables" @@ -200,6 +202,10 @@ buildArgs "haskell" = , "codeworld-api" , "-package" , "QuickCheck" + , "-package" + , "codeworld-requirements" + , "-fplugin" + , "CodeWorld.Requirements.RequirementsChecker" ] runCompiler :: FilePath -> Int -> [String] -> Bool -> IO (ExitCode, Text) diff --git a/codeworld-compiler/src/CodeWorld/Compile/Framework.hs b/codeworld-compiler/src/CodeWorld/Compile/Framework.hs index ff6a3da16..5a7743929 100644 --- a/codeworld-compiler/src/CodeWorld/Compile/Framework.hs +++ b/codeworld-compiler/src/CodeWorld/Compile/Framework.hs @@ -50,23 +50,6 @@ import System.IO import System.IO.Temp (withSystemTempDirectory) import System.Process -import qualified "ghc-lib-parser" Config as GHCParse -import qualified "ghc-lib-parser" DynFlags as GHCParse -import qualified "ghc-lib-parser" FastString as GHCParse -import qualified "ghc-lib-parser" Fingerprint as GHCParse -import qualified "ghc-lib-parser" GHC.LanguageExtensions.Type as GHCParse -import qualified "ghc-lib-parser" HeaderInfo as GHCParse -import qualified "ghc-lib-parser" HsExtension as GHCParse -import qualified "ghc-lib-parser" HsSyn as GHCParse -import qualified "ghc-lib-parser" HscTypes as GHCParse -import qualified "ghc-lib-parser" Lexer as GHCParse -import qualified "ghc-lib-parser" Panic as GHCParse -import qualified "ghc-lib-parser" Parser as GHCParse -import qualified "ghc-lib-parser" Platform as GHCParse -import qualified "ghc-lib-parser" SrcLoc as GHCParse -import qualified "ghc-lib-parser" StringBuffer as GHCParse -import qualified "ghc-lib-parser" ToolSettings as GHCParse - data Stage = ErrorCheck | FullBuild FilePath -- ^ Output file location @@ -95,8 +78,7 @@ data CompileState = CompileState { compileStatus :: CompileStatus, compileErrors :: [Diagnostic], compileReadSource :: Maybe ByteString, - compileParsedSource :: Maybe ParsedCode, - compileGHCParsedSource :: Maybe GHCParsedCode + compileParsedSource :: Maybe ParsedCode } type MonadCompile m = (MonadState CompileState m, MonadIO m, MonadMask m) @@ -107,8 +89,6 @@ type Diagnostic = (SrcSpanInfo, CompileStatus, String) data ParsedCode = Parsed (Module SrcSpanInfo) | NoParse deriving Show -data GHCParsedCode = GHCParsed (GHCParse.HsModule GHCParse.GhcPs) | GHCNoParse - getSourceCode :: MonadCompile m => m ByteString getSourceCode = do cached <- gets compileReadSource @@ -131,17 +111,6 @@ getParsedCode = do modify $ \state -> state { compileParsedSource = Just parsed } return parsed -getGHCParsedCode :: MonadCompile m => m GHCParsedCode -getGHCParsedCode = do - cached <- gets compileGHCParsedSource - case cached of - Just parsed -> return parsed - Nothing -> do - source <- getSourceCode - parsed <- ghcParseCode ["TupleSections"] (decodeUtf8 source) - modify $ \state -> state { compileGHCParsedSource = Just parsed } - return parsed - getDiagnostics :: MonadCompile m => m [Diagnostic] getDiagnostics = do diags <- gets compileErrors @@ -187,71 +156,6 @@ parseCode extraExts src = do ParseOk mod -> Parsed mod ParseFailed _ _ -> NoParse -ghcExtensionsByName :: Map String GHCParse.Extension -ghcExtensionsByName = M.fromList [ - (GHCParse.flagSpecName spec, GHCParse.flagSpecFlag spec) - | spec <- GHCParse.xFlags ] - -applyExtensionToFlags :: GHCParse.DynFlags -> String -> GHCParse.DynFlags -applyExtensionToFlags dflags name - | "No" `isPrefixOf` name = - GHCParse.xopt_unset dflags $ fromJust $ M.lookup (drop 2 name) ghcExtensionsByName - | otherwise = - GHCParse.xopt_set dflags $ fromJust $ M.lookup name ghcExtensionsByName - -ghcParseCode :: MonadCompile m => [String] -> Text -> m GHCParsedCode -ghcParseCode extraExts src = do - sourceMode <- gets compileMode - let buffer = GHCParse.stringToStringBuffer (T.unpack src) - exts | sourceMode == "codeworld" = codeworldModeExts ++ extraExts - | otherwise = extraExts - defaultFlags = GHCParse.defaultDynFlags fakeSettings fakeLlvmConfig - dflags = foldl' applyExtensionToFlags defaultFlags exts - dflagsWithPragmas <- liftIO $ - fromMaybe dflags <$> parsePragmasIntoDynFlags dflags "program.hs" buffer - let location = GHCParse.mkRealSrcLoc (GHCParse.mkFastString "program.hs") 1 1 - state = GHCParse.mkPState dflagsWithPragmas buffer location - return $ case GHCParse.unP GHCParse.parseModule state of - GHCParse.POk _ (GHCParse.L _ mod) -> GHCParsed mod - GHCParse.PFailed _ -> GHCNoParse - -fakeSettings :: GHCParse.Settings -fakeSettings = - GHCParse.Settings { - GHCParse.sGhcNameVersion = GHCParse.GhcNameVersion { - GHCParse.ghcNameVersion_programName = "ghcjs", - GHCParse.ghcNameVersion_projectVersion = GHCParse.cProjectVersion - }, - GHCParse.sFileSettings = GHCParse.FileSettings {}, - GHCParse.sTargetPlatform = GHCParse.Platform { - GHCParse.platformWordSize = 8, - GHCParse.platformOS = GHCParse.OSUnknown, - GHCParse.platformUnregisterised = True - }, - GHCParse.sPlatformMisc = GHCParse.PlatformMisc {}, - GHCParse.sPlatformConstants = GHCParse.PlatformConstants { - GHCParse.pc_DYNAMIC_BY_DEFAULT = False, - GHCParse.pc_WORD_SIZE = 8 - }, - GHCParse.sToolSettings = GHCParse.ToolSettings { - GHCParse.toolSettings_opt_P_fingerprint = GHCParse.fingerprint0 - } - } - -fakeLlvmConfig :: (GHCParse.LlvmTargets, GHCParse.LlvmPasses) -fakeLlvmConfig = ([], []) - -parsePragmasIntoDynFlags :: GHCParse.DynFlags - -> FilePath - -> GHCParse.StringBuffer - -> IO (Maybe GHCParse.DynFlags) -parsePragmasIntoDynFlags dflags f src = - GHCParse.handleGhcException (const $ return Nothing) $ - GHCParse.handleSourceError (const $ return Nothing) $ do - let opts = GHCParse.getOptions dflags src f - (dflagsWithPragmas, _, _) <- GHCParse.parseDynamicFilePragma dflags opts - return $ Just dflagsWithPragmas - addDiagnostics :: MonadCompile m => [Diagnostic] -> m () addDiagnostics diags = modify $ \state -> state { compileErrors = compileErrors state ++ diags, diff --git a/codeworld-compiler/src/CodeWorld/Compile/Requirements.hs b/codeworld-compiler/src/CodeWorld/Compile/Requirements.hs deleted file mode 100644 index f1f4c197c..000000000 --- a/codeworld-compiler/src/CodeWorld/Compile/Requirements.hs +++ /dev/null @@ -1,128 +0,0 @@ -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ParallelListComp #-} -{-# LANGUAGE ScopedTypeVariables #-} - -{- - Copyright 2019 The CodeWorld Authors. All rights reserved. - - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. --} - -module CodeWorld.Compile.Requirements (checkRequirements) where - -import CodeWorld.Compile.Framework -import CodeWorld.Compile.Requirements.Eval -import CodeWorld.Compile.Requirements.Language -import CodeWorld.Compile.Requirements.Types -import Codec.Compression.Zlib -import Control.Exception -import Control.Monad -import Data.Array -import Data.ByteString (ByteString) -import qualified Data.ByteString as B -import qualified Data.ByteString.Lazy as B (toStrict, fromStrict) -import qualified Data.ByteString.Base64 as B64 -import Data.Char -import Data.Either -import Data.Monoid -import Data.Text (Text) -import qualified Data.Text as T -import Data.Text.Encoding (encodeUtf8, decodeUtf8) -import Language.Haskell.Exts -import System.IO.Unsafe -import Text.Regex.TDFA -import Text.Regex.TDFA.Text - -checkRequirements :: MonadCompile m => m () -checkRequirements = do - sources <- extractRequirementsSource - reqs <- extractRequirements sources - when (not (null reqs)) $ do - results <- mapM handleRequirement reqs - let obfuscated = T.unpack (obfuscate (map snd sources)) - addDiagnostics - [ (noSrcSpan, CompileSuccess, - " :: REQUIREMENTS ::\n" ++ - "Obfuscated:\n\n XREQUIRES" ++ obfuscated ++ "\n\n" ++ - concat results ++ - " :: END REQUIREMENTS ::\n") - ] - -plainPattern :: Text -plainPattern = "{-+[[:space:]]*REQUIRES\\b((\n|[^-]|-[^}])*)-}" - -codedPattern :: Text -codedPattern = "{-+[[:space:]]*XREQUIRES\\b((\n|[^-]|-[^}])*)-}" - -extractRequirementsSource :: MonadCompile m => m [(SrcSpanInfo, Text)] -extractRequirementsSource = do - src <- decodeUtf8 <$> getSourceCode - let plain = extractSubmatches plainPattern src - let blocks = map (fmap deobfuscate) (extractSubmatches codedPattern src) - addDiagnostics [ (spn, CompileSuccess, "warning: Coded requirements were corrupted.") - | (spn, Nothing) <- blocks ] - let coded = [ (spn, rule) | (spn, Just block) <- blocks, rule <- block ] - return (plain ++ coded) - -extractSubmatches :: Text -> Text -> [(SrcSpanInfo, Text)] -extractSubmatches pattern src = - [ (srcSpanFor src off len, T.take len (T.drop off src)) - | matchArray :: MatchArray <- src =~ pattern - , rangeSize (bounds matchArray) > 1 - , let (off, len) = matchArray ! 1 ] - -extractRequirements :: MonadCompile m => [(SrcSpanInfo, Text)] -> m [Requirement] -extractRequirements sources = do - addDiagnostics diags - return reqs - where results = [ parseRequirement ln col source - | (SrcSpanInfo spn _, source) <- sources - , let ln = srcSpanStartLine spn - , let col = srcSpanStartColumn spn ] - diags = [ format loc err | Left err <- results | (loc, _) <- sources ] - reqs = [ req | Right req <- results ] - format loc err = (loc, CompileSuccess, - "error: The requirement could not be understood:\n" ++ err) - -handleRequirement :: MonadCompile m => Requirement -> m String -handleRequirement req = do - let desc = requiredDescription req - (success, msgs) <- evalRequirement req - let label | success == Nothing = "[?] " ++ desc ++ "\n" - | success == Just True = "[Y] " ++ desc ++ "\n" - | otherwise = "[N] " ++ desc ++ "\n" - return $ label ++ concat [ " " ++ msg ++ "\n" | msg <- msgs ] - -obfuscate :: [Text] -> Text -obfuscate = wrapWithPrefix 60 "\n " . decodeUtf8 . B64.encode . - B.toStrict . compress . B.fromStrict . encodeUtf8 . T.pack . - show . map T.unpack - -deobfuscate :: Text -> Maybe [Text] -deobfuscate = fmap (map T.pack . read . T.unpack . decodeUtf8) . - partialToMaybe . B.toStrict . decompress . B.fromStrict . - B64.decodeLenient . encodeUtf8 . T.filter (not . isSpace) - -wrapWithPrefix :: Int -> Text -> Text -> Text -wrapWithPrefix n pre txt = T.concat (parts txt) - where parts t | T.length t < n = [pre <> t] - | otherwise = let (a, b) = T.splitAt n t - in pre <> a : parts b - -partialToMaybe :: a -> Maybe a -partialToMaybe = (eitherToMaybe :: Either SomeException a -> Maybe a) . - unsafePerformIO . try . evaluate - -eitherToMaybe :: Either a b -> Maybe b -eitherToMaybe = either (const Nothing) Just diff --git a/codeworld-compiler/src/CodeWorld/Compile/Requirements/Eval.hs b/codeworld-compiler/src/CodeWorld/Compile/Requirements/Eval.hs deleted file mode 100644 index 303d82280..000000000 --- a/codeworld-compiler/src/CodeWorld/Compile/Requirements/Eval.hs +++ /dev/null @@ -1,303 +0,0 @@ -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE MultiWayIf #-} -{-# LANGUAGE PackageImports #-} -{-# LANGUAGE RecordWildCards #-} - -{- - Copyright 2019 The CodeWorld Authors. All rights reserved. - - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. --} - -module CodeWorld.Compile.Requirements.Eval ( - Requirement, - evalRequirement - ) where - -import CodeWorld.Compile.Framework -import CodeWorld.Compile.Requirements.Matcher -import CodeWorld.Compile.Requirements.Types -import Control.Monad.IO.Class -import Data.Array -import Data.Char -import Data.Either -import Data.Generics hiding (empty) -import Data.Hashable -import Data.List -import qualified Data.Text as T -import qualified Data.ByteString.Char8 as C -import Data.Void -import qualified Language.Haskell.Exts as Exts -import Text.Regex.TDFA hiding (match) - -import "ghc-lib-parser" HsSyn -import "ghc-lib-parser" Outputable -import "ghc-lib-parser" SrcLoc - -evalRequirement :: MonadCompile m => Requirement -> m (Maybe Bool, [String]) -evalRequirement Requirement{..} = do - results <- fmap concat <$> (sequence <$> mapM checkRule requiredRules) - return $ case results of - Nothing -> (Nothing, ["Could not check this requirement."]) - Just errs -> (Just (null errs), errs) - -type Result = Maybe [String] - -success :: MonadCompile m => m Result -success = return (Just []) - -failure :: MonadCompile m => String -> m Result -failure err = return (Just [err]) - -abort :: MonadCompile m => m Result -abort = return Nothing - -withParsedCode :: MonadCompile m - => (HsModule GhcPs -> m Result) - -> m Result -withParsedCode check = do - getGHCParsedCode >>= \pc -> case pc of - GHCNoParse -> abort - GHCParsed m -> check m - -checkRule :: MonadCompile m => Rule -> m Result - -checkRule (DefinedByFunction a b) = withParsedCode $ \m -> do - let defs = allDefinitionsOf a m - - isDefinedBy :: String -> (GRHSs GhcPs (LHsExpr GhcPs)) -> Bool - isDefinedBy b (GRHSs{grhssGRHSs=rhss}) - = all (\(L _ (GRHS _ _ (L _ exp))) -> isExpOf b exp) rhss - - isExpOf :: String -> (HsExpr GhcPs) -> Bool - isExpOf b (HsVar _ (L _ bb)) = b == idName bb - isExpOf b (HsApp _ (L _ exp) _) = isExpOf b exp - isExpOf b (HsLet _ _ (L _ exp)) = isExpOf b exp - isExpOf b (HsPar _ (L _ exp)) = isExpOf b exp - isExpOf b _ = False - - if | null defs -> failure $ "`" ++ a ++ "` is not defined." - | all (isDefinedBy b) defs -> success - | otherwise -> failure ("`" ++ a ++ "` is not defined directly using `" ++ b ++ "`.") - -checkRule (MatchesExpected a h) = withParsedCode $ \m -> do - let defs = allBindingsOf a m - computedHash = hash (concatMap showSDocUnsafe defs) `mod` 1000000 - if | null defs -> failure $ "`" ++ a ++ "` is not defined." - | computedHash == h -> success - | otherwise -> failure $ - "`" ++ a ++ "` does not have the expected definition. (" ++ - show computedHash ++ ")" - -checkRule (HasSimpleParams a) = withParsedCode $ \m -> do - let paramPatterns = everything (++) (mkQ [] funParams) m - - funParams :: (HsBind GhcPs) -> [LPat GhcPs] - funParams (FunBind{fun_id=(L _ aa), fun_matches=(MG{mg_alts=(L _ matches)})}) - | a == idName aa = concat $ matchParams <$> matches - funParams _ = [] - - matchParams :: (LMatch GhcPs (LHsExpr GhcPs)) -> [LPat GhcPs] - matchParams (L _ (Match{m_pats=pats})) = pats - matchParams _ = [] - - isSimpleParam :: LPat GhcPs -> Bool - isSimpleParam (VarPat _ (L _ nm)) = isLower (head (idName nm)) - isSimpleParam (TuplePat _ pats _) = all isSimpleParam pats - isSimpleParam (ParPat _ pat) = isSimpleParam pat - isSimpleParam (WildPat _) = True - isSimpleParam _ = False - - if | null paramPatterns -> failure $ "`" ++ a ++ "` is not defined as a function." - | all isSimpleParam paramPatterns -> success - | otherwise -> failure $ "`" ++ a ++ "` has equations with pattern matching." - -checkRule (UsesAllParams a) = withParsedCode $ \m -> do - let usesAllParams = everything (&&) (mkQ True targetVarUsesParams) m - - targetVarUsesParams :: (HsBind GhcPs) -> Bool - targetVarUsesParams (FunBind{fun_id=(L _ aa), fun_matches=(MG{mg_alts=(L _ ms)})}) - | idName aa == a = all matchUsesAllArgs ms - targetVarUsesParams _ = True - - matchUsesAllArgs (L _ (Match{m_pats=ps, m_grhss=rhs})) = uses ps rhs - - uses ps rhs = - all (\v -> rhsUses v rhs) (patVars ps) - - patVars ps = concatMap (everything (++) (mkQ [] patShallowVars)) ps - - patShallowVars :: LPat GhcPs -> [String] - patShallowVars (VarPat _ (L _ v)) = [idName v] - patShallowVars (NPlusKPat _ (L _ v) _ _ _ _) = [idName v] - patShallowVars (AsPat _ (L _ v) _) = [idName v] - patShallowVars _ = [] - - rhsUses v rhs = everything (||) (mkQ False (isVar v)) rhs - - isVar :: String -> HsExpr GhcPs -> Bool - isVar v (HsVar _ (L _ vv)) = v == idName vv - isVar _ _ = False - - if | usesAllParams -> success - | otherwise -> failure $ "`" ++ a ++ "` has unused arguments." - -checkRule (NotDefined a) = withParsedCode $ \m -> do - if | null (allDefinitionsOf a m) -> success - | otherwise -> failure $ "`" ++ a ++ "` should not be defined." - -checkRule (NotUsed a) = withParsedCode $ \m -> do - let exprUse :: HsExpr GhcPs -> Bool - exprUse (HsVar _ (L _ v)) | idName v == a = True - exprUse _ = False - - if | everything (||) (mkQ False exprUse) m - -> failure $ "`" ++ a ++ "` should not be used." - | otherwise -> success - -checkRule (ContainsMatch tmpl topLevel card) = withParsedCode $ \m -> do - tmpl <- ghcParseCode ["TemplateHaskell", "TemplateHaskellQuotes"] (T.pack tmpl) - let n = case tmpl of - GHCParsed (HsModule {hsmodDecls=[tmpl]}) -> - let decls | topLevel = concat $ gmapQ (mkQ [] id) m - | otherwise = everything (++) (mkQ [] (:[])) m - in length (filter (match tmpl) decls) - GHCParsed (HsModule {hsmodImports=[tmpl]}) -> - length $ filter (match tmpl) $ concat $ gmapQ (mkQ [] id) m - if | hasCardinality card n -> success - | otherwise -> failure $ "Wrong number of matches." - -checkRule (MatchesRegex pat card) = do - src <- getSourceCode - let n = rangeSize (bounds (src =~ pat :: MatchArray)) - if | hasCardinality card n -> success - | otherwise -> failure $ "Wrong number of matches." - -checkRule (OnFailure msg rule) = do - result <- checkRule rule - case result of - Just (_:_) -> failure msg - other -> return other - -checkRule (IfThen a b) = do - cond <- checkRule a - case cond of - Just [] -> checkRule b - Just _ -> success - Nothing -> abort - -checkRule (AllOf rules) = do - results <- sequence <$> mapM checkRule rules - return (concat <$> results) - -checkRule (AnyOf rules) = do - results <- sequence <$> mapM checkRule rules - return $ (<$> results) $ \errs -> - if any null errs then [] else ["No alternatives succeeded."] - -checkRule (NotThis rule) = do - result <- checkRule rule - case result of - Just [] -> failure "A rule matched, but shouldn't have." - Just _ -> success - Nothing -> abort - -checkRule (MaxLineLength len) = do - src <- getSourceCode - if | any (> len) (C.length <$> C.lines src) -> - failure $ "One or more lines longer than " ++ show len ++ " characters." - | otherwise -> success - -checkRule (NoWarningsExcept ex) = do - diags <- getDiagnostics - let warns = filter (\(Exts.SrcSpanInfo _ _,_,x) -> not (any (x =~) ex)) diags - if | null warns -> success - | otherwise -> do - let (Exts.SrcSpanInfo (Exts.SrcSpan _ l c _ _) _,_,x) = head warns - failure $ "Warning found at line " ++ show l ++ ", column " ++ show c - -checkRule (TypeSignatures b) = withParsedCode $ \m -> do - let defs = nub $ topLevelNames m - noTypeSig = defs \\ typeSignatures m - - if | null noTypeSig || not b -> success - | otherwise -> failure $ "The declaration of `" ++ head noTypeSig - ++ "` has no type signature." - -checkRule (Blacklist bl) = withParsedCode $ \m -> do - let symbols = nub $ everything (++) (mkQ [] idNameList) m - blacklisted = intersect bl symbols - - idNameList x = [idName x] - - if | null blacklisted -> success - | otherwise -> failure $ "The symbol `" ++ head blacklisted - ++ "` is blacklisted." - -checkRule (Whitelist wl) = withParsedCode $ \m -> do - let symbols = nub $ everything (++) (mkQ [] idNameList) m - notWhitelisted = symbols \\ wl - - idNameList x = [idName x] - - if | null notWhitelisted -> success - | otherwise -> failure $ "The symbol `" ++ head notWhitelisted - ++ "` is not whitelisted." - -checkRule _ = abort - -allDefinitionsOf :: String -> HsModule GhcPs -> [GRHSs GhcPs (LHsExpr GhcPs)] -allDefinitionsOf a m = everything (++) (mkQ [] defs) m - where defs :: HsBind GhcPs -> [GRHSs GhcPs (LHsExpr GhcPs)] - defs (FunBind{fun_id=(L _ funid), fun_matches=(MG{mg_alts=(L _ matches)})}) - | idName funid == a = concat $ funcDefs <$> matches - defs (PatBind{pat_lhs=pat, pat_rhs=rhs}) | patDefines pat a = [rhs] - defs _ = [] - - funcDefs :: LMatch GhcPs (LHsExpr GhcPs) -> [GRHSs GhcPs (LHsExpr GhcPs)] - funcDefs (L _ (Match{m_grhss=rhs})) = [rhs] - funcDefs _ = [] - -allBindingsOf :: String -> HsModule GhcPs -> [SDoc] -allBindingsOf a m = everything (++) (mkQ [] binds) m - where binds :: HsBind GhcPs -> [SDoc] - binds (FunBind{fun_id=(L _ funid), fun_matches=matches}) | idName funid == a = [pprFunBind matches] - binds (PatBind{pat_lhs=pat, pat_rhs=rhs}) | patDefines pat a = [pprPatBind pat rhs] - binds _ = [] - -topLevelNames :: HsModule GhcPs -> [String] -topLevelNames (HsModule {hsmodDecls=decls}) = concat $ names <$> decls - where names :: LHsDecl GhcPs -> [String] - names (L _ (ValD _ FunBind{fun_id=(L _ funid)})) = [idName funid] - names (L _ (ValD _ PatBind{pat_lhs=pat})) = [patName pat] - names _ = [] - - patName :: LPat GhcPs -> String - patName (VarPat _ (L _ patid)) = idName patid - patName (ParPat _ pat) = patName pat - patName _ = [] - -typeSignatures :: HsModule GhcPs -> [String] -typeSignatures (HsModule {hsmodDecls=decls}) = concat $ typeSigNames <$> decls - where typeSigNames :: LHsDecl GhcPs -> [String] - typeSigNames (L _ (SigD _ (TypeSig _ sigids _))) = locatedIdName <$> sigids - typeSigNames _ = [] - - locatedIdName (L _ s) = idName s - -patDefines :: LPat GhcPs -> String -> Bool -patDefines (VarPat _ (L _ patid)) a = idName patid == a -patDefines (ParPat _ pat) a = patDefines pat a -patDefines _ a = False - diff --git a/codeworld-compiler/src/CodeWorld/Compile/Requirements/Language.hs b/codeworld-compiler/src/CodeWorld/Compile/Requirements/Language.hs deleted file mode 100644 index 9d46ed75d..000000000 --- a/codeworld-compiler/src/CodeWorld/Compile/Requirements/Language.hs +++ /dev/null @@ -1,168 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RecordWildCards #-} - -{- - Copyright 2019 The CodeWorld Authors. All rights reserved. - - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. --} - -module CodeWorld.Compile.Requirements.Language (parseRequirement) where - -import CodeWorld.Compile.Framework -import CodeWorld.Compile.Requirements.LegacyLanguage -import CodeWorld.Compile.Requirements.Types -import Control.Applicative -import Data.Aeson -import Data.Aeson.Types (explicitParseFieldMaybe) -import qualified Data.Aeson.Types as Aeson -import Data.Either -import Data.Foldable -import Data.Maybe -import Data.Text (Text) -import qualified Data.Text as T -import qualified Data.Text.Encoding as T -import qualified Data.Yaml as Yaml -import Language.Haskell.Exts.SrcLoc - -instance FromJSON Requirement where - parseJSON = withObject "Requirement" $ \v -> - Requirement <$> v .: "Description" - <*> v .: "Rules" - -instance FromJSON Rule where - parseJSON = withObject "Rule" $ \o -> do - choices <- sequence - [ explicitParseFieldMaybe definedByFunction o "definedByFunction" - , explicitParseFieldMaybe matchesExpected o "matchesExpected" - , explicitParseFieldMaybe hasSimpleParams o "hasSimpleParams" - , explicitParseFieldMaybe usesAllParams o "usesAllParams" - , explicitParseFieldMaybe notDefined o "notDefined" - , explicitParseFieldMaybe notUsed o "notUsed" - , explicitParseFieldMaybe containsMatch o "containsMatch" - , explicitParseFieldMaybe matchesRegex o "matchesRegex" - , explicitParseFieldMaybe ifThen o "ifThen" - , explicitParseFieldMaybe allOf o "all" - , explicitParseFieldMaybe anyOf o "any" - , explicitParseFieldMaybe notThis o "not" - , explicitParseFieldMaybe maxLineLength o "maxLineLength" - , explicitParseFieldMaybe noWarningsExcept o "noWarningsExcept" - , explicitParseFieldMaybe typeSignatures o "typeSignatures" - , explicitParseFieldMaybe blacklist o "blacklist" - , explicitParseFieldMaybe whitelist o "whitelist" - ] - case catMaybes choices of - [r] -> decorateWith o r - [] -> fail "No recognized rule type was defined." - _ -> fail "More than one type was found for a single rule." - -decorateWith :: Aeson.Object -> Rule -> Aeson.Parser Rule -decorateWith obj = wrapCustomMessage - where wrapCustomMessage rule = do - msg <- obj .:? "explanation" - case msg of Just str -> return (OnFailure str rule) - _ -> return rule - -definedByFunction :: Aeson.Value -> Aeson.Parser Rule -definedByFunction = withObject "definedByFunction" $ \o -> - DefinedByFunction <$> o .: "variable" - <*> o .: "function" - -matchesExpected :: Aeson.Value -> Aeson.Parser Rule -matchesExpected = withObject "matchesExpected" $ \o -> - MatchesExpected <$> o .: "variable" - <*> o .: "hash" - -hasSimpleParams :: Aeson.Value -> Aeson.Parser Rule -hasSimpleParams = withText "hasSimpleParams" $ \t -> - return $ HasSimpleParams $ T.unpack t - -usesAllParams :: Aeson.Value -> Aeson.Parser Rule -usesAllParams = withText "usesAllParams" $ \t -> - return $ UsesAllParams $ T.unpack t - -notDefined :: Aeson.Value -> Aeson.Parser Rule -notDefined = withText "notDefined" $ \t -> - return $ NotDefined $ T.unpack t - -notUsed :: Aeson.Value -> Aeson.Parser Rule -notUsed = withText "notUsed" $ \t -> - return $ NotUsed $ T.unpack t - -containsMatch :: Aeson.Value -> Aeson.Parser Rule -containsMatch = withObject "containsMatch" $ \o -> - ContainsMatch <$> o .: "template" - <*> o .:? "topLevel" .!= True - <*> o .:? "cardinality" .!= atLeastOne - -matchesRegex :: Aeson.Value -> Aeson.Parser Rule -matchesRegex = withObject "matchesRegex" $ \o -> - MatchesRegex <$> o .: "pattern" - <*> o .:? "cardinality" .!= atLeastOne - -ifThen :: Aeson.Value -> Aeson.Parser Rule -ifThen = withObject "ifThen" $ \o -> - OnFailure <$> o .: "if" - <*> o .: "then" - -allOf :: Aeson.Value -> Aeson.Parser Rule -allOf v = AllOf <$> withArray "all" (mapM parseJSON . toList) v - -anyOf :: Aeson.Value -> Aeson.Parser Rule -anyOf v = AnyOf <$> withArray "any" (mapM parseJSON . toList) v - -notThis :: Aeson.Value -> Aeson.Parser Rule -notThis v = NotThis <$> parseJSON v - -maxLineLength :: Aeson.Value -> Aeson.Parser Rule -maxLineLength v = MaxLineLength <$> parseJSON v - -noWarningsExcept :: Aeson.Value -> Aeson.Parser Rule -noWarningsExcept v = NoWarningsExcept <$> withArray "exceptions" (mapM parseJSON . toList) v - -typeSignatures :: Aeson.Value -> Aeson.Parser Rule -typeSignatures v = TypeSignatures <$> parseJSON v - -blacklist :: Aeson.Value -> Aeson.Parser Rule -blacklist v = Blacklist <$> withArray "blacklist" (mapM parseJSON . toList) v - -whitelist :: Aeson.Value -> Aeson.Parser Rule -whitelist v = Whitelist <$> withArray "whitelist" (mapM parseJSON . toList) v - -instance FromJSON Cardinality where - parseJSON val = parseAsNum val <|> parseAsObj val - where parseAsNum val = do - n <- parseJSON val - return (Cardinality (Just n) (Just n)) - parseAsObj = withObject "cardinality" $ \o -> do - exactly <- o .:? "exactly" - mini <- o .:? "atLeast" - maxi <- o .:? "atMost" - case (exactly, mini, maxi) of - (Just n, Nothing, Nothing) -> - return (Cardinality (Just n) (Just n)) - (Nothing, Nothing, Nothing) -> - fail "Missing cardinality" - (Nothing, m, n) -> - return (Cardinality m n) - -parseRequirement :: Int -> Int -> Text -> Either String Requirement -parseRequirement ln col txt - | isLegacyFormat txt = parseLegacyRequirement ln col txt - | otherwise = either (Left . prettyPrintYamlParseException ln col) Right $ - Yaml.decodeEither' (T.encodeUtf8 txt) - -prettyPrintYamlParseException ln col e = - formatLocation srcSpan ++ ": " ++ Yaml.prettyPrintParseException e - where srcSpan = SrcSpanInfo loc [] - loc = SrcSpan "program.hs" ln col ln col diff --git a/codeworld-compiler/src/CodeWorld/Compile/Requirements/LegacyLanguage.hs b/codeworld-compiler/src/CodeWorld/Compile/Requirements/LegacyLanguage.hs deleted file mode 100644 index 17d87a53d..000000000 --- a/codeworld-compiler/src/CodeWorld/Compile/Requirements/LegacyLanguage.hs +++ /dev/null @@ -1,151 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RecordWildCards #-} - -{- - Copyright 2019 The CodeWorld Authors. All rights reserved. - - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. --} - -module CodeWorld.Compile.Requirements.LegacyLanguage ( - isLegacyFormat, - parseLegacyRequirement - ) where - -import CodeWorld.Compile.Framework -import CodeWorld.Compile.Requirements.Types -import Data.Char -import Data.Either -import Data.Text (Text) -import qualified Data.Text as T -import Data.Void -import Text.Megaparsec -import Text.Megaparsec.Char -import qualified Text.Megaparsec.Char.Lexer as L -import Text.Regex.TDFA ((=~)) -import Text.Regex.TDFA.Text () - ------------------------------------------------------------------ --- WARNING! --- --- This module defines a legacy parser for an old requirements --- format. Usually, it should NOT be updated when new rules --- types are added. Instead, please add them to --- CodeWorld.Compile.Requirements.Language so that they have --- a YAML-based format. ------------------------------------------------------------------ - -type Parser = Parsec Void String - -ws :: Parser () -ws = L.space space1 empty empty - -lexeme :: Parser a -> Parser a -lexeme = L.lexeme ws - -symbol :: String -> Parser String -symbol = L.symbol ws - -quote :: Parser Char -quote = lexeme (char '\"') - -nonquote :: Parser Char -nonquote = anySingleBut '\"' - -identifier :: Parser String -identifier = lexeme ((:) <$> letterChar <*> many alphaNumChar) - -integer :: Parser Int -integer = lexeme L.decimal - -legacyRequirementParser :: Parser Requirement -legacyRequirementParser = do - optional ws - optional (symbol "REQUIRES") - doc <- between quote quote (many nonquote) - rules <- many ruleParser - eof - return (Requirement doc rules) - -ruleParser :: Parser Rule -ruleParser = definedByParser <|> - matchesExpectedParser <|> - simpleParamsParser <|> - usesAllParamsParser <|> - notDefinedParser <|> - notUsedParser - -definedByParser :: Parser Rule -definedByParser = do - symbol "definedByFunction" - symbol "(" - a <- identifier - symbol "," - b <- identifier - symbol ")" - return (DefinedByFunction a b) - -matchesExpectedParser :: Parser Rule -matchesExpectedParser = do - symbol "matchesExpected" - symbol "(" - a <- identifier - symbol "," - expectedHash <- integer - symbol ")" - return (MatchesExpected a expectedHash) - -simpleParamsParser :: Parser Rule -simpleParamsParser = do - symbol "hasSimpleParams" - symbol "(" - a <- identifier - symbol ")" - return (HasSimpleParams a) - -usesAllParamsParser :: Parser Rule -usesAllParamsParser = do - symbol "usesAllParams" - symbol "(" - a <- identifier - symbol ")" - return (UsesAllParams a) - -notDefinedParser :: Parser Rule -notDefinedParser = do - symbol "notDefined" - symbol "(" - a <- identifier - symbol ")" - return (NotDefined a) - -notUsedParser :: Parser Rule -notUsedParser = do - symbol "notUsed" - symbol "(" - a <- identifier - symbol ")" - return (NotUsed a) - -isLegacyFormat :: Text -> Bool -isLegacyFormat txt = - txt =~ ("^[[:space:]]*(REQUIRES)?[[:space:]]*\"[^\n]*\".*" :: Text) - -parseLegacyRequirement :: Int -> Int -> Text -> Either String Requirement -parseLegacyRequirement ln col txt = - either (Left . errorBundlePretty) Right $ - snd $ runParser' legacyRequirementParser initialState - where str = T.unpack txt - initialState = State str 0 posState - posState = PosState str 0 srcPos (mkPos 8) (replicate (col - 1) ' ') - srcPos = SourcePos "program.hs" (mkPos ln) (mkPos col) diff --git a/codeworld-compiler/src/CodeWorld/Compile/Requirements/Matcher.hs b/codeworld-compiler/src/CodeWorld/Compile/Requirements/Matcher.hs deleted file mode 100644 index 59773e109..000000000 --- a/codeworld-compiler/src/CodeWorld/Compile/Requirements/Matcher.hs +++ /dev/null @@ -1,223 +0,0 @@ -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE PackageImports #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE ViewPatterns #-} - -{- - Copyright 2019 The CodeWorld Authors. All rights reserved. - - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. --} - -module CodeWorld.Compile.Requirements.Matcher where - -import Control.Monad -import Data.Generics -import Data.Generics.Twins -import Data.List -import Data.Maybe - -import "ghc-lib-parser" HsSyn -import "ghc-lib-parser" OccName -import "ghc-lib-parser" RdrName -import "ghc-lib-parser" SrcLoc - -class (Data a, Typeable a) => Template a where - toSplice :: a -> Maybe (HsSplice GhcPs) - fromBracket :: (HsBracket GhcPs) -> Maybe a - - toParens :: a -> Maybe a - toTuple :: a -> Maybe [a] - toVar :: a -> Maybe a - toCon :: a -> Maybe a - toLit :: a -> Maybe a - toNum :: a -> Maybe a - toChar :: a -> Maybe a - toStr :: a -> Maybe a - toName :: a -> Maybe a - -instance Template (Pat GhcPs) where - toSplice (SplicePat _ s) = Just s - toSplice _ = Nothing - - fromBracket (PatBr _ p) = Just p - fromBracket _ = Nothing - - toParens (ParPat _ x) = Just x - toParens _ = Nothing - - toTuple (TuplePat _ ps _) = Just ps - toTuple _ = Nothing - - toVar x@(VarPat _ _) = Just x - toVar _ = Nothing - - toCon x@(ConPatIn _ _) = Just x - toCon x@(ConPatOut {}) = Just x - toCon _ = Nothing - - toLit x@(LitPat _ _) = Just x - toLit _ = Nothing - - toNum x@(LitPat _ (HsInt _ _)) = Just x - toNum x@(LitPat _ (HsInteger _ _ _)) = Just x - toNum x@(LitPat _ (HsRat _ _ _)) = Just x - toNum x@(LitPat _ (HsIntPrim _ _)) = Just x - toNum x@(LitPat _ (HsWordPrim _ _)) = Just x - toNum x@(LitPat _ (HsInt64Prim _ _)) = Just x - toNum x@(LitPat _ (HsWord64Prim _ _)) = Just x - toNum x@(LitPat _ (HsFloatPrim _ _)) = Just x - toNum x@(LitPat _ (HsDoublePrim _ _)) = Just x - toNum _ = Nothing - - toChar x@(LitPat _ (HsChar _ _)) = Just x - toChar x@(LitPat _ (HsCharPrim _ _)) = Just x - toChar _ = Nothing - - toStr x@(LitPat _ (HsString _ _)) = Just x - toStr x@(LitPat _ (HsStringPrim _ _)) = Just x - toStr _ = Nothing - -instance Template (HsExpr GhcPs) where - toSplice (HsSpliceE _ s) = Just s - toSplice _ = Nothing - - fromBracket (ExpBr _ (L _ e)) = Just e - fromBracket _ = Nothing - - toParens (HsPar _ (L _ x)) = Just x - toParens _ = Nothing - - toTuple (ExplicitTuple _ args _) = Just (concat $ tupArgExpr <$> args) - toTuple _ = Nothing - - toVar x@(HsVar _ _) = Just x - toVar _ = Nothing - - toCon x@(HsConLikeOut _ _) = Just x - toCon _ = Nothing - - toLit x@(HsLit _ _) = Just x - toLit x@(NegApp _ (L _ (HsLit _ _)) _) = Just x - toLit _ = Nothing - - toNum x@(HsLit _ (HsInt _ _)) = Just x - toNum x@(HsLit _ (HsInteger _ _ _)) = Just x - toNum x@(HsLit _ (HsRat _ _ _)) = Just x - toNum x@(HsLit _ (HsIntPrim _ _)) = Just x - toNum x@(HsLit _ (HsWordPrim _ _)) = Just x - toNum x@(HsLit _ (HsInt64Prim _ _)) = Just x - toNum x@(HsLit _ (HsWord64Prim _ _)) = Just x - toNum x@(HsLit _ (HsFloatPrim _ _)) = Just x - toNum x@(HsLit _ (HsDoublePrim _ _)) = Just x - toNum x@(NegApp _ (L _ (toNum -> Just _)) _)= Just x - toNum _ = Nothing - - toChar x@(HsLit _ (HsChar _ _)) = Just x - toChar x@(HsLit _ (HsCharPrim _ _)) = Just x - toChar _ = Nothing - - toStr x@(HsLit _ (HsString _ _)) = Just x - toStr x@(HsLit _ (HsStringPrim _ _)) = Just x - toStr _ = Nothing - -tupArgExpr :: (LHsTupArg GhcPs) -> [HsExpr GhcPs] -tupArgExpr (L _ (Present _ (L _ x))) = [x] -tupArgExpr _ = [] - -match :: Data a => a -> a -> Bool -match tmpl val = matchQ tmpl val - -matchQ :: GenericQ (GenericQ Bool) -matchQ = matchesGhcPs - ||| (matchesSpecials :: (Pat GhcPs) -> (Pat GhcPs) -> Maybe Bool) - ||| (matchesSpecials :: (HsExpr GhcPs) -> (HsExpr GhcPs) -> Maybe Bool) - ||| matchesWildcard - ||| mismatchedNames - ||| structuralEq - -matchesGhcPs :: GhcPs -> GhcPs -> Maybe Bool -matchesGhcPs _ _ = Just True - -matchesSpecials :: Template a => a -> a -> Maybe Bool -matchesSpecials (toParens -> Just x) y = Just (matchQ x y) -matchesSpecials x (toParens -> Just y) = Just (matchQ x y) -matchesSpecials (toSplice -> - Just (HsTypedSplice _ _ _ (L _ (HsApp _ op (L _ (HsBracket _ (fromBracket -> Just tmpl))))))) x = - matchBrackets op tmpl x -matchesSpecials (toSplice -> - Just (HsUntypedSplice _ _ _ (L _ (HsApp _ op (L _ (HsBracket _ (fromBracket -> Just tmpl))))))) x = - matchBrackets op tmpl x -matchesSpecials (toSplice -> - Just (HsTypedSplice _ _ _ (L _ (HsApp _ op (L _ (ExplicitList _ _ (sequence . map (\(L _ (HsBracket _ b)) -> fromBracket b) -> Just xs))))))) x = - matchLogical op xs x -matchesSpecials (toSplice -> - Just (HsUntypedSplice _ _ _ (L _ (HsApp _ op (L _ (ExplicitList _ _ (sequence . map (\(L _ (HsBracket _ b)) -> fromBracket b) -> Just xs))))))) x = - matchLogical op xs x -matchesSpecials (toSplice -> - Just (HsTypedSplice _ _ _ (L _ (HsVar _ (L _ id))))) x = - matchSimple id x -matchesSpecials (toSplice -> - Just (HsUntypedSplice _ _ _ (L _ (HsVar _ (L _ id))))) x = - matchSimple id x -matchesSpecials _ _ = Nothing - -matchBrackets :: Template a => LHsExpr GhcPs -> a -> a -> Maybe Bool -matchBrackets op tmpl x = case op of - (L _ (HsVar _ (L _ id))) -> - case idName id of - "tupleOf" -> case toTuple x of Just xs -> Just (all (match tmpl) xs); Nothing -> Just False - "contains" -> Just (everything (||) (mkQ False (match tmpl)) x) - _ -> Nothing - _ -> Nothing - -matchLogical :: Template a => LHsExpr GhcPs -> [a] -> a -> Maybe Bool -matchLogical op xs x = case op of - (L _ (HsVar _ (L _ id))) -> - case idName id of - "allOf" -> Just (all (flip match x) xs) - "anyOf" -> Just (any (flip match x) xs) - "noneOf" -> Just (not (any (flip match x) xs)) - _ -> Nothing - _ -> Nothing - -matchSimple :: Template a => IdP GhcPs -> a -> Maybe Bool -matchSimple id x = case idName id of - "any" -> Just True - "var" -> case toVar x of Just _ -> Just True; Nothing -> Just False - "con" -> case toCon x of Just _ -> Just True; Nothing -> Just False - "lit" -> case toLit x of Just _ -> Just True; Nothing -> Just False - "num" -> case toNum x of Just _ -> Just True; Nothing -> Just False - "char" -> case toChar x of Just _ -> Just True; Nothing -> Just False - "str" -> case toStr x of Just _ -> Just True; Nothing -> Just False - _ -> Nothing - -matchesWildcard :: IdP GhcPs -> IdP GhcPs -> Maybe Bool -matchesWildcard id _ | "_" `isPrefixOf` (idName id) && "_" `isSuffixOf` (idName id) = Just True -matchesWildcard _ _ = Nothing - -mismatchedNames :: IdP GhcPs -> IdP GhcPs -> Maybe Bool -mismatchedNames x y = if idName x /= idName y then Just False else Nothing - -structuralEq :: (Data a, Data b) => a -> b -> Bool -structuralEq x y = toConstr x == toConstr y && and (gzipWithQ matchQ x y) - -(|||) :: (Typeable a, Typeable b, Typeable x) - => (x -> x -> Maybe Bool) - -> (a -> b -> Bool) - -> (a -> b -> Bool) -f ||| g = \x y -> fromMaybe (g x y) (join (f <$> cast x <*> cast y)) -infixr 0 ||| - -idName :: IdP GhcPs -> String -idName = occNameString . rdrNameOcc diff --git a/codeworld-compiler/src/CodeWorld/Compile/Requirements/Types.hs b/codeworld-compiler/src/CodeWorld/Compile/Requirements/Types.hs deleted file mode 100644 index e791c7887..000000000 --- a/codeworld-compiler/src/CodeWorld/Compile/Requirements/Types.hs +++ /dev/null @@ -1,66 +0,0 @@ -{- - Copyright 2019 The CodeWorld Authors. All rights reserved. - - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. --} - -module CodeWorld.Compile.Requirements.Types where - -data Requirement = Requirement { - requiredDescription :: String, - requiredRules :: [Rule] - } - deriving Show - -data Rule = DefinedByFunction String String - | MatchesExpected String Int - | HasSimpleParams String - | UsesAllParams String - | NotDefined String - | NotUsed String - | ContainsMatch { - matchTemplate :: String, - matchTopLevel :: Bool, - matchCardinality :: Cardinality - } - | MatchesRegex { - regexPattern :: String, - regexCardinality :: Cardinality - } - | OnFailure String Rule - | IfThen Rule Rule - | AllOf [Rule] - | AnyOf [Rule] - | NotThis Rule - | MaxLineLength Int - | NoWarningsExcept [String] - | TypeSignatures Bool - | Blacklist [String] - | Whitelist [String] - deriving Show - -data Cardinality = Cardinality { - atLeast :: Maybe Int, - atMost :: Maybe Int - } - deriving Show - -anyNumber, exactlyOne, atLeastOne :: Cardinality -anyNumber = Cardinality Nothing Nothing -exactlyOne = Cardinality (Just 1) (Just 1) -atLeastOne = Cardinality (Just 1) Nothing - -hasCardinality :: Cardinality -> Int -> Bool -hasCardinality (Cardinality (Just k) _) n | n < k = False -hasCardinality (Cardinality _ (Just k)) n | n > k = False -hasCardinality _ _ = True diff --git a/codeworld-compiler/src/CodeWorld/Compile/Stages.hs b/codeworld-compiler/src/CodeWorld/Compile/Stages.hs index 651c472bb..79b40fa3d 100644 --- a/codeworld-compiler/src/CodeWorld/Compile/Stages.hs +++ b/codeworld-compiler/src/CodeWorld/Compile/Stages.hs @@ -23,11 +23,9 @@ module CodeWorld.Compile.Stages ( checkDangerousSource , checkCodeConventions - , checkRequirements ) where import CodeWorld.Compile.Framework -import CodeWorld.Compile.Requirements import Control.Monad import Control.Monad.State import Data.Array diff --git a/codeworld-requirements/codeworld-requirements.cabal b/codeworld-requirements/codeworld-requirements.cabal index 455f5b36e..4144ebd49 100644 --- a/codeworld-requirements/codeworld-requirements.cabal +++ b/codeworld-requirements/codeworld-requirements.cabal @@ -13,14 +13,21 @@ extra-source-files: ChangeLog.md cabal-version: >=1.10 library - exposed-modules: CodeWorld.Requirements.RequirementsChecker - other-modules: CodeWorld.Requirements.Framework + if impl(ghcjs) + hs-source-dirs: stub-src + build-depends: ghc-api-ghcjs + else + hs-source-dirs: src + other-modules: CodeWorld.Requirements.Framework CodeWorld.Requirements.Requirements CodeWorld.Requirements.Checker.Eval CodeWorld.Requirements.Checker.Language CodeWorld.Requirements.Checker.Matcher CodeWorld.Requirements.Checker.Types - -- other-extensions: + build-depends: ghc >= 8.6.5, + ghc-boot-th + + exposed-modules: CodeWorld.Requirements.RequirementsChecker build-depends: base, aeson, array, @@ -30,8 +37,6 @@ library directory, exceptions, filepath, - ghc >= 8.6.5, - ghc-boot-th, hashable, haskell-src-exts >= 1.20, mtl, @@ -43,5 +48,4 @@ library text, yaml, zlib - hs-source-dirs: src default-language: Haskell2010 diff --git a/codeworld-requirements/stub-src/CodeWorld/Requirements/RequirementsChecker.hs b/codeworld-requirements/stub-src/CodeWorld/Requirements/RequirementsChecker.hs new file mode 100644 index 000000000..62a0da88b --- /dev/null +++ b/codeworld-requirements/stub-src/CodeWorld/Requirements/RequirementsChecker.hs @@ -0,0 +1,6 @@ +module CodeWorld.Requirements.RequirementsChecker (plugin) where + + import Plugins + + plugin :: Plugin + plugin = defaultPlugin \ No newline at end of file From 7a5bd1e1c56e06a108d6b9ee1fa6336f82c6f817 Mon Sep 17 00:00:00 2001 From: Daniel Marshall Date: Fri, 9 Aug 2019 12:01:41 +0100 Subject: [PATCH 4/6] Added installation of ghc-api-ghcjs to install.sh --- codeworld-compiler/src/CodeWorld/Compile.hs | 4 ---- install.sh | 4 ++++ 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/codeworld-compiler/src/CodeWorld/Compile.hs b/codeworld-compiler/src/CodeWorld/Compile.hs index 1dc79215d..b72bf1b1f 100644 --- a/codeworld-compiler/src/CodeWorld/Compile.hs +++ b/codeworld-compiler/src/CodeWorld/Compile.hs @@ -150,8 +150,6 @@ buildArgs "codeworld" = , "base" , "-package" , "codeworld-base" - , "-package" - , "codeworld-requirements" , "-fplugin" , "CodeWorld.Requirements.RequirementsChecker" , "-Wall" @@ -202,8 +200,6 @@ buildArgs "haskell" = , "codeworld-api" , "-package" , "QuickCheck" - , "-package" - , "codeworld-requirements" , "-fplugin" , "CodeWorld.Requirements.RequirementsChecker" ] diff --git a/install.sh b/install.sh index 271ed9f2a..c276e05de 100755 --- a/install.sh +++ b/install.sh @@ -229,6 +229,10 @@ fi if [ ! -f $BUILD/progress/ghcjs-boot ]; then run $BUILD/ghcjs ghcjs-boot -j$NPROC --no-prof --no-haddock -s lib/boot touch $BUILD/progress/ghcjs-boot + + run . cabal_install --ghcjs ./build/ghcjs/lib/ghc-api-ghcjs \ + ./build/ghcjs/lib/template-haskell-ghcjs \ + ./build/ghcjs/lib/ghci-ghcjs fi # Install tools to build CodeMirror editor. From 5c67b536fccd7ebb5de89fdc4ea0eba4ab724950 Mon Sep 17 00:00:00 2001 From: Daniel Marshall Date: Mon, 12 Aug 2019 10:21:24 +0100 Subject: [PATCH 5/6] Fixed ghc-lib-parser version bounds and brought back compiler framework code --- codeworld-compiler/codeworld-compiler.cabal | 1 + .../src/CodeWorld/Compile/Framework.hs | 100 +++++++++++++++++- 2 files changed, 99 insertions(+), 2 deletions(-) diff --git a/codeworld-compiler/codeworld-compiler.cabal b/codeworld-compiler/codeworld-compiler.cabal index 60e5486af..2fce56257 100644 --- a/codeworld-compiler/codeworld-compiler.cabal +++ b/codeworld-compiler/codeworld-compiler.cabal @@ -48,6 +48,7 @@ Library directory, exceptions, filepath, + ghc-lib-parser > 0.20190703, hashable, haskell-src-exts >= 1.20, megaparsec, diff --git a/codeworld-compiler/src/CodeWorld/Compile/Framework.hs b/codeworld-compiler/src/CodeWorld/Compile/Framework.hs index 5a7743929..02380168f 100644 --- a/codeworld-compiler/src/CodeWorld/Compile/Framework.hs +++ b/codeworld-compiler/src/CodeWorld/Compile/Framework.hs @@ -50,6 +50,23 @@ import System.IO import System.IO.Temp (withSystemTempDirectory) import System.Process +import qualified "ghc-lib-parser" Config as GHCParse +import qualified "ghc-lib-parser" DynFlags as GHCParse +import qualified "ghc-lib-parser" FastString as GHCParse +import qualified "ghc-lib-parser" Fingerprint as GHCParse +import qualified "ghc-lib-parser" GHC.LanguageExtensions.Type as GHCParse +import qualified "ghc-lib-parser" HeaderInfo as GHCParse +import qualified "ghc-lib-parser" HsExtension as GHCParse +import qualified "ghc-lib-parser" HsSyn as GHCParse +import qualified "ghc-lib-parser" HscTypes as GHCParse +import qualified "ghc-lib-parser" Lexer as GHCParse +import qualified "ghc-lib-parser" Panic as GHCParse +import qualified "ghc-lib-parser" Parser as GHCParse +import qualified "ghc-lib-parser" Platform as GHCParse +import qualified "ghc-lib-parser" SrcLoc as GHCParse +import qualified "ghc-lib-parser" StringBuffer as GHCParse +import qualified "ghc-lib-parser" ToolSettings as GHCParse + data Stage = ErrorCheck | FullBuild FilePath -- ^ Output file location @@ -78,7 +95,8 @@ data CompileState = CompileState { compileStatus :: CompileStatus, compileErrors :: [Diagnostic], compileReadSource :: Maybe ByteString, - compileParsedSource :: Maybe ParsedCode + compileParsedSource :: Maybe ParsedCode, + compileGHCParsedSource :: Maybe GHCParsedCode } type MonadCompile m = (MonadState CompileState m, MonadIO m, MonadMask m) @@ -89,6 +107,8 @@ type Diagnostic = (SrcSpanInfo, CompileStatus, String) data ParsedCode = Parsed (Module SrcSpanInfo) | NoParse deriving Show +data GHCParsedCode = GHCParsed (GHCParse.HsModule GHCParse.GhcPs) | GHCNoParse + getSourceCode :: MonadCompile m => m ByteString getSourceCode = do cached <- gets compileReadSource @@ -111,6 +131,17 @@ getParsedCode = do modify $ \state -> state { compileParsedSource = Just parsed } return parsed +getGHCParsedCode :: MonadCompile m => m GHCParsedCode +getGHCParsedCode = do + cached <- gets compileGHCParsedSource + case cached of + Just parsed -> return parsed + Nothing -> do + source <- getSourceCode + parsed <- ghcParseCode ["TupleSections"] (decodeUtf8 source) + modify $ \state -> state { compileGHCParsedSource = Just parsed } + return parsed + getDiagnostics :: MonadCompile m => m [Diagnostic] getDiagnostics = do diags <- gets compileErrors @@ -156,6 +187,71 @@ parseCode extraExts src = do ParseOk mod -> Parsed mod ParseFailed _ _ -> NoParse +ghcExtensionsByName :: Map String GHCParse.Extension +ghcExtensionsByName = M.fromList [ + (GHCParse.flagSpecName spec, GHCParse.flagSpecFlag spec) + | spec <- GHCParse.xFlags ] + +applyExtensionToFlags :: GHCParse.DynFlags -> String -> GHCParse.DynFlags +applyExtensionToFlags dflags name + | "No" `isPrefixOf` name = + GHCParse.xopt_unset dflags $ fromJust $ M.lookup (drop 2 name) ghcExtensionsByName + | otherwise = + GHCParse.xopt_set dflags $ fromJust $ M.lookup name ghcExtensionsByName + +ghcParseCode :: MonadCompile m => [String] -> Text -> m GHCParsedCode +ghcParseCode extraExts src = do + sourceMode <- gets compileMode + let buffer = GHCParse.stringToStringBuffer (T.unpack src) + exts | sourceMode == "codeworld" = codeworldModeExts ++ extraExts + | otherwise = extraExts + defaultFlags = GHCParse.defaultDynFlags fakeSettings fakeLlvmConfig + dflags = foldl' applyExtensionToFlags defaultFlags exts + dflagsWithPragmas <- liftIO $ + fromMaybe dflags <$> parsePragmasIntoDynFlags dflags "program.hs" buffer + let location = GHCParse.mkRealSrcLoc (GHCParse.mkFastString "program.hs") 1 1 + state = GHCParse.mkPState dflagsWithPragmas buffer location + return $ case GHCParse.unP GHCParse.parseModule state of + GHCParse.POk _ (GHCParse.L _ mod) -> GHCParsed mod + GHCParse.PFailed _ -> GHCNoParse + +fakeSettings :: GHCParse.Settings +fakeSettings = + GHCParse.Settings { + GHCParse.sGhcNameVersion = GHCParse.GhcNameVersion { + GHCParse.ghcNameVersion_programName = "ghcjs", + GHCParse.ghcNameVersion_projectVersion = GHCParse.cProjectVersion + }, + GHCParse.sFileSettings = GHCParse.FileSettings {}, + GHCParse.sTargetPlatform = GHCParse.Platform { + GHCParse.platformWordSize = 8, + GHCParse.platformOS = GHCParse.OSUnknown, + GHCParse.platformUnregisterised = True + }, + GHCParse.sPlatformMisc = GHCParse.PlatformMisc {}, + GHCParse.sPlatformConstants = GHCParse.PlatformConstants { + GHCParse.pc_DYNAMIC_BY_DEFAULT = False, + GHCParse.pc_WORD_SIZE = 8 + }, + GHCParse.sToolSettings = GHCParse.ToolSettings { + GHCParse.toolSettings_opt_P_fingerprint = GHCParse.fingerprint0 + } + } + +fakeLlvmConfig :: (GHCParse.LlvmTargets, GHCParse.LlvmPasses) +fakeLlvmConfig = ([], []) + +parsePragmasIntoDynFlags :: GHCParse.DynFlags + -> FilePath + -> GHCParse.StringBuffer + -> IO (Maybe GHCParse.DynFlags) +parsePragmasIntoDynFlags dflags f src = + GHCParse.handleGhcException (const $ return Nothing) $ + GHCParse.handleSourceError (const $ return Nothing) $ do + let opts = GHCParse.getOptions dflags src f + (dflagsWithPragmas, _, _) <- GHCParse.parseDynamicFilePragma dflags opts + return $ Just dflagsWithPragmas + addDiagnostics :: MonadCompile m => [Diagnostic] -> m () addDiagnostics diags = modify $ \state -> state { compileErrors = compileErrors state ++ diags, @@ -224,4 +320,4 @@ srcSpanFor src off len = next (!n, !ln, !col) '\r' = (n - 1, ln, col) next (!n, !ln, !col) '\n' = (n - 1, ln + 1, 1) next (!n, !ln, !col) '\t' = (n - 1, ln, col + 8 - (col - 1) `mod` 8) - next (!n, !ln, !col) _ = (n - 1, ln, col + 1) + next (!n, !ln, !col) _ = (n - 1, ln, col + 1) \ No newline at end of file From febbb611071197b1400d18f684f333003d329518 Mon Sep 17 00:00:00 2001 From: Daniel Marshall Date: Mon, 12 Aug 2019 14:20:38 +0100 Subject: [PATCH 6/6] Fixed conditionals in requirements checker cabal file for GHCJS --- build.sh | 3 ++- codeworld-compiler/codeworld-compiler.cabal | 2 +- codeworld-requirements/codeworld-requirements.cabal | 13 +++++++++++-- 3 files changed, 14 insertions(+), 4 deletions(-) diff --git a/build.sh b/build.sh index 2e6d5c91d..0b1bc227d 100755 --- a/build.sh +++ b/build.sh @@ -53,7 +53,8 @@ run . cabal_install ./codeworld-server \ ./codeworld-api \ ./codeworld-game-server \ ./codeworld-account \ - ./codeworld-auth + ./codeworld-auth \ + -f build-plugin-for-ghcjs # Build the JavaScript client code for FunBlocks, the block-based UI. run . cabal_install --ghcjs ./funblocks-client diff --git a/codeworld-compiler/codeworld-compiler.cabal b/codeworld-compiler/codeworld-compiler.cabal index 2fce56257..92db183c6 100644 --- a/codeworld-compiler/codeworld-compiler.cabal +++ b/codeworld-compiler/codeworld-compiler.cabal @@ -48,7 +48,7 @@ Library directory, exceptions, filepath, - ghc-lib-parser > 0.20190703, + ghc-lib-parser >= 0.20190603 && < 0.20190703, hashable, haskell-src-exts >= 1.20, megaparsec, diff --git a/codeworld-requirements/codeworld-requirements.cabal b/codeworld-requirements/codeworld-requirements.cabal index 4144ebd49..4a12d988a 100644 --- a/codeworld-requirements/codeworld-requirements.cabal +++ b/codeworld-requirements/codeworld-requirements.cabal @@ -12,10 +12,16 @@ build-type: Simple extra-source-files: ChangeLog.md cabal-version: >=1.10 +flag build-plugin-for-ghcjs + Description: Build for GHCJS + Default: False + Manual: True + library if impl(ghcjs) hs-source-dirs: stub-src - build-depends: ghc-api-ghcjs + build-depends: ghc >= 8.6.5, + ghc-boot-th else hs-source-dirs: src other-modules: CodeWorld.Requirements.Framework @@ -24,7 +30,10 @@ library CodeWorld.Requirements.Checker.Language CodeWorld.Requirements.Checker.Matcher CodeWorld.Requirements.Checker.Types - build-depends: ghc >= 8.6.5, + if flag(build-plugin-for-ghcjs) + build-depends: ghc-api-ghcjs + else + build-depends: ghc >= 8.6.5, ghc-boot-th exposed-modules: CodeWorld.Requirements.RequirementsChecker