converting GhcMonad to IOish.
This commit is contained in:
parent
233f4cf05e
commit
26316262aa
@ -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)
|
||||||
|
@ -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)
|
||||||
|
|
||||||
----------------------------------------------------------------
|
----------------------------------------------------------------
|
||||||
|
|
||||||
|
@ -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
|
||||||
|
@ -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]
|
||||||
|
@ -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.
|
||||||
|
@ -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]
|
||||||
|
39
Language/Haskell/GhcMod/Target.hs
Normal file
39
Language/Haskell/GhcMod/Target.hs
Normal 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]
|
@ -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
|
||||||
|
Loading…
Reference in New Issue
Block a user