{-# LANGUAGE CPP #-}
-- | Pretty printer utilities
module HIE.Bios.Ghc.Doc where


import GHC (DynFlags, getPrintUnqual, pprCols, GhcMonad)

#if __GLASGOW_HASKELL__ >= 900
import GHC.Driver.Session (initSDocContext)
import GHC.Utils.Outputable (PprStyle, SDoc, runSDoc, neverQualify, )
import GHC.Utils.Ppr  (Mode(..), Doc, Style(..), renderStyle, style)
#else
import Outputable (PprStyle, SDoc, runSDoc, neverQualify, initSDocContext)
import Pretty (Mode(..), Doc, Style(..), renderStyle, style)
#endif

import HIE.Bios.Ghc.Gap (makeUserStyle, pageMode, oneLineMode)

showPage :: DynFlags -> PprStyle -> SDoc -> String
showPage :: DynFlags -> PprStyle -> SDoc -> String
showPage DynFlags
dflag PprStyle
stl SDoc
sdoc = DynFlags -> Mode -> Doc -> String
showDocWith DynFlags
dflag Mode
pageMode (Doc -> String) -> Doc -> String
forall a b. (a -> b) -> a -> b
$ SDoc -> SDocContext -> Doc
runSDoc SDoc
sdoc SDocContext
scontext
  where
    scontext :: SDocContext
scontext = DynFlags -> PprStyle -> SDocContext
initSDocContext DynFlags
dflag PprStyle
stl

showOneLine :: DynFlags -> PprStyle -> SDoc -> String
showOneLine :: DynFlags -> PprStyle -> SDoc -> String
showOneLine DynFlags
dflag PprStyle
stl SDoc
sdoc = DynFlags -> Mode -> Doc -> String
showDocWith DynFlags
dflag Mode
oneLineMode (Doc -> String) -> Doc -> String
forall a b. (a -> b) -> a -> b
$ SDoc -> SDocContext -> Doc
runSDoc SDoc
sdoc SDocContext
scontext
  where
    scontext :: SDocContext
scontext = DynFlags -> PprStyle -> SDocContext
initSDocContext DynFlags
dflag PprStyle
stl

getStyle :: (GhcMonad m) => DynFlags -> m PprStyle
getStyle :: DynFlags -> m PprStyle
getStyle DynFlags
dflags = DynFlags -> PrintUnqualified -> PprStyle
makeUserStyle DynFlags
dflags (PrintUnqualified -> PprStyle) -> m PrintUnqualified -> m PprStyle
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m PrintUnqualified
forall (m :: * -> *). GhcMonad m => m PrintUnqualified
getPrintUnqual

styleUnqualified :: DynFlags -> PprStyle
styleUnqualified :: DynFlags -> PprStyle
styleUnqualified DynFlags
dflags = DynFlags -> PrintUnqualified -> PprStyle
makeUserStyle DynFlags
dflags PrintUnqualified
neverQualify

showDocWith :: DynFlags -> Mode -> Doc -> String
showDocWith :: DynFlags -> Mode -> Doc -> String
showDocWith DynFlags
dflags Mode
md = Style -> Doc -> String
renderStyle Style
mstyle
  where
    mstyle :: Style
mstyle = Style
style { mode :: Mode
mode = Mode
md, lineLength :: Int
lineLength = DynFlags -> Int
pprCols DynFlags
dflags }