-- | Printer combinators for printing values of types implementing
-- 'Outputable'.
module HIndent.Pretty.Combinators.Outputable
  ( output
  , showOutputable
  ) where

import GHC.Driver.Ppr
import GHC.Driver.Session
import GHC.Stack
import GHC.Utils.Outputable
import HIndent.Pretty.Combinators.String
import HIndent.Printer
import Language.Haskell.GhclibParserEx.GHC.Settings.Config

-- | Prints the given value using the type's 'Outputable' implementation.
--
-- The use of this function should be avoided for these reasons:
--
-- * It may raise an error due to 'showPpr' returning a 'String' containing
-- @\n@s. Use 'newline' to print @\n@s.
--
-- * ghc-lib-parser may change a type's implementation of 'Outputable',
-- causing a sudden test failure. It becomes a maintaince burden.
--
-- * All comments of the node's children are ignored.
output :: (HasCallStack, Outputable a) => a -> Printer ()
output :: forall a. (HasCallStack, Outputable a) => a -> Printer ()
output = HasCallStack => String -> Printer ()
String -> Printer ()
string (String -> Printer ()) -> (a -> String) -> a -> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Outputable a => a -> String
showOutputable

-- | Converts the given value to a 'String'.
showOutputable :: Outputable a => a -> String
showOutputable :: forall a. Outputable a => a -> String
showOutputable = DynFlags -> a -> String
forall a. Outputable a => DynFlags -> a -> String
showPpr DynFlags
dynFlags

-- | 'DynFlags' for calling 'showPpr'
dynFlags :: DynFlags
dynFlags :: DynFlags
dynFlags = Settings -> LlvmConfig -> DynFlags
defaultDynFlags Settings
fakeSettings LlvmConfig
fakeLlvmConfig