From 7115fe470a018c6c40c2f5f07ff1992f3e06b4b7 Mon Sep 17 00:00:00 2001 From: Erik de Castro Lopo Date: Wed, 29 Aug 2018 20:43:12 +1000 Subject: [PATCH] Fix various unused binding/match/etc related warnings Add `-Wunused-do-bind -Wunused-local-binds -Wunused-top-binds -Wunused-matches` and fix all the things. --- ihaskell.cabal | 6 +-- main/Main.hs | 18 ++----- src/IHaskell/BrokenPackages.hs | 8 +-- src/IHaskell/Eval/Completion.hs | 33 +++---------- src/IHaskell/Eval/Evaluate.hs | 71 +++++++++------------------ src/IHaskell/Eval/Inspect.hs | 2 +- src/IHaskell/Eval/Lint.hs | 2 +- src/IHaskell/Eval/ParseShell.hs | 10 ++-- src/IHaskell/Eval/Parser.hs | 12 ++--- src/IHaskell/Eval/Util.hs | 12 ++--- src/IHaskell/IPython.hs | 54 +------------------- src/tests/IHaskell/Test/Completion.hs | 17 ++----- src/tests/IHaskell/Test/Eval.hs | 10 ++-- 13 files changed, 68 insertions(+), 187 deletions(-) diff --git a/ihaskell.cabal b/ihaskell.cabal index 059f8d2a..2d853321 100644 --- a/ihaskell.cabal +++ b/ihaskell.cabal @@ -49,7 +49,7 @@ data-files: library hs-source-dirs: src default-language: Haskell2010 - ghc-options: -Wincomplete-patterns -Wmissing-signatures + ghc-options: -Wincomplete-patterns -Wmissing-signatures -Wunused-do-bind -Wunused-local-binds -Wunused-top-binds -Wunused-matches build-depends: aeson >=1.0, base >=4.9, @@ -125,7 +125,7 @@ executable ihaskell -- Other library packages from which modules are imported. default-language: Haskell2010 - ghc-options: -Wincomplete-patterns -Wmissing-signatures + ghc-options: -Wincomplete-patterns -Wmissing-signatures -Wunused-do-bind -Wunused-local-binds -Wunused-top-binds -Wunused-matches build-depends: ihaskell -any, base >=4.9 && < 4.13, @@ -152,7 +152,7 @@ Test-Suite hspec IHaskell.Test.Util IHaskell.Test.Parser default-language: Haskell2010 - ghc-options: -Wincomplete-patterns -Wmissing-signatures + ghc-options: -Wincomplete-patterns -Wmissing-signatures -Wunused-do-bind -Wunused-local-binds -Wunused-top-binds -Wunused-matches build-depends: base, ihaskell, diff --git a/main/Main.hs b/main/Main.hs index cb10cc6c..92582900 100644 --- a/main/Main.hs +++ b/main/Main.hs @@ -56,18 +56,6 @@ import GHC hiding (extensions, language, convert) import GHC hiding (extensions, language) #endif --- | Compute the GHC API version number using the dist/build/autogen/cabal_macros.h -ghcVersionInts :: [Int] -ghcVersionInts = map (fromJust . readMay) . words . map dotToSpace $ VERSION_ghc - where - dotToSpace '.' = ' ' - dotToSpace x = x - -consoleBanner :: Text -consoleBanner = - "Welcome to IHaskell! Run `IHaskell --help` for more information.\n" <> - "Enter `:help` to learn more about IHaskell built-ins." - main :: IO () main = do args <- parseFlags <$> getArgs @@ -121,7 +109,7 @@ parseKernelArgs = foldl' addFlag defaultKernelSpecOptions kernelSpecOpts { kernelSpecInstallPrefix = Just prefix } addFlag kernelSpecOpts KernelspecUseStack = kernelSpecOpts { kernelSpecUseStack = True } - addFlag kernelSpecOpts flag = error $ "Unknown flag" ++ show flag + addFlag _kernelSpecOpts flag = error $ "Unknown flag" ++ show flag -- | Run the IHaskell language kernel. runKernel :: KernelSpecOptions -- ^ Various options from when the kernel was installed. @@ -170,7 +158,7 @@ runKernel kernelOpts profileSrc = do interpret libdir True $ \hasSupportLibraries -> do -- Ignore Ctrl-C the first time. This has to go inside the `interpret`, because GHC API resets the -- signal handlers for some reason (completely unknown to me). - liftIO ignoreCtrlC + _ <- liftIO ignoreCtrlC liftIO $ modifyMVar_ state $ \kernelState -> return $ kernelState { supportLibrariesAvailable = hasSupportLibraries } @@ -469,7 +457,7 @@ handleComm send kernelState req replyHeader = do pgrOut <- liftIO $ readMVar pagerOutput liftIO $ publish $ FinalResult disp (if toUsePager then pgrOut else []) [] return kernelState { openComms = Map.delete uuid widgets } - x -> + _ -> -- Only sensible thing to do. return kernelState diff --git a/src/IHaskell/BrokenPackages.hs b/src/IHaskell/BrokenPackages.hs index bd9fb57a..853a80cd 100644 --- a/src/IHaskell/BrokenPackages.hs +++ b/src/IHaskell/BrokenPackages.hs @@ -15,16 +15,16 @@ import Control.Applicative hiding ((<|>), many) import Shelly -data BrokenPackage = BrokenPackage { packageID :: String, brokenDeps :: [String] } +data BrokenPackage = BrokenPackage String [String] instance Show BrokenPackage where - show = packageID + show (BrokenPackage packageID _) = packageID -- | Get a list of broken packages. This function internally shells out to `ghc-pkg`, and parses the -- output in order to determine what packages are broken. getBrokenPackages :: IO [String] getBrokenPackages = shelly $ do - silently $ errExit False $ run "ghc-pkg" ["check"] + _ <- silently $ errExit False $ run "ghc-pkg" ["check"] checkOut <- lastStderr -- Get rid of extraneous things @@ -34,7 +34,7 @@ getBrokenPackages = shelly $ do return $ case parse (many check) "ghc-pkg output" ghcPkgOutput of - Left err -> [] + Left _ -> [] Right pkgs -> map show pkgs check :: Parser BrokenPackage diff --git a/src/IHaskell/Eval/Completion.hs b/src/IHaskell/Eval/Completion.hs index 8863c24a..10af8646 100644 --- a/src/IHaskell/Eval/Completion.hs +++ b/src/IHaskell/Eval/Completion.hs @@ -101,7 +101,7 @@ complete code posOffset = do case completion of HsFilePath _ match -> match FilePath _ match -> match - otherwise -> intercalate "." target + _ -> intercalate "." target options <- case completion of Empty -> return [] @@ -110,7 +110,6 @@ complete code posOffset = do return $ filter (candidate `isPrefixOf`) unqualNames Qualified moduleName candidate -> do - trueName <- getTrueModuleName moduleName let prefix = intercalate "." [moduleName, candidate] completions = filter (prefix `isPrefixOf`) qualNames return completions @@ -123,8 +122,7 @@ complete code posOffset = do DynFlag ext -> do -- Possibly leave out the fLangFlags? - let kernelOptNames = concatMap getSetName kernelOpts - otherNames = ["-package", "-Wall", "-w"] + let otherNames = ["-package", "-Wall", "-w"] fNames = map extName fFlags ++ map extName wWarningFlags ++ @@ -145,33 +143,16 @@ complete code posOffset = do xNoNames = map ("No" ++) xNames return $ filter (ext `isPrefixOf`) $ xNames ++ xNoNames - HsFilePath lineUpToCursor match -> completePathWithExtensions [".hs", ".lhs"] + HsFilePath lineUpToCursor _match -> completePathWithExtensions [".hs", ".lhs"] lineUpToCursor - FilePath lineUpToCursor match -> completePath lineUpToCursor + FilePath lineUpToCursor _match -> completePath lineUpToCursor KernelOption str -> return $ filter (str `isPrefixOf`) (concatMap getOptionName kernelOpts) return (matchedText, options) -getTrueModuleName :: String -> Interpreter String -getTrueModuleName name = do - -- Only use the things that were actually imported - let onlyImportDecl (IIDecl decl) = Just decl - onlyImportDecl _ = Nothing - - -- Get all imports that we use. - imports <- catMaybes <$> map onlyImportDecl <$> getContext - - -- Find the ones that have a qualified name attached. If this name isn't one of them, it already is - -- the true name. - flags <- getSessionDynFlags - let qualifiedImports = filter (isJust . ideclAs) imports - hasName imp = name == (showPpr flags . fromJust . ideclAs) imp - case find hasName qualifiedImports of - Nothing -> return name - Just trueImp -> return $ showPpr flags $ unLoc $ ideclName trueImp -- | Get which type of completion this is from the surrounding context. completionType :: String -- ^ The line on which the completion is being done. @@ -246,9 +227,9 @@ completionType line loc target go acc rest = case rest of '"':'\\':rem -> go ('"' : acc) rem - '"':rem -> acc + '"':_ -> acc ' ':'\\':rem -> go (' ' : acc) rem - ' ':rem -> acc + ' ':_ -> acc x:rem -> go (x : acc) rem [] -> acc @@ -268,7 +249,7 @@ completionTarget code cursor = expandCompletionPiece pieceToComplete } isDelim :: Char -> Int -> Bool - isDelim char idx = char `elem` neverIdent || isSymbol char + isDelim char _idx = char `elem` neverIdent || isSymbol char splitAlongCursor :: [[(Char, Int)]] -> [[(Char, Int)]] splitAlongCursor [] = [] diff --git a/src/IHaskell/Eval/Evaluate.hs b/src/IHaskell/Eval/Evaluate.hs index 986e1746..55895acc 100644 --- a/src/IHaskell/Eval/Evaluate.hs +++ b/src/IHaskell/Eval/Evaluate.hs @@ -217,13 +217,6 @@ initializeImports = do iHaskellPkgName = initStr ++ intercalate "." (map show (versionBranch version)) #endif - dependsOnRight pkg = not $ null $ do - pkg <- db - depId <- depends pkg - dep <- filter ((== depId) . unitId) db - let idString = packageIdString' dflags dep - guard (iHaskellPkgName `isPrefixOf` idString) - displayPkgs = [ pkgName | pkgName <- packageNames , Just (x:_) <- [stripPrefix initStr pkgName] @@ -239,13 +232,15 @@ initializeImports = do importFmt = "import IHaskell.Display.%s" + +#if MIN_VERSION_ghc(8,2,0) + toImportStmt :: String -> String + toImportStmt = printf importFmt . concatMap capitalize . drop 1 . split "-" +#else dropFirstAndLast :: [a] -> [a] dropFirstAndLast = reverse . drop 1 . reverse . drop 1 toImportStmt :: String -> String -#if MIN_VERSION_ghc(8,2,0) - toImportStmt = printf importFmt . concatMap capitalize . drop 1 . split "-" -#else toImportStmt = printf importFmt . concatMap capitalize . dropFirstAndLast . split "-" #endif @@ -525,7 +520,7 @@ evalCommand _ (Module contents) state = wrapExecution state $ do Nothing -> doLoadModule modName modName -- | Directives set via `:set`. -evalCommand output (Directive SetDynFlag flagsStr) state = safely state $ do +evalCommand _output (Directive SetDynFlag flagsStr) state = safely state $ do write state $ "All Flags: " ++ flagsStr -- Find which flags are IHaskell flags, and which are GHC flags @@ -589,7 +584,7 @@ evalCommand output (Directive SetExtension opts) state = do let set = concatMap (" -X" ++) $ words opts evalCommand output (Directive SetDynFlag set) state -evalCommand output (Directive LoadModule mods) state = wrapExecution state $ do +evalCommand _output (Directive LoadModule mods) state = wrapExecution state $ do write state $ "Load Module: " ++ mods let stripped@(firstChar:remainder) = mods (modules, removeModule) = @@ -604,9 +599,9 @@ evalCommand output (Directive LoadModule mods) state = wrapExecution state $ do return mempty -evalCommand a (Directive SetOption opts) state = do +evalCommand _output (Directive SetOption opts) state = do write state $ "Option: " ++ opts - let (existing, nonExisting) = partition optionExists $ words opts + let nonExisting = filter (not . optionExists) $ words opts if not $ null nonExisting then let err = "No such options: " ++ intercalate ", " nonExisting in return @@ -679,7 +674,7 @@ evalCommand publish (Directive ShellCmd cmd) state = wrapExecution state $ let cmd = printf "IHaskellDirectory.setCurrentDirectory \"%s\"" $ replace " " "\\ " $ replace "\"" "\\\"" directory - execStmt cmd execOptions + _ <- execStmt cmd execOptions return mempty else return $ displayError $ printf "No such directory: '%s'" directory cmd -> liftIO $ do @@ -863,8 +858,8 @@ evalCommand output (Expression expr) state = do -- If it typechecks as a DecsQ, we do not want to display the DecsQ, we just want the -- declaration made. do - write state "Suppressing display for template haskell declaration" - GHC.runDecls expr + _ <- write state "Suppressing display for template haskell declaration" + _ <- GHC.runDecls expr return EvalOut { evalStatus = Success @@ -916,7 +911,7 @@ evalCommand output (Expression expr) state = do removeSvg (Display disps) = Display $ filter (not . isSvg) disps removeSvg (ManyDisplay disps) = ManyDisplay $ map removeSvg disps - useDisplay displayExpr = do + useDisplay _displayExpr = do -- If there are instance matches, convert the object into a Display. We also serialize it into a -- bytestring. We get the bytestring IO action as a dynamic and then convert back to a bytestring, -- which we promptly unserialize. Note that attempting to do this without the serialization to @@ -1027,7 +1022,7 @@ evalCommand _ (ParseError loc err) state = do , evalMsgs = [] } -evalCommand _ (Pragma (PragmaUnsupported pragmaType) pragmas) state = wrapExecution state $ +evalCommand _ (Pragma (PragmaUnsupported pragmaType) _pragmas) state = wrapExecution state $ return $ displayError $ "Pragmas of type " ++ pragmaType ++ "\nare not supported." evalCommand output (Pragma PragmaLanguage pragmas) state = do @@ -1055,10 +1050,10 @@ doLoadModule name modName = do -- Compile loaded modules. flags <- getSessionDynFlags errRef <- liftIO $ newIORef [] - setSessionDynFlags $ flip gopt_set Opt_BuildDynamicToo + _ <- setSessionDynFlags $ flip gopt_set Opt_BuildDynamicToo flags { hscTarget = objTarget flags - , log_action = \dflags sev srcspan ppr _style msg -> modifyIORef' errRef (showSDoc flags msg :) + , log_action = \_dflags _sev _srcspan _ppr _style msg -> modifyIORef' errRef (showSDoc flags msg :) } -- Load the new target. @@ -1084,7 +1079,7 @@ doLoadModule name modName = do Succeeded -> IIDecl (simpleImportDecl $ mkModuleName modName) : importedModules -- Switch back to interpreted mode. - setSessionDynFlags flags + _ <- setSessionDynFlags flags case result of Succeeded -> return mempty @@ -1098,11 +1093,11 @@ doLoadModule name modName = do print $ show exception -- Explicitly clear targets setTargets [] - load LoadAllTargets + _ <- load LoadAllTargets -- Switch to interpreted mode! flags <- getSessionDynFlags - setSessionDynFlags flags { hscTarget = HscInterpreted } + _ <- setSessionDynFlags flags { hscTarget = HscInterpreted } -- Return to old context, make sure we have `it`. setContext imported @@ -1113,20 +1108,6 @@ doLoadModule name modName = do objTarget :: DynFlags -> HscTarget objTarget flags = defaultObjectTarget $ targetPlatform flags -keepingItVariable :: Interpreter a -> Interpreter a -keepingItVariable act = do - -- Generate the it variable temp name - gen <- liftIO getStdGen - let rand = take 20 $ randomRs ('0', '9') gen - var name = name ++ rand - goStmt s = execStmt s execOptions - itVariable = var "it_var_temp_" - - goStmt $ printf "let %s = it" itVariable - val <- act - goStmt $ printf "let it = %s" itVariable - act - data Captured a = CapturedStmt String | CapturedIO (IO a) @@ -1185,7 +1166,7 @@ capturedEval output stmt = do AnyException e -> ExecComplete (Left e) 0 -- Initialize evaluation context. - results <- forM initStmts goStmt + forM_ initStmts goStmt -- This works fine on GHC 8.0 and newer dyn <- dynCompileExpr readVariable @@ -1208,9 +1189,6 @@ capturedEval output stmt = do ms = 1000 delay = 100 * ms - -- How much to read each time. - chunkSize = 100 - -- Maximum size of the output (after which we truncate). maxSize = 100 * 1000 @@ -1236,7 +1214,7 @@ capturedEval output stmt = do -- We're done reading. putMVar finishedReading True - liftIO $ forkIO loop + _ <- liftIO $ forkIO loop result <- gfinally (runWithResult stmt) $ do -- Execution is done. @@ -1270,7 +1248,7 @@ evalStatementOrIO publish state cmd = do case cmd of CapturedStmt stmt -> write state $ "Statement:\n" ++ stmt - CapturedIO io -> + CapturedIO _ -> write state "Evaluating Action" (printed, result) <- capturedEval output cmd @@ -1317,7 +1295,7 @@ evalStatementOrIO publish state cmd = do -- Read from a file handle until we hit a delimiter or until we've read as many characters as -- requested readChars :: Handle -> String -> Int -> IO String -readChars handle delims 0 = +readChars _handle _delims 0 = -- If we're done reading, return nothing. return [] readChars handle delims nchars = do @@ -1353,9 +1331,6 @@ formatErrorWithClass cls = where fixDollarSigns = replace "$" "$" useDashV = "\n Use -v to see a list of the files searched for." - isShowError err = - "No instance for (Show" `isPrefixOf` err && - isInfixOf " arising from a use of `print'" err formatParseError :: StringLoc -> String -> ErrMsg formatParseError (Loc line col) = diff --git a/src/IHaskell/Eval/Inspect.hs b/src/IHaskell/Eval/Inspect.hs index b0fd4962..303616fb 100644 --- a/src/IHaskell/Eval/Inspect.hs +++ b/src/IHaskell/Eval/Inspect.hs @@ -34,7 +34,7 @@ whitespace = " \t\n" -- | Compute the identifier that is being queried. getIdentifier :: String -> Int -> String -getIdentifier code pos = identifier +getIdentifier code _pos = identifier where chunks = splitOn whitespace code lastChunk = P.last chunks :: String diff --git a/src/IHaskell/Eval/Lint.hs b/src/IHaskell/Eval/Lint.hs index b99a8272..e7cbb93f 100644 --- a/src/IHaskell/Eval/Lint.hs +++ b/src/IHaskell/Eval/Lint.hs @@ -149,7 +149,7 @@ createModule mode (Located line block) = stmtToModule :: String -> ParseResult ExtsModule stmtToModule stmtStr = case parseStmtWithMode mode stmtStr of - ParseOk stmt -> ParseOk mod + ParseOk _ -> ParseOk mod ParseFailed a b -> ParseFailed a b where mod = moduleWithDecls decl diff --git a/src/IHaskell/Eval/ParseShell.hs b/src/IHaskell/Eval/ParseShell.hs index d514234f..5a2927ee 100644 --- a/src/IHaskell/Eval/ParseShell.hs +++ b/src/IHaskell/Eval/ParseShell.hs @@ -37,12 +37,12 @@ manyTillEnd1 p end = do unescapedChar :: Parser Char -> Parser String unescapedChar p = try $ do x <- noneOf "\\" - lookAhead p + _ <- lookAhead p return [x] quotedString :: Parser [Char] quotedString = do - quote "expected starting quote" + _ <- quote "expected starting quote" (manyTillEnd anyChar (unescapedChar quote) <* quote) "unexpected in quoted String " unquotedString :: Parser [Char] @@ -61,9 +61,9 @@ separator = many1 space "separator" shellWords :: Parser [String] shellWords = try (eof *> return []) <|> do x <- word - rest1 <- lookAhead (many anyToken) - ss <- separator - rest2 <- lookAhead (many anyToken) + _rest1 <- lookAhead (many anyToken) + _ss <- separator + _rest2 <- lookAhead (many anyToken) xs <- shellWords return $ x : xs diff --git a/src/IHaskell/Eval/Parser.hs b/src/IHaskell/Eval/Parser.hs index 73c261ca..3a52ec23 100644 --- a/src/IHaskell/Eval/Parser.hs +++ b/src/IHaskell/Eval/Parser.hs @@ -193,7 +193,7 @@ parseCodeChunk code startLine = do case parser string of Parsed res -> Parsed (blockType res) Failure err loc -> Failure err loc - otherwise -> error "tryParser failed, output was neither Parsed nor Failure" + _ -> error "tryParser failed, output was neither Parsed nor Failure" parsers :: DynFlags -> [(String -> CodeBlock, String -> ParseOutput String)] parsers flags = @@ -206,8 +206,8 @@ parseCodeChunk code startLine = do unparser :: Parser a -> String -> ParseOutput String unparser parser code = case runParser flags parser code of - Parsed out -> Parsed code - Partial out strs -> Partial code strs + Parsed _ -> Parsed code + Partial _ strs -> Partial code strs Failure err loc -> Failure err loc -- | Find consecutive declarations of the same function and join them into a single declaration. @@ -239,7 +239,7 @@ joinFunctions blocks = parsePragma :: String -- ^ Pragma string. -> Int -- ^ Line number at which the directive appears. -> CodeBlock -- ^ Pragma code block or a parse error. -parsePragma pragma line = +parsePragma pragma _line = let commaToSpace :: Char -> Char commaToSpace ',' = ' ' commaToSpace x = x @@ -256,7 +256,7 @@ parsePragma pragma line = parseDirective :: String -- ^ Directive string. -> Int -- ^ Line number at which the directive appears. -> CodeBlock -- ^ Directive code block or a parse error. -parseDirective (':':'!':directive) line = Directive ShellCmd $ '!' : directive +parseDirective (':':'!':directive) _line = Directive ShellCmd $ '!' : directive parseDirective (':':directive) line = case find rightDirective directives of Just (directiveType, _) -> Directive directiveType arg @@ -302,4 +302,4 @@ getModuleName moduleSrc = do case unLoc <$> hsmodName (unLoc mod) of Nothing -> error "Module must have a name." Just name -> return $ split "." $ moduleNameString name - otherwise -> error "getModuleName failed, output was neither Parsed nor Failure" + _ -> error "getModuleName failed, output was neither Parsed nor Failure" diff --git a/src/IHaskell/Eval/Util.hs b/src/IHaskell/Eval/Util.hs index d48b5f21..f6b79caf 100644 --- a/src/IHaskell/Eval/Util.hs +++ b/src/IHaskell/Eval/Util.hs @@ -190,7 +190,7 @@ setExtension ext = do case extensionFlag ext of Nothing -> return $ Just $ "Could not parse extension name: " ++ ext Just flag -> do - setSessionDynFlags $ + _ <- setSessionDynFlags $ case flag of SetFlag ghcFlag -> xopt_set flags ghcFlag UnsetFlag ghcFlag -> xopt_unset flags ghcFlag @@ -205,9 +205,8 @@ setFlags ext = do (flags', unrecognized, warnings) <- parseDynamicFlags flags (map noLoc ext) -- First, try to check if this flag matches any extension name. - let restorePkg x = x { packageFlags = packageFlags flags } let restoredPkgs = flags' { packageFlags = packageFlags flags } - GHC.setProgramDynFlags restoredPkgs + _ <- GHC.setProgramDynFlags restoredPkgs GHC.setInteractiveDynFlags restoredPkgs -- Create the parse errors. @@ -348,7 +347,6 @@ evalImport imports = do removeImport :: GhcMonad m => String -> m () removeImport moduleName = do - flags <- getSessionDynFlags ctx <- getContext let ctx' = filter (not . (isImportOf $ mkModuleName moduleName)) ctx setContext ctx' @@ -378,10 +376,8 @@ cleanUpDuplicateInstances = modifySession $ \hscEnv -> where instEq :: ClsInst -> ClsInst -> Bool -- Only support replacing instances on GHC 7.8 and up - instEq c1 c2 - | ClsInst { is_tvs = tpl_tvs, is_tys = tpl_tys, is_cls = cls } <- c1, - ClsInst { is_tys = tpl_tys', is_cls = cls' } <- c2 - = cls == cls' && isJust (tcMatchTys tpl_tys tpl_tys') + instEq c1 c2 = + is_cls c1 == is_cls c2 && isJust (tcMatchTys (is_tys c1) (is_tys c2)) -- | Get the type of an expression and convert it to a string. diff --git a/src/IHaskell/IPython.hs b/src/IHaskell/IPython.hs index 0ea9a324..809c3860 100644 --- a/src/IHaskell/IPython.hs +++ b/src/IHaskell/IPython.hs @@ -66,9 +66,6 @@ defaultKernelSpecOptions = KernelSpecOptions kernelName :: String kernelName = "haskell" -kernelArgs :: [String] -kernelArgs = ["--kernel", kernelName] - ipythonCommand :: SH.Sh SH.FilePath ipythonCommand = do jupyterMay <- SH.which "jupyter" @@ -84,34 +81,6 @@ locateIPython = do Nothing -> SH.errorExit "The Jupyter binary could not be located" Just ipython -> return ipython --- | Run the IPython command with any arguments. The kernel is set to IHaskell. -ipython :: Bool -- ^ Whether to suppress output. - -> [Text] -- ^ IPython command line arguments. - -> SH.Sh String -- ^ IPython output. -ipython suppress args = do - liftIO $ installHandler keyboardSignal (CatchOnce $ return ()) Nothing - - -- We have this because using `run` does not let us use stdin. - cmd <- ipythonCommand - SH.runHandles cmd args handles doNothing - - where - handles = [SH.InHandle SH.Inherit, outHandle suppress, errorHandle suppress] - outHandle True = SH.OutHandle SH.CreatePipe - outHandle False = SH.OutHandle SH.Inherit - errorHandle True = SH.ErrorHandle SH.CreatePipe - errorHandle False = SH.ErrorHandle SH.Inherit - doNothing _ stdout _ = if suppress - then liftIO $ StrictIO.hGetContents stdout - else return "" - --- | Run while suppressing all output. -quietRun :: SH.FilePath -> [Text] -> SH.Sh () -quietRun path args = SH.runHandles path args handles nothing - where - handles = [SH.InHandle SH.Inherit, SH.OutHandle SH.CreatePipe, SH.ErrorHandle SH.CreatePipe] - nothing _ _ _ = return () - fp :: SH.FilePath -> FilePath fp = T.unpack . SH.toTextIgnore @@ -128,9 +97,6 @@ ihaskellDir = do home <- maybe (error "$HOME not defined.") SH.fromText <$> SH.get_env "HOME" fp <$> ensure (return (home SH. ".ihaskell")) -notebookDir :: SH.Sh SH.FilePath -notebookDir = ensure $ (SH. "notebooks") <$> ihaskellDir - getIHaskellDir :: IO String getIHaskellDir = SH.shelly ihaskellDir @@ -196,7 +162,7 @@ installKernelspec replace opts = void $ do ++ ["--ghclib", kernelSpecGhcLibdir opts] ++ (case kernelSpecRTSOptions opts of [] -> [] - rtsOpts -> "+RTS" : kernelSpecRTSOptions opts ++ ["-RTS"]) + _ -> "+RTS" : kernelSpecRTSOptions opts ++ ["-RTS"]) ++ ["--stack" | kernelSpecUseStack opts] let kernelSpec = KernelSpec @@ -226,30 +192,12 @@ installKernelspec replace opts = void $ do SH.silently $ SH.run ipython cmd -kernelSpecCreated :: SH.Sh Bool -kernelSpecCreated = do - ipython <- locateIPython - out <- SH.silently $ SH.run ipython ["kernelspec", "list"] - let kernelspecs = map T.strip $ T.lines out - return $ T.pack kernelName `elem` kernelspecs - -- | Replace "~" with $HOME if $HOME is defined. Otherwise, do nothing. subHome :: String -> IO String subHome path = SH.shelly $ do home <- T.unpack <$> fromMaybe "~" <$> SH.get_env "HOME" return $ replace "~" home path --- | Get the path to an executable. If it doensn't exist, fail with an error message complaining --- about it. -path :: Text -> SH.Sh SH.FilePath -path exe = do - path <- SH.which $ SH.fromText exe - case path of - Nothing -> do - liftIO $ putStrLn $ "Could not find `" ++ T.unpack exe ++ "` executable." - fail $ "`" ++ T.unpack exe ++ "` not on $PATH." - Just exePath -> return exePath - -- | Parse an IPython version string into a list of integers. parseVersion :: String -> Maybe [Int] parseVersion versionStr = diff --git a/src/tests/IHaskell/Test/Completion.hs b/src/tests/IHaskell/Test/Completion.hs index f28c2fdb..2058b5f8 100644 --- a/src/tests/IHaskell/Test/Completion.hs +++ b/src/tests/IHaskell/Test/Completion.hs @@ -43,24 +43,20 @@ completionEventInDirectory string = withHsDirectory $ const $ completionEvent st shouldHaveCompletionsInDirectory :: String -> [String] -> IO () shouldHaveCompletionsInDirectory string expected = do - (matched, completions) <- completionEventInDirectory string - let existsInCompletion = (`elem` completions) - unmatched = filter (not . existsInCompletion) expected + (_, completions) <- completionEventInDirectory string expected `shouldBeAmong` completions completionHas :: String -> [String] -> IO () completionHas string expected = do - (matched, completions) <- ghc $ do + (_, completions) <- ghc $ do initCompleter completionEvent string - let existsInCompletion = (`elem` completions) - unmatched = filter (not . existsInCompletion) expected expected `shouldBeAmong` completions initCompleter :: Interpreter () initCompleter = do flags <- getSessionDynFlags - setSessionDynFlags $ flags { hscTarget = HscInterpreted, ghcLink = LinkInMemory } + _ <- setSessionDynFlags $ flags { hscTarget = HscInterpreted, ghcLink = LinkInMemory } -- Import modules. imports <- mapM parseImportDecl @@ -164,9 +160,8 @@ testCommandCompletion = describe "Completes commands" $ do it "correctly interprets ~ as the environment HOME variable" $ do let shouldHaveCompletions :: String -> [String] -> IO () shouldHaveCompletions string expected = do - (matched, completions) <- withHsHome $ completionEvent string - let existsInCompletion = (`elem` completions) - unmatched = filter (not . existsInCompletion) expected + (_, completions) <- withHsHome $ completionEvent string + expected `shouldBeAmong` completions ":! cd ~/*" `shouldHaveCompletions` ["~/dir/"] ":! ~/*" `shouldHaveCompletions` ["~/dir/"] @@ -178,8 +173,6 @@ testCommandCompletion = describe "Completes commands" $ do matchText <- withHsHome $ fst <$> uncurry complete (readCompletePrompt string) matchText `shouldBe` expected - setHomeEvent path = liftIO $ setEnv "HOME" (T.unpack $ toTextIgnore path) - it "generates the correct matchingText on `:! cd ~/*` " $ ":! cd ~/*" `shouldHaveMatchingText` ("~/" :: String) diff --git a/src/tests/IHaskell/Test/Eval.hs b/src/tests/IHaskell/Test/Eval.hs index 410251fb..fb670da8 100644 --- a/src/tests/IHaskell/Test/Eval.hs +++ b/src/tests/IHaskell/Test/Eval.hs @@ -34,8 +34,8 @@ eval string = do getTemporaryDirectory >>= setCurrentDirectory let state = defaultKernelState { getLintStatus = LintOff } - interpret GHC.Paths.libdir False $ const $ - IHaskell.Eval.Evaluate.evaluate state string publish noWidgetHandling + _ <- interpret GHC.Paths.libdir False $ const $ + IHaskell.Eval.Evaluate.evaluate state string publish noWidgetHandling out <- readIORef outputAccum pagerOut <- readIORef pagerAccum return (reverse out, unlines . map extractPlain . reverse $ pagerOut) @@ -44,7 +44,7 @@ becomes :: String -> [String] -> IO () becomes string expected = evaluationComparing comparison string where comparison :: ([Display], String) -> IO () - comparison (results, pageOut) = do + comparison (results, _pageOut) = do when (length results /= length expected) $ expectationFailure $ "Expected result to have " ++ show (length expected) ++ " results. Got " ++ show results @@ -66,7 +66,7 @@ evaluationComparing comparison string = do pages :: String -> [String] -> IO () pages string expected = evaluationComparing comparison string where - comparison (results, pageOut) = + comparison (_results, pageOut) = strip (stripHtml pageOut) `shouldBe` strip (fixQuotes $ unlines expected) -- A very, very hacky method for removing HTML @@ -80,7 +80,7 @@ pages string expected = evaluationComparing comparison string go [] = [] go' ('>':str) = go str - go' (x:xs) = go' xs + go' (_:xs) = go' xs go' [] = error $ "Unending bracket html tag in string " ++ str dropScriptTag str =