-- Copyright 2020-2021 Google LLC
-- Copyright 2022 Andrew Pritchard
--
-- Licensed under the Apache License, Version 2.0 (the "License");
-- you may not use this file except in compliance with the License.
-- You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
-- Unless required by applicable law or agreed to in writing, software
-- distributed under the License is distributed on an "AS IS" BASIS,
-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-- See the License for the specific language governing permissions and
-- limitations under the License.

-- | Provides rendering of 'Portrayal' to 'Doc'.
--
-- There are two intended uses of this module: firstly, to use @pretty@'s
-- layout and rendering algorithms to render 'Portray' instances, 'Diff's, or
-- other 'Portrayal's; and secondly, to derive 'Pretty' instances based on
-- existing 'Portray' instances.  I find the former more ergonomic, but in
-- established codebases that want to benefit from deriving, the latter may be
-- more achievable.
--
-- The first usage is for codebases with pervasive use of 'Portray', and
-- involves using e.g. 'pp' and 'ppd' in GHCi, or 'showPortrayal' or 'showDiff'
-- in application code.  With this usage, anything you want to pretty-print
-- needs a 'Portray' instance, and the typeclass 'Pretty' is not involved in
-- any way.  With this approach, pretty-printable types and the types they
-- include should derive only 'Portray', and pretty-printing should be done
-- with the aforementioned utility functions:
--
-- @
-- data MyRecord = MyRecord { anInt :: Int, anotherRecord :: MyOtherRecord }
--   deriving Generic
--   deriving Portray via Wrapped Generic MyRecord
--
-- example = 'showPortrayal' (MyRecord 2 ...)
-- @
--
-- The second usage is to use @portray@'s generic deriving to provide derived
-- 'Pretty' instances, in a codebase that uses 'Pretty' as the preferred
-- typeclass for pretty-printable values.  With this usage, things you want to
-- pretty-print need 'Pretty' instances, and 'Portray' is needed for the
-- transitive closure of types included in types you want to derive 'Pretty'
-- instances for.  This may result in many types needing both instances of both
-- 'Pretty' (for direct pretty-printing) and 'Portray' (for deriving 'Portray'
-- on downstream types) instances.  Note that with this approach, types that
-- derive their 'Pretty' instances via 'Portray' will ignore any custom
-- 'Pretty' instances of nested types, since they recurse to nested 'Portray'
-- instances instead.
--
-- To derive an instance for a pretty-printable type, the type itself should
-- look like the following:
--
-- @
-- data MyRecord = MyRecord { anInt :: Int, anotherRecord :: MyOtherRecord }
--   deriving Generic
--   deriving Portray via Wrapped Generic MyRecord
--   deriving Pretty via WrappedPortray MyRecord
--
-- example = 'Text.PrettyPrint.HughesPJClass.prettyShow' (MyRecord 2 ...)
-- @
--
-- And any types transitively included in it should look like the following:
--
-- @
-- data MyOtherRecord = MyOtherRecord
--   deriving Generic
--   deriving Portray via Wrapped Generic MyRecord
-- @
--
-- This module also exports the underlying rendering functionality in a variety
-- of forms for more esoteric uses.

{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}

module Data.Portray.Pretty
         ( -- * Pretty-Printing
           showPortrayal, pp
           -- * Diffing
         , showDiff, ppd
           -- * DerivingVia wrapper
         , WrappedPortray(..)
           -- * Rendering Functions
           -- ** With Associativity
         , DocAssocPrec, toDocAssocPrecF, toDocAssocPrec
           -- ** With Precedence
         , portrayalToDocPrecF, portrayalToDocPrec
           -- ** Convenience Functions
         , portrayalToDoc
         , prettyShowPortrayal
         , pPrintPortrayal
         ) where

import Data.Functor ((<&>))

import qualified Data.Text as T
import Text.PrettyPrint (Doc)
import qualified Text.PrettyPrint as P
import qualified Text.PrettyPrint.HughesPJ as P (maybeParens)
import Text.PrettyPrint.HughesPJClass (Pretty(..), PrettyLevel, prettyNormal)

import Data.Portray
         ( Assoc(..), Infixity(..), FactorPortrayal(..)
         , Ident(..), IdentKind(..), shouldUseScientific
         , formatFloatLit, formatIntLit, formatSpecialFloat
         , Portray, Portrayal(..), PortrayalF(..)
         , cata, portray
         )
