-- editorconfig-checker-disable-file
{-# LANGUAGE ConstraintKinds       #-}
{-# LANGUAGE LambdaCase            #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE UndecidableInstances  #-}
{-# LANGUAGE ViewPatterns          #-}
{-# OPTIONS_GHC -Wno-orphans       #-}
{-# OPTIONS_GHC -Wno-name-shadowing #-}
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
{-# HLINT ignore "Eta reduce" #-} -- breaks type inference

module PlutusIR.Core.Instance.Pretty.Readable
    ( prettyPirReadable
    , prettyPirReadableSimple
    , PrettyPir
    ) where

import PlutusCore.Pretty
import PlutusIR.Core.Type
import PlutusPrelude

import Data.Profunctor
import Prettyprinter
import Prettyprinter.Custom

type PrettyPir = PrettyBy (PrettyConfigReadable PrettyConfigName)

-- | Pretty-print something with the @PrettyConfigReadable@ config.
prettyPirReadable :: PrettyPir a => a -> Doc ann
prettyPirReadable :: forall a ann. PrettyPir a => a -> Doc ann
prettyPirReadable = 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.
prettyPirReadableSimple :: PrettyPir a => a -> Doc ann
prettyPirReadableSimple :: forall a ann. PrettyPir a => a -> Doc ann
prettyPirReadableSimple = 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)

-- | Split an iterated 'LamAbs' (if any) into a list of variables that it binds and its body.
viewLamAbs
    :: Term tyname name uni fun ann
    -> Maybe ([VarDecl tyname name uni ann], Term tyname name uni fun ann)
viewLamAbs :: forall tyname name (uni :: * -> *) fun ann.
Term tyname name uni fun ann
-> Maybe
     ([VarDecl tyname name uni ann], Term tyname name uni fun ann)
viewLamAbs term0 :: Term tyname name uni fun ann
term0@LamAbs{} = ([VarDecl tyname name uni ann], Term tyname name uni fun ann)
-> Maybe
     ([VarDecl tyname name uni ann], Term tyname name uni fun ann)
forall a. a -> Maybe a
Just (([VarDecl tyname name uni ann], Term tyname name uni fun ann)
 -> Maybe
      ([VarDecl tyname name uni ann], Term tyname name uni fun ann))
-> ([VarDecl tyname name uni ann], Term tyname name uni fun ann)
-> Maybe
     ([VarDecl tyname name uni ann], Term tyname name uni fun ann)
forall a b. (a -> b) -> a -> b
$ Term tyname name uni fun ann
-> ([VarDecl tyname name uni ann], Term tyname name uni fun ann)
forall {tyname} {name} {uni :: * -> *} {fun} {ann}.
Term tyname name uni fun ann
-> ([VarDecl tyname name uni ann], Term tyname name uni fun ann)
go Term tyname name uni fun ann
term0 where
    go :: Term tyname name uni fun ann
-> ([VarDecl tyname name uni ann], Term tyname name uni fun ann)
go (LamAbs ann
ann name
name Type tyname uni ann
ty Term tyname name uni fun ann
body) = ([VarDecl tyname name uni ann] -> [VarDecl tyname name uni ann])
-> ([VarDecl tyname name uni ann], Term tyname name uni fun ann)
-> ([VarDecl tyname name uni ann], Term tyname name uni fun ann)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (ann -> name -> Type tyname uni ann -> VarDecl tyname name uni ann
forall tyname name (uni :: * -> *) ann.
ann -> name -> Type tyname uni ann -> VarDecl tyname name uni ann
VarDecl ann
ann name
name Type tyname uni ann
ty VarDecl tyname name uni ann
-> [VarDecl tyname name uni ann] -> [VarDecl tyname name uni ann]
forall a. a -> [a] -> [a]
:) (([VarDecl tyname name uni ann], Term tyname name uni fun ann)
 -> ([VarDecl tyname name uni ann], Term tyname name uni fun ann))
-> ([VarDecl tyname name uni ann], Term tyname name uni fun ann)
-> ([VarDecl tyname name uni ann], Term tyname name uni fun ann)
forall a b. (a -> b) -> a -> b
$ Term tyname name uni fun ann
-> ([VarDecl tyname name uni ann], Term tyname name uni fun ann)
go Term tyname name uni fun ann
body
    go Term tyname name uni fun ann
term                      = ([], Term tyname name uni fun ann
term)
viewLamAbs Term tyname name uni fun ann
_ = Maybe ([VarDecl tyname name uni ann], Term tyname name uni fun ann)
forall a. Maybe a
Nothing

-- | Split an iterated 'TyAbs' (if any) into a list of variables that it binds and its body.
viewTyAbs
    :: Term tyname name uni fun ann -> Maybe ([TyVarDecl tyname ann], Term tyname name uni fun ann)
viewTyAbs :: forall tyname name (uni :: * -> *) fun ann.
Term tyname name uni fun ann
-> Maybe ([TyVarDecl tyname ann], Term tyname name uni fun ann)
viewTyAbs term0 :: Term tyname name uni fun ann
term0@TyAbs{} = ([TyVarDecl tyname ann], Term tyname name uni fun ann)
-> Maybe ([TyVarDecl tyname ann], Term tyname name uni fun ann)
forall a. a -> Maybe a
Just (([TyVarDecl tyname ann], Term tyname name uni fun ann)
 -> Maybe ([TyVarDecl tyname ann], Term tyname name uni fun ann))
-> ([TyVarDecl tyname ann], Term tyname name uni fun ann)
-> Maybe ([TyVarDecl tyname ann], Term tyname name uni fun ann)
forall a b. (a -> b) -> a -> b
$ Term tyname name uni fun ann
-> ([TyVarDecl tyname ann], Term tyname name uni fun ann)
forall {tyname} {name} {uni :: * -> *} {fun} {ann}.
Term tyname name uni fun ann
-> ([TyVarDecl tyname ann], Term tyname name uni fun ann)
go Term tyname name uni fun ann
term0 where
    go :: Term tyname name uni fun ann
-> ([TyVarDecl tyname ann], Term tyname name uni fun ann)
go (TyAbs ann
ann tyname
name Kind ann
kind Term tyname name uni fun ann
body) = ([TyVarDecl tyname ann] -> [TyVarDecl tyname ann])
-> ([TyVarDecl tyname ann], Term tyname name uni fun ann)
-> ([TyVarDecl tyname ann], Term tyname name uni fun ann)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (ann -> tyname -> Kind ann -> TyVarDecl tyname ann
forall tyname ann.
ann -> tyname -> Kind ann -> TyVarDecl tyname ann
TyVarDecl ann
ann tyname
name Kind ann
kind TyVarDecl tyname ann
-> [TyVarDecl tyname ann] -> [TyVarDecl tyname ann]
forall a. a -> [a] -> [a]
:) (([TyVarDecl tyname ann], Term tyname name uni fun ann)
 -> ([TyVarDecl tyname ann], Term tyname name uni fun ann))
-> ([TyVarDecl tyname ann], Term tyname name uni fun ann)
-> ([TyVarDecl tyname ann], Term tyname name uni fun ann)
forall a b. (a -> b) -> a -> b
$ Term tyname name uni fun ann
-> ([TyVarDecl tyname ann], Term tyname name uni fun ann)
go Term tyname name uni fun ann
body
    go Term tyname name uni fun ann
term                       = ([], Term tyname name uni fun ann
term)
viewTyAbs Term tyname name uni fun ann
_ = Maybe ([TyVarDecl tyname ann], Term tyname name uni fun ann)
forall a. Maybe a
Nothing

-- | Split an iterated 'Apply'/'TyInst' (if any) into the head of the application and the spine.
viewApp
    :: Term tyname name uni fun ann
    -> Maybe
        ( Term tyname name uni fun ann
        , [Either (Type tyname uni ann) (Term tyname name uni fun ann)]
        )
viewApp :: forall tyname name (uni :: * -> *) fun ann.
Term tyname name uni fun ann
-> Maybe
     (Term tyname name uni fun ann,
      [Either (Type tyname uni ann) (Term tyname name uni fun ann)])
viewApp Term tyname name uni fun ann
term0 = Term tyname name uni fun ann
-> [Either (Type tyname uni ann) (Term tyname name uni fun ann)]
-> Maybe
     (Term tyname name uni fun ann,
      [Either (Type tyname uni ann) (Term tyname name uni fun ann)])
forall {tyname} {name} {uni :: * -> *} {fun} {a}.
Term tyname name uni fun a
-> [Either (Type tyname uni a) (Term tyname name uni fun a)]
-> Maybe
     (Term tyname name uni fun a,
      [Either (Type tyname uni a) (Term tyname name uni fun a)])
go Term tyname name uni fun ann
term0 [] where
    go :: Term tyname name uni fun a
-> [Either (Type tyname uni a) (Term tyname name uni fun a)]
-> Maybe
     (Term tyname name uni fun a,
      [Either (Type tyname uni a) (Term tyname name uni fun a)])
go (Apply a
_ Term tyname name uni fun a
fun Term tyname name uni fun a
argTerm) [Either (Type tyname uni a) (Term tyname name uni fun a)]
args = Term tyname name uni fun a
-> [Either (Type tyname uni a) (Term tyname name uni fun a)]
-> Maybe
     (Term tyname name uni fun a,
      [Either (Type tyname uni a) (Term tyname name uni fun a)])
go Term tyname name uni fun a
fun ([Either (Type tyname uni a) (Term tyname name uni fun a)]
 -> Maybe
      (Term tyname name uni fun a,
       [Either (Type tyname uni a) (Term tyname name uni fun a)]))
-> [Either (Type tyname uni a) (Term tyname name uni fun a)]
-> Maybe
     (Term tyname name uni fun a,
      [Either (Type tyname uni a) (Term tyname name uni fun a)])
forall a b. (a -> b) -> a -> b
$ Term tyname name uni fun a
-> Either (Type tyname uni a) (Term tyname name uni fun a)
forall a b. b -> Either a b
Right Term tyname name uni fun a
argTerm Either (Type tyname uni a) (Term tyname name uni fun a)
-> [Either (Type tyname uni a) (Term tyname name uni fun a)]
-> [Either (Type tyname uni a) (Term tyname name uni fun a)]
forall a. a -> [a] -> [a]
: [Either (Type tyname uni a) (Term tyname name uni fun a)]
args
    go (TyInst a
_ Term tyname name uni fun a
fun Type tyname uni a
argTy)  [Either (Type tyname uni a) (Term tyname name uni fun a)]
args = Term tyname name uni fun a
-> [Either (Type tyname uni a) (Term tyname name uni fun a)]
-> Maybe
     (Term tyname name uni fun a,
      [Either (Type tyname uni a) (Term tyname name uni fun a)])
go Term tyname name uni fun a
fun ([Either (Type tyname uni a) (Term tyname name uni fun a)]
 -> Maybe
      (Term tyname name uni fun a,
       [Either (Type tyname uni a) (Term tyname name uni fun a)]))
-> [Either (Type tyname uni a) (Term tyname name uni fun a)]
-> Maybe
     (Term tyname name uni fun a,
      [Either (Type tyname uni a) (Term tyname name uni fun a)])
forall a b. (a -> b) -> a -> b
$ Type tyname uni a
-> Either (Type tyname uni a) (Term tyname name uni fun a)
forall a b. a -> Either a b
Left Type tyname uni a
argTy Either (Type tyname uni a) (Term tyname name uni fun a)
-> [Either (Type tyname uni a) (Term tyname name uni fun a)]
-> [Either (Type tyname uni a) (Term tyname name uni fun a)]
forall a. a -> [a] -> [a]
: [Either (Type tyname uni a) (Term tyname name uni fun a)]
args
    go Term tyname name uni fun a
_                     []   = Maybe
  (Term tyname name uni fun a,
   [Either (Type tyname uni a) (Term tyname name uni fun a)])
forall a. Maybe a
Nothing
    go Term tyname name uni fun a
fun                   [Either (Type tyname uni a) (Term tyname name uni fun a)]
args = (Term tyname name uni fun a,
 [Either (Type tyname uni a) (Term tyname name uni fun a)])
-> Maybe
     (Term tyname name uni fun a,
      [Either (Type tyname uni a) (Term tyname name uni fun a)])
forall a. a -> Maybe a
Just (Term tyname name uni fun a
fun, [Either (Type tyname uni a) (Term tyname name uni fun a)]
args)

-- | Split a 'Let' (if any) into a list of bindings and its body.
viewLet
    :: Term tyname name uni fun ann
    -> Maybe ([(Recursivity, [Binding tyname name uni fun ann])], Term tyname name uni fun ann)
viewLet :: forall tyname name (uni :: * -> *) fun ann.
Term tyname name uni fun ann
-> Maybe
     ([(Recursivity, [Binding tyname name uni fun ann])],
      Term tyname name uni fun ann)
viewLet term0 :: Term tyname name uni fun ann
term0@Let{} = ([(Recursivity, [Binding tyname name uni fun ann])],
 Term tyname name uni fun ann)
-> Maybe
     ([(Recursivity, [Binding tyname name uni fun ann])],
      Term tyname name uni fun ann)
forall a. a -> Maybe a
Just (([(Recursivity, [Binding tyname name uni fun ann])],
  Term tyname name uni fun ann)
 -> Maybe
      ([(Recursivity, [Binding tyname name uni fun ann])],
       Term tyname name uni fun ann))
-> ([(Recursivity, [Binding tyname name uni fun ann])],
    Term tyname name uni fun ann)
-> Maybe
     ([(Recursivity, [Binding tyname name uni fun ann])],
      Term tyname name uni fun ann)
forall a b. (a -> b) -> a -> b
$ Term tyname name uni fun ann
-> ([(Recursivity, [Binding tyname name uni fun ann])],
    Term tyname name uni fun ann)
forall {tyname} {name} {uni :: * -> *} {fun} {a}.
Term tyname name uni fun a
-> ([(Recursivity, [Binding tyname name uni fun a])],
    Term tyname name uni fun a)
go Term tyname name uni fun ann
term0 where
    go :: Term tyname name uni fun a
-> ([(Recursivity, [Binding tyname name uni fun a])],
    Term tyname name uni fun a)
go (Let a
_ Recursivity
rec NonEmpty (Binding tyname name uni fun a)
binds Term tyname name uni fun a
body) = ([(Recursivity, [Binding tyname name uni fun a])]
 -> [(Recursivity, [Binding tyname name uni fun a])])
-> ([(Recursivity, [Binding tyname name uni fun a])],
    Term tyname name uni fun a)
-> ([(Recursivity, [Binding tyname name uni fun a])],
    Term tyname name uni fun a)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ((Recursivity
rec, NonEmpty (Binding tyname name uni fun a)
-> [Binding tyname name uni fun a]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty (Binding tyname name uni fun a)
binds) (Recursivity, [Binding tyname name uni fun a])
-> [(Recursivity, [Binding tyname name uni fun a])]
-> [(Recursivity, [Binding tyname name uni fun a])]
forall a. a -> [a] -> [a]
:) (([(Recursivity, [Binding tyname name uni fun a])],
  Term tyname name uni fun a)
 -> ([(Recursivity, [Binding tyname name uni fun a])],
     Term tyname name uni fun a))
-> ([(Recursivity, [Binding tyname name uni fun a])],
    Term tyname name uni fun a)
-> ([(Recursivity, [Binding tyname name uni fun a])],
    Term tyname name uni fun a)
forall a b. (a -> b) -> a -> b
$ Term tyname name uni fun a
-> ([(Recursivity, [Binding tyname name uni fun a])],
    Term tyname name uni fun a)
go Term tyname name uni fun a
body
    go Term tyname name uni fun a
term                   = ([], Term tyname name uni fun a
term)
viewLet Term tyname name uni fun ann
_       = Maybe
  ([(Recursivity, [Binding tyname name uni fun ann])],
   Term tyname name uni fun ann)
forall a. Maybe a
Nothing

type PrettyConstraints configName tyname name uni =
    ( PrettyReadableBy configName tyname
    , PrettyReadableBy configName name
    , PrettyUni uni
    )

instance (PrettyConstraints configName tyname name uni, Pretty fun)
          => PrettyBy (PrettyConfigReadable configName) (Term tyname name uni fun a) where
    prettyBy :: forall ann.
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 -> (PrettyConfigReadable configName -> ConstConfig)
-> InContextM ConstConfig (Doc ann)
-> InContextM (PrettyConfigReadable configName) (Doc ann)
forall a b c. (a -> b) -> InContextM b c -> InContextM a c
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap (RenderContext -> ConstConfig
ConstConfig (RenderContext -> ConstConfig)
-> (PrettyConfigReadable configName -> RenderContext)
-> PrettyConfigReadable configName
-> ConstConfig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrettyConfigReadable configName -> RenderContext
forall configName. PrettyConfigReadable configName -> RenderContext
_pcrRenderContext) (InContextM ConstConfig (Doc ann)
 -> InContextM (PrettyConfigReadable configName) (Doc ann))
-> InContextM ConstConfig (Doc ann)
-> InContextM (PrettyConfigReadable configName) (Doc ann)
forall a b. (a -> b) -> a -> b
$ Some (ValueOf uni) -> InContextM ConstConfig (Doc ann)
forall config env (m :: * -> *) a ann.
(MonadPretty config env m, PrettyBy config a) =>
a -> m (Doc ann)
prettyM 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 ann. fun -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty fun
bi
        (Term tyname name uni fun a
-> Maybe
     (Term tyname name uni fun a,
      [Either (Type tyname uni a) (Term tyname name uni fun a)])
forall tyname name (uni :: * -> *) fun ann.
Term tyname name uni fun ann
-> Maybe
     (Term tyname name uni fun ann,
      [Either (Type tyname uni ann) (Term tyname name uni fun ann)])
viewApp -> Just (Term tyname name uni fun a
fun, [Either (Type tyname uni a) (Term tyname name uni fun a)]
args)) -> Term tyname name uni fun a
-> [Either (Type tyname uni a) (Term tyname name uni fun a)]
-> InContextM (PrettyConfigReadable configName) (Doc ann)
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 Term tyname name uni fun a
fun [Either (Type tyname uni a) (Term tyname name uni fun a)]
args
        Apply {} -> [Char] -> InContextM (PrettyConfigReadable configName) (Doc ann)
forall a. HasCallStack => [Char] -> a
error [Char]
"Panic: 'Apply' is not covered by 'viewApp'"
        TyInst {} -> [Char] -> InContextM (PrettyConfigReadable configName) (Doc ann)
forall a. HasCallStack => [Char] -> a
error [Char]
"Panic: 'TyInst' is not covered by 'viewApp'"
        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
        (Term tyname name uni fun a
-> Maybe ([TyVarDecl tyname a], Term tyname name uni fun a)
forall tyname name (uni :: * -> *) fun ann.
Term tyname name uni fun ann
-> Maybe ([TyVarDecl tyname ann], Term tyname name uni fun ann)
viewTyAbs -> Just ([TyVarDecl tyname a]
args, Term tyname name uni fun a
body)) -> [TyVarDecl tyname a]
-> Term tyname name uni fun a
-> InContextM (PrettyConfigReadable configName) (Doc ann)
forall configName env (m :: * -> *) arg body ann.
(MonadPrettyReadable configName env m,
 PrettyReadableBy configName arg,
 PrettyReadableBy configName body) =>
[arg] -> body -> m (Doc ann)
iterTyAbsPrettyM [TyVarDecl tyname a]
args Term tyname name uni fun a
body
        TyAbs {} -> [Char] -> InContextM (PrettyConfigReadable configName) (Doc ann)
forall a. HasCallStack => [Char] -> a
error [Char]
"Panic: 'TyAbs' is not covered by 'viewTyAbs'"
        (Term tyname name uni fun a
-> Maybe ([VarDecl tyname name uni a], Term tyname name uni fun a)
forall tyname name (uni :: * -> *) fun ann.
Term tyname name uni fun ann
-> Maybe
     ([VarDecl tyname name uni ann], Term tyname name uni fun ann)
viewLamAbs -> Just ([VarDecl tyname name uni a]
args, Term tyname name uni fun a
body)) -> [VarDecl tyname name uni a]
-> Term tyname name uni fun a
-> InContextM (PrettyConfigReadable configName) (Doc ann)
forall configName env (m :: * -> *) arg body ann.
(MonadPrettyReadable configName env m,
 PrettyReadableBy configName arg,
 PrettyReadableBy configName body) =>
[arg] -> body -> m (Doc ann)
iterLamAbsPrettyM [VarDecl tyname name uni a]
args Term tyname name uni fun a
body
        LamAbs {} -> [Char] -> InContextM (PrettyConfigReadable configName) (Doc ann)
forall a. HasCallStack => [Char] -> a
error [Char]
"Panic: 'LamAbs' is not covered by 'viewLamAbs'"
        Unwrap a
_ Term tyname name uni fun a
term -> (AnyToDoc (PrettyConfigReadable configName) ann
 -> AnyToDoc (PrettyConfigReadable configName) ann
 -> NonEmpty (Doc ann))
-> InContextM (PrettyConfigReadable configName) (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))
 -> InContextM (PrettyConfigReadable configName) (Doc ann))
-> (AnyToDoc (PrettyConfigReadable configName) ann
    -> AnyToDoc (PrettyConfigReadable configName) ann
    -> NonEmpty (Doc ann))
-> InContextM (PrettyConfigReadable configName) (Doc ann)
forall a b. (a -> b) -> a -> b
$ \AnyToDoc (PrettyConfigReadable configName) ann
_ AnyToDoc (PrettyConfigReadable configName) ann
prettyArg -> Doc ann
"unwrap" Doc ann -> [Doc ann] -> NonEmpty (Doc ann)
forall a. a -> [a] -> NonEmpty a
:| [Term tyname name uni fun a -> Doc ann
AnyToDoc (PrettyConfigReadable configName) ann
prettyArg 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 ->
            (AnyToDoc (PrettyConfigReadable configName) ann
 -> AnyToDoc (PrettyConfigReadable configName) ann
 -> NonEmpty (Doc ann))
-> InContextM (PrettyConfigReadable configName) (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))
 -> InContextM (PrettyConfigReadable configName) (Doc ann))
-> (AnyToDoc (PrettyConfigReadable configName) ann
    -> AnyToDoc (PrettyConfigReadable configName) ann
    -> NonEmpty (Doc ann))
-> InContextM (PrettyConfigReadable configName) (Doc ann)
forall a b. (a -> b) -> a -> b
$ \AnyToDoc (PrettyConfigReadable configName) ann
_ AnyToDoc (PrettyConfigReadable configName) ann
prettyArg ->
                Doc ann
"iwrap" Doc ann -> [Doc ann] -> NonEmpty (Doc ann)
forall a. a -> [a] -> NonEmpty a
:| [Type tyname uni a -> Doc ann
AnyToDoc (PrettyConfigReadable configName) ann
prettyArg Type tyname uni a
pat, Type tyname uni a -> Doc ann
AnyToDoc (PrettyConfigReadable configName) ann
prettyArg Type tyname uni a
arg, Term tyname name uni fun a -> Doc ann
AnyToDoc (PrettyConfigReadable configName) ann
prettyArg Term tyname name uni fun a
term]
        Error a
_ Type tyname uni a
ty -> (AnyToDoc (PrettyConfigReadable configName) ann
 -> AnyToDoc (PrettyConfigReadable configName) ann
 -> NonEmpty (Doc ann))
-> InContextM (PrettyConfigReadable configName) (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))
 -> InContextM (PrettyConfigReadable configName) (Doc ann))
