From ce1d9d1da1e306f2aed34f3e4d5d02daab8c2d32 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Gr=C3=B6ber?= Date: Fri, 11 Sep 2015 04:13:44 +0200 Subject: [PATCH] Fix ghc<7.10 --- Language/Haskell/GhcMod/DebugLogger.hs | 52 ++++++++++++++++++++------ Language/Haskell/GhcMod/Gap.hs | 11 ++++-- 2 files changed, 49 insertions(+), 14 deletions(-) diff --git a/Language/Haskell/GhcMod/DebugLogger.hs b/Language/Haskell/GhcMod/DebugLogger.hs index 3e3069a..83c11c9 100644 --- a/Language/Haskell/GhcMod/DebugLogger.hs +++ b/Language/Haskell/GhcMod/DebugLogger.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} module Language.Haskell.GhcMod.DebugLogger where @@ -7,28 +8,46 @@ import Pretty import Outputable (SDoc, PprStyle, runSDoc, initSDocContext, blankLine) import qualified Outputable import ErrUtils -import DynFlags (LogAction) import Language.Haskell.GhcMod.Error +import Language.Haskell.GhcMod.Gap import Prelude -debugLogAction :: (String -> IO ()) -> LogAction +debugLogAction :: (String -> IO ()) -> GmLogAction debugLogAction putErr dflags severity srcSpan style msg = case severity of - SevOutput -> printSDoc msg style - SevDump -> printSDoc (msg Outputable.$$ blankLine) style - SevInteractive -> putStrSDoc msg style - SevInfo -> printErrs msg style - SevFatal -> printErrs msg style + SevOutput -> printSDoc putErr msg style + +#if __GLASGOW_HASKELL__ >= 706 + SevDump -> printSDoc putErr (msg Outputable.$$ blankLine) style +#endif + +#if __GLASGOW_HASKELL__ >= 708 + SevInteractive -> let + putStrSDoc = debugLogActionHPutStrDoc dflags putErr + in + putStrSDoc msg style +#endif + SevInfo -> printErrs putErr msg style + SevFatal -> printErrs putErr msg style _ -> do putErr "\n" - printErrs (mkLocMessage severity srcSpan msg) style +#if __GLASGOW_HASKELL__ >= 706 + printErrs putErr (mkLocMessage severity srcSpan msg) style +#else + printErrs putErr (mkLocMessage srcSpan msg) style +#endif -- careful (#2302): printErrs prints in UTF-8, -- whereas converting to string first and using -- hPutStr would just emit the low 8 bits of -- each unicode char. - where printSDoc = debugLogActionHPrintDoc dflags putErr - printErrs = debugLogActionHPrintDoc dflags putErr - putStrSDoc = debugLogActionHPutStrDoc dflags putErr + where +#if __GLASGOW_HASKELL__ >= 706 + printSDoc put = debugLogActionHPrintDoc dflags put + printErrs put = debugLogActionHPrintDoc dflags put +#endif + + +#if __GLASGOW_HASKELL__ >= 706 debugLogActionHPrintDoc :: DynFlags -> (String -> IO ()) -> SDoc -> PprStyle -> IO () debugLogActionHPrintDoc dflags put d sty @@ -42,6 +61,15 @@ debugLogActionHPutStrDoc dflags put d sty -- calls to this log-action can output all on the same line doc = runSDoc d (initSDocContext dflags sty) +#else + +printSDoc = printErrs + +printErrs :: (String -> IO ()) -> SDoc -> PprStyle -> IO () +printErrs put doc sty = do + gmPrintDoc PageMode 100 put (runSDoc doc (initSDocContext sty)) + +#endif gmPrintDoc :: Mode -> Int -> (String -> IO ()) -> Doc -> IO () -- printDoc adds a newline to the end @@ -54,7 +82,9 @@ gmPrintDoc_ mode pprCols putS doc put (Chr c) next = putS [c] >> next put (Str s) next = putS s >> next put (PStr s) next = putS (unpackFS s) >> next +#if __GLASGOW_HASKELL__ >= 708 put (ZStr s) next = putS (zString s) >> next +#endif put (LStr s _l) next = putS (unpackLitString s) >> next done = return () -- hPutChar hdl '\n' diff --git a/Language/Haskell/GhcMod/Gap.hs b/Language/Haskell/GhcMod/Gap.hs index da96c82..00d8bc5 100644 --- a/Language/Haskell/GhcMod/Gap.hs +++ b/Language/Haskell/GhcMod/Gap.hs @@ -4,6 +4,7 @@ module Language.Haskell.GhcMod.Gap ( Language.Haskell.GhcMod.Gap.ClsInst , mkTarget , withStyle + , GmLogAction , setLogAction , getSrcSpan , getSrcFile @@ -135,9 +136,13 @@ withStyle = withPprStyleDoc withStyle _ = withPprStyleDoc #endif -setLogAction :: DynFlags - -> (DynFlags -> Severity -> SrcSpan -> PprStyle -> SDoc -> IO ()) - -> DynFlags +#if __GLASGOW_HASKELL__ >= 706 +type GmLogAction = LogAction +#else +type GmLogAction = DynFlags -> LogAction +#endif + +setLogAction :: DynFlags -> GmLogAction -> DynFlags setLogAction df f = #if __GLASGOW_HASKELL__ >= 706 df { log_action = f }