import Data.Portray.Diff (Diff(..))

-- | Pretty-print a value to stdout using its 'Portray' instance.
pp :: Portray a => a -> IO ()
pp :: forall a. Portray a => a -> IO ()
pp = String -> IO ()
putStrLn forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Portray a => a -> String
showPortrayal

-- | Pretty-print a value using its 'Portray' instance.
showPortrayal :: Portray a => a -> String
showPortrayal :: forall a. Portray a => a -> String
showPortrayal = Portrayal -> String
prettyShowPortrayal forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Portray a => a -> Portrayal
portray

-- | Pretty-print a diff between two values to stdout using a 'Diff' instance.
ppd :: Diff a => a -> a -> IO ()
ppd :: forall a. Diff a => a -> a -> IO ()
ppd a
x = String -> IO ()
putStrLn forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Diff a => a -> a -> String
showDiff a
x

-- | Pretty-print a diff between two values using a 'Diff' instance.
showDiff :: Diff a => a -> a -> String
showDiff :: forall a. Diff a => a -> a -> String
showDiff a
x = forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"_" Portrayal -> String
prettyShowPortrayal forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Diff a => a -> a -> Maybe Portrayal
diff a
x

-- | A 'Doc' that varies according to associativity and precedence context.
type DocAssocPrec = Assoc -> Rational -> Doc

fixityCompatible :: Infixity -> Assoc -> Rational -> Bool
fixityCompatible :: Infixity -> Assoc -> Rational -> Bool
fixityCompatible (Infixity Assoc
assoc Rational
p) Assoc
assoc' Rational
p' = case forall a. Ord a => a -> a -> Ordering
compare Rational
p' Rational
p of
  Ordering
GT -> Bool
False  -- Context has higher precedence than this binop.
  Ordering
EQ -> Assoc
assoc forall a. Eq a => a -> a -> Bool
== Assoc
assoc'
  Ordering
LT -> Bool
True

matchCtx :: Assoc -> Assoc -> Assoc
matchCtx :: Assoc -> Assoc -> Assoc
matchCtx Assoc
ctx Assoc
assoc
  | Assoc
ctx forall a. Eq a => a -> a -> Bool
== Assoc
assoc = Assoc
ctx
  | Bool
otherwise = Assoc
AssocNope

-- | Convert a 'Portrayal' to a 'Doc'.
portrayalToDoc :: Portrayal -> Doc
portrayalToDoc :: Portrayal -> Doc
portrayalToDoc Portrayal
t = Portrayal -> PrettyLevel -> Rational -> Doc
portrayalToDocPrec Portrayal
t PrettyLevel
prettyNormal (-Rational
1)

ppInfix :: Ident -> Doc
ppInfix :: Ident -> Doc
ppInfix (Ident IdentKind
k Text
nm) = case IdentKind
k of
  IdentKind
OpConIdent -> Doc
nmDoc
  IdentKind
OpIdent -> Doc
nmDoc
  IdentKind
VarIdent -> Doc
wrappedNm
  IdentKind
ConIdent -> Doc
wrappedNm
 where
  nmDoc :: Doc
nmDoc = String -> Doc
P.text forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
nm
  wrappedNm :: Doc
wrappedNm = Char -> Doc
P.char Char
'`' forall a. Semigroup a => a -> a -> a
<> Doc
nmDoc forall a. Semigroup a => a -> a -> a
<> Char -> Doc
P.char Char
'`'

ppPrefix :: Ident -> Doc
ppPrefix :: Ident -> Doc
ppPrefix (Ident IdentKind
k Text
nm) = case IdentKind
k of
  IdentKind
OpConIdent -> Doc
wrappedNm
  IdentKind
OpIdent -> Doc
wrappedNm
  IdentKind
VarIdent -> Doc
nmDoc
  IdentKind
ConIdent -> Doc
nmDoc
 where
  nmDoc :: Doc
nmDoc = String -> Doc
P.text forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
nm
  wrappedNm :: Doc
wrappedNm = Doc -> Doc
P.parens Doc
nmDoc

ppBinop
  :: Ident
  -> Infixity
  -> DocAssocPrec -> DocAssocPrec -> DocAssocPrec