-> (AnyToDoc (PrettyConfigReadable configName) ann
    -> AnyToDoc (PrettyConfigReadable configName) ann
    -> NonEmpty (Doc ann))
-> InContextM (PrettyConfigReadable configName) (Doc ann)
forall a b. (a -> b) -> a -> b
$ \AnyToDoc (PrettyConfigReadable configName) ann
_ AnyToDoc (PrettyConfigReadable configName) ann
prettyArg -> Doc ann
"error" Doc ann -> [Doc ann] -> NonEmpty (Doc ann)
forall a. a -> [a] -> NonEmpty a
:| [Parened (Type tyname uni a) -> Doc ann
AnyToDoc (PrettyConfigReadable configName) ann
prettyArg (Parened (Type tyname uni a) -> Doc ann)
-> Parened (Type tyname uni a) -> Doc ann
forall a b. (a -> b) -> a -> b
$ Type tyname uni a -> Parened (Type tyname uni a)
forall a. a -> Parened a
inBraces Type tyname uni a
ty]
        (Term tyname name uni fun a
-> Maybe
     ([(Recursivity, [Binding tyname name uni fun a])],
      Term tyname name uni fun a)
forall tyname name (uni :: * -> *) fun ann.
Term tyname name uni fun ann
-> Maybe
     ([(Recursivity, [Binding tyname name uni fun ann])],
      Term tyname name uni fun ann)
viewLet -> Just ([(Recursivity, [Binding tyname name uni fun a])]
lets, 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
                    prec :: Recursivity -> a
prec Recursivity
NonRec = a
""
                    prec Recursivity
_      = a
"rec"
                    -- nest 2 including the "let": this means that we will always break after the let,
                    -- so that the bindings can be simply indented by 2 spaces, keeping the indent low
                    prettyLet :: Recursivity -> [a] -> Doc ann
prettyLet Recursivity
r [a]
binds = [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep [ Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
nest Int
2 (Doc ann
"let" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Recursivity -> Doc ann
forall {a}. IsString a => Recursivity -> a
prec Recursivity
r Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
line Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vcatHard (a -> Doc ann
AnyToDoc (PrettyConfigReadable configName) ann
prettyBot (a -> Doc ann) -> [a] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a]
binds)), Doc ann
"in"]
                -- Lay out let-bindings in a layout-sensitive way
                --
                -- let
                --   !x : t = a
                --   !y : t = b
                -- in
                -- foo x y
                in [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ [ Recursivity -> [Binding tyname name uni fun a] -> Doc ann
forall {a}.
PrettyBy (PrettyConfigReadable configName) a =>
Recursivity -> [a] -> Doc ann
prettyLet Recursivity
r [Binding tyname name uni fun a]
binds | (Recursivity
r, [Binding tyname name uni fun a]
binds) <- [(Recursivity, [Binding tyname name uni fun a])]
lets ] [Doc ann] -> [Doc ann] -> [Doc ann]
forall a. [a] -> [a] -> [a]
++ [ Term tyname name uni fun a -> Doc ann
AnyToDoc (PrettyConfigReadable configName) ann
prettyBot Term tyname name uni fun a
body ]
        Let {} -> [Char] -> InContextM (PrettyConfigReadable configName) (Doc ann)
forall a. HasCallStack => [Char] -> a
error [Char]
"Panic: 'Let' is not covered by 'viewLet'"
        Constr a
_ Type tyname uni a
ty Word64
i [Term tyname name uni fun a]
es ->
            (AnyToDoc (PrettyConfigReadable configName) ann
 -> AnyToDoc (PrettyConfigReadable configName) ann
 -> NonEmpty (Doc ann))
-> InContextM (PrettyConfigReadable configName) (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))
 -> InContextM (PrettyConfigReadable configName) (Doc ann))
-> (AnyToDoc (PrettyConfigReadable configName) ann
    -> AnyToDoc (PrettyConfigReadable configName) ann
    -> NonEmpty (Doc ann))
-> InContextM (PrettyConfigReadable configName) (Doc ann)
forall a b. (a -> b) -> a -> b
$ \AnyToDoc (PrettyConfigReadable configName) ann
_ AnyToDoc (PrettyConfigReadable configName) ann
prettyArg -> Doc ann
"constr" Doc ann -> [Doc ann] -> NonEmpty (Doc ann)
forall a. a -> [a] -> NonEmpty a
:| [Type tyname uni a -> Doc ann
AnyToDoc (PrettyConfigReadable configName) ann
prettyArg Type tyname uni a
ty, Word64 -> Doc ann
AnyToDoc (PrettyConfigReadable configName) ann
prettyArg Word64
i, [Term tyname name uni fun a] -> Doc ann
AnyToDoc (PrettyConfigReadable configName) ann
prettyArg [Term tyname name uni fun a]
es]
        Case a
_ Type tyname uni a
ty Term tyname name uni fun a
arg [Term tyname name uni fun a]
cs ->
            (AnyToDoc (PrettyConfigReadable configName) ann
 -> AnyToDoc (PrettyConfigReadable configName) ann
 -> NonEmpty (Doc ann))
-> InContextM (PrettyConfigReadable configName) (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))
 -> InContextM (PrettyConfigReadable configName) (Doc ann))
