From 2875275fc002eaedf4576d774c54d71a36f611ef Mon Sep 17 00:00:00 2001 From: Kazu Yamamoto Date: Thu, 14 Aug 2014 11:11:02 +0900 Subject: [PATCH] hlint suggestions. --- Language/Haskell/GhcMod/CabalApi.hs | 2 +- Language/Haskell/GhcMod/Check.hs | 2 +- Language/Haskell/GhcMod/FillSig.hs | 22 +++++++++++----------- Language/Haskell/GhcMod/Find.hs | 4 ++-- Language/Haskell/GhcMod/Monad.hs | 9 ++++----- 5 files changed, 19 insertions(+), 20 deletions(-) diff --git a/Language/Haskell/GhcMod/CabalApi.hs b/Language/Haskell/GhcMod/CabalApi.hs index 8483691..60cdb8a 100644 --- a/Language/Haskell/GhcMod/CabalApi.hs +++ b/Language/Haskell/GhcMod/CabalApi.hs @@ -76,7 +76,7 @@ parseCabalFile :: (MonadIO m, Error e, MonadError e m) => FilePath -> m PackageDescription parseCabalFile file = do - cid <- liftIO $ getGHCId + cid <- liftIO getGHCId epgd <- liftIO $ readPackageDescription silent file case toPkgDesc cid epgd of Left deps -> fail $ show deps ++ " are not installed" diff --git a/Language/Haskell/GhcMod/Check.hs b/Language/Haskell/GhcMod/Check.hs index 7ec5eb3..6d30f55 100644 --- a/Language/Haskell/GhcMod/Check.hs +++ b/Language/Haskell/GhcMod/Check.hs @@ -36,7 +36,7 @@ checkSyntax files = withErrorHandler sessionName $ check :: IOish m => [FilePath] -- ^ The target files. -> GhcModT m (Either String String) -check fileNames = overrideGhcUserOptions $ \ghcOpts -> do +check fileNames = overrideGhcUserOptions $ \ghcOpts -> withLogger (setAllWaringFlags . setNoMaxRelevantBindings) $ do _ <- G.setSessionDynFlags =<< addCmdOpts ghcOpts =<< G.getSessionDynFlags setTargetFiles fileNames diff --git a/Language/Haskell/GhcMod/FillSig.hs b/Language/Haskell/GhcMod/FillSig.hs index 213c047..e6646df 100644 --- a/Language/Haskell/GhcMod/FillSig.hs +++ b/Language/Haskell/GhcMod/FillSig.hs @@ -118,13 +118,13 @@ getSignature modSum lineNo colNo = do G.DataFamily -> Data #endif #if __GLASGOW_HASKELL__ >= 706 - getTyFamVarName = \x -> case x of - L _ (G.UserTyVar n) -> n - L _ (G.KindedTyVar n _) -> n + getTyFamVarName x = case x of + L _ (G.UserTyVar n) -> n + L _ (G.KindedTyVar n _) -> n #else - getTyFamVarName = \x -> case x of -- In GHC 7.4, HsTyVarBndr's have an extra arg - L _ (G.UserTyVar n _) -> n - L _ (G.KindedTyVar n _ _) -> n + getTyFamVarName x = case x of -- In GHC 7.4, HsTyVarBndr's have an extra arg + L _ (G.UserTyVar n _) -> n + L _ (G.KindedTyVar n _ _) -> n #endif in return $ Just (TyFamDecl loc name flavour $ map getTyFamVarName vars) _ -> return Nothing @@ -169,7 +169,7 @@ initialBody' fname args = initialHead fname args ++ " = " initialFamBody :: FnArgsInfo ty name => DynFlags -> PprStyle -> name -> [name] -> String initialFamBody dflag style name args = initialHead (getFnName dflag style name) - (map (\arg -> FnExplicitName (getFnName dflag style arg)) args) + (map (FnExplicitName . getFnName dflag style) args) ++ " = ()" initialHead :: String -> [FnArg] -> String @@ -298,7 +298,7 @@ findVar dflag style tcm tcs lineNo colNo = then let Just (s,t) = tyInfo b = case others of -- If inside an App, we need parenthesis [] -> False - (L _ (G.HsApp (L _ a1) (L _ a2))):_ -> + L _ (G.HsApp (L _ a1) (L _ a2)):_ -> isSearchedVar i a1 || isSearchedVar i a2 _ -> False in return $ Just (s, name, t, b) @@ -339,9 +339,9 @@ auto file lineNo colNo = ghandle handler body topLevel <- getEverythingInTopLevel minfo let (f,pats) = getPatsForVariable tcs (lineNo,colNo) -- Remove self function to prevent recursion, and id to trim cases - filterFn = (\(n,_) -> let funName = G.getOccString n - recName = G.getOccString (G.getName f) - in not $ funName `elem` recName:notWantedFuns) + filterFn (n,_) = let funName = G.getOccString n + recName = G.getOccString (G.getName f) + in funName `notElem` recName:notWantedFuns -- Find without using other functions in top-level localBnds = M.unions $ map (\(L _ pat) -> getBindingsForPat pat) pats lbn = filter filterFn (M.toList localBnds) diff --git a/Language/Haskell/GhcMod/Find.hs b/Language/Haskell/GhcMod/Find.hs index 7fb0b50..b713ec0 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 #ifndef SPEC @@ -150,7 +150,7 @@ dumpSymbol = do writeSymbolCache :: FilePath -> [(Symbol,[ModuleString])] -> IO () -writeSymbolCache cache sm = do +writeSymbolCache cache sm = void . withFile cache WriteMode $ \hdl -> mapM (hPrint hdl) sm diff --git a/Language/Haskell/GhcMod/Monad.hs b/Language/Haskell/GhcMod/Monad.hs index eb1d860..52f63d1 100644 --- a/Language/Haskell/GhcMod/Monad.hs +++ b/Language/Haskell/GhcMod/Monad.hs @@ -1,7 +1,6 @@ {-# LANGUAGE CPP, GeneralizedNewtypeDeriving, FlexibleInstances #-} {-# LANGUAGE FlexibleContexts, MultiParamTypeClasses, RankNTypes #-} {-# LANGUAGE TypeFamilies, UndecidableInstances, RecordWildCards #-} -{-# LANGUAGE StandaloneDeriving #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Language.Haskell.GhcMod.Monad ( @@ -167,7 +166,7 @@ instance MonadTrans GhcModT where lift = GhcModT . lift . lift . lift . lift instance MonadState s m => MonadState s (GhcModT m) where - get = GhcModT $ lift $ lift $ lift $ get + get = GhcModT $ lift $ lift $ lift get put = GhcModT . lift . lift . lift . put state = GhcModT . lift . lift . lift . state @@ -271,9 +270,9 @@ runGhcModT' :: IOish m -> m (Either GhcModError (a, GhcModState), GhcModLog) runGhcModT' r s a = do (res, w') <- - flip runReaderT r $ runJournalT $ runErrorT $ flip runStateT s - $ (unGhcModT $ initGhcMonad (Just libdir) >> a) - return $ (res, w') + flip runReaderT r $ runJournalT $ runErrorT $ + runStateT (unGhcModT $ initGhcMonad (Just libdir) >> a) s + return (res, w') ---------------------------------------------------------------- withErrorHandler :: IOish m => String -> GhcModT m a -> GhcModT m a