ppBinop :: Ident -> Infixity -> DocAssocPrec -> DocAssocPrec -> DocAssocPrec
ppBinop Ident
nm fx :: Infixity
fx@(Infixity Assoc
assoc Rational
opPrec) DocAssocPrec
x DocAssocPrec
y Assoc
lr Rational
p =
  Bool -> Doc -> Doc
P.maybeParens (Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ Infixity -> Assoc -> Rational -> Bool
fixityCompatible Infixity
fx Assoc
lr Rational
p) forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
P.sep
    [ DocAssocPrec
x (Assoc -> Assoc -> Assoc
matchCtx Assoc
AssocL Assoc
assoc) Rational
opPrec Doc -> Doc -> Doc
P.<+> Ident -> Doc
ppInfix Ident
nm
    , Int -> Doc -> Doc
P.nest Int
2 forall a b. (a -> b) -> a -> b
$ DocAssocPrec
y (Assoc -> Assoc -> Assoc
matchCtx Assoc
AssocR Assoc
assoc) Rational
opPrec
    ]

ppBulletList
  :: Doc -- ^ Open brace,  e.g. {  [  {  (
  -> Doc -- ^ Separator,   e.g. ;  ,  ,  ,
  -> Doc -- ^ Close brace, e.g. }  ]  }  )
  -> [Doc]
  -> Doc
ppBulletList :: Doc -> Doc -> Doc -> [Doc] -> Doc
ppBulletList Doc
opener Doc
_         Doc
closer []   = Doc
opener forall a. Semigroup a => a -> a -> a
<> Doc
closer
ppBulletList Doc
opener Doc
separator Doc
closer [Doc]
docs =
  [Doc] -> Doc
P.sep forall a b. (a -> b) -> a -> b
$
    [ [Doc] -> Doc
P.fcat forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Doc -> Doc -> Doc
(P.<+>) (Doc
opener forall a. a -> [a] -> [a]
: forall a. a -> [a]
repeat Doc
separator) [Doc]
docs
    , Doc
closer
    ]

-- | Render one layer of 'PortrayalF' to 'DocAssocPrec'.
toDocAssocPrecF :: PortrayalF DocAssocPrec -> DocAssocPrec
toDocAssocPrecF :: PortrayalF DocAssocPrec -> DocAssocPrec
toDocAssocPrecF = \case
  NameF Ident
nm -> \Assoc
_ Rational
_ -> Ident -> Doc
ppPrefix Ident
nm
  LitIntBaseF Base
b Integer
x -> \Assoc
_ Rational
_ -> String -> Doc
P.text forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack forall a b. (a -> b) -> a -> b
$ forall a. (Show a, Integral a) => Base -> [Int] -> a -> Text
formatIntLit Base
b [] Integer
x

  LitFloatF FloatLiteral
x -> \Assoc
_ Rational
_ ->
    String -> Doc
P.text forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack forall a b. (a -> b) -> a -> b
$ Bool -> [Int] -> FloatLiteral -> Text
formatFloatLit (FloatLiteral -> Bool
shouldUseScientific FloatLiteral
x) [] FloatLiteral
x

  SpecialFloatF SpecialFloatVal
x -> \Assoc
_ Rational
_ -> String -> Doc
P.text forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack forall a b. (a -> b) -> a -> b
$ SpecialFloatVal -> Text
formatSpecialFloat SpecialFloatVal
x
  LitStrF Text
x -> \Assoc
_ Rational
_ -> String -> Doc
P.text (forall a. Show a => a -> String
show Text
x)
  LitCharF Char
x -> \Assoc
_ Rational
_ -> String -> Doc
P.text (forall a. Show a => a -> String
show Char
x)
  OpaqueF Text
txt -> \Assoc
_ Rational
_ -> String -> Doc
P.text (Text -> String
T.unpack Text
txt)
  ApplyF DocAssocPrec
fn [] -> \Assoc
_ Rational
_ -> DocAssocPrec
fn Assoc
AssocL Rational
10

  ApplyF DocAssocPrec
fn [DocAssocPrec]
xs -> \Assoc
lr Rational
p ->
    Bool -> Doc -> Doc
P.maybeParens (Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ Infixity -> Assoc -> Rational -> Bool
fixityCompatible (Assoc -> Rational -> Infixity
Infixity Assoc
AssocL Rational
10) Assoc
lr Rational
p) forall a b. (a -> b) -> a -> b
$
      [Doc] -> Doc