-> (AnyToDoc (PrettyConfigReadable configName) ann
    -> AnyToDoc (PrettyConfigReadable configName) ann
    -> NonEmpty (Doc ann))
-> InContextM (PrettyConfigReadable configName) (Doc ann)
forall a b. (a -> b) -> a -> b
$ \AnyToDoc (PrettyConfigReadable configName) ann
_ AnyToDoc (PrettyConfigReadable configName) ann
prettyArg -> Doc ann
"case" Doc ann -> [Doc ann] -> NonEmpty (Doc ann)
forall a. a -> [a] -> NonEmpty a
:| [Type tyname uni a -> Doc ann
AnyToDoc (PrettyConfigReadable configName) ann
prettyArg Type tyname uni a
ty, Term tyname name uni fun a -> Doc ann
AnyToDoc (PrettyConfigReadable configName) ann
prettyArg Term tyname name uni fun a
arg, [Term tyname name uni fun a] -> Doc ann
AnyToDoc (PrettyConfigReadable configName) ann
prettyArg [Term tyname name uni fun a]
cs]

instance (PrettyConstraints configName tyname name uni, Pretty fun)
          => PrettyBy (PrettyConfigReadable configName) (Program tyname name uni fun a) where
  prettyBy :: forall ann.
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
version Term tyname name uni fun a
term) ->
    (AnyToDoc (PrettyConfigReadable configName) ann
 -> AnyToDoc (PrettyConfigReadable configName) ann
 -> NonEmpty (Doc ann))
