Merge branch 'HaRe' of https://github.com/alanz/ghc-mod
This commit is contained in:
commit
312a8c81fb
2
.gitignore
vendored
2
.gitignore
vendored
@ -16,3 +16,5 @@ cabal.sandbox.config
|
|||||||
# For instance, .#Help.page
|
# For instance, .#Help.page
|
||||||
# .#*
|
# .#*
|
||||||
cabal-dev
|
cabal-dev
|
||||||
|
/TAGS
|
||||||
|
/tags
|
||||||
|
@ -12,7 +12,6 @@ import Language.Haskell.GhcMod.Convert
|
|||||||
import Language.Haskell.GhcMod.Monad
|
import Language.Haskell.GhcMod.Monad
|
||||||
import Language.Haskell.GhcMod.Types
|
import Language.Haskell.GhcMod.Types
|
||||||
import Language.Haskell.GhcMod.Internal
|
import Language.Haskell.GhcMod.Internal
|
||||||
import Language.Haskell.GhcMod.CabalHelper
|
|
||||||
import Language.Haskell.GhcMod.Target
|
import Language.Haskell.GhcMod.Target
|
||||||
import Language.Haskell.GhcMod.Pretty
|
import Language.Haskell.GhcMod.Pretty
|
||||||
import Language.Haskell.GhcMod.Utils
|
import Language.Haskell.GhcMod.Utils
|
||||||
@ -44,8 +43,8 @@ debugInfo = do
|
|||||||
|
|
||||||
cabalDebug :: IOish m => GhcModT m [String]
|
cabalDebug :: IOish m => GhcModT m [String]
|
||||||
cabalDebug = do
|
cabalDebug = do
|
||||||
crdl@Cradle {..} <- cradle
|
Cradle {..} <- cradle
|
||||||
mcs <- resolveGmComponents Nothing =<< mapM (resolveEntrypoint crdl) =<< getComponents
|
mcs <- cabalResolvedComponents
|
||||||
let entrypoints = Map.map gmcEntrypoints mcs
|
let entrypoints = Map.map gmcEntrypoints mcs
|
||||||
graphs = Map.map gmcHomeModuleGraph mcs
|
graphs = Map.map gmcHomeModuleGraph mcs
|
||||||
opts = Map.map gmcGhcOpts mcs
|
opts = Map.map gmcGhcOpts mcs
|
||||||
@ -69,8 +68,7 @@ componentInfo ts = do
|
|||||||
-- useful function from there.
|
-- useful function from there.
|
||||||
crdl <- cradle
|
crdl <- cradle
|
||||||
sefnmn <- Set.fromList `liftM` mapM guessModuleFile ts
|
sefnmn <- Set.fromList `liftM` mapM guessModuleFile ts
|
||||||
comps <- mapM (resolveEntrypoint crdl) =<< getComponents
|
mcs <- cabalResolvedComponents
|
||||||
mcs <- resolveGmComponents Nothing comps
|
|
||||||
let
|
let
|
||||||
mdlcs = moduleComponents mcs `zipMap` Set.toList sefnmn
|
mdlcs = moduleComponents mcs `zipMap` Set.toList sefnmn
|
||||||
candidates = findCandidates $ map snd mdlcs
|
candidates = findCandidates $ map snd mdlcs
|
||||||
|
@ -8,6 +8,9 @@ module Language.Haskell.GhcMod.Internal (
|
|||||||
, PackageVersion
|
, PackageVersion
|
||||||
, PackageId
|
, PackageId
|
||||||
, IncludeDir
|
, IncludeDir
|
||||||
|
, GmlT(..)
|
||||||
|
, MonadIO(..)
|
||||||
|
, GmEnv(..)
|
||||||
-- * Various Paths
|
-- * Various Paths
|
||||||
, ghcLibDir
|
, ghcLibDir
|
||||||
, ghcModExecutable
|
, ghcModExecutable
|
||||||
@ -20,9 +23,18 @@ module Language.Haskell.GhcMod.Internal (
|
|||||||
, GhcModState
|
, GhcModState
|
||||||
, CompilerMode(..)
|
, CompilerMode(..)
|
||||||
, GhcModLog
|
, GhcModLog
|
||||||
|
, GmLog(..)
|
||||||
|
, GmLogLevel(..)
|
||||||
|
, gmSetLogLevel
|
||||||
-- * Monad utilities
|
-- * Monad utilities
|
||||||
, runGhcModT'
|
, runGhcModT'
|
||||||
, hoistGhcModT
|
, hoistGhcModT
|
||||||
|
, runGmlT
|
||||||
|
, runGmlT'
|
||||||
|
, gmlGetSession
|
||||||
|
, gmlSetSession
|
||||||
|
, loadTargets
|
||||||
|
, cabalResolvedComponents
|
||||||
-- ** Accessing 'GhcModEnv' and 'GhcModState'
|
-- ** Accessing 'GhcModEnv' and 'GhcModState'
|
||||||
, options
|
, options
|
||||||
, cradle
|
, cradle
|
||||||
@ -35,13 +47,20 @@ module Language.Haskell.GhcMod.Internal (
|
|||||||
, World
|
, World
|
||||||
, getCurrentWorld
|
, getCurrentWorld
|
||||||
, didWorldChange
|
, didWorldChange
|
||||||
|
-- * Cabal Helper
|
||||||
|
, ModulePath(..)
|
||||||
|
, GmComponent(..)
|
||||||
|
, GmComponentType(..)
|
||||||
|
, GmModuleGraph(..)
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import GHC.Paths (libdir)
|
import GHC.Paths (libdir)
|
||||||
|
|
||||||
|
import Language.Haskell.GhcMod.Target
|
||||||
import Language.Haskell.GhcMod.DynFlags
|
import Language.Haskell.GhcMod.DynFlags
|
||||||
import Language.Haskell.GhcMod.Error
|
import Language.Haskell.GhcMod.Error
|
||||||
import Language.Haskell.GhcMod.Logger
|
import Language.Haskell.GhcMod.Logger
|
||||||
|
import Language.Haskell.GhcMod.Logging
|
||||||
import Language.Haskell.GhcMod.Monad
|
import Language.Haskell.GhcMod.Monad
|
||||||
import Language.Haskell.GhcMod.Types
|
import Language.Haskell.GhcMod.Types
|
||||||
import Language.Haskell.GhcMod.Utils
|
import Language.Haskell.GhcMod.Utils
|
||||||
|
@ -51,6 +51,8 @@ module Language.Haskell.GhcMod.Monad.Types (
|
|||||||
-- * Re-exporting convenient stuff
|
-- * Re-exporting convenient stuff
|
||||||
, MonadIO
|
, MonadIO
|
||||||
, liftIO
|
, liftIO
|
||||||
|
, gmlGetSession
|
||||||
|
, gmlSetSession
|
||||||
) where
|
) where
|
||||||
|
|
||||||
-- MonadUtils of GHC 7.6 or earlier defines its own MonadIO.
|
-- MonadUtils of GHC 7.6 or earlier defines its own MonadIO.
|
||||||
@ -352,13 +354,22 @@ gmLiftWithInner f = liftWith f >>= restoreT . return
|
|||||||
type GmGhc m = (IOish m, GhcMonad m)
|
type GmGhc m = (IOish m, GhcMonad m)
|
||||||
|
|
||||||
instance (MonadIO m, MonadBaseControl IO m) => GhcMonad (GmlT m) where
|
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
|
ref <- gmgsSession . fromJust . gmGhcSession <$> gmsGet
|
||||||
GHC.liftIO $ readIORef ref
|
GHC.liftIO $ readIORef ref
|
||||||
setSession a = do
|
|
||||||
|
gmlSetSession :: (MonadIO m, MonadBaseControl IO m) => HscEnv -> GmlT m ()
|
||||||
|
gmlSetSession a = do
|
||||||
ref <- gmgsSession . fromJust . gmGhcSession <$> gmsGet
|
ref <- gmgsSession . fromJust . gmGhcSession <$> gmsGet
|
||||||
GHC.liftIO $ flip writeIORef a ref
|
GHC.liftIO $ flip writeIORef a ref
|
||||||
|
|
||||||
|
-- ---------------------------------------------------------------------
|
||||||
instance GhcMonad LightGhc where
|
instance GhcMonad LightGhc where
|
||||||
getSession = (GHC.liftIO . readIORef) =<< LightGhc ask
|
getSession = (GHC.liftIO . readIORef) =<< LightGhc ask
|
||||||
setSession a = (GHC.liftIO . flip writeIORef a) =<< 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 -> GhcModT m [String]
|
||||||
cabalOpts Cradle{..} = do
|
cabalOpts Cradle{..} = do
|
||||||
comps <- mapM (resolveEntrypoint crdl) =<< getComponents
|
mcs <- cabalResolvedComponents
|
||||||
mcs <- cached cradleRootDir resolvedComponentsCache comps
|
|
||||||
|
|
||||||
let mdlcs = moduleComponents mcs `zipMap` Set.toList sefnmn
|
let mdlcs = moduleComponents mcs `zipMap` Set.toList sefnmn
|
||||||
cns = map gmcName comps
|
|
||||||
candidates = findCandidates $ map snd mdlcs
|
candidates = findCandidates $ map snd mdlcs
|
||||||
|
|
||||||
let noCandidates = Set.null candidates
|
let noCandidates = Set.null candidates
|
||||||
@ -196,7 +194,10 @@ targetGhcOptions crdl sefnmn = do
|
|||||||
|
|
||||||
if noCandidates && noModuleHasAnyAssignment
|
if noCandidates && noModuleHasAnyAssignment
|
||||||
then do
|
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
|
return $ gmcGhcOpts $ fromJust $ Map.lookup (head cns) mcs
|
||||||
else do
|
else do
|
||||||
when noCandidates $
|
when noCandidates $
|
||||||
@ -476,3 +477,10 @@ needsFallback = any $ \ms ->
|
|||||||
#if __GLASGOW_HASKELL__ >= 708
|
#if __GLASGOW_HASKELL__ >= 708
|
||||||
|| (Opt_PatternSynonyms `xopt` df)
|
|| (Opt_PatternSynonyms `xopt` df)
|
||||||
#endif
|
#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 Data.Maybe
|
||||||
import Exception
|
import Exception
|
||||||
import Language.Haskell.GhcMod
|
import Language.Haskell.GhcMod
|
||||||
import Language.Haskell.GhcMod.Internal
|
import Language.Haskell.GhcMod.Internal hiding (MonadIO,liftIO)
|
||||||
import Paths_ghc_mod
|
import Paths_ghc_mod
|
||||||
import System.Console.GetOpt (OptDescr(..), ArgDescr(..), ArgOrder(..))
|
import System.Console.GetOpt (OptDescr(..), ArgDescr(..), ArgOrder(..))
|
||||||
import qualified System.Console.GetOpt as O
|
import qualified System.Console.GetOpt as O
|
||||||
|
@ -13,7 +13,7 @@ import Data.IORef (IORef, newIORef, readIORef, writeIORef)
|
|||||||
import Prelude
|
import Prelude
|
||||||
|
|
||||||
import Language.Haskell.GhcMod
|
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