ghc-mod/Gap.hs

140 lines
3.6 KiB
Haskell
Raw Normal View History

2012-02-14 07:09:53 +00:00
{-# LANGUAGE CPP #-}
module Gap (
supportedExtensions
, getSrcSpan
, getSrcFile
, renderMsg
, setCtx
, fOptions
, toStringBuffer
, liftIO
, extensionToString
2012-02-14 07:09:53 +00:00
#if __GLASGOW_HASKELL__ >= 702
#else
, module Pretty
#endif
) where
import Control.Applicative hiding (empty)
import Control.Monad
import DynFlags
import FastString
import GHC
2012-02-16 05:44:20 +00:00
import GHCChoice
import Language.Haskell.Extension
2012-02-14 07:09:53 +00:00
import Outputable
import StringBuffer
#if __GLASGOW_HASKELL__ >= 702
import CoreMonad (liftIO)
#else
import HscTypes (liftIO)
import Pretty
#endif
2012-02-15 04:58:04 +00:00
{-
pretty :: Outputable a => a -> String
pretty = showSDocForUser neverQualify . ppr
debug :: Outputable a => a -> b -> b
debug x v = trace (pretty x) v
-}
2012-02-14 07:09:53 +00:00
----------------------------------------------------------------
----------------------------------------------------------------
supportedExtensions :: [String]
#if __GLASGOW_HASKELL__ >= 700
supportedExtensions = supportedLanguagesAndExtensions
#else
supportedExtensions = supportedLanguages
#endif
----------------------------------------------------------------
----------------------------------------------------------------
getSrcSpan :: SrcSpan -> Maybe (Int,Int,Int,Int)
#if __GLASGOW_HASKELL__ >= 702
getSrcSpan (RealSrcSpan spn)
#else
getSrcSpan spn | isGoodSrcSpan spn
#endif
= Just (srcSpanStartLine spn
, srcSpanStartCol spn
, srcSpanEndLine spn
, srcSpanEndCol spn)
getSrcSpan _ = Nothing
getSrcFile :: SrcSpan -> Maybe String
#if __GLASGOW_HASKELL__ >= 702
getSrcFile (RealSrcSpan spn) = Just . unpackFS . srcSpanFile $ spn
#else
getSrcFile spn | isGoodSrcSpan spn = Just . unpackFS . srcSpanFile $ spn
#endif
getSrcFile _ = Nothing
----------------------------------------------------------------
renderMsg :: SDoc -> PprStyle -> String
#if __GLASGOW_HASKELL__ >= 702
renderMsg d stl = renderWithStyle d stl
#else
renderMsg d stl = Pretty.showDocWith PageMode $ d stl
#endif
----------------------------------------------------------------
toStringBuffer :: [String] -> Ghc StringBuffer
#if __GLASGOW_HASKELL__ >= 702
toStringBuffer = return . stringToStringBuffer . unlines
#else
toStringBuffer = liftIO . stringToStringBuffer . unlines
#endif
----------------------------------------------------------------
fOptions :: [String]
2012-06-07 06:56:55 +00:00
#if __GLASGOW_HASKELL__ >= 704
fOptions = [option | (option,_,_) <- fFlags]
++ [option | (option,_,_) <- fWarningFlags]
++ [option | (option,_,_) <- fLangFlags]
#elif __GLASGOW_HASKELL__ == 702
2012-02-14 07:09:53 +00:00
fOptions = [option | (option,_,_,_) <- fFlags]
#else
fOptions = [option | (option,_,_) <- fFlags]
#endif
----------------------------------------------------------------
----------------------------------------------------------------
setCtx :: [ModSummary] -> Ghc Bool
#if __GLASGOW_HASKELL__ >= 704
setCtx ms = do
top <- map (IIModule . ms_mod) <$> filterM isTop ms
setContext top
return (not . null $ top)
#else
setCtx ms = do
top <- map ms_mod <$> filterM isTop ms
setContext top []
return (not . null $ top)
#endif
where
2012-02-16 05:44:20 +00:00
isTop mos = lookupMod ||> returnFalse
2012-02-14 07:09:53 +00:00
where
lookupMod = lookupModule (ms_mod_name mos) Nothing >> return True
2012-02-15 05:52:48 +00:00
returnFalse = return False
----------------------------------------------------------------
-- This is Cabal, not GHC API
extensionToString :: Extension -> String
#if __GLASGOW_HASKELL__ == 704
extensionToString (EnableExtension ext) = show ext
extensionToString (DisableExtension ext) = show ext -- FIXME
extensionToString (UnknownExtension ext) = ext
#else
extensionToString = show
#endif