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

@@ -59,7 +59,8 @@ browse pkgmdl = do
 -- >>> splitPkgMdl "Prelude"
 -- (Nothing,"Prelude")
 splitPkgMdl :: String -> (Maybe String,String)
-splitPkgMdl pkgmdl = case break (==':') pkgmdl of
+splitPkgMdl pkgmdl =
+  case break (==':') pkgmdl of
     (mdl, "")    -> (Nothing, mdl)
     (pkg, _:mdl) -> (Just pkg, mdl)
 

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
 
 ----------------------------------------------------------------
 

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 {
@@ -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