P.sep
        [ DocAssocPrec
fn Assoc
AssocL Rational
10
        , Int -> Doc -> Doc
P.nest Int
2 forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
P.sep forall a b. (a -> b) -> a -> b
$ [DocAssocPrec]
xs forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \DocAssocPrec
docprec -> DocAssocPrec
docprec Assoc
AssocR Rational
10
        ]

  BinopF Ident
nm Infixity
fx DocAssocPrec
x DocAssocPrec
y -> Ident -> Infixity -> DocAssocPrec -> DocAssocPrec -> DocAssocPrec
ppBinop Ident
nm Infixity
fx DocAssocPrec
x DocAssocPrec
y
  TupleF [DocAssocPrec]
xs -> \Assoc
_ Rational
_ -> Doc -> Doc -> Doc -> [Doc] -> Doc
ppBulletList Doc
"(" Doc
"," Doc
")" forall a b. (a -> b) -> a -> b
$ [DocAssocPrec]
xs forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \DocAssocPrec
x -> DocAssocPrec
x Assoc
AssocNope (-Rational
1)
  ListF [DocAssocPrec]
xs -> \Assoc
_ Rational
_ -> Doc -> Doc -> Doc -> [Doc] -> Doc
ppBulletList Doc
"[" Doc
"," Doc
"]" forall a b. (a -> b) -> a -> b
$ [DocAssocPrec]
xs forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \DocAssocPrec
x -> DocAssocPrec
x Assoc
AssocNope (-Rational
1)
  LambdaCaseF [(DocAssocPrec, DocAssocPrec)]
xs -> \Assoc
_ Rational
p ->
    Bool -> Doc -> Doc
P.maybeParens (Rational
p forall a. Ord a => a -> a -> Bool
>= Rational
10) forall a b. (a -> b) -> a -> b
$
      [Doc] -> Doc
P.sep
        [ Doc
"\\case"
        , Int -> Doc -> Doc
P.nest Int
2 forall a b. (a -> b) -> a -> b
$ Doc -> Doc -> Doc -> [Doc] -> Doc
ppBulletList Doc
"{" Doc
";" Doc
"}"
            [ [Doc] -> Doc
P.sep forall a b. (a -> b) -> a -> b
$
                [ DocAssocPrec
pat Assoc
AssocNope Rational
0 Doc -> Doc -> Doc
P.<+> Doc
"->"
                , Int -> Doc -> Doc
P.nest Int
2 forall a b. (a -> b) -> a -> b
$ DocAssocPrec
val Assoc
AssocNope Rational
0
                ]
            | (DocAssocPrec
pat, DocAssocPrec
val) <- [(DocAssocPrec, DocAssocPrec)]
xs
            ]
        ]
  RecordF DocAssocPrec
con [FactorPortrayal DocAssocPrec]
sels -> \Assoc
_ Rational
_ -> case [FactorPortrayal DocAssocPrec]
sels of
    [] -> DocAssocPrec
con Assoc
AssocNope (-Rational
1)
    [FactorPortrayal DocAssocPrec]
_  -> [Doc] -> Doc
P.sep
      [ DocAssocPrec
con Assoc
AssocNope Rational
10
      , Int -> Doc -> Doc
P.nest Int
2 forall a b. (a -> b) -> a -> b
$ Doc -> Doc -> Doc -> [Doc] -> Doc
ppBulletList Doc
"{" Doc
"," Doc
"}"
          [ [Doc] -> Doc
P.sep
              [ Ident -> Doc
ppPrefix Ident
sel Doc -> Doc -> Doc
P.<+> Doc
"="
              , Int -> Doc -> Doc
P.nest Int
2 forall a b. (a -> b) -> a -> b
$ DocAssocPrec
val Assoc
AssocNope Rational
0
              ]
          | FactorPortrayal Ident
sel DocAssocPrec
val <- [FactorPortrayal DocAssocPrec]
sels
          ]
      ]
  TyAppF DocAssocPrec
val DocAssocPrec
ty -> \Assoc
_ Rational
_ ->
    [Doc] -> Doc
P.sep [DocAssocPrec
val Assoc
AssocNope Rational
10, Int -> Doc -> Doc
P.nest Int
2 forall a b. (a -> b) -> a -> b
$ Doc
"@" forall a. Semigroup a => a -> a -> a
<> DocAssocPrec
ty Assoc
AssocNope Rational
10]
  TySigF DocAssocPrec
