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


import GHC (DynFlags
#if __GLASGOW_HASKELL__ < 905
           , getPrintUnqual
#endif
           , pprCols, GhcMonad)
#if __GLASGOW_HASKELL__ >= 905
import GHC.Utils.Outputable
#endif

import GHC.Driver.Session (initSDocContext)
import GHC.Utils.Ppr  (Mode(..), Doc, Style(..), renderStyle, style)

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

#if __GLASGOW_HASKELL__ < 905
import GHC.Utils.Outputable (PprStyle, SDoc, runSDoc, neverQualify, )
#endif

#if __GLASGOW_HASKELL__ >= 905
getPrintUnqual :: Monad m => m NamePprCtx
getPrintUnqual :: forall (m :: * -> *). Monad m => m NamePprCtx
getPrintUnqual = NamePprCtx -> m NamePprCtx
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure NamePprCtx
neverQualify
#endif

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 :: forall (m :: * -> *). GhcMonad m => DynFlags -> m PprStyle
getStyle DynFlags
dflags = DynFlags -> NamePprCtx -> PprStyle
makeUserStyle DynFlags
dflags (NamePprCtx -> PprStyle) -> m NamePprCtx -> m PprStyle
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m NamePprCtx
forall (m :: * -> *). Monad m => m NamePprCtx
getPrintUnqual

styleUnqualified :: DynFlags -> PprStyle
styleUnqualified :: DynFlags -> PprStyle
styleUnqualified DynFlags
dflags = DynFlags -> NamePprCtx -> PprStyle
makeUserStyle DynFlags
dflags NamePprCtx
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 = md, lineLength = pprCols dflags }