converting GhcMonad to IOish.

This commit is contained in:
Kazu Yamamoto 2014-07-18 14:05:20 +09:00
parent 233f4cf05e
commit 26316262aa
8 changed files with 60 additions and 46 deletions

View File

@ -11,11 +11,11 @@ import Exception (ghandle)
import FastString (mkFastString) import FastString (mkFastString)
import GHC (GhcException(CmdLineError), ModuleInfo, Name, TyThing, DynFlags, Type, TyCon) import GHC (GhcException(CmdLineError), ModuleInfo, Name, TyThing, DynFlags, Type, TyCon)
import qualified GHC as G import qualified GHC as G
import Language.Haskell.GhcMod.Doc (showPage, styleUnqualified)
import Language.Haskell.GhcMod.DynFlags
import Language.Haskell.GhcMod.Gap
import Language.Haskell.GhcMod.Monad
import Language.Haskell.GhcMod.Convert import Language.Haskell.GhcMod.Convert
import Language.Haskell.GhcMod.Doc (showPage, styleUnqualified)
import Language.Haskell.GhcMod.Gap
import Language.Haskell.GhcMod.Monad (IOish, GhcModT, options)
import Language.Haskell.GhcMod.Target (setTargetFiles)
import Language.Haskell.GhcMod.Types import Language.Haskell.GhcMod.Types
import Name (getOccString) import Name (getOccString)
import Outputable (ppr, Outputable) import Outputable (ppr, Outputable)

View File

@ -9,7 +9,8 @@ import Control.Applicative ((<$>))
import Language.Haskell.GhcMod.DynFlags import Language.Haskell.GhcMod.DynFlags
import qualified Language.Haskell.GhcMod.Gap as Gap import qualified Language.Haskell.GhcMod.Gap as Gap
import Language.Haskell.GhcMod.Logger import Language.Haskell.GhcMod.Logger
import Language.Haskell.GhcMod.Monad import Language.Haskell.GhcMod.Monad (IOish, GhcModT, withErrorHandler)
import Language.Haskell.GhcMod.Target (setTargetFiles)
---------------------------------------------------------------- ----------------------------------------------------------------

View File

@ -1,9 +1,8 @@
module Language.Haskell.GhcMod.DynFlags where module Language.Haskell.GhcMod.DynFlags where
import Control.Applicative ((<$>)) import Control.Applicative ((<$>))
import Control.Monad (forM, void, (>=>)) import Control.Monad (void)
import DynFlags (ExtensionFlag(..), xopt) import GHC (DynFlags(..), GhcMode(..), GhcLink(..), HscTarget(..))
import GHC (DynFlags(..), GhcMode(..), GhcLink(..), HscTarget(..), LoadHowMuch(..))
import qualified GHC as G import qualified GHC as G
import GHC.Paths (libdir) import GHC.Paths (libdir)
import GhcMonad import GhcMonad
@ -67,36 +66,6 @@ addCmdOpts cmdOpts df =
---------------------------------------------------------------- ----------------------------------------------------------------
-- | Set the files as targets and load them.
setTargetFiles :: (GhcMonad m) => [FilePath] -> m ()
setTargetFiles files = do
targets <- forM files $ \file -> G.guessTarget file Nothing
G.setTargets targets
xs <- G.depanal [] False
-- FIXME, checking state
loadTargets $ needsFallback xs
where
loadTargets False = do
-- Reporting error A and error B
void $ G.load LoadAllTargets
mss <- filter (\x -> G.ms_hspp_file x `elem` files) <$> G.getModuleGraph
-- Reporting error B and error C
mapM_ (G.parseModule >=> G.typecheckModule >=> G.desugarModule) mss
-- Error B duplicates. But we cannot ignore both error reportings,
-- sigh. So, the logger makes log messages unique by itself.
loadTargets True = do
df <- G.getSessionDynFlags
void $ G.setSessionDynFlags (setModeIntelligent df)
void $ G.load LoadAllTargets
needsFallback :: G.ModuleGraph -> Bool
needsFallback = any (hasTHorQQ . G.ms_hspp_opts)
where
hasTHorQQ :: DynFlags -> Bool
hasTHorQQ dflags = any (`xopt` dflags) [Opt_TemplateHaskell, Opt_QuasiQuotes]
----------------------------------------------------------------
-- | Return the 'DynFlags' currently in use in the GHC session. -- | Return the 'DynFlags' currently in use in the GHC session.
getDynamicFlags :: IO DynFlags getDynamicFlags :: IO DynFlags
getDynamicFlags = G.runGhc (Just libdir) G.getSessionDynFlags getDynamicFlags = G.runGhc (Just libdir) G.getSessionDynFlags

