hasufell/ghc-mod
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

adopting hlint's suggestions.

Browse Source
This commit is contained in:
Kazu Yamamoto 2014-07-17 17:16:44 +09:00
parent 05f45f1d36
commit cffa7463eb
15 changed files with 43 additions and 44 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
Language/Haskell/GhcMod/CabalConfig.hs
View File

@ -14,6 +14,10 @@ import Language.Haskell.GhcMod.Types
import qualified Language.Haskell.GhcMod.Cabal16 as C16
import qualified Language.Haskell.GhcMod.Cabal18 as C18
#ifndef MIN_VERSION_mtl
#define MIN_VERSION_mtl(x,y,z) 1
#endif
import qualified Control.Exception as E
import Control.Applicative ((<$>))
import Control.Monad (mplus)
@ -59,7 +63,7 @@ configDependencies :: PackageIdentifier -> CabalConfig -> [Package]
configDependencies thisPkg config = map fromInstalledPackageId deps
where
deps :: [InstalledPackageId]
deps = case (deps18 `mplus` deps16) of
deps = case deps18 `mplus` deps16 of
Right ps -> ps
Left msg -> error msg

2
Language/Haskell/GhcMod/CaseSplit.hs
View File

@ -184,7 +184,7 @@ getBindingText text srcSpan =
[T.drop (sc - 1) $ T.take ec $ head lines_]
else -- several lines
let (first,rest,last_) = (head lines_, tail $ init lines_, last lines_)
in (T.drop (sc - 1) first) : rest ++ [T.take ec last_]
in T.drop (sc - 1) first : rest ++ [T.take ec last_]
srcSpanDifference :: SrcSpan -> SrcSpan -> (Int,Int,Int,Int)
srcSpanDifference b v =

7
Language/Haskell/GhcMod/Check.hs
View File

@ -19,7 +19,7 @@ checkSyntax :: IOish m
=> [FilePath] -- ^ The target files.
-> GhcModT m String
checkSyntax [] = return ""
checkSyntax files = withErrorHandler sessionName $ do
checkSyntax files = withErrorHandler sessionName $
either id id <$> check files
where
sessionName = case files of
@ -33,8 +33,7 @@ checkSyntax files = withErrorHandler sessionName $ do
check :: IOish m
=> [FilePath] -- ^ The target files.
-> GhcModT m (Either String String)
check fileNames = do
withLogger setAllWaringFlags $ setTargetFiles fileNames
check fileNames = withLogger setAllWaringFlags $ setTargetFiles fileNames
----------------------------------------------------------------
@ -43,7 +42,7 @@ expandTemplate :: IOish m
=> [FilePath] -- ^ The target files.
-> GhcModT m String
expandTemplate [] = return ""
expandTemplate files = withErrorHandler sessionName $ do
expandTemplate files = withErrorHandler sessionName $
either id id <$> expand files
where
sessionName = case files of

4
Language/Haskell/GhcMod/Convert.hs
View File

@ -81,14 +81,14 @@ instance ToString ((Int,Int,Int,Int),String) where
toPlain opt x = tupToString opt x
instance ToString (String, (Int,Int,Int,Int),[String]) where
toLisp opt (s,x,y) = toSexp2 $ [toLisp opt s, ('(' :) . fourIntsToString opt x . (')' :), toLisp opt y]
toLisp opt (s,x,y) = toSexp2 [toLisp opt s, ('(' :) . fourIntsToString opt x . (')' :), toLisp opt y]
toPlain opt (s,x,y) = inter '\n' [toPlain opt s, fourIntsToString opt x, toPlain opt y]
toSexp1 :: Options -> [String] -> Builder
toSexp1 opt ss = ('(' :) . inter ' ' (map (quote opt) ss) . (')' :)
toSexp2 :: [Builder] -> Builder
toSexp2 ss = ('(' :) . (inter ' ' ss) . (')' :)
toSexp2 ss = ('(' :) . inter ' ' ss . (')' :)
fourIntsToString :: Options -> (Int,Int,Int,Int) -> Builder
fourIntsToString _ (a,b,c,d) = (show a ++) . (' ' :)

3
Language/Haskell/GhcMod/Cradle.hs
View File

@ -22,8 +22,7 @@ import System.FilePath ((</>), takeDirectory)
-- Find a sandbox according to a cabal sandbox config
-- in a cabal directory.
findCradle :: IO Cradle
findCradle = do
findCradle' =<< getCurrentDirectory
findCradle = findCradle' =<< getCurrentDirectory
findCradle' :: FilePath -> IO Cradle
findCradle' dir = cabalCradle dir ||> sandboxCradle dir ||> plainCradle dir

2
Language/Haskell/GhcMod/Debug.hs
View File

