Move lots of stuff to GhcMod

- Generalize many signatures to GhcMonad m

Language/Haskell/GhcMod/CaseSplit.hs

@@ -7,11 +7,12 @@ import Data.List (find, intercalate)
 import qualified Data.Text as T
 import qualified Data.Text.IO as T (readFile)
 import Exception (ghandle, SomeException(..))
-import GHC (Ghc, LHsBind, LHsExpr, LPat, Id, ParsedModule(..), TypecheckedModule(..), DynFlags, SrcSpan, Type, GenLocated(L))
+import GHC (GhcMonad, LHsBind, LHsExpr, LPat, Id, ParsedModule(..), TypecheckedModule(..), DynFlags, SrcSpan, Type, GenLocated(L))
 import qualified GHC as G
 import Language.Haskell.GhcMod.GHCApi
 import Language.Haskell.GhcMod.Gap (HasType(..))
 import qualified Language.Haskell.GhcMod.Gap as Gap
+import Language.Haskell.GhcMod.Monad
 import Language.Haskell.GhcMod.SrcUtils
 import Language.Haskell.GhcMod.Types
 import Language.Haskell.GhcMod.Convert
@@ -39,19 +40,19 @@ splitVar :: Options
          -> Int          -- ^ Line number.
          -> Int          -- ^ Column number.
          -> IO String
-splitVar opt cradle file lineNo colNo = withGHC' $ do
+splitVar opt cradle file lineNo colNo = runGhcMod opt $ do
     initializeFlagsWithCradle opt cradle
-    splits opt file lineNo colNo
+    splits file lineNo colNo
 
 -- | Splitting a variable in a equation.
-splits :: Options
-       -> FilePath     -- ^ A target file.
+splits :: FilePath     -- ^ A target file.
        -> Int          -- ^ Line number.
        -> Int          -- ^ Column number.
-       -> Ghc String
-splits opt file lineNo colNo = ghandle handler body
+       -> GhcMod String
+splits file lineNo colNo = ghandle handler body
   where
     body = inModuleContext file $ \dflag style -> do
+        opt <- options
         modSum <- Gap.fileModSummary file
         whenFound' opt (getSrcSpanTypeForSplit modSum lineNo colNo) $
           \(SplitInfo varName (bndLoc,_) (varLoc,varT) _matches) -> do
@@ -59,12 +60,12 @@ splits opt file lineNo colNo = ghandle handler body
              text <- genCaseSplitTextFile file (SplitToTextInfo varName' bndLoc varLoc $
                                                 getTyCons dflag style varName varT)
              return (fourInts bndLoc, text)
-    handler (SomeException _) = emptyResult opt
+    handler (SomeException _) = emptyResult =<< options
 
 ----------------------------------------------------------------
 -- a. Code for getting the information of the variable
 
-getSrcSpanTypeForSplit :: G.ModSummary -> Int -> Int -> Ghc (Maybe SplitInfo)
+getSrcSpanTypeForSplit :: GhcMonad m => G.ModSummary -> Int -> Int -> m (Maybe SplitInfo)
 getSrcSpanTypeForSplit modSum lineNo colNo = do
     p@ParsedModule{pm_parsed_source = pms} <- G.parseModule modSum
     tcm@TypecheckedModule{tm_typechecked_source = tcs} <- G.typecheckModule p
@@ -173,7 +174,7 @@ showFieldNames dflag style v (x:xs) = let fName = showName dflag style x
 ----------------------------------------------------------------
 -- c. Code for performing the case splitting
 
-genCaseSplitTextFile :: FilePath -> SplitToTextInfo -> Ghc String
+genCaseSplitTextFile :: GhcMonad m => FilePath -> SplitToTextInfo -> m String
 genCaseSplitTextFile file info = liftIO $ do
   text <- T.readFile file
   return $ getCaseSplitText (T.lines text) info

Language/Haskell/GhcMod/Doc.hs

@@ -1,6 +1,6 @@
 module Language.Haskell.GhcMod.Doc where
 
-import GHC (Ghc, DynFlags)
+import GHC (DynFlags, GhcMonad)
 import qualified GHC as G
 import Language.Haskell.GhcMod.Gap (withStyle, showDocWith)
 import Outputable (SDoc, PprStyle, mkUserStyle, Depth(AllTheWay), neverQualify)
@@ -12,7 +12,7 @@ showPage dflag style = showDocWith dflag PageMode . withStyle dflag style
 showOneLine :: DynFlags -> PprStyle -> SDoc -> String
 showOneLine dflag style = showDocWith dflag OneLineMode . withStyle dflag style
 
-getStyle :: Ghc PprStyle
+getStyle :: GhcMonad m => m PprStyle
 getStyle = do
     unqual <- G.getPrintUnqual
     return $ mkUserStyle unqual AllTheWay

Language/Haskell/GhcMod/FillSig.hs

@@ -8,13 +8,14 @@ module Language.Haskell.GhcMod.FillSig (
 import Data.Char (isSymbol)
 import Data.List (find, intercalate)
 import Exception (ghandle, SomeException(..))
-import GHC (Ghc, Id, ParsedModule(..), TypecheckedModule(..), DynFlags, SrcSpan, Type, GenLocated(L))
+import GHC (GhcMonad, Id, ParsedModule(..), TypecheckedModule(..), DynFlags, SrcSpan, Type, GenLocated(L))
 import qualified GHC as G
 import Language.Haskell.GhcMod.GHCApi
 import qualified Language.Haskell.GhcMod.Gap as Gap
+import Language.Haskell.GhcMod.Convert
+import Language.Haskell.GhcMod.Monad
 import Language.Haskell.GhcMod.SrcUtils
 import Language.Haskell.GhcMod.Types
-import Language.Haskell.GhcMod.Convert
 import MonadUtils (liftIO)
 import Outputable (PprStyle)
 import qualified Type as Ty
@@ -41,19 +42,19 @@ fillSig :: Options
         -> Int          -- ^ Line number.
         -> Int          -- ^ Column number.
         -> IO String
-fillSig opt cradle file lineNo colNo = withGHC' $ do
+fillSig opt cradle file lineNo colNo = runGhcMod opt $ do
     initializeFlagsWithCradle opt cradle
-    sig opt file lineNo colNo
+    sig file lineNo colNo
 
 -- | Create a initial body from a signature.
-sig :: Options
-    -> FilePath     -- ^ A target file.
+sig :: FilePath     -- ^ A target file.
     -> Int          -- ^ Line number.
     -> Int          -- ^ Column number.
-    -> Ghc String
-sig opt file lineNo colNo = ghandle handler body
+    -> GhcMod String
+sig file lineNo colNo = ghandle handler body
   where
     body = inModuleContext file $ \dflag style -> do
+        opt <- options
         modSum <- Gap.fileModSummary file
         whenFound opt (getSignature modSum lineNo colNo) $ \s -> case s of
           Signature loc names ty ->
@@ -63,6 +64,7 @@ sig opt file lineNo colNo = ghandle handler body
                                             (Ty.classMethods cls))
             
     handler (SomeException _) = do
+      opt <- options
       -- Code cannot be parsed by ghc module
       -- Fallback: try to get information via haskell-src-exts
       whenFound opt (getSignatureFromHE file lineNo colNo) $
@@ -73,7 +75,7 @@ sig opt file lineNo colNo = ghandle handler body
 -- a. Code for getting the information
 
 -- Get signature from ghc parsing and typechecking
-getSignature :: G.ModSummary -> Int -> Int -> Ghc (Maybe SigInfo)
+getSignature :: GhcMonad m => G.ModSummary -> Int -> Int -> m (Maybe SigInfo)
 getSignature modSum lineNo colNo = do
     p@ParsedModule{pm_parsed_source = ps} <- G.parseModule modSum
     -- Inspect the parse tree to find the signature
@@ -96,7 +98,7 @@ getSignature modSum lineNo colNo = do
                obtainClassInfo minfo clsName loc
           _ -> return Nothing
       _ -> return Nothing
-  where obtainClassInfo :: G.ModuleInfo -> G.Name -> SrcSpan -> Ghc (Maybe SigInfo)
+  where obtainClassInfo :: GhcMonad m => G.ModuleInfo -> G.Name -> SrcSpan -> m (Maybe SigInfo)
         obtainClassInfo minfo clsName loc = do
           tyThing <- G.modInfoLookupName minfo clsName
           return $ do Ty.ATyCon clsCon <- tyThing  -- In Maybe
@@ -104,7 +106,7 @@ getSignature modSum lineNo colNo = do
                       return $ InstanceDecl loc cls
 
 -- Get signature from haskell-src-exts
-getSignatureFromHE :: FilePath -> Int -> Int -> Ghc (Maybe HESigInfo)
+getSignatureFromHE :: GhcMonad m => FilePath -> Int -> Int -> m (Maybe HESigInfo)
 getSignatureFromHE file lineNo colNo = do
   presult <- liftIO $ HE.parseFile file
   return $ case presult of

Language/Haskell/GhcMod/GHCApi.hs

@@ -19,11 +19,11 @@ import Language.Haskell.GhcMod.GhcPkg
 
 import Control.Applicative ((<$>))
 import Control.Monad (forM, void)
-import CoreMonad (liftIO)
 import Data.Maybe (isJust, fromJust)
 import Exception (ghandle, SomeException(..))
-import GHC (Ghc, GhcMonad, DynFlags(..), GhcLink(..), HscTarget(..), LoadHowMuch(..))
+import GHC (DynFlags(..), GhcLink(..), HscTarget(..), LoadHowMuch(..))
 import qualified GHC as G
+import GhcMonad
 import GHC.Paths (libdir)
 import qualified Language.Haskell.GhcMod.Gap as Gap
 import Language.Haskell.GhcMod.Types

Language/Haskell/GhcMod/GHCChoice.hs

@@ -5,21 +5,21 @@ module Language.Haskell.GhcMod.GHCChoice where
 import Control.Exception (IOException)
 import CoreMonad (liftIO)
 import qualified Exception as GE
-import GHC (Ghc, GhcMonad)
+import GHC (GhcMonad)
 
 ----------------------------------------------------------------
 
 -- | Try the left 'Ghc' action. If 'IOException' occurs, try
 --   the right 'Ghc' action.
-(||>) :: Ghc a -> Ghc a -> Ghc a
+(||>) :: GhcMonad m => m a -> m a -> m a
 x ||> y = x `GE.gcatch` (\(_ :: IOException) -> y)
 
 -- | Go to the next 'Ghc' monad by throwing 'AltGhcgoNext'.
-goNext :: Ghc a
+goNext :: GhcMonad m => m a
 goNext = liftIO . GE.throwIO $ userError "goNext"
 
 -- | Run any one 'Ghc' monad.
-runAnyOne :: [Ghc a] -> Ghc a
+runAnyOne :: GhcMonad m => [m a] -> m a
 runAnyOne = foldr (||>) goNext
 
 ----------------------------------------------------------------

Language/Haskell/GhcMod/Gap.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, CPP #-}
+{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, CPP, ScopedTypeVariables, RankNTypes #-}
 
 module Language.Haskell.GhcMod.Gap (
     Language.Haskell.GhcMod.Gap.ClsInst
@@ -46,6 +46,7 @@ import Desugar (deSugarExpr)
 import DynFlags
 import ErrUtils
 import FastString
+import GhcMonad
 import HscTypes
 import Language.Haskell.GhcMod.GHCChoice
 import Language.Haskell.GhcMod.Types
@@ -151,7 +152,7 @@ getSrcFile _ = Nothing
 
 ----------------------------------------------------------------
 
-toStringBuffer :: [String] -> Ghc StringBuffer
+toStringBuffer :: GhcMonad m => [String] -> m StringBuffer
 #if __GLASGOW_HASKELL__ >= 702
 toStringBuffer = return . stringToStringBuffer . unlines
 #else
@@ -174,13 +175,13 @@ fOptions = [option | (option,_,_,_) <- fFlags]
 ----------------------------------------------------------------
 ----------------------------------------------------------------
 
-fileModSummary :: FilePath -> Ghc ModSummary
+fileModSummary :: GhcMonad m => FilePath -> m ModSummary
 fileModSummary file = do
     mss <- getModuleGraph
     let [ms] = filter (\m -> ml_hs_file (ms_location m) == Just file) mss
     return ms
 
-withContext :: Ghc a -> Ghc a
+withContext :: GhcMonad m => m a -> m a
 withContext action = gbracket setup teardown body
   where
     setup = getContext
@@ -296,7 +297,7 @@ filterOutChildren get_thing xs
   where
     implicits = mkNameSet [getName t | x <- xs, t <- implicitTyThings (get_thing x)]
 
-infoThing :: String -> Ghc SDoc
+infoThing :: GhcMonad m => String -> m SDoc
 infoThing str = do
     names <- parseName str
 #if __GLASGOW_HASKELL__ >= 708

Language/Haskell/GhcMod/Info.hs

@@ -10,12 +10,13 @@ import Data.Function (on)
 import Data.List (sortBy)
 import Data.Maybe (catMaybes)
 import Exception (ghandle, SomeException(..))
-import GHC (Ghc, LHsBind, LHsExpr, LPat, Id, TypecheckedModule(..), SrcSpan, Type)
+import GHC (GhcMonad, LHsBind, LHsExpr, LPat, Id, TypecheckedModule(..), SrcSpan, Type)
 import qualified GHC as G
 import Language.Haskell.GhcMod.Doc (showPage)
 import Language.Haskell.GhcMod.GHCApi
 import Language.Haskell.GhcMod.Gap (HasType(..))
 import qualified Language.Haskell.GhcMod.Gap as Gap
+import Language.Haskell.GhcMod.Monad
 import Language.Haskell.GhcMod.SrcUtils
 import Language.Haskell.GhcMod.Types
 import Language.Haskell.GhcMod.Convert
@@ -28,16 +29,17 @@ infoExpr :: Options
          -> FilePath     -- ^ A target file.
          -> Expression   -- ^ A Haskell expression.
          -> IO String
-infoExpr opt cradle file expr = withGHC' $ do
+infoExpr opt cradle file expr = runGhcMod opt $ do
     initializeFlagsWithCradle opt cradle
-    info opt file expr
+    info file expr
 
 -- | Obtaining information of a target expression. (GHCi's info:)
-info :: Options
-     -> FilePath     -- ^ A target file.
+info :: FilePath     -- ^ A target file.
      -> Expression   -- ^ A Haskell expression.
-     -> Ghc String
-info opt file expr = convert opt <$> ghandle handler body
+     -> GhcMod String
+info file expr = do
+    opt <- options
+    convert opt <$> ghandle handler body
   where
     body = inModuleContext file $ \dflag style -> do
         sdoc <- Gap.infoThing expr
@@ -53,17 +55,18 @@ typeExpr :: Options
          -> Int          -- ^ Line number.
          -> Int          -- ^ Column number.
          -> IO String
-typeExpr opt cradle file lineNo colNo = withGHC' $ do
+typeExpr opt cradle file lineNo colNo = runGhcMod opt $ do
     initializeFlagsWithCradle opt cradle
-    types opt file lineNo colNo
+    types file lineNo colNo
 
 -- | Obtaining type of a target expression. (GHCi's type:)
-types :: Options
-      -> FilePath     -- ^ A target file.
+types :: FilePath     -- ^ A target file.
       -> Int          -- ^ Line number.
       -> Int          -- ^ Column number.
-      -> Ghc String
-types opt file lineNo colNo = convert opt <$> ghandle handler body
+      -> GhcMod String
+types file lineNo colNo = do
+    opt <- options
+    convert opt <$> ghandle handler body
   where
     body = inModuleContext file $ \dflag style -> do
         modSum <- Gap.fileModSummary file
@@ -71,7 +74,7 @@ types opt file lineNo colNo = convert opt <$> ghandle handler body
         return $ map (toTup dflag style) $ sortBy (cmp `on` fst) srcSpanTypes
     handler (SomeException _) = return []
 
-getSrcSpanType :: G.ModSummary -> Int -> Int -> Ghc [(SrcSpan, Type)]
+getSrcSpanType :: GhcMonad m => G.ModSummary -> Int -> Int -> m [(SrcSpan, Type)]
 getSrcSpanType modSum lineNo colNo = do
     p <- G.parseModule modSum
     tcm@TypecheckedModule{tm_typechecked_source = tcs} <- G.typecheckModule p

Language/Haskell/GhcMod/SrcUtils.hs

@@ -10,6 +10,7 @@ import Data.Generics
 import Data.Maybe (fromMaybe)
 import Data.Ord as O
 import GHC (Ghc, LHsExpr, LPat, Id, DynFlags, SrcSpan, Type, Located, ParsedSource, RenamedSource, TypecheckedSource, GenLocated(L))
+import GhcMonad
 import qualified GHC as G
 import GHC.SYB.Utils (Stage(..), everythingStaged)
 import Language.Haskell.GhcMod.Doc (showOneLine, getStyle)
@@ -79,7 +80,7 @@ pretty dflag style = showOneLine dflag style . Gap.typeForUser
 
 ----------------------------------------------------------------
 
-inModuleContext :: FilePath -> (DynFlags -> PprStyle -> Ghc a) -> Ghc a
+inModuleContext ::GhcMonad m => FilePath -> (DynFlags -> PprStyle -> m a) -> m a
 inModuleContext file action =
     withDynFlags (setWarnTypedHoles . setDeferTypeErrors . setNoWaringFlags) $ do
     setTargetFiles [file]

src/GHCModi.hs

@@ -31,7 +31,7 @@ import Data.Set (Set)
 import qualified Data.Set as S
 import Data.Typeable (Typeable)
 import Data.Version (showVersion)
-import GHC (Ghc)
+import GHC (GhcMonad)
 import qualified GHC as G
 import Language.Haskell.GhcMod
 import Language.Haskell.GhcMod.Ghc
@@ -142,10 +142,10 @@ loop opt set mvar = do
         "check"  -> checkStx opt set arg
         "find"   -> findSym set arg mvar
         "lint"   -> toGhcMod $ lintStx  opt set arg
-        "info"   -> toGhcMod $ showInfo opt set arg
-        "type"   -> toGhcMod $ showType opt set arg
-        "split"  -> toGhcMod $ doSplit  opt set arg
-        "sig"    -> toGhcMod $ doSig    opt set arg
+        "info"   -> showInfo set arg
+        "type"   -> showType set arg
+        "split"  -> doSplit set arg
+        "sig"    -> doSig set arg
         "boot"   -> bootIt set
         "browse" -> browseIt set arg
         "quit"   -> return ("quit", False, set)
@@ -173,7 +173,7 @@ checkStx _ set file = do
         Right ret -> return (ret, True, set')
         Left ret  -> return (ret, True, set) -- fxime: set
 
-newFileSet :: Set FilePath -> FilePath -> Ghc (Set FilePath)
+newFileSet :: GhcMonad m => Set FilePath -> FilePath -> m (Set FilePath)
 newFileSet set file = do
     let set1
          | S.member file set = set
@@ -183,7 +183,7 @@ newFileSet set file = do
         Nothing       -> set1
         Just mainfile -> S.delete mainfile set1
 
-getModSummaryForMain :: Ghc (Maybe G.ModSummary)
+getModSummaryForMain :: GhcMonad m => m (Maybe G.ModSummary)
 getModSummaryForMain = find isMain <$> G.getModuleGraph
   where
     isMain m = G.moduleNameString (G.moduleName (G.ms_mod m)) == "Main"
@@ -209,8 +209,9 @@ findSym set sym mvar = do
     let ret = lookupSym' opt sym db
     return (ret, True, set)
 
-lintStx :: Options -> Set FilePath -> FilePath
-        -> Ghc (String, Bool, Set FilePath)
+lintStx :: GhcMonad m
+        => Options -> Set FilePath -> FilePath
+        -> m (String, Bool, Set FilePath)
 lintStx opt set optFile = liftIO $ do
     ret <-lintSyntax opt' file
     return (ret, True, set)
@@ -236,44 +237,40 @@ parseLintOptions optFile = case brk (== ']') (dropWhile (/= '[') optFile) of
 
 ----------------------------------------------------------------
 
-showInfo :: Options
-         -> Set FilePath
+showInfo :: Set FilePath
          -> FilePath
-         -> Ghc (String, Bool, Set FilePath)
-showInfo opt set fileArg = do
+         -> GhcMod (String, Bool, Set FilePath)
+showInfo set fileArg = do
     let [file, expr] = words fileArg
     set' <- newFileSet set file
-    ret <- info opt file expr
+    ret <- info file expr
     return (ret, True, set')
 
-showType :: Options
-         -> Set FilePath
+showType :: Set FilePath
          -> FilePath
-         -> Ghc (String, Bool, Set FilePath)
-showType opt set fileArg  = do
+         -> GhcMod (String, Bool, Set FilePath)
+showType set fileArg  = do
     let [file, line, column] = words fileArg
     set' <- newFileSet set file
-    ret <- types opt file (read line) (read column)
+    ret <- types file (read line) (read column)
     return (ret, True, set')
 
-doSplit :: Options
-        -> Set FilePath
+doSplit :: Set FilePath
         -> FilePath
-        -> Ghc (String, Bool, Set FilePath)
-doSplit opt set fileArg  = do
+        -> GhcMod (String, Bool, Set FilePath)
+doSplit set fileArg  = do
     let [file, line, column] = words fileArg
     set' <- newFileSet set file
-    ret <- splits opt file (read line) (read column)
+    ret <- splits file (read line) (read column)
     return (ret, True, set')
 
-doSig :: Options
-      -> Set FilePath
+doSig :: Set FilePath
       -> FilePath
-      -> Ghc (String, Bool, Set FilePath)
-doSig opt set fileArg  = do
+      -> GhcMod (String, Bool, Set FilePath)
+doSig set fileArg  = do
     let [file, line, column] = words fileArg
     set' <- newFileSet set file
-    ret <- sig opt file (read line) (read column)
+    ret <- sig file (read line) (read column)
     return (ret, True, set')
 
 ----------------------------------------------------------------