Commit ca56a29d authored by Erik de Castro Lopo's avatar Erik de Castro Lopo

Fix incomplete pattern matches

Add `-Wincomplete-patterns` to the `ghc-options` field of the cabal file
and fix all warnings.
parent dcd7d330
...@@ -49,6 +49,7 @@ data-files: ...@@ -49,6 +49,7 @@ data-files:
library library
hs-source-dirs: src hs-source-dirs: src
default-language: Haskell2010 default-language: Haskell2010
ghc-options: -Wincomplete-patterns
build-depends: build-depends:
aeson >=1.0, aeson >=1.0,
base >=4.9, base >=4.9,
...@@ -124,6 +125,7 @@ executable ihaskell ...@@ -124,6 +125,7 @@ executable ihaskell
-- Other library packages from which modules are imported. -- Other library packages from which modules are imported.
default-language: Haskell2010 default-language: Haskell2010
ghc-options: -Wincomplete-patterns
build-depends: build-depends:
ihaskell -any, ihaskell -any,
base >=4.9 && < 4.13, base >=4.9 && < 4.13,
...@@ -150,6 +152,7 @@ Test-Suite hspec ...@@ -150,6 +152,7 @@ Test-Suite hspec
IHaskell.Test.Util IHaskell.Test.Util
IHaskell.Test.Parser IHaskell.Test.Parser
default-language: Haskell2010 default-language: Haskell2010
ghc-options: -Wincomplete-patterns
build-depends: build-depends:
base, base,
ihaskell, ihaskell,
......
...@@ -469,6 +469,9 @@ handleComm send kernelState req replyHeader = do ...@@ -469,6 +469,9 @@ handleComm send kernelState req replyHeader = do
pgrOut <- liftIO $ readMVar pagerOutput pgrOut <- liftIO $ readMVar pagerOutput
liftIO $ publish $ FinalResult disp (if toUsePager then pgrOut else []) [] liftIO $ publish $ FinalResult disp (if toUsePager then pgrOut else []) []
return kernelState { openComms = Map.delete uuid widgets } return kernelState { openComms = Map.delete uuid widgets }
x ->
-- Only sensible thing to do.
return kernelState
-- Notify the frontend that the kernel is idle once again -- Notify the frontend that the kernel is idle once again
idleHeader <- liftIO $ dupHeader replyHeader StatusMessage idleHeader <- liftIO $ dupHeader replyHeader StatusMessage
......
...@@ -234,6 +234,7 @@ initializeImports = do ...@@ -234,6 +234,7 @@ initializeImports = do
-- Generate import statements all Display modules. -- Generate import statements all Display modules.
let capitalize :: String -> String let capitalize :: String -> String
capitalize [] = []
capitalize (first:rest) = Char.toUpper first : rest capitalize (first:rest) = Char.toUpper first : rest
importFmt = "import IHaskell.Display.%s" importFmt = "import IHaskell.Display.%s"
...@@ -655,8 +656,9 @@ evalCommand _ (Directive LoadFile names) state = wrapExecution state $ do ...@@ -655,8 +656,9 @@ evalCommand _ (Directive LoadFile names) state = wrapExecution state $ do
doLoadModule filename modName doLoadModule filename modName
return (ManyDisplay displays) return (ManyDisplay displays)
evalCommand publish (Directive ShellCmd ('!':cmd)) state = wrapExecution state $ evalCommand publish (Directive ShellCmd cmd) state = wrapExecution state $
case words cmd of -- Assume the first character of 'cmd' is '!'.
case words $ drop 1 cmd of
"cd":dirs -> do "cd":dirs -> do
-- Get home so we can replace '~` with it. -- Get home so we can replace '~` with it.
homeEither <- liftIO (try $ getEnv "HOME" :: IO (Either SomeException String)) homeEither <- liftIO (try $ getEnv "HOME" :: IO (Either SomeException String))
......
...@@ -110,9 +110,8 @@ search string = do ...@@ -110,9 +110,8 @@ search string = do
document :: String -> IO [HoogleResult] document :: String -> IO [HoogleResult]
document string = do document string = do
matchingResults <- filter matches <$> search string matchingResults <- filter matches <$> search string
let results = map toDocResult matchingResults
return $ return $
case results of case mapMaybe toDocResult matchingResults of
[] -> [NoResult "no matching identifiers found."] [] -> [NoResult "no matching identifiers found."]
res -> res res -> res
...@@ -123,7 +122,9 @@ document string = do ...@@ -123,7 +122,9 @@ document string = do
_ -> False _ -> False
matches _ = False matches _ = False
toDocResult (SearchResult resp) = DocResult resp toDocResult (SearchResult resp) = Just $ DocResult resp
toDocResult (DocResult _) = Nothing
toDocResult (NoResult _) = Nothing
-- | Render a Hoogle search result into an output format. -- | Render a Hoogle search result into an output format.
render :: OutputFormat -> HoogleResult -> String render :: OutputFormat -> HoogleResult -> String
...@@ -233,7 +234,10 @@ renderDocs doc = ...@@ -233,7 +234,10 @@ renderDocs doc =
bothAreCode s1 s2 = bothAreCode s1 s2 =
isPrefixOf ">" (strip s1) && isPrefixOf ">" (strip s1) &&
isPrefixOf ">" (strip s2) isPrefixOf ">" (strip s2)
isCode (s:_) = isPrefixOf ">" $ strip s isCode xs =
case xs of
[] -> False
(s:_) -> isPrefixOf ">" $ strip s
makeBlock lines = makeBlock lines =
if isCode lines if isCode lines
then div' "hoogle-code" $ unlines $ nonull lines then div' "hoogle-code" $ unlines $ nonull lines
......
...@@ -115,6 +115,9 @@ createModule mode (Located line block) = ...@@ -115,6 +115,9 @@ createModule mode (Located line block) =
Import impt -> impt Import impt -> impt
Module mod -> mod Module mod -> mod
-- TODO: Properly handle the other constructors
_ -> []
unparse :: ParseResult a -> Maybe a unparse :: ParseResult a -> Maybe a
unparse (ParseOk a) = Just a unparse (ParseOk a) = Just a
unparse _ = Nothing unparse _ = Nothing
......
...@@ -142,7 +142,7 @@ activateExtensions _ = return () ...@@ -142,7 +142,7 @@ activateExtensions _ = return ()
parseCodeChunk :: GhcMonad m => String -> LineNumber -> m CodeBlock parseCodeChunk :: GhcMonad m => String -> LineNumber -> m CodeBlock
parseCodeChunk code startLine = do parseCodeChunk code startLine = do
flags <- getSessionDynFlags flags <- getSessionDynFlags
let let
-- Try each parser in turn. -- Try each parser in turn.
rawResults = map (tryParser code) (parsers flags) rawResults = map (tryParser code) (parsers flags)
...@@ -239,11 +239,11 @@ joinFunctions blocks = ...@@ -239,11 +239,11 @@ joinFunctions blocks =
parsePragma :: String -- ^ Pragma string. parsePragma :: String -- ^ Pragma string.
-> Int -- ^ Line number at which the directive appears. -> Int -- ^ Line number at which the directive appears.
-> CodeBlock -- ^ Pragma code block or a parse error. -> CodeBlock -- ^ Pragma code block or a parse error.
parsePragma ('{':'-':'#':pragma) line = parsePragma pragma line =
let commaToSpace :: Char -> Char let commaToSpace :: Char -> Char
commaToSpace ',' = ' ' commaToSpace ',' = ' '
commaToSpace x = x commaToSpace x = x
pragmas = words $ takeWhile (/= '#') $ map commaToSpace pragma pragmas = words $ takeWhile (/= '#') $ map commaToSpace $ drop 3 pragma
in case pragmas of in case pragmas of
--empty string pragmas are unsupported --empty string pragmas are unsupported
[] -> Pragma (PragmaUnsupported "") [] [] -> Pragma (PragmaUnsupported "") []
......
...@@ -246,6 +246,7 @@ doc sdoc = do ...@@ -246,6 +246,7 @@ doc sdoc = do
string_txt (Pretty.Str s1) s2 = s1 ++ s2 string_txt (Pretty.Str s1) s2 = s1 ++ s2
string_txt (Pretty.PStr s1) s2 = unpackFS s1 ++ s2 string_txt (Pretty.PStr s1) s2 = unpackFS s1 ++ s2
string_txt (Pretty.LStr s1 _) s2 = unpackLitString s1 ++ s2 string_txt (Pretty.LStr s1 _) s2 = unpackLitString s1 ++ s2
string_txt (Pretty.ZStr s1) s2 = CBS.unpack (fastZStringToByteString s1) ++ s2
#endif #endif
-- | Initialize the GHC API. Run this as the first thing in the `runGhc`. This initializes some dyn -- | Initialize the GHC API. Run this as the first thing in the `runGhc`. This initializes some dyn
......
...@@ -29,7 +29,7 @@ data Args = Args IHaskellMode [Argument] ...@@ -29,7 +29,7 @@ data Args = Args IHaskellMode [Argument]
deriving Show deriving Show
data Argument = ConfFile String -- ^ A file with commands to load at startup. data Argument = ConfFile String -- ^ A file with commands to load at startup.
| OverwriteFiles -- ^ Present when output should overwrite existing files. | OverwriteFiles -- ^ Present when output should overwrite existing files.
| GhcLibDir String -- ^ Where to find the GHC libraries. | GhcLibDir String -- ^ Where to find the GHC libraries.
| RTSFlags [String] -- ^ Options for the GHC runtime (e.g. heap-size limit | RTSFlags [String] -- ^ Options for the GHC runtime (e.g. heap-size limit
-- or number of threads). -- or number of threads).
...@@ -94,6 +94,7 @@ help mode = showText (Wrap 100) $ helpText [] HelpFormatAll $ chooseMode mode ...@@ -94,6 +94,7 @@ help mode = showText (Wrap 100) $ helpText [] HelpFormatAll $ chooseMode mode
chooseMode InstallKernelSpec = installKernelSpec chooseMode InstallKernelSpec = installKernelSpec
chooseMode (Kernel _) = kernel chooseMode (Kernel _) = kernel
chooseMode ConvertLhs = convert chooseMode ConvertLhs = convert
chooseMode (ShowDefault _) = error "IHaskell.Flags.help: Should never happen."
ghcLibFlag :: Flag Args ghcLibFlag :: Flag Args
ghcLibFlag = flagReq ["ghclib", "l"] (store GhcLibDir) "<path>" "Library directory for GHC." ghcLibFlag = flagReq ["ghclib", "l"] (store GhcLibDir) "<path>" "Library directory for GHC."
......
...@@ -27,7 +27,7 @@ eval string = do ...@@ -27,7 +27,7 @@ eval string = do
let publish evalResult = let publish evalResult =
case evalResult of case evalResult of
IntermediateResult{} -> return () IntermediateResult{} -> return ()
FinalResult outs page [] -> do FinalResult outs page _ -> do
modifyIORef outputAccum (outs :) modifyIORef outputAccum (outs :)
modifyIORef pagerAccum (page :) modifyIORef pagerAccum (page :)
noWidgetHandling s _ = return s noWidgetHandling s _ = return s
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment