-- | A "readable" Agda-like way to pretty-print PLC entities.

{-# OPTIONS_GHC -fno-warn-orphans #-}

{-# LANGUAGE LambdaCase            #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE RankNTypes            #-}
{-# LANGUAGE TypeOperators         #-}
{-# LANGUAGE UndecidableInstances  #-}

module PlutusCore.Core.Instance.Pretty.Readable () where

import PlutusPrelude

import PlutusCore.Core.Instance.Pretty.Common ()
import PlutusCore.Core.Type
import PlutusCore.Pretty.PrettyConst
import PlutusCore.Pretty.Readable

import Control.Monad.Reader
import Prettyprinter
import Universe

-- | Pretty-print a binding at the type level.
typeBinderDocM
    :: ( MonadReader env m, HasPrettyConfigReadable env configName
       , PrettyReadableBy configName tyname
       )
    => ((tyname -> Kind a -> Doc ann) -> AnyToDoc (PrettyConfigReadable configName) ann -> Doc ann)
    -> m (Doc ann)
typeBinderDocM :: ((tyname -> Kind a -> Doc ann)
 -> AnyToDoc (PrettyConfigReadable configName) ann -> Doc ann)
-> m (Doc ann)
typeBinderDocM (tyname -> Kind a -> Doc ann)
-> AnyToDoc (PrettyConfigReadable configName) ann -> Doc ann
k = do
    ShowKinds
showKinds <- Getting ShowKinds env ShowKinds -> m ShowKinds
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Getting ShowKinds env ShowKinds -> m ShowKinds)
-> Getting ShowKinds env ShowKinds -> m ShowKinds
forall a b. (a -> b) -> a -> b
$ (PrettyConfigReadable configName
 -> Const ShowKinds (PrettyConfigReadable configName))
-> env -> Const ShowKinds env
forall env config. HasPrettyConfig env config => Lens' env config
prettyConfig ((PrettyConfigReadable configName
  -> Const ShowKinds (PrettyConfigReadable configName))
 -> env -> Const ShowKinds env)
-> ((ShowKinds -> Const ShowKinds ShowKinds)
    -> PrettyConfigReadable configName
    -> Const ShowKinds (PrettyConfigReadable configName))
-> Getting ShowKinds env ShowKinds
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ShowKinds -> Const ShowKinds ShowKinds)
-> PrettyConfigReadable configName
-> Const ShowKinds (PrettyConfigReadable configName)
forall configName.
Lens' (PrettyConfigReadable configName) ShowKinds
pcrShowKinds
    Direction
-> Fixity
-> (AnyToDoc (PrettyConfigReadable configName) ann -> m (Doc ann))
-> m (Doc ann)
forall config env (m :: * -> *) ann r.
MonadPrettyContext config env m =>
Direction -> Fixity -> (AnyToDoc config ann -> m r) -> m r
withPrettyAt Direction
ToTheRight Fixity
botFixity ((AnyToDoc (PrettyConfigReadable configName) ann -> m (Doc ann))
 -> m (Doc ann))
-> (AnyToDoc (PrettyConfigReadable configName) ann -> m (Doc ann))
-> m (Doc ann)
forall a b. (a -> b) -> a -> b
$ \AnyToDoc (PrettyConfigReadable configName) ann
prettyBot -> do
        let prettyBind :: a -> a -> Doc ann
prettyBind a
name a
kind = case ShowKinds
showKinds of
                ShowKinds
ShowKindsYes -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$ a -> Doc ann
AnyToDoc (PrettyConfigReadable configName) ann
prettyBot a
name Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"::" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> a -> Doc ann
AnyToDoc (PrettyConfigReadable configName) ann
prettyBot a
kind
                ShowKinds
ShowKindsNo  -> a -> Doc ann
AnyToDoc (PrettyConfigReadable configName) ann
prettyBot a
name
        Fixity -> Doc ann -> m (Doc ann)
forall config env (m :: * -> *) ann.
MonadPrettyContext config env m =>
Fixity -> Doc ann -> m (Doc ann)
encloseM Fixity
binderFixity (Doc ann -> m (Doc ann)) -> Doc ann -> m (Doc ann)
forall a b. (a -> b) -> a -> b
$ (tyname -> Kind a -> Doc ann)
-> AnyToDoc (PrettyConfigReadable configName) ann -> Doc ann
k tyname -> Kind a -> Doc ann
forall a a.
(PrettyBy (PrettyConfigReadable configName) a,
 PrettyBy (PrettyConfigReadable configName) a) =>
a -> a -> Doc ann
prettyBind AnyToDoc (PrettyConfigReadable configName) ann
prettyBot

instance PrettyBy (PrettyConfigReadable configName) (Kind a) where
    prettyBy :: PrettyConfigReadable configName -> Kind a -> Doc ann
prettyBy = (Kind a -> InContextM (PrettyConfigReadable configName) (Doc ann))
-> PrettyConfigReadable configName -> Kind a -> Doc ann
forall a config ann.
(a -> InContextM config (Doc ann)) -> config -> a -> Doc ann
inContextM ((Kind a -> InContextM (PrettyConfigReadable configName) (Doc ann))
 -> PrettyConfigReadable configName -> Kind a -> Doc ann)
-> (Kind a
    -> InContextM (PrettyConfigReadable configName) (Doc ann))
-> PrettyConfigReadable configName
-> Kind a
-> Doc ann
forall a b. (a -> b) -> a -> b
$ \case
        Type{}          -> InContextM (PrettyConfigReadable configName) (Doc ann)
"*"
        KindArrow a
_ Kind a
k Kind a
l -> Kind a
k Kind a
-> Kind a -> InContextM (PrettyConfigReadable configName) (Doc ann)
forall config env (m :: * -> *) a b ann.
(MonadPrettyContext config env m, PrettyBy config a,
 PrettyBy config b) =>
a -> b -> m (Doc ann)
`arrowPrettyM` Kind a
l

instance (PrettyReadableBy configName tyname, GShow uni) =>
        PrettyBy (PrettyConfigReadable configName) (Type tyname uni a) where
    prettyBy :: PrettyConfigReadable configName -> Type tyname uni a -> Doc ann
prettyBy = (Type tyname uni a
 -> InContextM (PrettyConfigReadable configName) (Doc ann))
-> PrettyConfigReadable configName -> Type tyname uni a -> Doc ann
forall a config ann.
(a -> InContextM config (Doc ann)) -> config -> a -> Doc ann
inContextM ((Type tyname uni a
  -> InContextM (PrettyConfigReadable configName) (Doc ann))
 -> PrettyConfigReadable configName -> Type tyname uni a -> Doc ann)
-> (Type tyname uni a
    -> InContextM (PrettyConfigReadable configName) (Doc ann))
-> PrettyConfigReadable configName
-> Type tyname uni a
-> Doc ann
forall a b. (a -> b) -> a -> b
$ \case
        TyApp a
_ Type tyname uni a
fun Type tyname uni a
arg           -> Type tyname uni a
fun Type tyname uni a
-> Type tyname uni a
-> InContextM (PrettyConfigReadable configName) (Doc ann)
forall config env (m :: * -> *) a b ann.
(MonadPrettyContext config env m, PrettyBy config a,
 PrettyBy config b) =>
a -> b -> m (Doc ann)
`juxtPrettyM` Type tyname uni a
arg
        TyVar a
_ tyname
name              -> tyname -> InContextM (PrettyConfigReadable configName) (Doc ann)
forall config env (m :: * -> *) a ann.
(MonadPretty config env m, PrettyBy config a) =>
a -> m (Doc ann)
prettyM tyname
name
        TyFun a
_ Type tyname uni a
tyIn Type tyname uni a
tyOut        -> Type tyname uni a
tyIn Type tyname uni a
-> Type tyname uni a
-> InContextM (PrettyConfigReadable configName) (Doc ann)
forall config env (m :: * -> *) a b ann.
(MonadPrettyContext config env m, PrettyBy config a,
 PrettyBy config b) =>
a -> b -> m (Doc ann)
`arrowPrettyM` Type tyname uni a
tyOut
        TyIFix a
_ Type tyname uni a
pat Type tyname uni a
arg          ->
            Direction
-> Fixity
-> (AnyToDoc (PrettyConfigReadable configName) ann -> Doc ann)
-> InContextM (PrettyConfigReadable configName) (Doc ann)
forall config env (m :: * -> *) ann.
MonadPrettyContext config env m =>
Direction
-> Fixity -> (AnyToDoc config ann -> Doc ann) -> m (Doc ann)
sequenceDocM Direction
ToTheRight Fixity
juxtFixity ((AnyToDoc (PrettyConfigReadable configName) ann -> Doc ann)
 -> InContextM (PrettyConfigReadable configName) (Doc ann))
-> (AnyToDoc (PrettyConfigReadable configName) ann -> Doc ann)
-> InContextM (PrettyConfigReadable configName) (Doc ann)
forall a b. (a -> b) -> a -> b
$ \AnyToDoc (PrettyConfigReadable configName) ann
prettyEl ->
                Doc ann
"ifix" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Type tyname uni a -> Doc ann
AnyToDoc (PrettyConfigReadable configName) ann
prettyEl Type tyname uni a
pat Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Type tyname uni a -> Doc ann
AnyToDoc (PrettyConfigReadable configName) ann
prettyEl Type tyname uni a
arg
        TyForall a
_ tyname
name Kind a
kind Type tyname uni a
body ->
            ((tyname -> Kind a -> Doc ann)
 -> AnyToDoc (PrettyConfigReadable configName) ann -> Doc ann)
-> InContextM (PrettyConfigReadable configName) (Doc ann)
forall env (m :: * -> *) configName tyname a ann.
(MonadReader env m, HasPrettyConfigReadable env configName,
 PrettyReadableBy configName tyname) =>
((tyname -> Kind a -> Doc ann)
 -> AnyToDoc (PrettyConfigReadable configName) ann -> Doc ann)
-> m (Doc ann)
typeBinderDocM (((tyname -> Kind a -> Doc ann)
  -> AnyToDoc (PrettyConfigReadable configName) ann -> Doc ann)
 -> InContextM (PrettyConfigReadable configName) (Doc ann))
-> ((tyname -> Kind a -> Doc ann)
    -> AnyToDoc (PrettyConfigReadable configName) ann -> Doc ann)
-> InContextM (PrettyConfigReadable configName) (Doc ann)
forall a b. (a -> b) -> a -> b
$ \tyname -> Kind a -> Doc ann
prettyBinding AnyToDoc (PrettyConfigReadable configName) ann
prettyBody ->
                Doc ann
"all" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> tyname -> Kind a -> Doc ann
prettyBinding tyname
name Kind a
kind Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"." Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Type tyname uni a -> Doc ann
AnyToDoc (PrettyConfigReadable configName) ann
prettyBody Type tyname uni a
body
        TyBuiltin a
_ SomeTypeIn uni
builtin       -> Doc ann -> InContextM (PrettyConfigReadable configName) (Doc ann)
forall config env (m :: * -> *) ann.
MonadPrettyContext config env m =>
Doc ann -> m (Doc ann)
unitDocM (Doc ann -> InContextM (PrettyConfigReadable configName) (Doc ann))
-> Doc ann
-> InContextM (PrettyConfigReadable configName) (Doc ann)
forall a b. (a -> b) -> a -> b
$ SomeTypeIn uni -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty SomeTypeIn uni
builtin
        TyLam a
_ tyname
name Kind a
kind Type tyname uni a
body    ->
            ((tyname -> Kind a -> Doc ann)
 -> AnyToDoc (PrettyConfigReadable configName) ann -> Doc ann)
-> InContextM (PrettyConfigReadable configName) (Doc ann)
forall env (m :: * -> *) configName tyname a ann.
(MonadReader env m, HasPrettyConfigReadable env configName,
 PrettyReadableBy configName tyname) =>
((tyname -> Kind a -> Doc ann)
 -> AnyToDoc (PrettyConfigReadable configName) ann -> Doc ann)
-> m (Doc ann)
typeBinderDocM (((tyname -> Kind a -> Doc ann)
  -> AnyToDoc (PrettyConfigReadable configName) ann -> Doc ann)
 -> InContextM (PrettyConfigReadable configName) (Doc ann))
-> ((tyname -> Kind a -> Doc ann)
    -> AnyToDoc (PrettyConfigReadable configName) ann -> Doc ann)
-> InContextM (PrettyConfigReadable configName) (Doc ann)
forall a b. (a -> b) -> a -> b
$ \tyname -> Kind a -> Doc ann
prettyBinding AnyToDoc (PrettyConfigReadable configName) ann
prettyBody ->
                Doc ann
"\\" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> tyname -> Kind a -> Doc ann
prettyBinding tyname
name Kind a
kind Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"->" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Type tyname uni a -> Doc ann
AnyToDoc (PrettyConfigReadable configName) ann
prettyBody Type tyname uni a
body

instance
        ( PrettyReadableBy configName tyname
        , PrettyReadableBy configName name
        , GShow uni, Closed uni, uni `Everywhere` PrettyConst, Pretty fun
        ) => PrettyBy (PrettyConfigReadable configName) (Term tyname name uni fun a) where
    prettyBy :: PrettyConfigReadable configName
-> Term tyname name uni fun a -> Doc ann
prettyBy = (Term tyname name uni fun a
 -> InContextM (PrettyConfigReadable configName) (Doc ann))
-> PrettyConfigReadable configName
-> Term tyname name uni fun a
-> Doc ann
forall a config ann.
(a -> InContextM config (Doc ann)) -> config -> a -> Doc ann
inContextM ((Term tyname name uni fun a
  -> InContextM (PrettyConfigReadable configName) (Doc ann))
 -> PrettyConfigReadable configName
 -> Term tyname name uni fun a
 -> Doc ann)
-> (Term tyname name uni fun a
    -> InContextM (PrettyConfigReadable configName) (Doc ann))
-> PrettyConfigReadable configName
-> Term tyname name uni fun a
-> Doc ann
forall a b. (a -> b) -> a -> b
$ \case
        Constant a
_ Some (ValueOf uni)
con         -> Doc ann -> InContextM (PrettyConfigReadable configName) (Doc ann)
forall config env (m :: * -> *) ann.
MonadPrettyContext config env m =>
Doc ann -> m (Doc ann)
unitDocM (Doc ann -> InContextM (PrettyConfigReadable configName) (Doc ann))
-> Doc ann
-> InContextM (PrettyConfigReadable configName) (Doc ann)
forall a b. (a -> b) -> a -> b
$ Some (ValueOf uni) -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Some (ValueOf uni)
con
        Builtin a
_ fun
bi           -> Doc ann -> InContextM (PrettyConfigReadable configName) (Doc ann)
forall config env (m :: * -> *) ann.
MonadPrettyContext config env m =>
Doc ann -> m (Doc ann)
unitDocM (Doc ann -> InContextM (PrettyConfigReadable configName) (Doc ann))
-> Doc ann
-> InContextM (PrettyConfigReadable configName) (Doc ann)
forall a b. (a -> b) -> a -> b
$ fun -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty fun
bi
        Apply a
_ Term tyname name uni fun a
fun Term tyname name uni fun a
arg        -> Term tyname name uni fun a
fun Term tyname name uni fun a
-> Term tyname name uni fun a
-> InContextM (PrettyConfigReadable configName) (Doc ann)
forall config env (m :: * -> *) a b ann.
(MonadPrettyContext config env m, PrettyBy config a,
 PrettyBy config b) =>
a -> b -> m (Doc ann)
`juxtPrettyM` Term tyname name uni fun a
arg
        Var a
_ name
name             -> name -> InContextM (PrettyConfigReadable configName) (Doc ann)
forall config env (m :: * -> *) a ann.
(MonadPretty config env m, PrettyBy config a) =>
a -> m (Doc ann)
prettyM name
name
        TyAbs a
_ tyname
name Kind a
kind Term tyname name uni fun a
body ->
            ((tyname -> Kind a -> Doc ann)
 -> AnyToDoc (PrettyConfigReadable configName) ann -> Doc ann)
-> InContextM (PrettyConfigReadable configName) (Doc ann)
forall env (m :: * -> *) configName tyname a ann.
(MonadReader env m, HasPrettyConfigReadable env configName,
 PrettyReadableBy configName tyname) =>
((tyname -> Kind a -> Doc ann)
 -> AnyToDoc (PrettyConfigReadable configName) ann -> Doc ann)
-> m (Doc ann)
typeBinderDocM (((tyname -> Kind a -> Doc ann)
  -> AnyToDoc (PrettyConfigReadable configName) ann -> Doc ann)
 -> InContextM (PrettyConfigReadable configName) (Doc ann))
-> ((tyname -> Kind a -> Doc ann)
    -> AnyToDoc (PrettyConfigReadable configName) ann -> Doc ann)
-> InContextM (PrettyConfigReadable configName) (Doc ann)
forall a b. (a -> b) -> a -> b
$ \tyname -> Kind a -> Doc ann
prettyBinding AnyToDoc (PrettyConfigReadable configName) ann
prettyBody ->
                Doc ann
"/\\" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> tyname -> Kind a -> Doc ann
prettyBinding tyname
name Kind a
kind Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"->" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Term tyname name uni fun a -> Doc ann
AnyToDoc (PrettyConfigReadable configName) ann
prettyBody Term tyname name uni fun a
body
        TyInst a
_ Term tyname name uni fun a
fun Type tyname uni a
ty        ->
            Fixity
-> ((forall a.
     PrettyBy (PrettyConfigReadable configName) a =>
     Direction -> Fixity -> a -> Doc ann)
    -> Doc ann)
-> InContextM (PrettyConfigReadable configName) (Doc ann)
forall config env (m :: * -> *) ann.
MonadPrettyContext config env m =>
Fixity
-> ((forall a.
     PrettyBy config a =>
     Direction -> Fixity -> a -> Doc ann)
    -> Doc ann)
-> m (Doc ann)
compoundDocM Fixity
juxtFixity (((forall a.
   PrettyBy (PrettyConfigReadable configName) a =>
   Direction -> Fixity -> a -> Doc ann)
  -> Doc ann)
 -> InContextM (PrettyConfigReadable configName) (Doc ann))
-> ((forall a.
     PrettyBy (PrettyConfigReadable configName) a =>
     Direction -> Fixity -> a -> Doc ann)
    -> Doc ann)
-> InContextM (PrettyConfigReadable configName) (Doc ann)
forall a b. (a -> b) -> a -> b
$ \forall a.
PrettyBy (PrettyConfigReadable configName) a =>
Direction -> Fixity -> a -> Doc ann
prettyIn ->
                Direction -> Fixity -> Term tyname name uni fun a -> Doc ann
forall a.
PrettyBy (PrettyConfigReadable configName) a =>
Direction -> Fixity -> a -> Doc ann
prettyIn Direction
ToTheLeft Fixity
juxtFixity Term tyname name uni fun a
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
braces (Direction -> Fixity -> Type tyname uni a -> Doc ann
forall a.
PrettyBy (PrettyConfigReadable configName) a =>
Direction -> Fixity -> a -> Doc ann
prettyIn Direction
ToTheRight Fixity
botFixity Type tyname uni a
ty)
        LamAbs a
_ name
name Type tyname uni a
ty Term tyname name uni fun a
body  ->
            Fixity
-> ((forall a.
     PrettyBy (PrettyConfigReadable configName) a =>
     Direction -> Fixity -> a -> Doc ann)
    -> Doc ann)
-> InContextM (PrettyConfigReadable configName) (Doc ann)
forall config env (m :: * -> *) ann.
MonadPrettyContext config env m =>
Fixity
-> ((forall a.
     PrettyBy config a =>
     Direction -> Fixity -> a -> Doc ann)
    -> Doc ann)
-> m (Doc ann)
compoundDocM Fixity
binderFixity (((forall a.
   PrettyBy (PrettyConfigReadable configName) a =>
   Direction -> Fixity -> a -> Doc ann)
  -> Doc ann)
 -> InContextM (PrettyConfigReadable configName) (Doc ann))
-> ((forall a.
     PrettyBy (PrettyConfigReadable configName) a =>
     Direction -> Fixity -> a -> Doc ann)
    -> Doc ann)
-> InContextM (PrettyConfigReadable configName) (Doc ann)
forall a b. (a -> b) -> a -> b
$ \forall a.
PrettyBy (PrettyConfigReadable configName) a =>
Direction -> Fixity -> a -> Doc ann
prettyIn ->
                let prettyBot :: a -> Doc ann
prettyBot a
x = Direction -> Fixity -> a -> Doc ann
forall a.
PrettyBy (PrettyConfigReadable configName) a =>
Direction -> Fixity -> a -> Doc ann
prettyIn Direction
ToTheRight Fixity
botFixity a
x
                in Doc ann
"\\" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens (name -> Doc ann
AnyToDoc (PrettyConfigReadable configName) ann
prettyBot name
name Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
":" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Type tyname uni a -> Doc ann
AnyToDoc (PrettyConfigReadable configName) ann
prettyBot Type tyname uni a
ty) Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"->" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Term tyname name uni fun a -> Doc ann
AnyToDoc (PrettyConfigReadable configName) ann
prettyBot Term tyname name uni fun a
body
        Unwrap a
_ Term tyname name uni fun a
term          ->
            Direction
-> Fixity
-> (AnyToDoc (PrettyConfigReadable configName) ann -> Doc ann)
-> InContextM (PrettyConfigReadable configName) (Doc ann)
forall config env (m :: * -> *) ann.
MonadPrettyContext config env m =>
Direction
-> Fixity -> (AnyToDoc config ann -> Doc ann) -> m (Doc ann)
sequenceDocM Direction
ToTheRight Fixity
juxtFixity ((AnyToDoc (PrettyConfigReadable configName) ann -> Doc ann)
 -> InContextM (PrettyConfigReadable configName) (Doc ann))
-> (AnyToDoc (PrettyConfigReadable configName) ann -> Doc ann)
-> InContextM (PrettyConfigReadable configName) (Doc ann)
forall a b. (a -> b) -> a -> b
$ \AnyToDoc (PrettyConfigReadable configName) ann
prettyEl ->
                Doc ann
"unwrap" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Term tyname name uni fun a -> Doc ann
AnyToDoc (PrettyConfigReadable configName) ann
prettyEl Term tyname name uni fun a
term
        IWrap a
_ Type tyname uni a
pat Type tyname uni a
arg Term tyname name uni fun a
term   ->
            Direction
-> Fixity
-> (AnyToDoc (PrettyConfigReadable configName) ann -> Doc ann)
-> InContextM (PrettyConfigReadable configName) (Doc ann)
forall config env (m :: * -> *) ann.
MonadPrettyContext config env m =>
Direction
-> Fixity -> (AnyToDoc config ann -> Doc ann) -> m (Doc ann)
sequenceDocM Direction
ToTheRight Fixity
juxtFixity ((AnyToDoc (PrettyConfigReadable configName) ann -> Doc ann)
 -> InContextM (PrettyConfigReadable configName) (Doc ann))
-> (AnyToDoc (PrettyConfigReadable configName) ann -> Doc ann)
-> InContextM (PrettyConfigReadable configName) (Doc ann)
forall a b. (a -> b) -> a -> b
$ \AnyToDoc (PrettyConfigReadable configName) ann
prettyEl ->
                Doc ann
"iwrap" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Type tyname uni a -> Doc ann
AnyToDoc (PrettyConfigReadable configName) ann
prettyEl Type tyname uni a
pat Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Type tyname uni a -> Doc ann
AnyToDoc (PrettyConfigReadable configName) ann
prettyEl Type tyname uni a
arg Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Term tyname name uni fun a -> Doc ann
AnyToDoc (PrettyConfigReadable configName) ann
prettyEl Term tyname name uni fun a
term
        Error a
_ Type tyname uni a
ty             ->
            Fixity
-> ((forall a.
     PrettyBy (PrettyConfigReadable configName) a =>
     Direction -> Fixity -> a -> Doc ann)
    -> Doc ann)
-> InContextM (PrettyConfigReadable configName) (Doc ann)
forall config env (m :: * -> *) ann.
MonadPrettyContext config env m =>
Fixity
-> ((forall a.
     PrettyBy config a =>
     Direction -> Fixity -> a -> Doc ann)
    -> Doc ann)
-> m (Doc ann)
compoundDocM Fixity
juxtFixity (((forall a.
   PrettyBy (PrettyConfigReadable configName) a =>
   Direction -> Fixity -> a -> Doc ann)
  -> Doc ann)
 -> InContextM (PrettyConfigReadable configName) (Doc ann))
-> ((forall a.
     PrettyBy (PrettyConfigReadable configName) a =>
     Direction -> Fixity -> a -> Doc ann)
    -> Doc ann)
-> InContextM (PrettyConfigReadable configName) (Doc ann)
forall a b. (a -> b) -> a -> b
$ \forall a.
PrettyBy (PrettyConfigReadable configName) a =>
Direction -> Fixity -> a -> Doc ann
prettyIn ->
                Doc ann
"error" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
braces (Direction -> Fixity -> Type tyname uni a -> Doc ann
forall a.
PrettyBy (PrettyConfigReadable configName) a =>
Direction -> Fixity -> a -> Doc ann
prettyIn Direction
ToTheRight Fixity
botFixity Type tyname uni a
ty)

instance PrettyReadableBy configName (Term tyname name uni fun a) =>
        PrettyBy (PrettyConfigReadable configName) (Program tyname name uni fun a) where
    prettyBy :: PrettyConfigReadable configName
-> Program tyname name uni fun a -> Doc ann
prettyBy = (Program tyname name uni fun a
 -> InContextM (PrettyConfigReadable configName) (Doc ann))
-> PrettyConfigReadable configName
-> Program tyname name uni fun a
-> Doc ann
forall a config ann.
(a -> InContextM config (Doc ann)) -> config -> a -> Doc ann
inContextM ((Program tyname name uni fun a
  -> InContextM (PrettyConfigReadable configName) (Doc ann))
 -> PrettyConfigReadable configName
 -> Program tyname name uni fun a
 -> Doc ann)
-> (Program tyname name uni fun a
    -> InContextM (PrettyConfigReadable configName) (Doc ann))
-> PrettyConfigReadable configName
-> Program tyname name uni fun a
-> Doc ann
forall a b. (a -> b) -> a -> b
$ \(Program a
_ Version a
version Term tyname name uni fun a
term) ->
        Direction
-> Fixity
-> (AnyToDoc (PrettyConfigReadable configName) ann -> Doc ann)
-> InContextM (PrettyConfigReadable configName) (Doc ann)
forall config env (m :: * -> *) ann.
MonadPrettyContext config env m =>
Direction
-> Fixity -> (AnyToDoc config ann -> Doc ann) -> m (Doc ann)
sequenceDocM Direction
ToTheRight Fixity
juxtFixity ((AnyToDoc (PrettyConfigReadable configName) ann -> Doc ann)
 -> InContextM (PrettyConfigReadable configName) (Doc ann))
-> (AnyToDoc (PrettyConfigReadable configName) ann -> Doc ann)
-> InContextM (PrettyConfigReadable configName) (Doc ann)
forall a b. (a -> b) -> a -> b
$ \AnyToDoc (PrettyConfigReadable configName) ann
prettyEl ->
            Doc ann
"program" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Version a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Version a
version Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Term tyname name uni fun a -> Doc ann
AnyToDoc (PrettyConfigReadable configName) ann
prettyEl Term tyname name uni fun a
term