-> InContextM (PrettyConfigReadable configName) (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))
 -> InContextM (PrettyConfigReadable configName) (Doc ann))
-> (AnyToDoc (PrettyConfigReadable configName) ann
    -> AnyToDoc (PrettyConfigReadable configName) ann
    -> NonEmpty (Doc ann))
-> InContextM (PrettyConfigReadable configName) (Doc ann)
forall a b. (a -> b) -> a -> b
$ \AnyToDoc (PrettyConfigReadable configName) ann
_ AnyToDoc (PrettyConfigReadable configName) ann
prettyArg -> Doc ann
"program" Doc ann -> [Doc ann] -> NonEmpty (Doc ann)
forall a. a -> [a] -> NonEmpty a
:| [Version -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Version -> Doc ann
pretty Version
version, Term tyname name uni fun a -> Doc ann
AnyToDoc (PrettyConfigReadable configName) ann
prettyArg Term tyname name uni fun a
term]

instance (PrettyConstraints configName tyname name uni, Pretty fun)
          => PrettyBy (PrettyConfigReadable configName) (Binding tyname name uni fun ann) where
  prettyBy :: forall ann.
PrettyConfigReadable configName
-> Binding tyname name uni fun ann -> Doc ann
prettyBy = (Binding tyname name uni fun ann
 -> InContextM (PrettyConfigReadable configName) (Doc ann))