View File

@ -11,7 +11,8 @@ module Language.Haskell.GhcMod.GHCApi (
) where ) where
import Language.Haskell.GhcMod.GhcPkg import Language.Haskell.GhcMod.GhcPkg
import Language.Haskell.GhcMod.DynFlags import Language.Haskell.GhcMod.Monad (IOish, GhcModT)
import Language.Haskell.GhcMod.Target (setTargetFiles)
import Language.Haskell.GhcMod.Types import Language.Haskell.GhcMod.Types
import Control.Applicative ((<$>)) import Control.Applicative ((<$>))
@ -64,10 +65,10 @@ type Binding = String
-- should look for @module@ in the working directory. -- should look for @module@ in the working directory.
-- --
-- To map a 'ModuleString' to a package see 'findModule' -- To map a 'ModuleString' to a package see 'findModule'
moduleInfo :: GhcMonad m moduleInfo :: IOish m
=> Maybe Package => Maybe Package
-> ModuleString -> ModuleString
-> m (Maybe G.ModuleInfo) -> GhcModT m (Maybe G.ModuleInfo)
moduleInfo mpkg mdl = do moduleInfo mpkg mdl = do
let mdlName = G.mkModuleName mdl let mdlName = G.mkModuleName mdl
mfsPkgId = G.packageIdFS . ghcPkgId <$> mpkg mfsPkgId = G.packageIdFS . ghcPkgId <$> mpkg
@ -78,7 +79,7 @@ moduleInfo mpkg mdl = do
Just _ -> return () Just _ -> return ()
Nothing -> setTargetFiles [mdl] Nothing -> setTargetFiles [mdl]
localModuleInfo :: GhcMonad m => ModuleString -> m (Maybe G.ModuleInfo) localModuleInfo :: IOish m => ModuleString -> GhcModT m (Maybe G.ModuleInfo)
localModuleInfo mdl = moduleInfo Nothing mdl localModuleInfo mdl = moduleInfo Nothing mdl
bindings :: G.ModuleInfo -> [Binding] bindings :: G.ModuleInfo -> [Binding]

View File

@ -40,6 +40,7 @@ import Language.Haskell.GhcMod.CabalApi
import Language.Haskell.GhcMod.DynFlags import Language.Haskell.GhcMod.DynFlags
import Language.Haskell.GhcMod.GHCChoice import Language.Haskell.GhcMod.GHCChoice
import Language.Haskell.GhcMod.Logger import Language.Haskell.GhcMod.Logger
import Language.Haskell.GhcMod.Target
import Language.Haskell.GhcMod.Types import Language.Haskell.GhcMod.Types
-- | Obtaining the directory for ghc system libraries. -- | Obtaining the directory for ghc system libraries.

View File

