module Hhp.Doc (
    showPage,
    showOneLine,
    getStyle,
    styleUnqualified,
) where

import GHC (Ghc)
import GHC.Utils.Outputable (
    Depth (..),
    PprStyle,
    SDoc,
    SDocContext,
    mkUserStyle,
    neverQualify,
    runSDoc,
    sdocLineLength,
 )
import GHC.Utils.Ppr (Mode (..), Style (..), renderStyle, style)

import Hhp.Gap

----------------------------------------------------------------

showPage :: SDocContext -> SDoc -> String
showPage :: SDocContext -> SDoc -> String
showPage = Mode -> SDocContext -> SDoc -> String
showSDocWithMode Mode
pagemode

showOneLine :: SDocContext -> SDoc -> String
showOneLine :: SDocContext -> SDoc -> String
showOneLine = Mode -> SDocContext -> SDoc -> String
showSDocWithMode Mode
OneLineMode

showSDocWithMode :: Mode -> SDocContext -> SDoc -> String
showSDocWithMode :: Mode -> SDocContext -> SDoc -> String
showSDocWithMode Mode
md SDocContext
ctx SDoc
sdoc = Style -> Doc -> String
renderStyle Style
style' Doc
doc
  where
    doc :: Doc
doc = SDoc -> SDocContext -> Doc
runSDoc SDoc
sdoc SDocContext
ctx
    style' :: Style
style' = Style
style{mode = md, lineLength = sdocLineLength ctx}

----------------------------------------------------------------

getStyle :: Ghc PprStyle
getStyle :: Ghc PprStyle
getStyle = NamePprCtx -> PprStyle
makeUserStyle (NamePprCtx -> PprStyle) -> Ghc NamePprCtx -> Ghc PprStyle
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ghc NamePprCtx
forall (m :: * -> *). GhcMonad m => m NamePprCtx
getNamePprCtx

styleUnqualified :: PprStyle
styleUnqualified :: PprStyle
styleUnqualified = NamePprCtx -> PprStyle
makeUserStyle NamePprCtx
neverQualify

makeUserStyle :: NamePprCtx -> PprStyle
makeUserStyle :: NamePprCtx -> PprStyle
makeUserStyle NamePprCtx
pu = NamePprCtx -> Depth -> PprStyle
mkUserStyle NamePprCtx
pu Depth
AllTheWay