-> PrettyConfigReadable configName
-> Binding tyname name uni fun ann
-> Doc ann
forall a config ann.
(a -> InContextM config (Doc ann)) -> config -> a -> Doc ann
inContextM ((Binding tyname name uni fun ann
  -> InContextM (PrettyConfigReadable configName) (Doc ann))
 -> PrettyConfigReadable configName
 -> Binding tyname name uni fun ann
 -> Doc ann)
-> (Binding tyname name uni fun ann
    -> InContextM (PrettyConfigReadable configName) (Doc ann))
-> PrettyConfigReadable configName
-> Binding tyname name uni fun ann
-> Doc ann
forall a b. (a -> b) -> a -> b
$ \case
    TermBind ann
_ Strictness
s VarDecl tyname name uni ann
vdec Term tyname name uni fun ann
t ->
      -- Layout term bindings in lets like
      --
      --  let !a : t = body
      --
      -- or
      --
      --  let !a : t
      --       = biggerBody
      Direction
-> Fixity
-> (AnyToDoc (PrettyConfigReadable configName) ann
    -> InContextM (PrettyConfigReadable configName) (Doc ann))
-> InContextM (PrettyConfigReadable configName) (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
  -> InContextM (PrettyConfigReadable configName) (Doc ann))
 -> InContextM (PrettyConfigReadable configName) (Doc ann))
