Expose functions for integration with HaRe
This commit is contained in:
parent
143d17f925
commit
eafde94913
2
.gitignore
vendored
2
.gitignore
vendored
@ -16,3 +16,5 @@ cabal.sandbox.config
|
||||
# For instance, .#Help.page
|
||||
# .#*
|
||||
cabal-dev
|
||||
/TAGS
|
||||
/tags
|
||||
|
@ -12,7 +12,6 @@ import Language.Haskell.GhcMod.Convert
|
||||
import Language.Haskell.GhcMod.Monad
|
||||
import Language.Haskell.GhcMod.Types
|
||||
import Language.Haskell.GhcMod.Internal
|
||||
import Language.Haskell.GhcMod.CabalHelper
|
||||
import Language.Haskell.GhcMod.Target
|
||||
import Language.Haskell.GhcMod.Pretty
|
||||
import Language.Haskell.GhcMod.Utils
|
||||
@ -44,8 +43,8 @@ debugInfo = do
|
||||
|
||||
cabalDebug :: IOish m => GhcModT m [String]
|
||||
cabalDebug = do
|
||||
crdl@Cradle {..} <- cradle
|
||||
mcs <- resolveGmComponents Nothing =<< mapM (resolveEntrypoint crdl) =<< getComponents
|
||||
Cradle {..} <- cradle
|
||||
mcs <- cabalResolvedComponents
|
||||
let entrypoints = Map.map gmcEntrypoints mcs
|
||||
graphs = Map.map gmcHomeModuleGraph mcs
|
||||
opts = Map.map gmcGhcOpts mcs
|
||||
@ -69,8 +68,7 @@ componentInfo ts = do
|
||||
-- useful function from there.
|
||||
crdl <- cradle
|
||||
sefnmn <- Set.fromList `liftM` mapM guessModuleFile ts
|
||||
comps <- mapM (resolveEntrypoint crdl) =<< getComponents
|
||||
mcs <- resolveGmComponents Nothing comps
|
||||
mcs <- cabalResolvedComponents
|
||||
let
|
||||
mdlcs = moduleComponents mcs `zipMap` Set.toList sefnmn
|
||||
candidates = findCandidates $ map snd mdlcs
|
||||
|
@ -8,6 +8,9 @@ module Language.Haskell.GhcMod.Internal (
|
||||
, PackageVersion
|
||||
, PackageId
|
||||
, IncludeDir
|
||||
, GmlT(..)
|
||||
, MonadIO(..)
|
||||
, GmEnv(..)
|
||||
-- * Various Paths
|
||||
, ghcLibDir
|
||||
, ghcModExecutable
|
||||
@ -20,9 +23,18 @@ module Language.Haskell.GhcMod.Internal (
|
||||
, GhcModState
|
||||
, CompilerMode(..)
|
||||
, GhcModLog
|
||||
, GmLog(..)
|
||||
, GmLogLevel(..)
|
||||
, gmSetLogLevel
|
||||
-- * Monad utilities
|
||||
, runGhcModT'
|
||||
, hoistGhcModT
|
||||
, runGmlT
|
||||
, runGmlT'
|
||||
, gmlGetSession
|
||||
, gmlSetSession
|
||||
, loadTargets
|
||||
, cabalResolvedComponents
|
||||
-- ** Accessing 'GhcModEnv' and 'GhcModState'
|
||||
, options
|
||||
, cradle
|
||||
@ -35,13 +47,20 @@ module Language.Haskell.GhcMod.Internal (
|
||||
, World
|
||||
, getCurrentWorld
|
||||
, didWorldChange
|
||||
-- * Cabal Helper
|
||||
, ModulePath(..)
|
||||
, GmComponent(..)
|
||||
, GmComponentType(..)
|
||||
, GmModuleGraph(..)
|
||||
) where
|
||||
|
||||
import GHC.Paths (libdir)
|
||||
|
||||
import Language.Haskell.GhcMod.Target
|
||||
import Language.Haskell.GhcMod.DynFlags
|
||||
import Language.Haskell.GhcMod.Error
|
||||
import Language.Haskell.GhcMod.Logger
|
||||
import Language.Haskell.GhcMod.Logging
|
||||
import Language.Haskell.GhcMod.Monad
|
||||
import Language.Haskell.GhcMod.Types
|
||||
import Language.Haskell.GhcMod.Utils
|
||||
|
@ -50,6 +50,8 @@ module Language.Haskell.GhcMod.Monad.Types (
|
||||
-- * Re-exporting convenient stuff
|
||||
, MonadIO
|
||||
, liftIO
|
||||
, gmlGetSession
|
||||
, gmlSetSession
|
||||
) where
|
||||
|
||||
-- MonadUtils of GHC 7.6 or earlier defines its own MonadIO.
|
||||
@ -349,13 +351,22 @@ gmLiftWithInner f = liftWith f >>= restoreT . return
|
||||
type GmGhc m = (IOish m, GhcMonad m)
|
||||
|
||||
instance (MonadIO m, MonadBaseControl IO m) => GhcMonad (GmlT m) where
|
||||
getSession = do
|
||||
getSession = gmlGetSession
|
||||
setSession = gmlSetSession
|
||||
|
||||
-- ---------------------------------------------------------------------
|
||||
|
||||
gmlGetSession :: (MonadIO m, MonadBaseControl IO m) => GmlT m HscEnv
|
||||
gmlGetSession = do
|
||||
ref <- gmgsSession . fromJust . gmGhcSession <$> gmsGet
|
||||
GHC.liftIO $ readIORef ref
|
||||
setSession a = do
|
||||
|
||||
gmlSetSession :: (MonadIO m, MonadBaseControl IO m) => HscEnv -> GmlT m ()
|
||||
gmlSetSession a = do
|
||||
ref <- gmgsSession . fromJust . gmGhcSession <$> gmsGet
|
||||
GHC.liftIO $ flip writeIORef a ref
|
||||
|
||||
-- ---------------------------------------------------------------------
|
||||
instance GhcMonad LightGhc where
|
||||
getSession = (GHC.liftIO . readIORef) =<< LightGhc ask
|
||||
setSession a = (GHC.liftIO . flip writeIORef a) =<< LightGhc ask
|
||||
|
@ -184,11 +184,9 @@ targetGhcOptions crdl sefnmn = do
|
||||
|
||||
cabalOpts :: Cradle -> GhcModT m [String]
|
||||
cabalOpts Cradle{..} = do
|
||||
comps <- mapM (resolveEntrypoint crdl) =<< getComponents
|
||||
mcs <- cached cradleRootDir resolvedComponentsCache comps
|
||||
mcs <- cabalResolvedComponents
|
||||
|
||||
let mdlcs = moduleComponents mcs `zipMap` Set.toList sefnmn
|
||||
cns = map gmcName comps
|
||||
candidates = findCandidates $ map snd mdlcs
|
||||
|
||||
let noCandidates = Set.null candidates
|
||||
@ -196,7 +194,10 @@ targetGhcOptions crdl sefnmn = do
|
||||
|
||||
if noCandidates && noModuleHasAnyAssignment
|
||||
then do
|
||||
gmLog GmWarning "" $ strDoc $ "Could not find a component assignment, falling back to picking first component in cabal file."
|
||||
-- First component should be ChLibName, if no lib will take lexically first exe.
|
||||
let cns = filter (/= ChSetupHsName) $ Map.keys mcs
|
||||
|
||||
gmLog GmWarning "" $ strDoc $ "Could not find a component assignment, falling back to picking library component in cabal file."
|
||||
return $ gmcGhcOpts $ fromJust $ Map.lookup (head cns) mcs
|
||||
else do
|
||||
when noCandidates $
|
||||
@ -476,3 +477,10 @@ needsFallback = any $ \ms ->
|
||||
#if __GLASGOW_HASKELL__ >= 708
|
||||
|| (Opt_PatternSynonyms `xopt` df)
|
||||
#endif
|
||||
|
||||
cabalResolvedComponents :: (IOish m) =>
|
||||
GhcModT m (Map ChComponentName (GmComponent 'GMCResolved (Set ModulePath)))
|
||||
cabalResolvedComponents = do
|
||||
crdl@(Cradle{..}) <- cradle
|
||||
comps <- mapM (resolveEntrypoint crdl) =<< getComponents
|
||||
cached cradleRootDir resolvedComponentsCache comps
|
||||
|
@ -14,7 +14,7 @@ import Data.Char (isSpace)
|
||||
import Data.Maybe
|
||||
import Exception
|
||||
import Language.Haskell.GhcMod
|
||||
import Language.Haskell.GhcMod.Internal
|
||||
import Language.Haskell.GhcMod.Internal hiding (MonadIO,liftIO)
|
||||
import Paths_ghc_mod
|
||||
import System.Console.GetOpt (OptDescr(..), ArgDescr(..), ArgOrder(..))
|
||||
import qualified System.Console.GetOpt as O
|
||||
|
@ -13,7 +13,7 @@ import Data.IORef (IORef, newIORef, readIORef, writeIORef)
|
||||
import Prelude
|
||||
|
||||
import Language.Haskell.GhcMod
|
||||
import Language.Haskell.GhcMod.Internal
|
||||
import Language.Haskell.GhcMod.Internal hiding (MonadIO,liftIO)
|
||||
|
||||
----------------------------------------------------------------
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user