{-# LANGUAGE CPP #-}
-- Copyright 2019 Google LLC
--
-- Use of this source code is governed by a BSD-style
-- license that can be found in the LICENSE file or at
-- https://developers.google.com/open-source/licenses/bsd

-- | This module provides utilities for rendering GHC syntax as strings.
module GHC.SourceGen.Pretty
    ( showPpr
    , putPpr
    , hPutPpr
    ) where

import GHC.Driver.Monad
import GHC.Driver.Session
import GHC.Utils.Outputable
import System.IO

#if MIN_VERSION_ghc(9,2,0)
import GHC.Driver.Ppr (printForUser, showPpr)
#endif

hPutPpr :: Outputable a => Handle -> a -> Ghc ()
hPutPpr :: Handle -> a -> Ghc ()
hPutPpr Handle
h a
x = do
    DynFlags
dflags <- Ghc DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
    IO () -> Ghc ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Ghc ()) -> IO () -> Ghc ()
forall a b. (a -> b) -> a -> b
$ DynFlags -> Handle -> PrintUnqualified -> SDoc -> IO ()
printForUser DynFlags
dflags Handle
h PrintUnqualified
neverQualify
#if MIN_VERSION_ghc(9,0,1)
        AllTheWay
#endif
            (SDoc -> IO ()) -> SDoc -> IO ()
forall a b. (a -> b) -> a -> b
$ a -> SDoc
forall a. Outputable a => a -> SDoc
ppr a
x

putPpr :: Outputable a => a -> Ghc ()
putPpr :: a -> Ghc ()
putPpr = Handle -> a -> Ghc ()
forall a. Outputable a => Handle -> a -> Ghc ()
hPutPpr Handle
stdout