module Language.Haskell.Refact.Utils.GhcVersionSpecific
(
showGhc
, prettyprint
, prettyprint2
, lexStringToRichTokens
, getDataConstructors
, setGhcContext
)
where
import qualified DynFlags as GHC
import qualified GHC as GHC
import qualified GHC.Paths as GHC
import qualified Lexer as GHC
import qualified Outputable as GHC
import qualified StringBuffer as GHC
import Language.Haskell.Refact.Utils.TypeSyn
showGhc :: (GHC.Outputable a) => a -> String
#if __GLASGOW_HASKELL__ > 704
showGhc x = GHC.showSDoc GHC.tracingDynFlags $ GHC.ppr x
#else
showGhc x = GHC.showSDoc $ GHC.ppr x
#endif
prettyprint :: (GHC.Outputable a) => a -> String
#if __GLASGOW_HASKELL__ > 704
prettyprint x = GHC.renderWithStyle GHC.tracingDynFlags (GHC.ppr x) (GHC.mkUserStyle GHC.neverQualify GHC.AllTheWay)
#else
prettyprint x = GHC.renderWithStyle (GHC.ppr x) (GHC.mkUserStyle GHC.neverQualify GHC.AllTheWay)
#endif
prettyprint2 :: (GHC.Outputable a) => a -> String
#if __GLASGOW_HASKELL__ > 704
prettyprint2 x = GHC.renderWithStyle GHC.tracingDynFlags (GHC.ppr x) (GHC.cmdlineParserStyle)
#else
prettyprint2 x = GHC.renderWithStyle (GHC.ppr x) (GHC.cmdlineParserStyle)
#endif
lexStringToRichTokens :: GHC.RealSrcLoc -> String -> IO [PosToken]
lexStringToRichTokens startLoc str = do
#if __GLASGOW_HASKELL__ > 704
GHC.defaultErrorHandler GHC.defaultFatalMessager GHC.defaultFlushOut $ do
#else
GHC.defaultErrorHandler GHC.defaultLogAction $ do
#endif
GHC.runGhc (Just GHC.libdir) $ do
dflags <- GHC.getSessionDynFlags
let dflags' = foldl GHC.xopt_set dflags
[GHC.Opt_Cpp, GHC.Opt_ImplicitPrelude, GHC.Opt_MagicHash]
_ <- GHC.setSessionDynFlags dflags'
let res = GHC.lexTokenStream (GHC.stringToStringBuffer str) startLoc dflags'
case res of
GHC.POk _ toks -> return $ GHC.addSourceToTokens startLoc (GHC.stringToStringBuffer str) toks
GHC.PFailed _srcSpan _msg -> error $ "lexStringToRichTokens:"
getDataConstructors :: GHC.LHsDecl n -> [GHC.LConDecl n]
#if __GLASGOW_HASKELL__ > 704
getDataConstructors (GHC.L _ (GHC.TyClD (GHC.TyDecl _ _ (GHC.TyData _ _ _ _ cons _) _))) = cons
#else
getDataConstructors (GHC.L _ (GHC.TyClD (GHC.TyData _ _ _ _ _ _ cons _))) = cons
#endif
getDataConstructors _ = []
setGhcContext :: GHC.GhcMonad m => GHC.ModSummary -> m ()
#if __GLASGOW_HASKELL__ > 704
setGhcContext modSum = GHC.setContext [GHC.IIModule (GHC.moduleName $ GHC.ms_mod modSum)]
#else
setGhcContext modSum = GHC.setContext [GHC.IIModule ( GHC.ms_mod modSum)]
#endif