@ -9,17 +9,19 @@ import Data.Generics
import Data.Maybe (fromMaybe) import Data.Maybe (fromMaybe)
import Data.Ord as O import Data.Ord as O
import GHC (LHsExpr, LPat, Id, DynFlags, SrcSpan, Type, Located, ParsedSource, RenamedSource, TypecheckedSource, GenLocated(L)) import GHC (LHsExpr, LPat, Id, DynFlags, SrcSpan, Type, Located, ParsedSource, RenamedSource, TypecheckedSource, GenLocated(L))
import GhcMonad
import qualified GHC as G import qualified GHC as G
import GHC.SYB.Utils (Stage(..), everythingStaged) import GHC.SYB.Utils (Stage(..), everythingStaged)
import GhcMonad
import qualified Language.Haskell.Exts.Annotated as HE
import Language.Haskell.GhcMod.Doc (showOneLine, getStyle) import Language.Haskell.GhcMod.Doc (showOneLine, getStyle)
import Language.Haskell.GhcMod.DynFlags import Language.Haskell.GhcMod.DynFlags
import Language.Haskell.GhcMod.Gap (HasType(..), setWarnTypedHoles, setDeferTypeErrors) import Language.Haskell.GhcMod.Gap (HasType(..), setWarnTypedHoles, setDeferTypeErrors)
import qualified Language.Haskell.GhcMod.Gap as Gap import qualified Language.Haskell.GhcMod.Gap as Gap
import Language.Haskell.GhcMod.Monad (IOish, GhcModT)
import Language.Haskell.GhcMod.Target (setTargetFiles)
import OccName (OccName)
import Outputable (PprStyle) import Outputable (PprStyle)
import TcHsSyn (hsPatType) import TcHsSyn (hsPatType)
import OccName (OccName)
import qualified Language.Haskell.Exts.Annotated as HE
---------------------------------------------------------------- ----------------------------------------------------------------
@ -79,7 +81,7 @@ pretty dflag style = showOneLine dflag style . Gap.typeForUser
---------------------------------------------------------------- ----------------------------------------------------------------
inModuleContext ::GhcMonad m => FilePath -> (DynFlags -> PprStyle -> m a) -> m a inModuleContext :: IOish m => FilePath -> (DynFlags -> PprStyle -> GhcModT m a) -> GhcModT m a
inModuleContext file action = inModuleContext file action =
withDynFlags (setWarnTypedHoles . setDeferTypeErrors . setNoWaringFlags) $ do withDynFlags (setWarnTypedHoles . setDeferTypeErrors . setNoWaringFlags) $ do
setTargetFiles [file] setTargetFiles [file]

View File

@ -0,0 +1,39 @@
module Language.Haskell.GhcMod.Target (
setTargetFiles
) where
import Control.Applicative ((<$>))
import Control.Monad (forM, void, (>=>))
import DynFlags (ExtensionFlag(..), xopt)
import GHC (DynFlags(..), LoadHowMuch(..))
import qualified GHC as G
import Language.Haskell.GhcMod.DynFlags
import Language.Haskell.GhcMod.Monad (IOish, GhcModT)
-- | Set the files as targets and load them.
setTargetFiles :: IOish m => [FilePath] -> GhcModT m ()
setTargetFiles files = do
targets <- forM files $ \file -> G.guessTarget file Nothing
G.setTargets targets
xs <- G.depanal [] False
-- FIXME, checking state
loadTargets $ needsFallback xs
where
loadTargets False = do
-- Reporting error A and error B
void $ G.load LoadAllTargets
mss <- filter (\x -> G.ms_hspp_file x `elem` files) <$> G.getModuleGraph
-- Reporting error B and error C
mapM_ (G.parseModule >=> G.typecheckModule >=> G.desugarModule) mss
-- Error B duplicates. But we cannot ignore both error reportings,
-- sigh. So, the logger makes log messages unique by itself.
loadTargets True = do
df <- G.getSessionDynFlags
void $ G.setSessionDynFlags (setModeIntelligent df)
void $ G.load LoadAllTargets
needsFallback :: G.ModuleGraph -> Bool
needsFallback = any (hasTHorQQ . G.ms_hspp_opts)
where
hasTHorQQ :: DynFlags -> Bool
hasTHorQQ dflags = any (`xopt` dflags) [Opt_TemplateHaskell, Opt_QuasiQuotes]

View File

@ -83,6 +83,7 @@ Library
Language.Haskell.GhcMod.PkgDoc Language.Haskell.GhcMod.PkgDoc
Language.Haskell.GhcMod.Read Language.Haskell.GhcMod.Read
Language.Haskell.GhcMod.SrcUtils Language.Haskell.GhcMod.SrcUtils
Language.Haskell.GhcMod.Target
Language.Haskell.GhcMod.Types Language.Haskell.GhcMod.Types
Language.Haskell.GhcMod.Utils Language.Haskell.GhcMod.Utils
Build-Depends: base >= 4.0 && < 5 Build-Depends: base >= 4.0 && < 5