-> (AnyToDoc (PrettyConfigReadable configName) ann
    -> InContextM (PrettyConfigReadable configName) (Doc ann))
-> InContextM (PrettyConfigReadable configName) (Doc ann)
forall a b. (a -> b) -> a -> b
$ \AnyToDoc (PrettyConfigReadable configName) ann
prettyBot -> do
        Doc ann -> InContextM (PrettyConfigReadable configName) (Doc ann)
forall a. a -> InContextM (PrettyConfigReadable configName) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc ann -> InContextM (PrettyConfigReadable configName) (Doc ann))
-> Doc ann
-> InContextM (PrettyConfigReadable configName) (Doc ann)
forall a b. (a -> b) -> a -> b
$ (Doc ann
bt Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> VarDecl tyname name uni ann -> Doc ann
AnyToDoc (PrettyConfigReadable configName) ann
prettyBot VarDecl tyname name uni ann
vdec) 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 ann -> Doc ann
AnyToDoc (PrettyConfigReadable configName) ann
prettyBot Term tyname name uni fun ann
t
      where
        bt :: Doc ann
bt | Strictness
Strict <- Strictness
s = Doc ann
"!"
           | Bool
otherwise   = Doc ann
"~"
    TypeBind ann
_ TyVarDecl tyname ann
tydec Type tyname uni ann
a ->
      -- Basically the same as above
      Direction
