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

import GHC (Ghc)
import GHC.Utils.Outputable (PprStyle, SDoc, neverQualify, runSDoc, PprStyle, Depth(..), mkUserStyle, sdocLineLength, SDocContext)
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 :: Mode
mode = Mode
md, lineLength :: Int
lineLength = SDocContext -> Int
sdocLineLength SDocContext
ctx }

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

getStyle :: Ghc PprStyle
getStyle :: Ghc PprStyle
getStyle = NamePprCtx -> PprStyle
makeUserStyle forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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