val DocAssocPrec
ty -> \Assoc
_ Rational
p -> Bool -> Doc -> Doc
P.maybeParens (Rational
p forall a. Ord a => a -> a -> Bool
>= Rational
0) forall a b. (a -> b) -> a -> b
$
    [Doc] -> Doc
P.sep [DocAssocPrec
val Assoc
AssocNope Rational
0, Int -> Doc -> Doc
P.nest Int
2 forall a b. (a -> b) -> a -> b
$ Doc
"::" Doc -> Doc -> Doc
P.<+> DocAssocPrec
ty Assoc
AssocNope Rational
0]
  QuotF Text
nm DocAssocPrec
content -> \Assoc
_ Rational
_ ->
    [Doc] -> Doc
P.sep
      [ Char -> Doc
P.char Char
'[' forall a. Semigroup a => a -> a -> a
<> String -> Doc
P.text (Text -> String
T.unpack Text
nm) forall a. Semigroup a => a -> a -> a
<> Char -> Doc
P.char Char
'|'
      , Int -> Doc -> Doc
P.nest Int
2 forall a b. (a -> b) -> a -> b
$ DocAssocPrec
content Assoc
AssocNope (-Rational
1)
      , Doc
"|]"
      ]
  UnlinesF [DocAssocPrec]
ls -> \Assoc
_ Rational
_ -> [Doc] -> Doc
P.vcat ([DocAssocPrec]
ls forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \DocAssocPrec
l -> DocAssocPrec
l Assoc
AssocNope (-Rational
1))
  NestF Int
n DocAssocPrec
x -> \Assoc
_ Rational
_ -> Int -> Doc -> Doc
P.nest Int
n (DocAssocPrec
x Assoc
AssocNope (-Rational
1))

toDocPrec :: DocAssocPrec -> PrettyLevel -> Rational -> Doc
toDocPrec :: DocAssocPrec -> PrettyLevel -> Rational -> Doc
toDocPrec DocAssocPrec
dap PrettyLevel
_l = DocAssocPrec
dap Assoc
AssocNope forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Num a => a -> a -> a
subtract Rational
1

-- | Render a 'PortrayalF' to a 'Doc'.
portrayalToDocPrecF
  :: PortrayalF DocAssocPrec -> PrettyLevel -> Rational -> Doc
portrayalToDocPrecF :: PortrayalF DocAssocPrec -> PrettyLevel -> Rational -> Doc
portrayalToDocPrecF = DocAssocPrec -> PrettyLevel -> Rational -> Doc
toDocPrec forall b c a. (b -> c) -> (a -> b) -> a -> c
. PortrayalF DocAssocPrec -> DocAssocPrec
toDocAssocPrecF

-- | Render a 'Portrayal' to a 'Doc' with support for operator associativity.
toDocAssocPrec :: Portrayal -> DocAssocPrec
toDocAssocPrec :: Portrayal -> DocAssocPrec
toDocAssocPrec = forall (f :: * -> *) a. Functor f => (f a -> a) -> Fix f -> a
cata PortrayalF DocAssocPrec -> DocAssocPrec
toDocAssocPrecF forall b c a. (b -> c) -> (a -> b) -> a -> c
. Portrayal -> Fix PortrayalF
unPortrayal

-- | Render a 'Portrayal' to a 'Doc' with only operator precedence.
portrayalToDocPrec :: Portrayal -> PrettyLevel -> Rational -> Doc
portrayalToDocPrec :: Portrayal -> PrettyLevel -> Rational -> Doc
portrayalToDocPrec = DocAssocPrec -> PrettyLevel -> Rational -> Doc
toDocPrec forall b c a. (b -> c) -> (a -> b) -> a -> c
. Portrayal -> DocAssocPrec
toDocAssocPrec

-- | 'portrayalToDocPrec' with arguments ordered for use in 'pPrintPrec'.
pPrintPortrayal :: PrettyLevel -> Rational -> Portrayal -> Doc
pPrintPortrayal :: PrettyLevel -> Rational -> Portrayal -> Doc
pPrintPortrayal PrettyLevel
l Rational
p Portrayal
x = Portrayal -> PrettyLevel -> Rational -> Doc
portrayalToDocPrec Portrayal
x PrettyLevel
l Rational
p

