Improve style

Language/Haskell/GhcMod/Boot.hs

@@ -9,8 +9,9 @@ import Language.Haskell.GhcMod.Modules
 
 -- | Printing necessary information for front-end booting.
 boot :: IOish m => GhcModT m String
-boot =  concat <$> sequence [modules, languages, flags,
+boot = concat <$> sequence ms
-                             concat <$> mapM browse preBrowsedModules]
+  where
+    ms = [modules, languages, flags, concat <$> mapM browse preBrowsedModules]
 
 preBrowsedModules :: [String]
 preBrowsedModules = [

Language/Haskell/GhcMod/Browse.hs

@@ -48,7 +48,7 @@ browse pkgmdl = do
 
     tryModuleInfo m = fromJust <$> G.getModuleInfo m
 
-    (mpkg,mdl) = splitPkgMdl pkgmdl
+    (mpkg, mdl) = splitPkgMdl pkgmdl
     mdlname = G.mkModuleName mdl
     mpkgid = mkFastString <$> mpkg
 
@@ -59,9 +59,10 @@ browse pkgmdl = do
 -- >>> splitPkgMdl "Prelude"
 -- (Nothing,"Prelude")
 splitPkgMdl :: String -> (Maybe String,String)
-splitPkgMdl pkgmdl = case break (==':') pkgmdl of
+splitPkgMdl pkgmdl =
-    (mdl,"")    -> (Nothing,mdl)
+  case break (==':') pkgmdl of
-    (pkg,_:mdl) -> (Just pkg,mdl)
+    (mdl, "")    -> (Nothing, mdl)
+    (pkg, _:mdl) -> (Just pkg, mdl)
 
 -- Haskell 2010:
 -- small -> ascSmall | uniSmall | _

Language/Haskell/GhcMod/FillSig.hs

@@ -79,17 +79,14 @@ sig file lineNo colNo =
           Signature loc names ty ->
               ("function", fourInts loc, map (initialBody dflag style ty) names)
 
-          InstanceDecl loc cls -> let
+          InstanceDecl loc cls ->
-                body x = initialBody dflag style (G.idType x) x
+            let body x = initialBody dflag style (G.idType x) x
-            in
+            in ("instance", fourInts loc, body `map` Ty.classMethods cls)
-              ("instance", fourInts loc, body `map` Ty.classMethods cls)
 
           TyFamDecl loc name flavour vars ->
             let (rTy, initial) = initialTyFamString flavour
                 body = initialFamBody dflag style name vars
             in (rTy, fourInts loc, [initial ++ body])
-
-
   where
     fallback (SomeException _) = do
       opt <- options
@@ -244,9 +241,11 @@ initialHead1 :: String -> [FnArg] -> [String] -> String
 initialHead1 fname args elts =
   case initialBodyArgs1 args elts of
     []      -> fname
-    arglist -> if isSymbolName fname
+    arglist
-               then head arglist ++ " " ++ fname ++ " " ++ unwords (tail arglist)
+      | isSymbolName fname ->
-               else fname ++ " " ++ unwords arglist
+        head arglist ++ " " ++ fname ++ " " ++ unwords (tail arglist)
+      | otherwise ->
+        fname ++ " " ++ unwords arglist
 
 initialBodyArgs1 :: [FnArg] -> [String] -> [String]
 initialBodyArgs1 args elts = take (length args) elts
@@ -338,7 +337,8 @@ refine :: IOish m
        -> Expression   -- ^ A Haskell expression.
        -> GhcModT m String
 refine file lineNo colNo expr =
-  ghandle handler $ runGmlT' [Left file] deferErrors $ do
+  ghandle handler $
+    runGmlT' [Left file] deferErrors $ do
       opt <- options
       style <- getStyle
       dflag <- G.getSessionDynFlags
@@ -355,22 +355,27 @@ refine file lineNo colNo expr =
                 iArgs = take diffArgs eArgs
                 text = initialHead1 expr iArgs (infinitePrefixSupply name)
              in (fourInts loc, doParen paren text)
-
   where
     handler (SomeException _) = emptyResult =<< options
 
 -- Look for the variable in the specified position
-findVar :: GhcMonad m => DynFlags -> PprStyle
+findVar
-                      -> G.TypecheckedModule -> G.TypecheckedSource
+  :: GhcMonad m
-                      -> Int -> Int -> m (Maybe (SrcSpan, String, Type, Bool))
+  => DynFlags
+  -> PprStyle
+  -> G.TypecheckedModule
+  -> G.TypecheckedSource
+  -> Int
+  -> Int
+  -> m (Maybe (SrcSpan, String, Type, Bool))
 findVar dflag style tcm tcs lineNo colNo =
   case lst of
     e@(L _ (G.HsVar i)):others -> do
       tyInfo <- Gap.getType tcm e
       case tyInfo of
-        Just (span, typ)
+        Just (s, typ)
           | name == "undefined" || head name == '_' ->
-            return $ Just (span, name, typ, b)
+            return $ Just (s, name, typ, b)
           where
             name = getFnName dflag style i
             -- If inside an App, we need parenthesis

Language/Haskell/GhcMod/Find.hs

@@ -2,8 +2,7 @@
 
 module Language.Haskell.GhcMod.Find
 #ifndef SPEC
-  (
+  ( Symbol
-    Symbol
   , SymbolDb
   , loadSymbolDb
   , lookupSymbol
@@ -33,17 +32,8 @@ import System.Directory (doesFileExist, getModificationTime)
 import System.FilePath ((</>))
 import System.IO
 
-#ifndef MIN_VERSION_containers
-#define MIN_VERSION_containers(x,y,z) 1
-#endif
-
-#if MIN_VERSION_containers(0,5,0)
 import Data.Map (Map)
 import qualified Data.Map as M
-#else
-import Data.Map (Map)
-import qualified Data.Map as M
-#endif
 
 ----------------------------------------------------------------
 
@@ -88,7 +78,7 @@ loadSymbolDb = do
     , symbolDbCachePath = file
     }
   where
-    conv :: String -> (Symbol,[ModuleString])
+    conv :: String -> (Symbol, [ModuleString])
     conv = read
     chop :: String -> String
     chop "" = ""
@@ -113,7 +103,7 @@ dumpSymbol dir = do
     cache = dir </> symbolCacheFile
 
 writeSymbolCache :: FilePath
-                 -> [(Symbol,[ModuleString])]
+                 -> [(Symbol, [ModuleString])]
                  -> IO ()
 writeSymbolCache cache sm =
   void . withFile cache WriteMode $ \hdl ->
@@ -131,7 +121,7 @@ isOlderThan cache files = do
     return $ any (tCache <=) $ map tfTime files -- including equal just in case
 
 -- | Browsing all functions in all system modules.
-getGlobalSymbolTable :: LightGhc [(Symbol,[ModuleString])]
+getGlobalSymbolTable :: LightGhc [(Symbol, [ModuleString])]
 getGlobalSymbolTable = do
   df  <- G.getSessionDynFlags
   let mods = listVisibleModules df
@@ -141,14 +131,14 @@ getGlobalSymbolTable = do
 
 extractBindings :: (Maybe G.ModuleInfo, G.Module)
                 -> [(Symbol, ModuleString)]
-extractBindings (Nothing,_)  = []
+extractBindings (Nothing,  _)   = []
-extractBindings (Just inf,mdl) =
+extractBindings (Just inf, mdl) =
   map (\name -> (getOccString name, moduleNameString $ moduleName mdl)) names
   where
     names = G.modInfoExports inf
 
-collectModules :: [(Symbol,ModuleString)]
+collectModules :: [(Symbol, ModuleString)]
-               -> [(Symbol,[ModuleString])]
+               -> [(Symbol, [ModuleString])]
 collectModules = map tieup . groupBy ((==) `on` fst) . sort
   where
     tieup x = (head (map fst x), map snd x)

Language/Haskell/GhcMod/Info.hs

@@ -30,21 +30,22 @@ info :: IOish m
      -> Expression   -- ^ A Haskell expression.
      -> GhcModT m String
 info file expr =
-    ghandle handler $ runGmlT' [Left file] deferErrors $ withContext $
+  ghandle handler $
+    runGmlT' [Left file] deferErrors $
+      withContext $
         convert <$> options <*> body
   where
     handler (SomeException ex) = do
-        gmLog GmException "info" $
+      gmLog GmException "info" $ text "" $$ nest 4 (showDoc ex)
-                text "" $$ nest 4 (showDoc ex)
       convert' "Cannot show info"
 
+    body :: GhcMonad m => m String
     body = do
       sdoc  <- Gap.infoThing expr
       st    <- getStyle
       dflag <- G.getSessionDynFlags
       return $ showPage dflag st sdoc
 
-
 ----------------------------------------------------------------
 
 -- | Obtaining type of a target expression. (GHCi's type:)
@@ -54,14 +55,14 @@ types :: IOish m
       -> Int          -- ^ Column number.
       -> GhcModT m String
 types file lineNo colNo =
-    ghandle handler $ runGmlT' [Left file] deferErrors $ withContext $ do
+  ghandle handler $
+    runGmlT' [Left file] deferErrors $
+      withContext $ do
         crdl         <- cradle
         modSum       <- Gap.fileModSummary (cradleCurrentDir crdl </> file)
         srcSpanTypes <- getSrcSpanType modSum lineNo colNo
-
         dflag        <- G.getSessionDynFlags
         st           <- getStyle
-
         convert' $ map (toTup dflag st) $ sortBy (cmp `on` fst) srcSpanTypes
  where
    handler (SomeException ex) = do

Language/Haskell/GhcMod/Types.hs

@@ -83,7 +83,6 @@ data Options = Options {
   , hlintOpts     :: [String]
   } deriving (Show)
 
-
 -- | A default 'Options'.
 defaultOptions :: Options
 defaultOptions = Options {
@@ -93,7 +92,7 @@ defaultOptions = Options {
   , ghcProgram     = "ghc"
   , ghcPkgProgram  = "ghc-pkg"
   , cabalProgram   = "cabal"
-  , ghcUserOptions= []
+  , ghcUserOptions = []
   , operators      = False
   , detailed       = False
   , qualified      = False
@@ -140,19 +139,19 @@ type PackageId  = String
 type Package = (PackageBaseName, PackageVersion, PackageId)
 
 pkgName :: Package -> PackageBaseName
-pkgName (n,_,_) = n
+pkgName (n, _, _) = n
 
 pkgVer :: Package -> PackageVersion
-pkgVer (_,v,_) = v
+pkgVer (_, v, _) = v
 
 pkgId :: Package -> PackageId
-pkgId (_,_,i) = i
+pkgId (_, _, i) = i
 
 showPkg :: Package -> String
-showPkg (n,v,_) = intercalate "-" [n,v]
+showPkg (n, v, _) = intercalate "-" [n, v]
 
 showPkgId :: Package -> String
-showPkgId (n,v,i) = intercalate "-" [n,v,i]
+showPkgId (n, v, i) = intercalate "-" [n, v, i]
 
 -- | Haskell expression.
 type Expression = String
@@ -163,7 +162,8 @@ type ModuleString = String
 -- | A Module
 type Module = [String]
 
-data GmLogLevel = GmSilent
+data GmLogLevel =
+    GmSilent
   | GmPanic
   | GmException
   | GmError
@@ -180,28 +180,25 @@ data GmModuleGraph = GmModuleGraph {
   } deriving (Eq, Ord, Show, Read, Generic, Typeable)
 
 instance Serialize GmModuleGraph where
-    put GmModuleGraph {..} = let
+  put GmModuleGraph {..} = put (mpim, graph)
+    where
       mpim :: Map ModulePath Integer
+      mpim = Map.fromList $ Map.keys gmgGraph `zip` [0..]
       graph :: Map Integer (Set Integer)
-
+      graph = Map.map (Set.map mpToInt) $ Map.mapKeys mpToInt gmgGraph
-        mpim = Map.fromList $
-                (Map.keys gmgGraph) `zip` [0..]
       mpToInt :: ModulePath -> Integer
       mpToInt mp = fromJust $ Map.lookup mp mpim
 
-        graph = Map.map (Set.map mpToInt) $ Map.mapKeys mpToInt gmgGraph
-        in put (mpim, graph)
-
   get = do
     (mpim :: Map ModulePath Integer, graph :: Map Integer (Set Integer)) <- get
-     let
+    let impm = swapMap mpim
-         swapMap = Map.fromList . map swap . Map.toList
-         swap (a,b) = (b,a)
-         impm = swapMap mpim
         intToMp i = fromJust $ Map.lookup i impm
         mpGraph :: Map ModulePath (Set ModulePath)
         mpGraph = Map.map (Set.map intToMp) $ Map.mapKeys intToMp graph
     return $ GmModuleGraph mpGraph
+    where
+      swapMap :: (Ord k, Ord v) => Map k v -> Map v k
+      swapMap = Map.fromList . map (\(x, y) -> (y, x)) . Map.toList
 
 instance Monoid GmModuleGraph where
   mempty  = GmModuleGraph mempty
@@ -211,15 +208,15 @@ instance Monoid GmModuleGraph where
 data GmComponentType = GMCRaw
                      | GMCResolved
 data GmComponent (t :: GmComponentType) eps = GmComponent {
-      gmcHomeModuleGraph :: GmModuleGraph,
+    gmcHomeModuleGraph :: GmModuleGraph
-      gmcName            :: ChComponentName,
+  , gmcName            :: ChComponentName
-      gmcGhcOpts         :: [GHCOption],
+  , gmcGhcOpts         :: [GHCOption]
-      gmcGhcPkgOpts      :: [GHCOption],
+  , gmcGhcPkgOpts      :: [GHCOption]
-      gmcGhcSrcOpts      :: [GHCOption],
+  , gmcGhcSrcOpts      :: [GHCOption]
-      gmcGhcLangOpts     :: [GHCOption],
+  , gmcGhcLangOpts     :: [GHCOption]
-      gmcRawEntrypoints  :: ChEntrypoint,
+  , gmcRawEntrypoints  :: ChEntrypoint
-      gmcEntrypoints     :: eps,
+  , gmcEntrypoints     :: eps
-      gmcSourceDirs      :: [FilePath]
+  , gmcSourceDirs      :: [FilePath]
   } deriving (Eq, Ord, Show, Read, Generic, Functor)
 
 instance Serialize eps => Serialize (GmComponent t eps)
@@ -236,11 +233,15 @@ instance Show ModuleName where
   show mn = "ModuleName " ++ show (moduleNameString mn)
 
 instance Read ModuleName where
-    readsPrec d r = readParen (d > app_prec)
+  readsPrec d =
-                         (\r' -> [(mkModuleName m,t) |
+    readParen
-                                 ("ModuleName",s) <- lex r',
+      (d > app_prec)
-                                 (m,t) <- readsPrec (app_prec+1) s]) r
+      (\r' -> [ (mkModuleName m, t)
-        where app_prec = 10
+              | ("ModuleName", s) <- lex r'
+              , (m, t)            <- readsPrec (app_prec + 1) s
+              ])
+    where
+      app_prec = 10
 
 data GhcModError
   = GMENoMsg

Language/Haskell/GhcMod/Utils.hs

@@ -15,26 +15,26 @@
 -- along with this program.  If not, see <http://www.gnu.org/licenses/>.
 
 {-# LANGUAGE CPP #-}
+{-# LANGUAGE DoAndIfThenElse #-}
+
 module Language.Haskell.GhcMod.Utils (
     module Language.Haskell.GhcMod.Utils
   , module Utils
   , readProcess
   ) where
 
-import Control.Arrow
 import Control.Applicative
 import Data.Char
+import Exception
 import Language.Haskell.GhcMod.Error
 import Language.Haskell.GhcMod.Monad.Types
-import Exception
 import System.Directory (getCurrentDirectory, setCurrentDirectory, doesFileExist,
-                         getTemporaryDirectory, canonicalizePath, doesFileExist)
+                         getTemporaryDirectory, canonicalizePath)
-import System.Process (readProcess)
+import System.Environment
-import System.Directory ()
 import System.FilePath (splitDrive, takeDirectory, takeFileName, pathSeparators,
                         (</>))
 import System.IO.Temp (createTempDirectory)
-import System.Environment
+import System.Process (readProcess)
 import Text.Printf
 
 import Paths_ghc_mod (getLibexecDir)
@@ -46,18 +46,21 @@ dropWhileEnd p = foldr (\x xs -> if p x && null xs then [] else x : xs) []
 
 withDirectory_ :: (MonadIO m, ExceptionMonad m) => FilePath -> m a -> m a
 withDirectory_ dir action =
-    gbracket (liftIO getCurrentDirectory) (liftIO . setCurrentDirectory)
+  gbracket
+    (liftIO getCurrentDirectory)
+    (liftIO . setCurrentDirectory)
     (\_ -> liftIO (setCurrentDirectory dir) >> action)
 
 uniqTempDirName :: FilePath -> FilePath
-uniqTempDirName dir = ("ghc-mod"++) $ uncurry (++)
+uniqTempDirName dir =
-        $ map escapeDriveChar *** map escapePathChar
+  "ghc-mod" ++ map escapeDriveChar drive ++ map escapePathChar path
-        $ splitDrive dir
   where
+    (drive, path) = splitDrive dir
+    escapeDriveChar :: Char -> Char
     escapeDriveChar c
       | isAlphaNum c = c
       | otherwise     = '-'
-
+    escapePathChar :: Char -> Char
     escapePathChar c
       | c `elem` pathSeparators = '-'
       | otherwise               = c
@@ -119,10 +122,8 @@ tryFindGhcModTreeLibexecDir :: IO (Maybe FilePath)
 tryFindGhcModTreeLibexecDir  = do
   exe <- getExecutablePath'
   dir <- case takeFileName exe of
-    "ghc" -> do -- we're probably in ghci; try CWD
+    "ghc" -> getCurrentDirectory -- we're probably in ghci; try CWD
-        getCurrentDirectory
+    _     -> return $ (!!4) $ iterate takeDirectory exe
-    _ ->
-        return $ (!!4) $ iterate takeDirectory exe
   exists <- doesFileExist $ dir </> "ghc-mod.cabal"
   return $ if exists
            then Just dir