-> Fixity
-> (AnyToDoc (PrettyConfigReadable configName) ann
    -> InContextM (PrettyConfigReadable configName) (Doc ann))
-> InContextM (PrettyConfigReadable configName) (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
  -> InContextM (PrettyConfigReadable configName) (Doc ann))
 -> InContextM (PrettyConfigReadable configName) (Doc ann))
-> (AnyToDoc (PrettyConfigReadable configName) ann
    -> InContextM (PrettyConfigReadable configName) (Doc ann))
-> InContextM (PrettyConfigReadable configName) (Doc ann)
forall a b. (a -> b) -> a -> b
$ \AnyToDoc (PrettyConfigReadable configName) ann
prettyBot -> do
        Doc ann -> InContextM (PrettyConfigReadable configName) (Doc ann)
forall a. a -> InContextM (PrettyConfigReadable configName) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc ann -> InContextM (PrettyConfigReadable configName) (Doc ann))
-> Doc ann
-> InContextM (PrettyConfigReadable configName) (Doc ann)
forall a b. (a -> b) -> a -> b
$ TyVarDecl tyname ann -> Doc ann
AnyToDoc (PrettyConfigReadable configName) ann
prettyBot TyVarDecl tyname ann
tydec 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 ann -> Doc ann
AnyToDoc (PrettyConfigReadable configName) ann
prettyBot Type tyname uni ann
a
    DatatypeBind ann
