{-# LANGUAGE ConstraintKinds       #-}
{-# LANGUAGE DataKinds             #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE RankNTypes            #-}
{-# LANGUAGE TemplateHaskell       #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE TypeOperators         #-}
{-# LANGUAGE UndecidableInstances  #-}

-- | A "readable" Agda-like way to pretty-print PLC entities.
module PlutusCore.Pretty.Readable (
  module Export,
  module PlutusCore.Pretty.Readable,
) where

import PlutusPrelude

import PlutusCore.Pretty.ConfigName
import PlutusCore.Pretty.Extra as Export

import Control.Lens
import Data.Profunctor as Export (Profunctor (..))
import Prettyprinter.Custom
import Text.Pretty
import Text.PrettyBy.Default
import Text.PrettyBy.Fixity as Export
import Text.PrettyBy.Internal

data ShowKinds
  = ShowKindsYes
  | ShowKindsNonType
  | ShowKindsNo
  deriving stock (Int -> ShowKinds -> ShowS
[ShowKinds] -> ShowS
ShowKinds -> String
(Int -> ShowKinds -> ShowS)
-> (ShowKinds -> String)
-> ([ShowKinds] -> ShowS)
-> Show ShowKinds
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ShowKinds -> ShowS
showsPrec :: Int -> ShowKinds -> ShowS
$cshow :: ShowKinds -> String
show :: ShowKinds -> String
$cshowList :: [ShowKinds] -> ShowS
showList :: [ShowKinds] -> ShowS
Show, ShowKinds -> ShowKinds -> Bool
(ShowKinds -> ShowKinds -> Bool)
-> (ShowKinds -> ShowKinds -> Bool) -> Eq ShowKinds
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ShowKinds -> ShowKinds -> Bool
== :: ShowKinds -> ShowKinds -> Bool
$c/= :: ShowKinds -> ShowKinds -> Bool
/= :: ShowKinds -> ShowKinds -> Bool
Eq)

instance Default ShowKinds where
  def :: ShowKinds
def = ShowKinds
ShowKindsNonType

-- | Configuration for the readable pretty-printing.
data PrettyConfigReadable configName = PrettyConfigReadable
  { forall configName. PrettyConfigReadable configName -> configName
_pcrConfigName    :: configName
  , forall configName. PrettyConfigReadable configName -> RenderContext
_pcrRenderContext :: RenderContext
  , forall configName. PrettyConfigReadable configName -> ShowKinds
_pcrShowKinds     :: ShowKinds
  }
  deriving stock (Int -> PrettyConfigReadable configName -> ShowS
[PrettyConfigReadable configName] -> ShowS
PrettyConfigReadable configName -> String
(Int -> PrettyConfigReadable configName -> ShowS)
-> (PrettyConfigReadable configName -> String)
-> ([PrettyConfigReadable configName] -> ShowS)
-> Show (PrettyConfigReadable configName)
forall configName.
Show configName =>
Int -> PrettyConfigReadable configName -> ShowS
forall configName.
Show configName =>
[PrettyConfigReadable configName] -> ShowS
forall configName.
Show configName =>
PrettyConfigReadable configName -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall configName.
Show configName =>
Int -> PrettyConfigReadable configName -> ShowS
showsPrec :: Int -> PrettyConfigReadable configName -> ShowS
$cshow :: forall configName.
Show configName =>
PrettyConfigReadable configName -> String
show :: PrettyConfigReadable configName -> String
$cshowList :: forall configName.
Show configName =>
[PrettyConfigReadable configName] -> ShowS
showList :: [PrettyConfigReadable configName] -> ShowS
Show)

type instance HasPrettyDefaults (PrettyConfigReadable _) = 'True

-- | The "readably pretty-printable" constraint.
type PrettyReadableBy configName = PrettyBy (PrettyConfigReadable configName)

type PrettyReadable = PrettyReadableBy PrettyConfigName

-- | A constraint for \"@m@ is a monad that allows for pretty-printing values via a
-- 'PrettyConfigReadable'.
type MonadPrettyReadable configName env m = MonadPretty (PrettyConfigReadable configName) env m

type HasPrettyConfigReadable env configName =
  HasPrettyConfig env (PrettyConfigReadable configName)

makeLenses ''PrettyConfigReadable

instance
  (configName ~ PrettyConfigName) =>
  HasPrettyConfigName (PrettyConfigReadable configName)
  where
  toPrettyConfigName :: PrettyConfigReadable configName -> PrettyConfigName
toPrettyConfigName = PrettyConfigReadable configName -> configName
PrettyConfigReadable configName -> PrettyConfigName
forall configName. PrettyConfigReadable configName -> configName
_pcrConfigName

instance HasRenderContext (PrettyConfigReadable configName) where
  renderContext :: Lens' (PrettyConfigReadable configName) RenderContext
renderContext = (RenderContext -> f RenderContext)
-> PrettyConfigReadable configName
-> f (PrettyConfigReadable configName)
forall configName (f :: * -> *).
Functor f =>
(RenderContext -> f RenderContext)
-> PrettyConfigReadable configName
-> f (PrettyConfigReadable configName)
pcrRenderContext

{- | For rendering things in a readable manner regardless of the pretty-printing function chosen.
I.e. all of 'show', 'pretty', 'prettyClassic' will use 'PrettyReadable' instead of doing what
they normally do. @prettyBy config (AsReadable x)@ requires @config@ to have a 'PrettyConfigName'
and respects it.

This wrapper can be particularly useful if you want to apply a function having a 'Show' or
'Pretty' or 'PrettyClassic' or 'PrettyPlc' or whatever constraint, but want to get the argument
rendered in a readable manner instead.
-}
newtype AsReadable a = AsReadable
  { forall a. AsReadable a -> a
unAsReadable :: a
  }

instance
  (HasPrettyConfigName config, PrettyReadable a) =>
  DefaultPrettyBy config (AsReadable a)
  where
  defaultPrettyBy :: forall ann. config -> AsReadable a -> Doc ann
defaultPrettyBy config
config (AsReadable a
x) =
    PrettyConfigReadable PrettyConfigName -> a -> Doc ann
forall ann. PrettyConfigReadable PrettyConfigName -> a -> Doc ann
forall config a ann. PrettyBy config a => config -> a -> Doc ann
prettyBy (PrettyConfigName
-> ShowKinds -> PrettyConfigReadable PrettyConfigName
forall configName.
configName -> ShowKinds -> PrettyConfigReadable configName
botPrettyConfigReadable (config -> PrettyConfigName
forall config.
HasPrettyConfigName config =>
config -> PrettyConfigName
toPrettyConfigName config
config) ShowKinds
forall a. Default a => a
def) a
x

instance (PrettyReadable a) => Show (AsReadable a) where
  show :: AsReadable a -> String
show = Sole PrettyConfigName -> AsReadable a -> String
forall str a config.
(PrettyBy config a, Render str) =>
config -> a -> str
displayBy (Sole PrettyConfigName -> AsReadable a -> String)
-> Sole PrettyConfigName -> AsReadable a -> String
forall a b. (a -> b) -> a -> b
$ PrettyConfigName -> Sole PrettyConfigName
forall a. a -> Sole a
Sole PrettyConfigName
prettyConfigName

instance (PrettyReadable a) => Pretty (AsReadable a) where
  pretty :: forall ann. AsReadable a -> Doc ann
pretty = AsReadable a -> Doc ann
forall a ann. Show a => a -> Doc ann
viaShow

deriving via
  PrettyCommon (AsReadable a)
  instance
    (PrettyDefaultBy config (AsReadable a)) => PrettyBy config (AsReadable a)

-- | A value of type @a@ to render in parens using the readable pretty-printer.
data Parened a = Parened
    { forall a. Parened a -> String
parenOpening :: String
    , forall a. Parened a -> String
parenClosing :: String
    , forall a. Parened a -> a
parenedValue :: a
    }

instance PrettyReadableBy configName a =>
        PrettyBy (PrettyConfigReadable configName) (Parened a) where
    prettyBy :: forall ann. PrettyConfigReadable configName -> Parened a -> Doc ann
prettyBy PrettyConfigReadable configName
config (Parened String
opening String
closing a
x) = [Doc ann] -> Doc ann
forall m. Monoid m => [m] -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold
        [ String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
opening
        , PrettyConfigReadable configName -> a -> Doc ann
forall ann. PrettyConfigReadable configName -> a -> Doc ann
forall config a ann. PrettyBy config a => config -> a -> Doc ann
prettyBy (PrettyConfigReadable configName
config PrettyConfigReadable configName
-> (PrettyConfigReadable configName
    -> PrettyConfigReadable configName)
-> PrettyConfigReadable configName
forall a b. a -> (a -> b) -> b
& (RenderContext -> Identity RenderContext)
-> PrettyConfigReadable configName
-> Identity (PrettyConfigReadable configName)
forall config.
HasRenderContext config =>
Lens' config RenderContext
Lens' (PrettyConfigReadable configName) RenderContext
renderContext ((RenderContext -> Identity RenderContext)
 -> PrettyConfigReadable configName
 -> Identity (PrettyConfigReadable configName))
-> RenderContext
-> PrettyConfigReadable configName
-> PrettyConfigReadable configName
forall s t a b. ASetter s t a b -> b -> s -> t
.~ RenderContext
botRenderContext) a
x
        , String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
closing
        ]

-- | Enclose the given value, so that it's rendered inside of braces with no additional parens
-- regardless of the 'RenderContext'.
inBraces :: a -> Parened a
inBraces :: forall a. a -> Parened a
inBraces = String -> String -> a -> Parened a
forall a. String -> String -> a -> Parened a
Parened String
"{" String
"}"

-- | A 'PrettyConfigReadable' with the fixity specified to 'botFixity'.
botPrettyConfigReadable :: configName -> ShowKinds -> PrettyConfigReadable configName
botPrettyConfigReadable :: forall configName.
configName -> ShowKinds -> PrettyConfigReadable configName
botPrettyConfigReadable configName
configName = configName
-> RenderContext -> ShowKinds -> PrettyConfigReadable configName
forall configName.
configName
-> RenderContext -> ShowKinds -> PrettyConfigReadable configName
PrettyConfigReadable configName
configName RenderContext
botRenderContext

-- | A 'PrettyConfigReadable' with the fixity specified to 'topFixity'.
topPrettyConfigReadable :: configName -> ShowKinds -> PrettyConfigReadable configName
topPrettyConfigReadable :: forall configName.
configName -> ShowKinds -> PrettyConfigReadable configName
topPrettyConfigReadable configName
configName = configName
-> RenderContext -> ShowKinds -> PrettyConfigReadable configName
forall configName.
configName
-> RenderContext -> ShowKinds -> PrettyConfigReadable configName
PrettyConfigReadable configName
configName RenderContext
topRenderContext

-- | The fixity of a binder.
binderFixity :: Fixity
binderFixity :: Fixity
binderFixity = Associativity -> Precedence -> Fixity
forall prec. Associativity -> prec -> FixityOver prec
Fixity Associativity
RightAssociative Precedence
1

-- | The fixity of @(->)@.
arrowFixity :: Fixity
arrowFixity :: Fixity
arrowFixity = Associativity -> Precedence -> Fixity
forall prec. Associativity -> prec -> FixityOver prec
Fixity Associativity
RightAssociative Precedence
2

{- | Lay out an iterated binder. For example, this function lays out iterated lambdas either as

> \(x : a) (y : b) (z : c) -> body

or as

> \(x : a)
>  (y : b)
>  (z : c) ->
>   body
-}
iterBinderPrettyM ::
  ( MonadPrettyReadable configName env m
  , PrettyReadableBy configName arg
  , PrettyReadableBy configName body
  ) =>
  (Doc ann -> Doc ann) ->
  [arg] ->
  body ->
  m (Doc ann)
iterBinderPrettyM :: forall configName env (m :: * -> *) arg body ann.
(MonadPrettyReadable configName env m,
 PrettyReadableBy configName arg,
 PrettyReadableBy configName body) =>
(Doc ann -> Doc ann) -> [arg] -> body -> m (Doc ann)
iterBinderPrettyM Doc ann -> Doc ann
enframe [arg]
args body
body =
  Fixity
-> ((forall {a}.
     PrettyBy (PrettyConfigReadable configName) a =>
     a -> Doc ann)
    -> (forall {a}.
        PrettyBy (PrettyConfigReadable configName) a =>
        a -> Doc ann)
    -> Doc ann)
-> m (Doc ann)
forall config env (m :: * -> *) ann.
MonadPrettyContext config env m =>
Fixity
-> (AnyToDoc config ann -> AnyToDoc config ann -> Doc ann)
-> m (Doc ann)
infixDocM Fixity
binderFixity (((forall {a}.
   PrettyBy (PrettyConfigReadable configName) a =>
   a -> Doc ann)
  -> (forall {a}.
      PrettyBy (PrettyConfigReadable configName) a =>
      a -> Doc ann)
  -> Doc ann)
 -> m (Doc ann))
-> ((forall {a}.
     PrettyBy (PrettyConfigReadable configName) a =>
     a -> Doc ann)
    -> (forall {a}.
        PrettyBy (PrettyConfigReadable configName) a =>
        a -> Doc ann)
    -> Doc ann)
-> m (Doc ann)
forall a b. (a -> b) -> a -> b
$ \forall {a}.
PrettyBy (PrettyConfigReadable configName) a =>
a -> Doc ann
prettyBind forall {a}.
PrettyBy (PrettyConfigReadable configName) a =>
a -> Doc ann
prettyBody ->
    let prettyBinds :: Doc ann
prettyBinds = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
align (Doc ann -> Doc ann)
-> ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
sep ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ (arg -> Doc ann) -> [arg] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map arg -> Doc ann
forall {a}.
PrettyBy (PrettyConfigReadable configName) a =>
a -> Doc ann
prettyBind [arg]
args
    in Doc ann -> Doc ann
enframe Doc ann
prettyBinds Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<?> body -> Doc ann
forall {a}.
PrettyBy (PrettyConfigReadable configName) a =>
a -> Doc ann
prettyBody body
body

-- | Lay out an iterated 'TyForall' via 'iterBinderPrettyM'.
iterTyForallPrettyM ::
  ( MonadPrettyReadable configName env m
  , PrettyReadableBy configName arg
  , PrettyReadableBy configName body
  ) =>
  [arg] ->
  body ->
  m (Doc ann)
iterTyForallPrettyM :: forall configName env (m :: * -> *) arg body ann.
(MonadPrettyReadable configName env m,
 PrettyReadableBy configName arg,
 PrettyReadableBy configName body) =>
[arg] -> body -> m (Doc ann)
iterTyForallPrettyM = (Doc ann -> Doc ann) -> [arg] -> body -> m (Doc ann)
forall configName env (m :: * -> *) arg body ann.
(MonadPrettyReadable configName env m,
 PrettyReadableBy configName arg,
 PrettyReadableBy configName body) =>
(Doc ann -> Doc ann) -> [arg] -> body -> m (Doc ann)
iterBinderPrettyM ((Doc ann -> Doc ann) -> [arg] -> body -> m (Doc ann))
-> (Doc ann -> Doc ann) -> [arg] -> body -> m (Doc ann)
forall a b. (a -> b) -> a -> b
$ \Doc ann
binds -> Doc ann
"all" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
binds Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"."

-- | Lay out an iterated 'LamAbs' via 'iterBinderPrettyM'.
iterLamAbsPrettyM ::
  ( MonadPrettyReadable configName env m
  , PrettyReadableBy configName arg
  , PrettyReadableBy configName body
  ) =>
  [arg] ->
  body ->
  m (Doc ann)
iterLamAbsPrettyM :: forall configName env (m :: * -> *) arg body ann.
(MonadPrettyReadable configName env m,
 PrettyReadableBy configName arg,
 PrettyReadableBy configName body) =>
[arg] -> body -> m (Doc ann)
iterLamAbsPrettyM = (Doc ann -> Doc ann) -> [arg] -> body -> m (Doc ann)
forall configName env (m :: * -> *) arg body ann.
(MonadPrettyReadable configName env m,
 PrettyReadableBy configName arg,
 PrettyReadableBy configName body) =>
(Doc ann -> Doc ann) -> [arg] -> body -> m (Doc ann)
iterBinderPrettyM ((Doc ann -> Doc ann) -> [arg] -> body -> m (Doc ann))
-> (Doc ann -> Doc ann) -> [arg] -> body -> m (Doc ann)
forall a b. (a -> b) -> a -> b
$ \Doc ann
binds -> Doc ann
"\\" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
binds Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"->"

-- | Lay out an iterated 'TyAbs' via 'iterBinderPrettyM'.
iterTyAbsPrettyM ::
  ( MonadPrettyReadable configName env m
  , PrettyReadableBy configName arg
  , PrettyReadableBy configName body
  ) =>
  [arg] ->
  body ->
  m (Doc ann)
iterTyAbsPrettyM :: forall configName env (m :: * -> *) arg body ann.
(MonadPrettyReadable configName env m,
 PrettyReadableBy configName arg,
 PrettyReadableBy configName body) =>
[arg] -> body -> m (Doc ann)
iterTyAbsPrettyM = (Doc ann -> Doc ann) -> [arg] -> body -> m (Doc ann)
forall configName env (m :: * -> *) arg body ann.
(MonadPrettyReadable configName env m,
 PrettyReadableBy configName arg,
 PrettyReadableBy configName body) =>
(Doc ann -> Doc ann) -> [arg] -> body -> m (Doc ann)
iterBinderPrettyM ((Doc ann -> Doc ann) -> [arg] -> body -> m (Doc ann))
-> (Doc ann -> Doc ann) -> [arg] -> body -> m (Doc ann)
forall a b. (a -> b) -> a -> b
$ \Doc ann
binds -> Doc ann
"/\\" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
binds Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"->"

-- | Lay out an iterated @->@.
iterArrowPrettyM ::
  (MonadPrettyReadable configName env m, PrettyReadableBy configName a) =>
  [a] ->
  a ->
  m (Doc ann)
iterArrowPrettyM :: forall configName env (m :: * -> *) a ann.
(MonadPrettyReadable configName env m,
 PrettyReadableBy configName a) =>
[a] -> a -> m (Doc ann)
iterArrowPrettyM [a]
args a
res =
  Fixity
-> ((forall {a}.
     PrettyBy (PrettyConfigReadable configName) a =>
     a -> Doc ann)
    -> (forall {a}.
        PrettyBy (PrettyConfigReadable configName) a =>
        a -> Doc ann)
    -> Doc ann)
-> m (Doc ann)
forall config env (m :: * -> *) ann.
MonadPrettyContext config env m =>
Fixity
-> (AnyToDoc config ann -> AnyToDoc config ann -> Doc ann)
-> m (Doc ann)
infixDocM Fixity
arrowFixity (((forall {a}.
   PrettyBy (PrettyConfigReadable configName) a =>
   a -> Doc ann)
  -> (forall {a}.
      PrettyBy (PrettyConfigReadable configName) a =>
      a -> Doc ann)
  -> Doc ann)
 -> m (Doc ann))
-> ((forall {a}.
     PrettyBy (PrettyConfigReadable configName) a =>
     a -> Doc ann)
    -> (forall {a}.
        PrettyBy (PrettyConfigReadable configName) a =>
        a -> Doc ann)
    -> Doc ann)
-> m (Doc ann)
forall a b. (a -> b) -> a -> b
$ \forall {a}.
PrettyBy (PrettyConfigReadable configName) a =>
a -> Doc ann
prettyArg forall {a}.
PrettyBy (PrettyConfigReadable configName) a =>
a -> Doc ann
prettyRes ->
    Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
align (Doc ann -> Doc ann)
-> ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
sep ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ (a -> Doc ann) -> [a] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map (\a
x -> a -> Doc ann
forall {a}.
PrettyBy (PrettyConfigReadable configName) a =>
a -> Doc ann
prettyArg a
x Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"->") [a]
args [Doc ann] -> [Doc ann] -> [Doc ann]
forall a. [a] -> [a] -> [a]
++ [a -> Doc ann
forall {a}.
PrettyBy (PrettyConfigReadable configName) a =>
a -> Doc ann
prettyRes a
res]

-- | The type of a 'PrettyConfigReadable'-based pretty-printer, similar to 'AnyToDoc'.
type ReadableToDoc configName ann = forall a. PrettyReadableBy configName a => a -> Doc ann

-- | Lay out an iteration application, providing to the caller a function to render the head of the
-- application and a function to render each of the arguments.
iterAppDocM ::
   MonadPrettyContext config env m =>
   (AnyToDoc config ann -> AnyToDoc config ann -> NonEmpty (Doc ann)) ->
   m (Doc ann)
iterAppDocM :: forall config env (m :: * -> *) ann.
MonadPrettyContext config env m =>
(AnyToDoc config ann -> AnyToDoc config ann -> NonEmpty (Doc ann))
-> m (Doc ann)
iterAppDocM AnyToDoc config ann -> AnyToDoc config ann -> NonEmpty (Doc ann)
k =
  Fixity
-> (AnyToDoc config ann -> AnyToDoc config ann -> Doc ann)
-> m (Doc ann)
forall config env (m :: * -> *) ann.
MonadPrettyContext config env m =>
Fixity
-> (AnyToDoc config ann -> AnyToDoc config ann -> Doc ann)
-> m (Doc ann)
infixDocM Fixity
juxtFixity ((AnyToDoc config ann -> AnyToDoc config ann -> Doc ann)
 -> m (Doc ann))
-> (AnyToDoc config ann -> AnyToDoc config ann -> Doc ann)
-> m (Doc ann)
forall a b. (a -> b) -> a -> b
$ \AnyToDoc config ann
prettyFun AnyToDoc config ann
prettyArg ->
    let Doc ann
fun :| [Doc ann]
args = AnyToDoc config ann -> AnyToDoc config ann -> NonEmpty (Doc ann)
k a -> Doc ann
AnyToDoc config ann
prettyFun a -> Doc ann
AnyToDoc config ann
prettyArg
    in if [Doc ann] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Doc ann]
args
        then Doc ann
fun
        else Doc ann
fun Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<?> [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep [Doc ann]
args

{- | Lay out iterated function applications either as

> foo x y z

or as

> foo
>   x
>   y
>   z
-}
iterAppPrettyM ::
  ( MonadPrettyContext config env m
  , PrettyBy config fun, PrettyBy config term
  ) =>
  fun ->
  [term] ->
  m (Doc ann)
iterAppPrettyM :: forall config env (m :: * -> *) fun term ann.
(MonadPrettyContext config env m, PrettyBy config fun,
 PrettyBy config term) =>
fun -> [term] -> m (Doc ann)
iterAppPrettyM fun
fun [term]
args =
  (AnyToDoc config ann -> AnyToDoc config ann -> NonEmpty (Doc ann))
-> m (Doc ann)
forall config env (m :: * -> *) ann.
MonadPrettyContext config env m =>
(AnyToDoc config ann -> AnyToDoc config ann -> NonEmpty (Doc ann))
-> m (Doc ann)
iterAppDocM ((AnyToDoc config ann -> AnyToDoc config ann -> NonEmpty (Doc ann))
 -> m (Doc ann))
-> (AnyToDoc config ann
    -> AnyToDoc config ann -> NonEmpty (Doc ann))
-> m (Doc ann)
forall a b. (a -> b) -> a -> b
$ \AnyToDoc config ann
prettyFun AnyToDoc config ann
prettyArg ->
    fun -> Doc ann
AnyToDoc config ann
prettyFun fun
fun Doc ann -> [Doc ann] -> NonEmpty (Doc ann)
forall a. a -> [a] -> NonEmpty a
:| (term -> Doc ann) -> [term] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map term -> Doc ann
AnyToDoc config ann
prettyArg [term]
args

{- | Lay out interleaved function applications either as

> foo {a} x {b} y z

or as

> foo
>   {a}
>   x
>   {b}
>   y
>   z

'Left's are laid out in braces, 'Right's are laid out without braces.
-}
iterInterAppPrettyM ::
  ( MonadPrettyReadable configName env m
  , PrettyReadableBy configName fun
  , PrettyReadableBy configName ty
  , PrettyReadableBy configName term
  ) =>
  fun ->
  [Either ty term] ->
  m (Doc ann)
iterInterAppPrettyM :: forall configName env (m :: * -> *) fun ty term ann.
(MonadPrettyReadable configName env m,
 PrettyReadableBy configName fun, PrettyReadableBy configName ty,
 PrettyReadableBy configName term) =>
fun -> [Either ty term] -> m (Doc ann)
iterInterAppPrettyM fun
fun [Either ty term]
args =
  (AnyToDoc (PrettyConfigReadable configName) ann
 -> AnyToDoc (PrettyConfigReadable configName) ann
 -> NonEmpty (Doc ann))
-> m (Doc ann)
forall config env (m :: * -> *) ann.
MonadPrettyContext config env m =>
(AnyToDoc config ann -> AnyToDoc config ann -> NonEmpty (Doc ann))
-> m (Doc ann)
iterAppDocM ((AnyToDoc (PrettyConfigReadable configName) ann
  -> AnyToDoc (PrettyConfigReadable configName) ann
  -> NonEmpty (Doc ann))
 -> m (Doc ann))
-> (AnyToDoc (PrettyConfigReadable configName) ann
    -> AnyToDoc (PrettyConfigReadable configName) ann
    -> NonEmpty (Doc ann))
-> m (Doc ann)
forall a b. (a -> b) -> a -> b
$ \AnyToDoc (PrettyConfigReadable configName) ann
prettyFun AnyToDoc (PrettyConfigReadable configName) ann
prettyArg ->
    let ppArg :: Either ty term -> Doc ann
ppArg (Left ty
ty)    = Parened ty -> Doc ann
AnyToDoc (PrettyConfigReadable configName) ann
prettyArg (Parened ty -> Doc ann) -> Parened ty -> Doc ann
forall a b. (a -> b) -> a -> b
$ ty -> Parened ty
forall a. a -> Parened a
inBraces ty
ty
        ppArg (Right term
term) = term -> Doc ann
AnyToDoc (PrettyConfigReadable configName) ann
prettyArg term
term
    in fun -> Doc ann
AnyToDoc (PrettyConfigReadable configName) ann
prettyFun fun
fun Doc ann -> [Doc ann] -> NonEmpty (Doc ann)
forall a. a -> [a] -> NonEmpty a
:| (Either ty term -> Doc ann) -> [Either ty term] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map Either ty term -> Doc ann
ppArg [Either ty term]
args

-- | Pretty-print something with the @PrettyConfigReadable@ config.
prettyReadable :: (PrettyReadable a) => a -> Doc ann
prettyReadable :: forall a ann. PrettyReadable a => a -> Doc ann
prettyReadable = PrettyConfigReadable PrettyConfigName -> a -> Doc ann
forall ann. PrettyConfigReadable PrettyConfigName -> a -> Doc ann
forall config a ann. PrettyBy config a => config -> a -> Doc ann
prettyBy (PrettyConfigName
-> ShowKinds -> PrettyConfigReadable PrettyConfigName
forall configName.
configName -> ShowKinds -> PrettyConfigReadable configName
botPrettyConfigReadable PrettyConfigName
prettyConfigName ShowKinds
forall a. Default a => a
def)

-- | Pretty-print something with the @PrettyConfigReadableSimple@ config.
prettyReadableSimple :: (PrettyReadable a) => a -> Doc ann
prettyReadableSimple :: forall a ann. PrettyReadable a => a -> Doc ann
prettyReadableSimple = PrettyConfigReadable PrettyConfigName -> a -> Doc ann
forall ann. PrettyConfigReadable PrettyConfigName -> a -> Doc ann
forall config a ann. PrettyBy config a => config -> a -> Doc ann
prettyBy (PrettyConfigName
-> ShowKinds -> PrettyConfigReadable PrettyConfigName
forall configName.
configName -> ShowKinds -> PrettyConfigReadable configName
botPrettyConfigReadable PrettyConfigName
prettyConfigNameSimple ShowKinds
forall a. Default a => a
def)