diff --git a/Language/Haskell/GhcMod/CabalConfig.hs b/Language/Haskell/GhcMod/CabalConfig.hs index 7392ae4..5612535 100644 --- a/Language/Haskell/GhcMod/CabalConfig.hs +++ b/Language/Haskell/GhcMod/CabalConfig.hs @@ -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 diff --git a/Language/Haskell/GhcMod/CaseSplit.hs b/Language/Haskell/GhcMod/CaseSplit.hs index 01fe777..11871ca 100644 --- a/Language/Haskell/GhcMod/CaseSplit.hs +++ b/Language/Haskell/GhcMod/CaseSplit.hs @@ -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 = diff --git a/Language/Haskell/GhcMod/Check.hs b/Language/Haskell/GhcMod/Check.hs index f30a48d..cd6591c 100644 --- a/Language/Haskell/GhcMod/Check.hs +++ b/Language/Haskell/GhcMod/Check.hs @@ -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 diff --git a/Language/Haskell/GhcMod/Convert.hs b/Language/Haskell/GhcMod/Convert.hs index ee1398b..295f888 100644 --- a/Language/Haskell/GhcMod/Convert.hs +++ b/Language/Haskell/GhcMod/Convert.hs @@ -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 ++) . (' ' :) diff --git a/Language/Haskell/GhcMod/Cradle.hs b/Language/Haskell/GhcMod/Cradle.hs index ecfc1c8..3f2209d 100644 --- a/Language/Haskell/GhcMod/Cradle.hs +++ b/Language/Haskell/GhcMod/Cradle.hs @@ -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 diff --git a/Language/Haskell/GhcMod/Debug.hs b/Language/Haskell/GhcMod/Debug.hs index 994411d..d9cd186 100644 --- a/Language/Haskell/GhcMod/Debug.hs +++ b/Language/Haskell/GhcMod/Debug.hs @@ -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 [ diff --git a/Language/Haskell/GhcMod/DynFlags.hs b/Language/Haskell/GhcMod/DynFlags.hs index 76b6da1..a4c75d6 100644 --- a/Language/Haskell/GhcMod/DynFlags.hs +++ b/Language/Haskell/GhcMod/DynFlags.hs @@ -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 diff --git a/Language/Haskell/GhcMod/FillSig.hs b/Language/Haskell/GhcMod/FillSig.hs index 4698af1..2e103c0 100644 --- a/Language/Haskell/GhcMod/FillSig.hs +++ b/Language/Haskell/GhcMod/FillSig.hs @@ -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 diff --git a/Language/Haskell/GhcMod/Find.hs b/Language/Haskell/GhcMod/Find.hs index db7346c..cd0a6aa 100644 --- a/Language/Haskell/GhcMod/Find.hs +++ b/Language/Haskell/GhcMod/Find.hs @@ -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" diff --git a/Language/Haskell/GhcMod/GHCApi.hs b/Language/Haskell/GhcMod/GHCApi.hs index b765698..a3ac817 100644 --- a/Language/Haskell/GhcMod/GHCApi.hs +++ b/Language/Haskell/GhcMod/GHCApi.hs @@ -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 diff --git a/Language/Haskell/GhcMod/Lint.hs b/Language/Haskell/GhcMod/Lint.hs index cfa915f..b126e25 100644 --- a/Language/Haskell/GhcMod/Lint.hs +++ b/Language/Haskell/GhcMod/Lint.hs @@ -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" diff --git a/Language/Haskell/GhcMod/List.hs b/Language/Haskell/GhcMod/List.hs index dd8f700..6450e5e 100644 --- a/Language/Haskell/GhcMod/List.hs +++ b/Language/Haskell/GhcMod/List.hs @@ -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' diff --git a/Language/Haskell/GhcMod/Logger.hs b/Language/Haskell/GhcMod/Logger.hs index e46c2d7..5167372 100644 --- a/Language/Haskell/GhcMod/Logger.hs +++ b/Language/Haskell/GhcMod/Logger.hs @@ -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] diff --git a/Language/Haskell/GhcMod/Monad.hs b/Language/Haskell/GhcMod/Monad.hs index f4390a7..919289d 100644 --- a/Language/Haskell/GhcMod/Monad.hs +++ b/Language/Haskell/GhcMod/Monad.hs @@ -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 diff --git a/Language/Haskell/GhcMod/Utils.hs b/Language/Haskell/GhcMod/Utils.hs index cd04a3e..365f1b9 100644 --- a/Language/Haskell/GhcMod/Utils.hs +++ b/Language/Haskell/GhcMod/Utils.hs @@ -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