Fix ghc<7.10
This commit is contained in:
parent
acf78f2500
commit
ce1d9d1da1
@ -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'
|
||||
|
@ -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 }
|
||||
|
Loading…
Reference in New Issue
Block a user