module Hint.Compat
where
#if __GLASGOW_HASKELL__ < 702
import Control.Monad.Trans (liftIO)
#endif
#if __GLASGOW_HASKELL__ >= 704
import Control.Monad (foldM, liftM)
#endif
import qualified Hint.GHC as GHC
newtype Kind = Kind GHC.Kind
#if __GLASGOW_HASKELL__ >= 700
supportedExtensions = map f GHC.xFlags
where
#if (__GLASGOW_HASKELL__ < 702) || (__GLASGOW_HASKELL__ >= 704)
f (e,_,_) = e
#else
f (e,_,_,_) = e
#endif
#if __GLASGOW_HASKELL__ < 702
setContext xs = GHC.setContext xs . map (\y -> (y,Nothing))
getContext :: GHC.GhcMonad m => m ([GHC.Module], [GHC.Module])
getContext = fmap (\(as,bs) -> (as,map fst bs)) GHC.getContext
#else
#if __GLASGOW_HASKELL__ < 704
setContext = GHC.setContext
getContext = GHC.getContext
#else
setContext :: GHC.GhcMonad m => [GHC.Module] -> [GHC.ImportDecl GHC.RdrName] -> m ()
setContext ms ds =
let ms' = map GHC.IIModule ms
ds' = map GHC.IIDecl ds
is = ms' ++ ds'
in GHC.setContext is
getContext :: GHC.GhcMonad m => m ([GHC.Module], [GHC.ImportDecl GHC.RdrName])
getContext = GHC.getContext >>= foldM f ([], [])
where
f :: (GHC.GhcMonad m) =>
([GHC.Module], [GHC.ImportDecl GHC.RdrName]) ->
GHC.InteractiveImport ->
m ([GHC.Module], [GHC.ImportDecl GHC.RdrName])
f (ns, ds) i = case i of
(GHC.IIDecl d) -> return (ns, (d:ds))
(GHC.IIModule n) -> return ((n:ns), ds)
#endif
#endif
mkPState = GHC.mkPState
#else
supportedExtensions = GHC.supportedLanguages
setContext = GHC.setContext
getContext = GHC.getContext
mkPState df buf loc = GHC.mkPState buf loc df
#endif
#if __GLASGOW_HASKELL__ < 702
setContextModules :: GHC.GhcMonad m => [GHC.Module] -> [GHC.Module] -> m ()
setContextModules = setContext
getContextNames :: GHC.GhcMonad m => m([String], [String])
getContextNames = fmap (\(as,bs) -> (map name as, map name bs)) getContext
where name = GHC.moduleNameString . GHC.moduleName
#else
setContextModules :: GHC.GhcMonad m => [GHC.Module] -> [GHC.Module] -> m ()
setContextModules as = setContext as . map (GHC.simpleImportDecl . GHC.moduleName)
getContextNames :: GHC.GhcMonad m => m([String], [String])
getContextNames = fmap (\(as,bs) -> (map name as, map decl bs)) getContext
where name = GHC.moduleNameString . GHC.moduleName
decl = GHC.moduleNameString . GHC.unLoc . GHC.ideclName
#endif
#if __GLASGOW_HASKELL__ < 702
mkSrcLoc = GHC.mkSrcLoc
stringToStringBuffer = liftIO . GHC.stringToStringBuffer
#else
mkSrcLoc = GHC.mkRealSrcLoc
stringToStringBuffer = return . GHC.stringToStringBuffer
#endif
#if __GLASGOW_HASKELL__ >= 610
configureDynFlags :: GHC.DynFlags -> GHC.DynFlags
configureDynFlags dflags = dflags{GHC.ghcMode = GHC.CompManager,
GHC.hscTarget = GHC.HscInterpreted,
GHC.ghcLink = GHC.LinkInMemory,
GHC.verbosity = 0}
parseDynamicFlags :: GHC.GhcMonad m
=> GHC.DynFlags -> [String] -> m (GHC.DynFlags, [String])
parseDynamicFlags d = fmap firstTwo . GHC.parseDynamicFlags d . map GHC.noLoc
where firstTwo (a,b,_) = (a, map GHC.unLoc b)
fileTarget :: FilePath -> GHC.Target
fileTarget f = GHC.Target (GHC.TargetFile f $ Just next_phase) True Nothing
where next_phase = GHC.Cpp GHC.HsSrcFile
targetId :: GHC.Target -> GHC.TargetId
targetId = GHC.targetId
guessTarget :: GHC.GhcMonad m => String -> Maybe GHC.Phase -> m GHC.Target
guessTarget = GHC.guessTarget
compileExpr :: GHC.GhcMonad m => String -> m (Maybe GHC.HValue)
compileExpr = fmap Just . GHC.compileExpr
exprType :: GHC.GhcMonad m => String -> m (Maybe GHC.Type)
exprType = fmap Just . GHC.exprType
#if __GLASGOW_HASKELL__ < 704
typeKind :: GHC.GhcMonad m => String -> m (Maybe GHC.Kind)
typeKind = fmap Just . GHC.typeKind
#else
typeKind :: GHC.GhcMonad m => String -> m (Maybe GHC.Kind)
typeKind = fmap Just . (liftM snd) . (GHC.typeKind True)
#endif
#else
parseDynamicFlags :: GHC.Session
-> GHC.DynFlags
-> [String] -> IO (GHC.DynFlags, [String])
parseDynamicFlags = const GHC.parseDynamicFlags
fileTarget :: FilePath -> GHC.Target
fileTarget f = GHC.Target (GHC.TargetFile f $ Just next_phase) Nothing
where next_phase = GHC.Cpp GHC.HsSrcFile
targetId :: GHC.Target -> GHC.TargetId
targetId (GHC.Target _id _) = _id
guessTarget :: GHC.Session -> String -> Maybe GHC.Phase -> IO GHC.Target
guessTarget = const GHC.guessTarget
compileExpr :: GHC.Session -> String -> IO (Maybe GHC.HValue)
compileExpr = GHC.compileExpr
exprType :: GHC.Session -> String -> IO (Maybe GHC.Type)
exprType = GHC.exprType
typeKind :: GHC.Session -> String -> IO (Maybe GHC.Kind)
typeKind = GHC.typeKind
#endif
#if __GLASGOW_HASKELL__ >= 608
#if __GLASGOW_HASKELL__ < 610
newSession :: FilePath -> IO GHC.Session
newSession ghc_root = GHC.newSession (Just ghc_root)
configureDynFlags :: GHC.DynFlags -> GHC.DynFlags
configureDynFlags dflags = dflags{GHC.ghcMode = GHC.CompManager,
GHC.hscTarget = GHC.HscInterpreted,
GHC.ghcLink = GHC.LinkInMemory}
#endif
#if __GLASGOW_HASKELL__ < 701
pprType :: GHC.Type -> (GHC.PprStyle -> GHC.Doc)
pprType = GHC.pprTypeForUser False
pprKind :: GHC.Kind -> (GHC.PprStyle -> GHC.Doc)
pprKind = pprType
#else
pprType :: GHC.Type -> GHC.SDoc
pprType = GHC.pprTypeForUser False
pprKind :: GHC.Kind -> GHC.SDoc
pprKind = pprType
#endif
#elif __GLASGOW_HASKELL__ >= 606
newSession :: FilePath -> IO GHC.Session
newSession ghc_root = GHC.newSession GHC.Interactive (Just ghc_root)
configureDynFlags :: GHC.DynFlags -> GHC.DynFlags
configureDynFlags dflags = dflags{GHC.hscTarget = GHC.HscInterpreted}
pprType :: GHC.Type -> (GHC.PprStyle -> GHC.Doc)
pprType = GHC.ppr . GHC.dropForAlls
pprKind :: GHC.Kind -> (GHC.PprStyle -> GHC.Doc)
pprKind = GHC.ppr
#endif