@ -16,7 +16,7 @@ debugInfo :: IOish m => GhcModT m String
debugInfo = cradle >>= \c -> convert' =<< do
CompilerOptions gopts incDir pkgs <-
if isJust $ cradleCabalFile c then
(fromCabalFile c ||> simpleCompilerOption)
fromCabalFile c ||> simpleCompilerOption
else
simpleCompilerOption
return [

5
Language/Haskell/GhcMod/DynFlags.hs
View File

@ -101,8 +101,7 @@ needsFallback = any (hasTHorQQ . G.ms_hspp_opts)
-- | Return the 'DynFlags' currently in use in the GHC session.
getDynamicFlags :: IO DynFlags
getDynamicFlags = do
G.runGhc (Just libdir) G.getSessionDynFlags
getDynamicFlags = G.runGhc (Just libdir) G.getSessionDynFlags
withDynFlags :: GhcMonad m
=> (DynFlags -> DynFlags)
@ -136,7 +135,7 @@ setAllWaringFlags :: DynFlags -> DynFlags
setAllWaringFlags df = df { warningFlags = allWarningFlags }
allWarningFlags :: Gap.WarnFlags
allWarningFlags = unsafePerformIO $ do
allWarningFlags = unsafePerformIO $
G.runGhc (Just libdir) $ do
df <- G.getSessionDynFlags
df' <- addCmdOpts ["-Wall"] df

28
Language/Haskell/GhcMod/FillSig.hs
View File

@ -5,7 +5,7 @@ module Language.Haskell.GhcMod.FillSig (
) where
import Data.Char (isSymbol)
import Data.List (find, intercalate)
import Data.List (find)
import Exception (ghandle, SomeException(..))
import GHC (GhcMonad, Id, ParsedModule(..), TypecheckedModule(..), DynFlags, SrcSpan, Type, GenLocated(L))
import qualified GHC as G
@ -45,7 +45,7 @@ sig file lineNo colNo = ghandle handler body
whenFound opt (getSignature modSum lineNo colNo) $ \s -> case s of
Signature loc names ty ->
("function", fourInts loc, map (initialBody dflag style ty) names)
InstanceDecl loc cls -> do
InstanceDecl loc cls ->
("instance", fourInts loc, map (\x -> initialBody dflag style (G.idType x) x)
(Ty.classMethods cls))
@ -109,8 +109,8 @@ initialBody' fname args =
case initialBodyArgs args infiniteVars infiniteFns of
[] -> fname
arglist -> if isSymbolName fname
then (head arglist) ++ " " ++ fname ++ " " ++ (intercalate " " (tail arglist))
else fname ++ " " ++ (intercalate " " arglist)
then head arglist ++ " " ++ fname ++ " " ++ unwords (tail arglist)
else fname ++ " " ++ unwords arglist
++ " = " ++ (if isSymbolName fname then "" else '_':fname) ++ "_body"
initialBodyArgs :: [FnArg] -> [String] -> [String] -> [String]
@ -133,11 +133,11 @@ instance FnArgsInfo (G.HsType G.RdrName) (G.RdrName) where
getFnArgs (G.HsForAllTy _ _ _ (L _ iTy)) = getFnArgs iTy
getFnArgs (G.HsParTy (L _ iTy)) = getFnArgs iTy
getFnArgs (G.HsFunTy (L _ lTy) (L _ rTy)) = (if fnarg lTy then FnArgFunction else FnArgNormal):getFnArgs rTy
where fnarg = \ty -> case ty of
(G.HsForAllTy _ _ _ (L _ iTy)) -> fnarg iTy
(G.HsParTy (L _ iTy)) -> fnarg iTy
(G.HsFunTy _ _) -> True
_ -> False
where fnarg ty = case ty of
(G.HsForAllTy _ _ _ (L _ iTy)) -> fnarg iTy
(G.HsParTy (L _ iTy)) -> fnarg iTy
(G.HsFunTy _ _) -> True
_ -> False
getFnArgs _ = []
instance FnArgsInfo (HE.Type HE.SrcSpanInfo) (HE.Name HE.SrcSpanInfo) where
@ -146,11 +146,11 @@ instance FnArgsInfo (HE.Type HE.SrcSpanInfo) (HE.Name HE.SrcSpanInfo) where
getFnArgs (HE.TyForall _ _ _ iTy) = getFnArgs iTy
getFnArgs (HE.TyParen _ iTy) = getFnArgs iTy
getFnArgs (HE.TyFun _ lTy rTy) = (if fnarg lTy then FnArgFunction else FnArgNormal):getFnArgs rTy
where fnarg = \ty -> case ty of
(HE.TyForall _ _ _ iTy) -> fnarg iTy
(HE.TyParen _ iTy) -> fnarg iTy
(HE.TyFun _ _ _) -> True
_ -> False
where fnarg ty = case ty of
(HE.TyForall _ _ _ iTy) -> fnarg iTy
(HE.TyParen _ iTy) -> fnarg iTy
(HE.TyFun _ _ _) -> True
_ -> False
getFnArgs _ = []
instance FnArgsInfo Type Id where

4
Language/Haskell/GhcMod/Find.hs
View File

@ -1,4 +1,4 @@
{-# LANGUAGE CPP, BangPatterns #-}
{-# LANGUAGE CPP #-}
module Language.Haskell.GhcMod.Find (
Symbol
@ -118,7 +118,7 @@ dumpSymbol = do
when create $ do
sm <- getSymbol
void . liftIO $ withFile cache WriteMode $ \hdl ->
mapM (hPutStrLn hdl . show) sm
mapM (hPrint hdl) sm
return cache
return $ ret ++ "\n"

8
Language/Haskell/GhcMod/GHCApi.hs
View File

@ -1,4 +1,4 @@
{-# LANGUAGE ScopedTypeVariables, RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Language.Haskell.GhcMod.GHCApi (
ghcPkgDb
@ -42,8 +42,7 @@ modules :: G.PackageConfig -> [ModuleString]
modules = map G.moduleNameString . G.exposedModules
findModule :: ModuleString -> PkgDb -> [Package]
findModule m db = do
M.elems $ package `M.map` (containsModule `M.filter` db)
findModule m db = M.elems $ package `M.map` (containsModule `M.filter` db)
where
containsModule :: G.PackageConfig -> Bool
containsModule pkgConf =
@ -83,5 +82,4 @@ localModuleInfo :: GhcMonad m => ModuleString -> m (Maybe G.ModuleInfo)
localModuleInfo mdl = moduleInfo Nothing mdl
bindings :: G.ModuleInfo -> [Binding]
bindings minfo = do
map (G.occNameString . G.getOccName) $ G.modInfoExports minfo
bindings minfo = map (G.occNameString . G.getOccName) $ G.modInfoExports minfo

2
Language/Haskell/GhcMod/Lint.hs
View File

@ -16,7 +16,7 @@ lint :: IOish m
-> GhcModT m String
lint file = do
opt <- options
ghandle handler . pack =<< (liftIO $ hlint $ file : "--quiet" : hlintOpts opt)
ghandle handler . pack =<< liftIO (hlint $ file : "--quiet" : hlintOpts opt)
where
pack = convert' . map (init . show) -- init drops the last \n.
handler (SomeException e) = return $ checkErrorPrefix ++ show e ++ "\n"

2
Language/Haskell/GhcMod/List.hs
View File

@ -16,7 +16,7 @@ import UniqFM (eltsUFM)
modules :: IOish m => GhcModT m String
modules = do
opt <- options
convert opt . (arrange opt) <$> (getModules `G.gcatch` handler)
convert opt . arrange opt <$> (getModules `G.gcatch` handler)
where
getModules = getExposedModules <$> G.getSessionDynFlags
getExposedModules = concatMap exposedModules'

8
Language/Haskell/GhcMod/Logger.hs
View File

@ -1,4 +1,4 @@
{-# LANGUAGE BangPatterns, CPP #-}
{-# LANGUAGE CPP #-}
module Language.Haskell.GhcMod.Logger (
withLogger
@ -63,9 +63,9 @@ withLogger :: IOish m
-> GhcModT m ()
-> GhcModT m (Either String String)
withLogger setDF body = ghandle sourceError $ do
logref <- liftIO $ newLogRef
logref <- liftIO newLogRef
wflags <- filter ("-fno-warn" `isPrefixOf`) . ghcOpts <$> options
withDynFlags (setLogger logref . setDF) $ do
withDynFlags (setLogger logref . setDF) $
withCmdFlags wflags $ do
body
Right <$> readAndClearLogRef logref
@ -80,7 +80,7 @@ sourceError :: IOish m => SourceError -> GhcModT m (Either String String)
sourceError err = do
dflags <- G.getSessionDynFlags
style <- toGhcMod getStyle
ret <- convert' $ (errBagToStrList dflags style . srcErrorMessages $ err)
ret <- convert' (errBagToStrList dflags style . srcErrorMessages $ err)
return $ Left ret
errBagToStrList :: DynFlags -> PprStyle -> Bag ErrMsg -> [String]

4
Language/Haskell/GhcMod/Monad.hs
View File

@ -188,8 +188,8 @@ initSession :: GhcMonad m
-> m ()
initSession build Options {..} CompilerOptions {..} = do
df <- G.getSessionDynFlags
void $ G.setSessionDynFlags =<< (addCmdOpts ghcOptions
$ setModeSimple
void $ G.setSessionDynFlags =<< addCmdOpts ghcOptions
( setModeSimple
$ setIncludeDirs includeDirs
$ setBuildEnv build
$ setEmptyLogger

2
Language/Haskell/GhcMod/Utils.hs
View File

@ -18,7 +18,7 @@ extractParens str = extractParens' str 0
extractParens' (s:ss) level
| s `elem` "([{" = s : extractParens' ss (level+1)
| level == 0 = extractParens' ss 0
| s `elem` "}])" && level == 1 = s:[]
| s `elem` "}])" && level == 1 = [s]
| s `elem` "}])" = s : extractParens' ss (level-1)
| otherwise = s : extractParens' ss level