-- | Convenience function for rendering a 'Portrayal' to a 'String'.
prettyShowPortrayal :: Portrayal -> String
prettyShowPortrayal :: Portrayal -> String
prettyShowPortrayal Portrayal
p = forall a. Show a => a -> String
show (Portrayal -> DocAssocPrec
toDocAssocPrec Portrayal
p Assoc
AssocNope (-Rational
1))

-- | A newtype providing a 'Pretty' instance via 'Portray', for @DerivingVia@.
--
-- Sadly we can't use @Wrapped@ since it would be an orphan instance.  Oh well.
-- We'll just define a unique 'WrappedPortray' newtype in each
-- pretty-printer-integration package.
newtype WrappedPortray a = WrappedPortray { forall a. WrappedPortray a -> a
unWrappedPortray :: a }
  deriving newtype (WrappedPortray a -> WrappedPortray a -> Bool
forall a. Eq a => WrappedPortray a -> WrappedPortray a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WrappedPortray a -> WrappedPortray a -> Bool
$c/= :: forall a. Eq a => WrappedPortray a -> WrappedPortray a -> Bool
== :: WrappedPortray a -> WrappedPortray a -> Bool
$c== :: forall a. Eq a => WrappedPortray a -> WrappedPortray a -> Bool
Eq, WrappedPortray a -> WrappedPortray a -> Bool
WrappedPortray a -> WrappedPortray a -> Ordering
WrappedPortray a -> WrappedPortray a -> WrappedPortray a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {a}. Ord a => Eq (WrappedPortray a)
forall a. Ord a => WrappedPortray a -> WrappedPortray a -> Bool
forall a. Ord a => WrappedPortray a -> WrappedPortray a -> Ordering
forall a.
Ord a =>
WrappedPortray a -> WrappedPortray a -> WrappedPortray a
min :: WrappedPortray a -> WrappedPortray a -> WrappedPortray a
$cmin :: forall a.
Ord a =>
WrappedPortray a -> WrappedPortray a -> WrappedPortray a
max :: WrappedPortray a -> WrappedPortray a -> WrappedPortray a
$cmax :: forall a.
Ord a =>
WrappedPortray a -> WrappedPortray a -> WrappedPortray a
>= :: WrappedPortray a -> WrappedPortray a -> Bool
$c>= :: forall a. Ord a => WrappedPortray a -> WrappedPortray a -> Bool
> :: WrappedPortray a -> WrappedPortray a -> Bool
$c> :: forall a. Ord a => WrappedPortray a -> WrappedPortray a -> Bool
<= :: WrappedPortray a -> WrappedPortray a -> Bool
$c<= :: forall a. Ord a => WrappedPortray a -> WrappedPortray a -> Bool
< :: WrappedPortray a -> WrappedPortray a -> Bool
$c< :: forall a. Ord a => WrappedPortray a -> WrappedPortray a -> Bool
compare :: WrappedPortray a -> WrappedPortray a -> Ordering
$ccompare :: forall a. Ord a => WrappedPortray a -> WrappedPortray a -> Ordering
Ord, Int -> WrappedPortray a -> ShowS
[WrappedPortray a] -> ShowS
WrappedPortray a -> String
forall a. Show a => Int -> WrappedPortray a -> ShowS
forall a. Show a => [WrappedPortray a] -> ShowS
forall a. Show a => WrappedPortray a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WrappedPortray a] -> ShowS
$cshowList :: forall a. Show a => [WrappedPortray a] -> ShowS
show :: WrappedPortray a -> String
$cshow :: forall a. Show a => WrappedPortray a -> String
showsPrec :: Int -> WrappedPortray a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> WrappedPortray a -> ShowS
Show)

-- | Provide an instance for 'Pretty' by way of 'Portray'.
instance Portray a => Pretty (WrappedPortray a) where
  pPrintPrec :: PrettyLevel -> Rational -> WrappedPortray a -> Doc
pPrintPrec PrettyLevel
l Rational
p WrappedPortray a
x = Portrayal -> PrettyLevel -> Rational -> Doc
portrayalToDocPrec (forall a. Portray a => a -> Portrayal
portray forall a b. (a -> b) -> a -> b
$ forall a. WrappedPortray a -> a
unWrappedPortray WrappedPortray a
x) PrettyLevel
l Rational
p