mirror of
https://github.com/IHaskell/IHaskell.git
synced 2025-04-16 11:26:08 +00:00
Use CPP to stay compatible with old HLint
This commit is contained in:
parent
ac0882dc39
commit
cf453170bc
@ -68,7 +68,7 @@ library
|
||||
ghc-parser >=0.1.7,
|
||||
ghc-paths >=0.1,
|
||||
haskeline -any,
|
||||
hlint >=1.9 && <=2.1.17,
|
||||
hlint >=1.9,
|
||||
haskell-src-exts >=1.18,
|
||||
http-client >= 0.4,
|
||||
http-client-tls >= 0.2,
|
||||
|
@ -294,7 +294,7 @@ evaluate kernelState code output widgetHandler = do
|
||||
-- Only run things if there are no parse errors.
|
||||
[] -> do
|
||||
when (getLintStatus kernelState /= LintOff) $ liftIO $ do
|
||||
lintSuggestions <- lint cmds
|
||||
lintSuggestions <- lint code cmds
|
||||
unless (noResults lintSuggestions) $
|
||||
output (FinalResult lintSuggestions [] []) Success
|
||||
|
||||
|
@ -1,16 +1,13 @@
|
||||
{-# LANGUAGE NoImplicitPrelude, FlexibleContexts, ViewPatterns #-}
|
||||
{-# LANGUAGE NoImplicitPrelude, FlexibleContexts, ViewPatterns, CPP #-}
|
||||
|
||||
module IHaskell.Eval.Lint (lint) where
|
||||
|
||||
import IHaskellPrelude
|
||||
|
||||
import Prelude (last)
|
||||
|
||||
import Data.Maybe (mapMaybe)
|
||||
import System.IO.Unsafe (unsafePerformIO)
|
||||
|
||||
import Language.Haskell.Exts.Syntax hiding (Module)
|
||||
import qualified Language.Haskell.Exts.Syntax as SrcExts
|
||||
import Language.Haskell.Exts (parseFileContentsWithMode)
|
||||
import Language.Haskell.Exts hiding (Module)
|
||||
|
||||
import Language.Haskell.HLint as HLint
|
||||
@ -21,7 +18,15 @@ import IHaskell.Display
|
||||
import IHaskell.Eval.Parser hiding (line)
|
||||
import StringUtils (replace)
|
||||
|
||||
type ExtsModule = SrcExts.Module SrcSpanInfo
|
||||
#if MIN_VERSION_hlint(2,1,18)
|
||||
|
||||
#else
|
||||
|
||||
import Prelude (last)
|
||||
import qualified Language.Haskell.Exts.Syntax as SrcExts
|
||||
import Language.Haskell.Exts (parseFileContentsWithMode)
|
||||
|
||||
#endif
|
||||
|
||||
data LintSuggestion =
|
||||
Suggest
|
||||
@ -42,10 +47,47 @@ hlintSettings = unsafePerformIO newEmptyMVar
|
||||
lintIdent :: String
|
||||
lintIdent = "lintIdentAEjlkQeh"
|
||||
|
||||
#if MIN_VERSION_hlint(2,1,18)
|
||||
|
||||
-- | Given code chunks, perform linting and output a displayable report on linting warnings
|
||||
-- and errors.
|
||||
lint :: String -> [Located CodeBlock] -> IO Display
|
||||
lint code _blocks = do
|
||||
-- Initialize hlint settings
|
||||
initialized <- not <$> isEmptyMVar hlintSettings
|
||||
unless initialized $
|
||||
autoSettings' >>= putMVar hlintSettings
|
||||
|
||||
-- Get hlint settings
|
||||
(flags, classify, hint) <- readMVar hlintSettings
|
||||
|
||||
parsed <- parseModuleEx flags "-" (Just code)
|
||||
|
||||
-- create 'suggestions'
|
||||
let ideas = case parsed of
|
||||
Left _ -> []
|
||||
Right mods -> applyHints classify hint [mods]
|
||||
suggestions = mapMaybe showIdea $ filter (not . ignoredIdea) ideas
|
||||
|
||||
return $ Display $
|
||||
if null suggestions
|
||||
then []
|
||||
else [plain $ concatMap plainSuggestion suggestions, html $ htmlSuggestions suggestions]
|
||||
where
|
||||
autoSettings' = do
|
||||
(fixts, classify, hints) <- autoSettings
|
||||
let hidingIgnore = Classify Ignore "Unnecessary hiding" "" ""
|
||||
return (fixts, hidingIgnore:classify, hints)
|
||||
ignoredIdea idea = ideaSeverity idea == Ignore
|
||||
|
||||
#else
|
||||
|
||||
type ExtsModule = SrcExts.Module SrcSpanInfo
|
||||
|
||||
-- | Given parsed code chunks, perform linting and output a displayable report on linting warnings
|
||||
-- and errors.
|
||||
lint :: [Located CodeBlock] -> IO Display
|
||||
lint blocks = do
|
||||
lint :: String -> [Located CodeBlock] -> IO Display
|
||||
lint _code blocks = do
|
||||
-- Initialize hlint settings
|
||||
initialized <- not <$> isEmptyMVar hlintSettings
|
||||
unless initialized $
|
||||
@ -70,20 +112,6 @@ lint blocks = do
|
||||
return (fixts, hidingIgnore:classify, hints)
|
||||
ignoredIdea idea = ideaSeverity idea == Ignore
|
||||
|
||||
showIdea :: Idea -> Maybe LintSuggestion
|
||||
showIdea idea =
|
||||
case ideaTo idea of
|
||||
Nothing -> Nothing
|
||||
Just wn ->
|
||||
Just
|
||||
Suggest
|
||||
{ line = srcSpanStartLine $ ideaSpan idea
|
||||
, found = showSuggestion $ ideaFrom idea
|
||||
, whyNot = showSuggestion wn
|
||||
, severity = ideaSeverity idea
|
||||
, suggestion = ideaHint idea
|
||||
}
|
||||
|
||||
createModule :: ParseMode -> Located CodeBlock -> Maybe ExtsModule
|
||||
createModule md (Located ln block) =
|
||||
case block of
|
||||
@ -154,6 +182,23 @@ createModule md (Located ln block) =
|
||||
imptToModule :: String -> ParseResult ExtsModule
|
||||
imptToModule = parseFileContentsWithMode md
|
||||
|
||||
#endif
|
||||
|
||||
showIdea :: Idea -> Maybe LintSuggestion
|
||||
showIdea idea =
|
||||
case ideaTo idea of
|
||||
Nothing -> Nothing
|
||||
Just wn ->
|
||||
Just
|
||||
Suggest
|
||||
{ line = srcSpanStartLine $ ideaSpan idea
|
||||
, found = showSuggestion $ ideaFrom idea
|
||||
, whyNot = showSuggestion wn
|
||||
, severity = ideaSeverity idea
|
||||
, suggestion = ideaHint idea
|
||||
}
|
||||
|
||||
|
||||
plainSuggestion :: LintSuggestion -> String
|
||||
plainSuggestion suggest =
|
||||
printf "Line %d: %s\nFound:\n%s\nWhy not:\n%s" (line suggest) (suggestion suggest) (found suggest)
|
||||
|
Loading…
x
Reference in New Issue
Block a user