_ Datatype tyname name uni ann
dt -> Datatype tyname name uni ann
-> InContextM (PrettyConfigReadable configName) (Doc ann)
forall config env (m :: * -> *) a ann.
(MonadPretty config env m, PrettyBy config a) =>
a -> m (Doc ann)
prettyM Datatype tyname name uni ann
dt

instance PrettyConstraints configName tyname name uni
          => PrettyBy (PrettyConfigReadable configName) (Datatype tyname name uni ann) where
  prettyBy :: forall ann.
PrettyConfigReadable configName
-> Datatype tyname name uni ann -> Doc ann
prettyBy = (Datatype tyname name uni ann
 -> InContextM (PrettyConfigReadable configName) (Doc ann))
-> PrettyConfigReadable configName
-> Datatype tyname name uni ann
-> Doc ann
forall a config ann.
(a -> InContextM config (Doc ann)) -> config -> a -> Doc ann
inContextM ((Datatype tyname name uni ann
  -> InContextM (PrettyConfigReadable configName) (Doc ann))
 -> PrettyConfigReadable configName
 -> Datatype tyname name uni ann
 -> Doc ann)
-> (Datatype tyname name uni ann
    -> InContextM (PrettyConfigReadable configName) (Doc ann))
-> PrettyConfigReadable configName
-> Datatype tyname name uni ann
-> Doc ann
forall a b. (a -> b) -> a -> b
$ \case
    Datatype ann
_ TyVarDecl tyname ann
tydec [TyVarDecl tyname ann]
pars name
name [VarDecl tyname name uni ann]
cs -> do
      -- Layout datatypes as
      --  data (Maybe :: * -> *) a | match_Maybe where
      --    Nothing : D a
      --    Just : a -> D a
      Doc ann
header <- 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
"data" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
fillSep (TyVarDecl tyname ann -> Doc ann
AnyToDoc (PrettyConfigReadable configName) ann
prettyEl TyVarDecl tyname ann
tydec Doc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
: (TyVarDecl tyname ann -> Doc ann)
-> [TyVarDecl tyname ann] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map TyVarDecl tyname ann -> Doc ann
AnyToDoc (PrettyConfigReadable configName) ann
prettyEl [TyVarDecl tyname ann]
pars) 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
<+> name -> Doc ann
AnyToDoc (PrettyConfigReadable configName) ann
prettyEl name
name Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"where"
      Direction
-> Fixity
-> (AnyToDoc (PrettyConfigReadable configName) ann
    -> InContextM (PrettyConfigReadable configName) (Doc ann))
-> InContextM (PrettyConfigReadable configName) (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
  -> InContextM (PrettyConfigReadable configName) (Doc ann))
 -> InContextM (PrettyConfigReadable configName) (Doc ann))
-> (AnyToDoc (PrettyConfigReadable configName) ann
    -> InContextM (PrettyConfigReadable configName) (Doc ann))
-> InContextM (PrettyConfigReadable configName) (Doc ann)
forall a b. (a -> b) -> a -> b
$ \AnyToDoc (PrettyConfigReadable configName) ann
prettyBot -> do
        Doc ann -> InContextM (PrettyConfigReadable configName) (Doc ann)
forall a. a -> InContextM (PrettyConfigReadable configName) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc ann -> InContextM (PrettyConfigReadable configName) (Doc ann))
-> Doc ann
-> InContextM (PrettyConfigReadable configName) (Doc ann)
forall a b. (a -> b) -> a -> b
$ [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vcatHard [Doc ann
header, Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
indent Int
2 (Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
align (Doc ann -> Doc ann)
-> ([VarDecl tyname name uni ann] -> Doc ann)
-> [VarDecl tyname name uni ann]
-> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vcatHard ([Doc ann] -> Doc ann)
-> ([VarDecl tyname name uni ann] -> [Doc ann])
-> [VarDecl tyname name uni ann]
-> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (VarDecl tyname name uni ann -> Doc ann)
-> [VarDecl tyname name uni ann] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map VarDecl tyname name uni ann -> Doc ann
AnyToDoc (PrettyConfigReadable configName) ann
prettyBot ([VarDecl tyname name uni ann] -> Doc ann)
-> [VarDecl tyname name uni ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ [VarDecl tyname name uni ann]
cs)]