module Text.PrettyPrint.GenericPretty.Util
  ( inspect,
    inspectStr,
    inspectGen,
    inspectPlain,
    inspectStrPlain,
    inspectGenPlain,
    inspectStyle,
    inspectStyleStr,
    inspectStyleGen,
  )
where

import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import qualified Text.Pretty.Simple as PrettySimple
import qualified Text.PrettyPrint as Pretty
import Text.PrettyPrint.GenericPretty (Out)
import qualified Text.PrettyPrint.GenericPretty as GenericPretty
import Universum hiding (show)

inspect :: (Out a) => a -> T.Text
inspect :: forall a. Out a => a -> Text
inspect =
  OutputOptions -> a -> Text
forall a. Out a => OutputOptions -> a -> Text
inspectStyle OutputOptions
simpleStyle

inspectStr :: (Out a) => a -> String
inspectStr :: forall a. Out a => a -> String
inspectStr =
  OutputOptions -> a -> String
forall a. Out a => OutputOptions -> a -> String
inspectStyleStr OutputOptions
simpleStyle

inspectGen :: (Out a, IsString b) => a -> b
inspectGen :: forall a b. (Out a, IsString b) => a -> b
inspectGen =
  OutputOptions -> a -> b
forall a b. (Out a, IsString b) => OutputOptions -> a -> b
inspectStyleGen OutputOptions
simpleStyle

inspectPlain :: (Out a) => a -> T.Text
inspectPlain :: forall a. Out a => a -> Text
inspectPlain =
  OutputOptions -> a -> Text
forall a. Out a => OutputOptions -> a -> Text
inspectStyle OutputOptions
plainStyle

inspectStrPlain :: (Out a) => a -> String
inspectStrPlain :: forall a. Out a => a -> String
inspectStrPlain =
  OutputOptions -> a -> String
forall a. Out a => OutputOptions -> a -> String
inspectStyleStr OutputOptions
plainStyle

inspectGenPlain :: (Out a, IsString b) => a -> b
inspectGenPlain :: forall a b. (Out a, IsString b) => a -> b
inspectGenPlain =
  OutputOptions -> a -> b
forall a b. (Out a, IsString b) => OutputOptions -> a -> b
inspectStyleGen OutputOptions
plainStyle

inspectStyle ::
  (Out a) =>
  PrettySimple.OutputOptions ->
  a ->
  T.Text
inspectStyle :: forall a. Out a => OutputOptions -> a -> Text
inspectStyle OutputOptions
style =
  Text -> Text
TL.toStrict
    (Text -> Text) -> (a -> Text) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OutputOptions -> String -> Text
PrettySimple.pStringOpt OutputOptions
style
    (String -> Text) -> (a -> String) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Style -> a -> String
forall a. Out a => Style -> a -> String
GenericPretty.prettyStyle
      Style
Pretty.style
        { mode :: Mode
Pretty.mode = Mode
Pretty.OneLineMode
        }

inspectStyleStr ::
  (Out a) =>
  PrettySimple.OutputOptions ->
  a ->
  String
inspectStyleStr :: forall a. Out a => OutputOptions -> a -> String
inspectStyleStr OutputOptions
style =
  Text -> String
T.unpack (Text -> String) -> (a -> Text) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OutputOptions -> a -> Text
forall a. Out a => OutputOptions -> a -> Text
inspectStyle OutputOptions
style

inspectStyleGen ::
  ( Out a,
    IsString b
  ) =>
  PrettySimple.OutputOptions ->
  a ->
  b
inspectStyleGen :: forall a b. (Out a, IsString b) => OutputOptions -> a -> b
inspectStyleGen OutputOptions
style =
  String -> b
forall a. IsString a => String -> a
fromString (String -> b) -> (a -> String) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OutputOptions -> a -> String
forall a. Out a => OutputOptions -> a -> String
inspectStyleStr OutputOptions
style

simpleStyle :: PrettySimple.OutputOptions
simpleStyle :: OutputOptions
simpleStyle =
  OutputOptions
PrettySimple.defaultOutputOptionsDarkBg

plainStyle :: PrettySimple.OutputOptions
plainStyle :: OutputOptions
plainStyle =
  OutputOptions
PrettySimple.defaultOutputOptionsNoColor
    { outputOptionsPageWidth :: Int
PrettySimple.outputOptionsPageWidth = Int
100000,
      outputOptionsCompact :: Bool
PrettySimple.outputOptionsCompact = Bool
True,
      outputOptionsCompactParens :: Bool
PrettySimple.outputOptionsCompactParens = Bool
True
    }