Safe Haskell | Safe-Inferred |
---|---|
Language | Haskell2010 |
A "readable" Agda-like way to pretty-print PLC entities.
Synopsis
- data Direction
- data Associativity
- type Fixity = FixityOver Precedence
- data RenderContextOver prec = RenderContext {}
- type RenderContext = RenderContextOver Precedence
- data FixityOver prec = Fixity {}
- type Precedence = Double
- type MonadPretty config env (m ∷ Type → Type) = (MonadReader env m, HasPrettyConfig env config)
- class HasPrettyConfig env config | env → config where
- prettyConfig ∷ Lens' env config
- type AnyToDoc config ann = ∀ a. PrettyBy config a ⇒ a → Doc ann
- newtype InContextM config a = InContextM {
- unInContextM ∷ Reader (Sole config) a
- newtype Sole a = Sole {
- unSole ∷ a
- type MonadPrettyContext config env (m ∷ Type → Type) = (MonadPretty config env m, HasRenderContext config)
- class HasRenderContext config where
- renderContext ∷ Lens' config RenderContext
- class Profunctor (p ∷ Type → Type → Type) where
- type PrettyParens = PrettyBy RenderContext
- encloseIn ∷ Ord prec ⇒ (a → a) → RenderContextOver prec → FixityOver prec → a → a
- botFixity ∷ Fixity
- juxtFixity ∷ Fixity
- unitFixity ∷ Fixity
- topFixity ∷ Fixity
- botRenderContext ∷ RenderContext
- topRenderContext ∷ RenderContext
- prettyM ∷ (MonadPretty config env m, PrettyBy config a) ⇒ a → m (Doc ann)
- displayM ∷ ∀ str a m env config. (MonadPretty config env m, PrettyBy config a, Render str) ⇒ a → m str
- runInContextM ∷ config → InContextM config a → a
- inContextM ∷ (a → InContextM config (Doc ann)) → config → a → Doc ann
- encloseM ∷ MonadPrettyContext config env m ⇒ Fixity → Doc ann → m (Doc ann)
- withPrettyIn ∷ MonadPrettyContext config env m ⇒ ((∀ a. PrettyBy config a ⇒ Direction → Fixity → a → Doc ann) → m r) → m r
- withPrettyAt ∷ MonadPrettyContext config env m ⇒ Direction → Fixity → (AnyToDoc config ann → m r) → m r
- unitDocM ∷ MonadPrettyContext config env m ⇒ Doc ann → m (Doc ann)
- compoundDocM ∷ MonadPrettyContext config env m ⇒ Fixity → ((∀ a. PrettyBy config a ⇒ Direction → Fixity → a → Doc ann) → Doc ann) → m (Doc ann)
- sequenceDocM ∷ MonadPrettyContext config env m ⇒ Direction → Fixity → (AnyToDoc config ann → Doc ann) → m (Doc ann)
- infixDocM ∷ MonadPrettyContext config env m ⇒ Fixity → (AnyToDoc config ann → AnyToDoc config ann → Doc ann) → m (Doc ann)
- juxtPrettyM ∷ (MonadPrettyContext config env m, PrettyBy config a, PrettyBy config b) ⇒ a → b → m (Doc ann)
- juxtRenderContext ∷ RenderContext
- data ShowKinds
- data PrettyConfigReadable configName = PrettyConfigReadable {
- _pcrConfigName ∷ configName
- _pcrRenderContext ∷ RenderContext
- _pcrShowKinds ∷ ShowKinds
- type PrettyReadableBy configName = PrettyBy (PrettyConfigReadable configName)
- type PrettyReadable = PrettyReadableBy PrettyConfigName
- newtype AsReadable a = AsReadable {
- unAsReadable ∷ a
- data Parened a = Parened {}
- type MonadPrettyReadable configName env m = MonadPretty (PrettyConfigReadable configName) env m
- type HasPrettyConfigReadable env configName = HasPrettyConfig env (PrettyConfigReadable configName)
- type ReadableToDoc configName ann = ∀ a. PrettyReadableBy configName a ⇒ a → Doc ann
- prettyReadable ∷ PrettyReadable a ⇒ a → Doc ann
- prettyReadableSimple ∷ PrettyReadable a ⇒ a → Doc ann
- pcrConfigName ∷ ∀ configName configName. Lens (PrettyConfigReadable configName) (PrettyConfigReadable configName) configName configName
- pcrRenderContext ∷ ∀ configName. Lens' (PrettyConfigReadable configName) RenderContext
- pcrShowKinds ∷ ∀ configName. Lens' (PrettyConfigReadable configName) ShowKinds
- inBraces ∷ a → Parened a
- topPrettyConfigReadable ∷ configName → ShowKinds → PrettyConfigReadable configName
- botPrettyConfigReadable ∷ configName → ShowKinds → PrettyConfigReadable configName
- binderFixity ∷ Fixity
- arrowFixity ∷ Fixity
- iterTyForallPrettyM ∷ (MonadPrettyReadable configName env m, PrettyReadableBy configName arg, PrettyReadableBy configName body) ⇒ [arg] → body → m (Doc ann)
- iterLamAbsPrettyM ∷ (MonadPrettyReadable configName env m, PrettyReadableBy configName arg, PrettyReadableBy configName body) ⇒ [arg] → body → m (Doc ann)
- iterTyAbsPrettyM ∷ (MonadPrettyReadable configName env m, PrettyReadableBy configName arg, PrettyReadableBy configName body) ⇒ [arg] → body → m (Doc ann)
- iterArrowPrettyM ∷ (MonadPrettyReadable configName env m, PrettyReadableBy configName a) ⇒ [a] → a → m (Doc ann)
- iterAppDocM ∷ MonadPrettyContext config env m ⇒ (AnyToDoc config ann → AnyToDoc config ann → NonEmpty (Doc ann)) → m (Doc ann)
- iterInterAppPrettyM ∷ (MonadPrettyReadable configName env m, PrettyReadableBy configName fun, PrettyReadableBy configName ty, PrettyReadableBy configName term) ⇒ fun → [Either ty term] → m (Doc ann)
- iterAppPrettyM ∷ (MonadPrettyContext config env m, PrettyBy config fun, PrettyBy config term) ⇒ fun → [term] → m (Doc ann)
- iterBinderPrettyM ∷ (MonadPrettyReadable configName env m, PrettyReadableBy configName arg, PrettyReadableBy configName body) ⇒ (Doc ann → Doc ann) → [arg] → body → m (Doc ann)
Documentation
Direction in which pretty-printing goes. For example in x + y
x
is pretty-printed to the
left of +
and y
is pretty-printed to the right of +
.
Instances
data Associativity Source #
Associativity of an operator.
Instances
Show Associativity | |
Defined in Text.Fixity.Internal | |
Eq Associativity | |
Defined in Text.Fixity.Internal (==) ∷ Associativity → Associativity → Bool Source # (/=) ∷ Associativity → Associativity → Bool Source # |
type Fixity = FixityOver Precedence Source #
FixityOver
instantiated at Precedence
.
data RenderContextOver prec Source #
A context that an expression is being rendered in.
Instances
HasRenderContext RenderContext | |
Defined in Text.PrettyBy.Fixity | |
PrettyBy RenderContext (DefaultUni a) Source # | |
Defined in PlutusCore.Default.Universe prettyBy ∷ RenderContext → DefaultUni a → Doc ann Source # prettyListBy ∷ RenderContext → [DefaultUni a] → Doc ann Source # | |
PrettyBy RenderContext (SomeTypeIn DefaultUni) Source # | |
Defined in PlutusCore.Default.Universe prettyBy ∷ RenderContext → SomeTypeIn DefaultUni → Doc ann Source # prettyListBy ∷ RenderContext → [SomeTypeIn DefaultUni] → Doc ann Source # | |
Show prec ⇒ Show (RenderContextOver prec) | |
Defined in Text.Fixity.Internal | |
Eq prec ⇒ Eq (RenderContextOver prec) | |
Defined in Text.Fixity.Internal (==) ∷ RenderContextOver prec → RenderContextOver prec → Bool Source # (/=) ∷ RenderContextOver prec → RenderContextOver prec → Bool Source # |
type RenderContext = RenderContextOver Precedence Source #
FixityOver
instantiated at Precedence
.
data FixityOver prec Source #
Fixity of an operator.
We allow unary operators to have associativity, because it's useful to distinguish
between an expression like -(-x)
(unary minus, left-associative) and ~~b
(boolean NOT, right-associative).
Associativity of unary operators also matters when pretty-printing expressions like (-x) + y
,
which is pretty-printed as -x + y
, assuming unary minus has the same fixity as +
(and both
the operators are left-associative). I.e. unary minus is handled just like the binary one:
(0 - x) + y
is pretty-printed as 0 - x + y
.
Postfix operators are handled similarly. E.g. if !
is left-associative, then (x!)!
is
pretty-printed as x!!
and if it's right-associative -- (x!)!
.
The data type is parameterized, so that the user can choose precedence to be integer/fractional,
bounded/unbounded, etc (we could also allows operators to be partially or totally ordered, but
at the moment prec
is required to implement Ord
, i.e. it has to be totally ordered).
By default we go with bounded fractional precedence, see the main Text.Fixity module.
Fixity | |
|
Instances
Show prec ⇒ Show (FixityOver prec) | |
Defined in Text.Fixity.Internal | |
Eq prec ⇒ Eq (FixityOver prec) | |
Defined in Text.Fixity.Internal (==) ∷ FixityOver prec → FixityOver prec → Bool Source # (/=) ∷ FixityOver prec → FixityOver prec → Bool Source # |
type Precedence = Double Source #
Fractional precedence, so that it's always possible to squeeze an operator precedence between
two existing precedences. Ranges over [-20, 120]
. A normal operator should have a precedence
within [0, 100)
. It might be useful to have a negative precedence if you're trying to model
some already existing system, for example in Haskell ($)
has precedence 0
, but clearly
if b then y else f $ x
should be rendered without any parens, hence the precedence of
if_then_else_
is less than 0, i.e. negative.
The precedence of juxtaposition is 100
. Normally you want juxtaposition to have the highest
precedence, but some languages have operators that bind tighter than juxtaposition, e.g.
Haskell's postfix _{_}
: f z { x = y }
means f (z {x = y})
.
type MonadPretty config env (m ∷ Type → Type) = (MonadReader env m, HasPrettyConfig env config) Source #
A constraint for "m
is a monad that allows to pretty-print values in it by a config
".
class HasPrettyConfig env config | env → config where Source #
A constraint for "config
is a part of env
".
prettyConfig ∷ Lens' env config Source #
Instances
HasPrettyConfig (Sole config) config | It's not possible to have |
Defined in Text.PrettyBy.Fixity prettyConfig ∷ Lens' (Sole config) config Source # |
type AnyToDoc config ann = ∀ a. PrettyBy config a ⇒ a → Doc ann Source #
The type of a general config
-based pretty-printer.
newtype InContextM config a Source #
A monad for precedence-aware pretty-printing.
InContextM | |
|
Instances
A newtype
wrapper around a
introduced for its HasPrettyConfig
instance.
Instances
HasPrettyConfigName (Sole PrettyConfigName) Source # | |
HasPrettyConfig (Sole config) config | It's not possible to have |
Defined in Text.PrettyBy.Fixity prettyConfig ∷ Lens' (Sole config) config Source # | |
MonadReader (Sole config) (InContextM config) | |
Defined in Text.PrettyBy.Fixity ask ∷ InContextM config (Sole config) Source # local ∷ (Sole config → Sole config) → InContextM config a → InContextM config a Source # reader ∷ (Sole config → a) → InContextM config a Source # | |
type HasPrettyDefaults (Sole config) Source # | |
Defined in PlutusCore.Pretty.Extra |
type MonadPrettyContext config env (m ∷ Type → Type) = (MonadPretty config env m, HasRenderContext config) Source #
A constraint for "m
is a Monad
supporting configurable precedence-aware pretty-printing".
class HasRenderContext config where Source #
A constraint for "RenderContext
is a part of config
".
renderContext ∷ Lens' config RenderContext Source #
Instances
HasRenderContext ConstConfig Source # | |
HasRenderContext RenderContext | |
Defined in Text.PrettyBy.Fixity | |
HasRenderContext (PrettyConfigReadable configName) Source # | |
Defined in PlutusCore.Pretty.Readable renderContext ∷ Lens' (PrettyConfigReadable configName) RenderContext Source # |
class Profunctor (p ∷ Type → Type → Type) where Source #
Formally, the class Profunctor
represents a profunctor
from Hask
-> Hask
.
Intuitively it is a bifunctor where the first argument is contravariant and the second argument is covariant.
You can define a Profunctor
by either defining dimap
or by defining both
lmap
and rmap
.
If you supply dimap
, you should ensure that:
dimap
id
id
≡id
If you supply lmap
and rmap
, ensure:
lmap
id
≡id
rmap
id
≡id
If you supply both, you should also ensure:
dimap
f g ≡lmap
f.
rmap
g
These ensure by parametricity:
dimap
(f.
g) (h.
i) ≡dimap
g h.
dimap
f ilmap
(f.
g) ≡lmap
g.
lmap
frmap
(f.
g) ≡rmap
f.
rmap
g
Instances
Profunctor ReifiedFold | |
Defined in Control.Lens.Reified dimap ∷ (a → b) → (c → d) → ReifiedFold b c → ReifiedFold a d Source # lmap ∷ (a → b) → ReifiedFold b c → ReifiedFold a c Source # rmap ∷ (b → c) → ReifiedFold a b → ReifiedFold a c Source # (#.) ∷ ∀ a b c q. Coercible c b ⇒ q b c → ReifiedFold a b → ReifiedFold a c Source # (.#) ∷ ∀ a b c q. Coercible b a ⇒ ReifiedFold b c → q a b → ReifiedFold a c Source # | |
Profunctor ReifiedGetter | |
Defined in Control.Lens.Reified dimap ∷ (a → b) → (c → d) → ReifiedGetter b c → ReifiedGetter a d Source # lmap ∷ (a → b) → ReifiedGetter b c → ReifiedGetter a c Source # rmap ∷ (b → c) → ReifiedGetter a b → ReifiedGetter a c Source # (#.) ∷ ∀ a b c q. Coercible c b ⇒ q b c → ReifiedGetter a b → ReifiedGetter a c Source # (.#) ∷ ∀ a b c q. Coercible b a ⇒ ReifiedGetter b c → q a b → ReifiedGetter a c Source # | |
Profunctor InContextM Source # | |
Defined in PlutusCore.Pretty.Extra dimap ∷ (a → b) → (c → d) → InContextM b c → InContextM a d Source # lmap ∷ (a → b) → InContextM b c → InContextM a c Source # rmap ∷ (b → c) → InContextM a b → InContextM a c Source # (#.) ∷ ∀ a b c q. Coercible c b ⇒ q b c → InContextM a b → InContextM a c Source # (.#) ∷ ∀ a b c q. Coercible b a ⇒ InContextM b c → q a b → InContextM a c Source # | |
Monad m ⇒ Profunctor (Kleisli m) | |
Defined in Data.Profunctor.Unsafe dimap ∷ (a → b) → (c → d) → Kleisli m b c → Kleisli m a d Source # lmap ∷ (a → b) → Kleisli m b c → Kleisli m a c Source # rmap ∷ (b → c) → Kleisli m a b → Kleisli m a c Source # (#.) ∷ ∀ a b c q. Coercible c b ⇒ q b c → Kleisli m a b → Kleisli m a c Source # (.#) ∷ ∀ a b c q. Coercible b a ⇒ Kleisli m b c → q a b → Kleisli m a c Source # | |
Profunctor (Indexed i) | |
Defined in Control.Lens.Internal.Indexed dimap ∷ (a → b) → (c → d) → Indexed i b c → Indexed i a d Source # lmap ∷ (a → b) → Indexed i b c → Indexed i a c Source # rmap ∷ (b → c) → Indexed i a b → Indexed i a c Source # (#.) ∷ ∀ a b c q. Coercible c b ⇒ q b c → Indexed i a b → Indexed i a c Source # (.#) ∷ ∀ a b c q. Coercible b a ⇒ Indexed i b c → q a b → Indexed i a c Source # | |
Profunctor (ReifiedIndexedFold i) | |
Defined in Control.Lens.Reified dimap ∷ (a → b) → (c → d) → ReifiedIndexedFold i b c → ReifiedIndexedFold i a d Source # lmap ∷ (a → b) → ReifiedIndexedFold i b c → ReifiedIndexedFold i a c Source # rmap ∷ (b → c) → ReifiedIndexedFold i a b → ReifiedIndexedFold i a c Source # (#.) ∷ ∀ a b c q. Coercible c b ⇒ q b c → ReifiedIndexedFold i a b → ReifiedIndexedFold i a c Source # (.#) ∷ ∀ a b c q. Coercible b a ⇒ ReifiedIndexedFold i b c → q a b → ReifiedIndexedFold i a c Source # | |
Profunctor (ReifiedIndexedGetter i) | |
Defined in Control.Lens.Reified dimap ∷ (a → b) → (c → d) → ReifiedIndexedGetter i b c → ReifiedIndexedGetter i a d Source # lmap ∷ (a → b) → ReifiedIndexedGetter i b c → ReifiedIndexedGetter i a c Source # rmap ∷ (b → c) → ReifiedIndexedGetter i a b → ReifiedIndexedGetter i a c Source # (#.) ∷ ∀ a b c q. Coercible c b ⇒ q b c → ReifiedIndexedGetter i a b → ReifiedIndexedGetter i a c Source # (.#) ∷ ∀ a b c q. Coercible b a ⇒ ReifiedIndexedGetter i b c → q a b → ReifiedIndexedGetter i a c Source # | |
Profunctor (CopastroSum p) | |
Defined in Data.Profunctor.Choice dimap ∷ (a → b) → (c → d) → CopastroSum p b c → CopastroSum p a d Source # lmap ∷ (a → b) → CopastroSum p b c → CopastroSum p a c Source # rmap ∷ (b → c) → CopastroSum p a b → CopastroSum p a c Source # (#.) ∷ ∀ a b c q. Coercible c b ⇒ q b c → CopastroSum p a b → CopastroSum p a c Source # (.#) ∷ ∀ a b c q. Coercible b a ⇒ CopastroSum p b c → q a b → CopastroSum p a c Source # | |
Profunctor (CotambaraSum p) | |
Defined in Data.Profunctor.Choice dimap ∷ (a → b) → (c → d) → CotambaraSum p b c → CotambaraSum p a d Source # lmap ∷ (a → b) → CotambaraSum p b c → CotambaraSum p a c Source # rmap ∷ (b → c) → CotambaraSum p a b → CotambaraSum p a c Source # (#.) ∷ ∀ a b c q. Coercible c b ⇒ q b c → CotambaraSum p a b → CotambaraSum p a c Source # (.#) ∷ ∀ a b c q. Coercible b a ⇒ CotambaraSum p b c → q a b → CotambaraSum p a c Source # | |
Profunctor (PastroSum p) | |
Defined in Data.Profunctor.Choice dimap ∷ (a → b) → (c → d) → PastroSum p b c → PastroSum p a d Source # lmap ∷ (a → b) → PastroSum p b c → PastroSum p a c Source # rmap ∷ (b → c) → PastroSum p a b → PastroSum p a c Source # (#.) ∷ ∀ a b c q. Coercible c b ⇒ q b c → PastroSum p a b → PastroSum p a c Source # (.#) ∷ ∀ a b c q. Coercible b a ⇒ PastroSum p b c → q a b → PastroSum p a c Source # | |
Profunctor p ⇒ Profunctor (TambaraSum p) | |
Defined in Data.Profunctor.Choice dimap ∷ (a → b) → (c → d) → TambaraSum p b c → TambaraSum p a d Source # lmap ∷ (a → b) → TambaraSum p b c → TambaraSum p a c Source # rmap ∷ (b → c) → TambaraSum p a b → TambaraSum p a c Source # (#.) ∷ ∀ a b c q. Coercible c b ⇒ q b c → TambaraSum p a b → TambaraSum p a c Source # (.#) ∷ ∀ a b c q. Coercible b a ⇒ TambaraSum p b c → q a b → TambaraSum p a c Source # | |
Profunctor p ⇒ Profunctor (Closure p) | |
Defined in Data.Profunctor.Closed dimap ∷ (a → b) → (c → d) → Closure p b c → Closure p a d Source # lmap ∷ (a → b) → Closure p b c → Closure p a c Source # rmap ∷ (b → c) → Closure p a b → Closure p a c Source # (#.) ∷ ∀ a b c q. Coercible c b ⇒ q b c → Closure p a b → Closure p a c Source # (.#) ∷ ∀ a b c q. Coercible b a ⇒ Closure p b c → q a b → Closure p a c Source # | |
Profunctor (Environment p) | |
Defined in Data.Profunctor.Closed dimap ∷ (a → b) → (c → d) → Environment p b c → Environment p a d Source # lmap ∷ (a → b) → Environment p b c → Environment p a c Source # rmap ∷ (b → c) → Environment p a b → Environment p a c Source # (#.) ∷ ∀ a b c q. Coercible c b ⇒ q b c → Environment p a b → Environment p a c Source # (.#) ∷ ∀ a b c q. Coercible b a ⇒ Environment p b c → q a b → Environment p a c Source # | |
Profunctor p ⇒ Profunctor (CofreeMapping p) | |
Defined in Data.Profunctor.Mapping dimap ∷ (a → b) → (c → d) → CofreeMapping p b c → CofreeMapping p a d Source # lmap ∷ (a → b) → CofreeMapping p b c → CofreeMapping p a c Source # rmap ∷ (b → c) → CofreeMapping p a b → CofreeMapping p a c Source # (#.) ∷ ∀ a b c q. Coercible c b ⇒ q b c → CofreeMapping p a b → CofreeMapping p a c Source # (.#) ∷ ∀ a b c q. Coercible b a ⇒ CofreeMapping p b c → q a b → CofreeMapping p a c Source # | |
Profunctor (FreeMapping p) | |
Defined in Data.Profunctor.Mapping dimap ∷ (a → b) → (c → d) → FreeMapping p b c → FreeMapping p a d Source # lmap ∷ (a → b) → FreeMapping p b c → FreeMapping p a c Source # rmap ∷ (b → c) → FreeMapping p a b → FreeMapping p a c Source # (#.) ∷ ∀ a b c q. Coercible c b ⇒ q b c → FreeMapping p a b → FreeMapping p a c Source # (.#) ∷ ∀ a b c q. Coercible b a ⇒ FreeMapping p b c → q a b → FreeMapping p a c Source # | |
Profunctor (Copastro p) | |
Defined in Data.Profunctor.Strong dimap ∷ (a → b) → (c → d) → Copastro p b c → Copastro p a d Source # lmap ∷ (a → b) → Copastro p b c → Copastro p a c Source # rmap ∷ (b → c) → Copastro p a b → Copastro p a c Source # (#.) ∷ ∀ a b c q. Coercible c b ⇒ q b c → Copastro p a b → Copastro p a c Source # (.#) ∷ ∀ a b c q. Coercible b a ⇒ Copastro p b c → q a b → Copastro p a c Source # | |
Profunctor (Cotambara p) | |
Defined in Data.Profunctor.Strong dimap ∷ (a → b) → (c → d) → Cotambara p b c → Cotambara p a d Source # lmap ∷ (a → b) → Cotambara p b c → Cotambara p a c Source # rmap ∷ (b → c) → Cotambara p a b → Cotambara p a c Source # (#.) ∷ ∀ a b c q. Coercible c b ⇒ q b c → Cotambara p a b → Cotambara p a c Source # (.#) ∷ ∀ a b c q. Coercible b a ⇒ Cotambara p b c → q a b → Cotambara p a c Source # | |
Profunctor (Pastro p) | |
Defined in Data.Profunctor.Strong dimap ∷ (a → b) → (c → d) → Pastro p b c → Pastro p a d Source # lmap ∷ (a → b) → Pastro p b c → Pastro p a c Source # rmap ∷ (b → c) → Pastro p a b → Pastro p a c Source # (#.) ∷ ∀ a b c q. Coercible c b ⇒ q b c → Pastro p a b → Pastro p a c Source # (.#) ∷ ∀ a b c q. Coercible b a ⇒ Pastro p b c → q a b → Pastro p a c Source # | |
Profunctor p ⇒ Profunctor (Tambara p) | |
Defined in Data.Profunctor.Strong dimap ∷ (a → b) → (c → d) → Tambara p b c → Tambara p a d Source # lmap ∷ (a → b) → Tambara p b c → Tambara p a c Source # rmap ∷ (b → c) → Tambara p a b → Tambara p a c Source # (#.) ∷ ∀ a b c q. Coercible c b ⇒ q b c → Tambara p a b → Tambara p a c Source # (.#) ∷ ∀ a b c q. Coercible b a ⇒ Tambara p b c → q a b → Tambara p a c Source # | |
Profunctor (Tagged ∷ Type → Type → Type) | |
Defined in Data.Profunctor.Unsafe dimap ∷ (a → b) → (c → d) → Tagged b c → Tagged a d Source # lmap ∷ (a → b) → Tagged b c → Tagged a c Source # rmap ∷ (b → c) → Tagged a b → Tagged a c Source # (#.) ∷ ∀ a b c q. Coercible c b ⇒ q b c → Tagged a b → Tagged a c Source # (.#) ∷ ∀ a b c q. Coercible b a ⇒ Tagged b c → q a b → Tagged a c Source # | |
Functor w ⇒ Profunctor (Cokleisli w) | |
Defined in Data.Profunctor.Unsafe dimap ∷ (a → b) → (c → d) → Cokleisli w b c → Cokleisli w a d Source # lmap ∷ (a → b) → Cokleisli w b c → Cokleisli w a c Source # rmap ∷ (b → c) → Cokleisli w a b → Cokleisli w a c Source # (#.) ∷ ∀ a b c q. Coercible c b ⇒ q b c → Cokleisli w a b → Cokleisli w a c Source # (.#) ∷ ∀ a b c q. Coercible b a ⇒ Cokleisli w b c → q a b → Cokleisli w a c Source # | |
Profunctor (Exchange a b) | |
Defined in Control.Lens.Internal.Iso dimap ∷ (a0 → b0) → (c → d) → Exchange a b b0 c → Exchange a b a0 d Source # lmap ∷ (a0 → b0) → Exchange a b b0 c → Exchange a b a0 c Source # rmap ∷ (b0 → c) → Exchange a b a0 b0 → Exchange a b a0 c Source # (#.) ∷ ∀ a0 b0 c q. Coercible c b0 ⇒ q b0 c → Exchange a b a0 b0 → Exchange a b a0 c Source # (.#) ∷ ∀ a0 b0 c q. Coercible b0 a0 ⇒ Exchange a b b0 c → q a0 b0 → Exchange a b a0 c Source # | |
Profunctor (Market a b) | |
Defined in Control.Lens.Internal.Prism dimap ∷ (a0 → b0) → (c → d) → Market a b b0 c → Market a b a0 d Source # lmap ∷ (a0 → b0) → Market a b b0 c → Market a b a0 c Source # rmap ∷ (b0 → c) → Market a b a0 b0 → Market a b a0 c Source # (#.) ∷ ∀ a0 b0 c q. Coercible c b0 ⇒ q b0 c → Market a b a0 b0 → Market a b a0 c Source # (.#) ∷ ∀ a0 b0 c q. Coercible b0 a0 ⇒ Market a b b0 c → q a0 b0 → Market a b a0 c Source # | |
Functor f ⇒ Profunctor (Costar f) | |
Defined in Data.Profunctor.Types dimap ∷ (a → b) → (c → d) → Costar f b c → Costar f a d Source # lmap ∷ (a → b) → Costar f b c → Costar f a c Source # rmap ∷ (b → c) → Costar f a b → Costar f a c Source # (#.) ∷ ∀ a b c q. Coercible c b ⇒ q b c → Costar f a b → Costar f a c Source # (.#) ∷ ∀ a b c q. Coercible b a ⇒ Costar f b c → q a b → Costar f a c Source # | |
Profunctor (Forget r ∷ Type → Type → Type) | |
Defined in Data.Profunctor.Types dimap ∷ (a → b) → (c → d) → Forget r b c → Forget r a d Source # lmap ∷ (a → b) → Forget r b c → Forget r a c Source # rmap ∷ (b → c) → Forget r a b → Forget r a c Source # (#.) ∷ ∀ a b c q. Coercible c b ⇒ q b c → Forget r a b → Forget r a c Source # (.#) ∷ ∀ a b c q. Coercible b a ⇒ Forget r b c → q a b → Forget r a c Source # | |
Functor f ⇒ Profunctor (Star f) | |
Defined in Data.Profunctor.Types dimap ∷ (a → b) → (c → d) → Star f b c → Star f a d Source # lmap ∷ (a → b) → Star f b c → Star f a c Source # rmap ∷ (b → c) → Star f a b → Star f a c Source # (#.) ∷ ∀ a b c q. Coercible c b ⇒ q b c → Star f a b → Star f a c Source # (.#) ∷ ∀ a b c q. Coercible b a ⇒ Star f b c → q a b → Star f a c Source # | |
Profunctor (->) | |
Defined in Data.Profunctor.Unsafe | |
Contravariant f ⇒ Profunctor (Clown f ∷ Type → Type → Type) | |
Defined in Data.Profunctor.Unsafe dimap ∷ (a → b) → (c → d) → Clown f b c → Clown f a d Source # lmap ∷ (a → b) → Clown f b c → Clown f a c Source # rmap ∷ (b → c) → Clown f a b → Clown f a c Source # (#.) ∷ ∀ a b c q. Coercible c b ⇒ q b c → Clown f a b → Clown f a c Source # (.#) ∷ ∀ a b c q. Coercible b a ⇒ Clown f b c → q a b → Clown f a c Source # | |
Functor f ⇒ Profunctor (Joker f ∷ Type → Type → Type) | |
Defined in Data.Profunctor.Unsafe dimap ∷ (a → b) → (c → d) → Joker f b c → Joker f a d Source # lmap ∷ (a → b) → Joker f b c → Joker f a c Source # rmap ∷ (b → c) → Joker f a b → Joker f a c Source # (#.) ∷ ∀ a b c q. Coercible c b ⇒ q b c → Joker f a b → Joker f a c Source # (.#) ∷ ∀ a b c q. Coercible b a ⇒ Joker f b c → q a b → Joker f a c Source # | |
Arrow p ⇒ Profunctor (WrappedArrow p) | |
Defined in Data.Profunctor.Types dimap ∷ (a → b) → (c → d) → WrappedArrow p b c → WrappedArrow p a d Source # lmap ∷ (a → b) → WrappedArrow p b c → WrappedArrow p a c Source # rmap ∷ (b → c) → WrappedArrow p a b → WrappedArrow p a c Source # (#.) ∷ ∀ a b c q. Coercible c b ⇒ q b c → WrappedArrow p a b → WrappedArrow p a c Source # (.#) ∷ ∀ a b c q. Coercible b a ⇒ WrappedArrow p b c → q a b → WrappedArrow p a c Source # | |
(Profunctor p, Profunctor q) ⇒ Profunctor (Product p q) | |
Defined in Data.Profunctor.Unsafe dimap ∷ (a → b) → (c → d) → Product p q b c → Product p q a d Source # lmap ∷ (a → b) → Product p q b c → Product p q a c Source # rmap ∷ (b → c) → Product p q a b → Product p q a c Source # (#.) ∷ ∀ a b c q0. Coercible c b ⇒ q0 b c → Product p q a b → Product p q a c Source # (.#) ∷ ∀ a b c q0. Coercible b a ⇒ Product p q b c → q0 a b → Product p q a c Source # | |
(Profunctor p, Profunctor q) ⇒ Profunctor (Sum p q) | |
Defined in Data.Profunctor.Unsafe dimap ∷ (a → b) → (c → d) → Sum p q b c → Sum p q a d Source # lmap ∷ (a → b) → Sum p q b c → Sum p q a c Source # rmap ∷ (b → c) → Sum p q a b → Sum p q a c Source # (#.) ∷ ∀ a b c q0. Coercible c b ⇒ q0 b c → Sum p q a b → Sum p q a c Source # (.#) ∷ ∀ a b c q0. Coercible b a ⇒ Sum p q b c → q0 a b → Sum p q a c Source # | |
(Functor f, Profunctor p) ⇒ Profunctor (Tannen f p) | |
Defined in Data.Profunctor.Unsafe dimap ∷ (a → b) → (c → d) → Tannen f p b c → Tannen f p a d Source # lmap ∷ (a → b) → Tannen f p b c → Tannen f p a c Source # rmap ∷ (b → c) → Tannen f p a b → Tannen f p a c Source # (#.) ∷ ∀ a b c q. Coercible c b ⇒ q b c → Tannen f p a b → Tannen f p a c Source # (.#) ∷ ∀ a b c q. Coercible b a ⇒ Tannen f p b c → q a b → Tannen f p a c Source # | |
(Profunctor p, Profunctor q) ⇒ Profunctor (Procompose p q) | |
Defined in Data.Profunctor.Composition dimap ∷ (a → b) → (c → d) → Procompose p q b c → Procompose p q a d Source # lmap ∷ (a → b) → Procompose p q b c → Procompose p q a c Source # rmap ∷ (b → c) → Procompose p q a b → Procompose p q a c Source # (#.) ∷ ∀ a b c q0. Coercible c b ⇒ q0 b c → Procompose p q a b → Procompose p q a c Source # (.#) ∷ ∀ a b c q0. Coercible b a ⇒ Procompose p q b c → q0 a b → Procompose p q a c Source # | |
(Profunctor p, Profunctor q) ⇒ Profunctor (Rift p q) | |
Defined in Data.Profunctor.Composition dimap ∷ (a → b) → (c → d) → Rift p q b c → Rift p q a d Source # lmap ∷ (a → b) → Rift p q b c → Rift p q a c Source # rmap ∷ (b → c) → Rift p q a b → Rift p q a c Source # (#.) ∷ ∀ a b c q0. Coercible c b ⇒ q0 b c → Rift p q a b → Rift p q a c Source # (.#) ∷ ∀ a b c q0. Coercible b a ⇒ Rift p q b c → q0 a b → Rift p q a c Source # | |
(Profunctor p, Functor f, Functor g) ⇒ Profunctor (Biff p f g) | |
Defined in Data.Profunctor.Unsafe dimap ∷ (a → b) → (c → d) → Biff p f g b c → Biff p f g a d Source # lmap ∷ (a → b) → Biff p f g b c → Biff p f g a c Source # rmap ∷ (b → c) → Biff p f g a b → Biff p f g a c Source # (#.) ∷ ∀ a b c q. Coercible c b ⇒ q b c → Biff p f g a b → Biff p f g a c Source # (.#) ∷ ∀ a b c q. Coercible b a ⇒ Biff p f g b c → q a b → Biff p f g a c Source # |
type PrettyParens = PrettyBy RenderContext Source #
For pretty-printing a value with a minimum amount of parens.
∷ Ord prec | |
⇒ (a → a) | Enclose a value of type |
→ RenderContextOver prec | An outer context. |
→ FixityOver prec | An inner fixity. |
→ a | |
→ a |
Enclose an a
(using the provided function) if required or leave it as is.
The need for enclosing is determined from an outer RenderContext
and the inner fixity.
A fixity with the lowest precedence. When used as a part of an outer context, never causes addition of parens.
The fixity of juxtaposition.
The fixity of a unitary expression which is safe to render without parens in any context.
A fixity with the highest precedence. When used as a part of an outer context, always causes addition of parens.
botRenderContext ∷ RenderContext Source #
An initial RenderContext
.
An expression printed in this context never gets enclosed in parens.
topRenderContext ∷ RenderContext Source #
An initial RenderContext
.
An expression printed in this context always gets enclosed in parens.
prettyM ∷ (MonadPretty config env m, PrettyBy config a) ⇒ a → m (Doc ann) Source #
Pretty-print a value in a configurable way in a monad holding a config.
displayM ∷ ∀ str a m env config. (MonadPretty config env m, PrettyBy config a, Render str) ⇒ a → m str Source #
Pretty-print and render a value as a string type in a configurable way in a monad holding a config.
runInContextM ∷ config → InContextM config a → a Source #
Run InContextM
by supplying a config
.
inContextM ∷ (a → InContextM config (Doc ann)) → config → a → Doc ann Source #
Takes a monadic pretty-printer and turns it into one that receives a config
explicitly.
Useful for defining instances of PrettyBy
monadically when writing precedence-aware
pretty-printing code (and since all functions below are monadic, it's currenty the only option).
encloseM ∷ MonadPrettyContext config env m ⇒ Fixity → Doc ann → m (Doc ann) Source #
Enclose a Doc
in parentheses if required or leave it as is. The need for enclosing is
determined from an outer RenderContext
(stored in the environment of the monad) and the inner
fixity provided as an argument.
withPrettyIn ∷ MonadPrettyContext config env m ⇒ ((∀ a. PrettyBy config a ⇒ Direction → Fixity → a → Doc ann) → m r) → m r Source #
Instantiate a supplied continuation with a precedence-aware pretty-printer.
withPrettyAt ∷ MonadPrettyContext config env m ⇒ Direction → Fixity → (AnyToDoc config ann → m r) → m r Source #
unitDocM ∷ MonadPrettyContext config env m ⇒ Doc ann → m (Doc ann) Source #
Call encloseM
on unitFixity
.
compoundDocM ∷ MonadPrettyContext config env m ⇒ Fixity → ((∀ a. PrettyBy config a ⇒ Direction → Fixity → a → Doc ann) → Doc ann) → m (Doc ann) Source #
sequenceDocM ∷ MonadPrettyContext config env m ⇒ Direction → Fixity → (AnyToDoc config ann → Doc ann) → m (Doc ann) Source #
infixDocM ∷ MonadPrettyContext config env m ⇒ Fixity → (AnyToDoc config ann → AnyToDoc config ann → Doc ann) → m (Doc ann) Source #
Instantiate a supplied continuation with two pretty-printers (one is going in the ToTheLeft
direction, the other is in the ToTheRight
direction) specialized to supplied Fixity
and apply encloseM
, specialized to the same fixity, to the result.
The idea is that to the outside an infix operator has the same inner fixity as
it has the outer fixity to inner subexpressions.
juxtPrettyM ∷ (MonadPrettyContext config env m, PrettyBy config a, PrettyBy config b) ⇒ a → b → m (Doc ann) Source #
Pretty-print two things with a space between them. The fixity of the context in which the
arguments get pretty-printed is set to juxtFixity
.
juxtRenderContext ∷ RenderContext Source #
An initial RenderContext
.
An expression printed in this context gets enclosed in parens unless its outermost operator (if
any) binds even stronger than function application.
data PrettyConfigReadable configName Source #
Configuration for the readable pretty-printing.
PrettyConfigReadable | |
|
Instances
type PrettyReadableBy configName = PrettyBy (PrettyConfigReadable configName) Source #
The "readably pretty-printable" constraint.
newtype AsReadable a Source #
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.
Instances
(HasPrettyConfigName config, PrettyReadable a) ⇒ DefaultPrettyBy config (AsReadable a) Source # | |
Defined in PlutusCore.Pretty.Readable defaultPrettyBy ∷ config → AsReadable a → Doc ann Source # defaultPrettyListBy ∷ config → [AsReadable a] → Doc ann Source # | |
PrettyDefaultBy config (AsReadable a) ⇒ PrettyBy config (AsReadable a) Source # | |
Defined in PlutusCore.Pretty.Readable prettyBy ∷ config → AsReadable a → Doc ann Source # prettyListBy ∷ config → [AsReadable a] → Doc ann Source # | |
PrettyReadable a ⇒ Show (AsReadable a) Source # | |
Defined in PlutusCore.Pretty.Readable | |
PrettyReadable a ⇒ Pretty (AsReadable a) Source # | |
Defined in PlutusCore.Pretty.Readable pretty ∷ AsReadable a → Doc ann Source # prettyList ∷ [AsReadable a] → Doc ann Source # |
A value of type a
to render in parens using the readable pretty-printer.
Instances
PrettyReadableBy configName a ⇒ PrettyBy (PrettyConfigReadable configName) (Parened a) Source # | |
Defined in PlutusCore.Pretty.Readable prettyBy ∷ PrettyConfigReadable configName → Parened a → Doc ann Source # prettyListBy ∷ PrettyConfigReadable configName → [Parened a] → Doc ann Source # |
type MonadPrettyReadable configName env m = MonadPretty (PrettyConfigReadable configName) env m Source #
A constraint for "m
is a monad that allows for pretty-printing values via a
PrettyConfigReadable
.
type HasPrettyConfigReadable env configName = HasPrettyConfig env (PrettyConfigReadable configName) Source #
type ReadableToDoc configName ann = ∀ a. PrettyReadableBy configName a ⇒ a → Doc ann Source #
The type of a PrettyConfigReadable
-based pretty-printer, similar to AnyToDoc
.
prettyReadable ∷ PrettyReadable a ⇒ a → Doc ann Source #
Pretty-print something with the PrettyConfigReadable
config.
prettyReadableSimple ∷ PrettyReadable a ⇒ a → Doc ann Source #
Pretty-print something with the PrettyConfigReadableSimple
config.
pcrConfigName ∷ ∀ configName configName. Lens (PrettyConfigReadable configName) (PrettyConfigReadable configName) configName configName Source #
pcrRenderContext ∷ ∀ configName. Lens' (PrettyConfigReadable configName) RenderContext Source #
pcrShowKinds ∷ ∀ configName. Lens' (PrettyConfigReadable configName) ShowKinds Source #
inBraces ∷ a → Parened a Source #
Enclose the given value, so that it's rendered inside of braces with no additional parens
regardless of the RenderContext
.
topPrettyConfigReadable ∷ configName → ShowKinds → PrettyConfigReadable configName Source #
A PrettyConfigReadable
with the fixity specified to topFixity
.
botPrettyConfigReadable ∷ configName → ShowKinds → PrettyConfigReadable configName Source #
A PrettyConfigReadable
with the fixity specified to botFixity
.
binderFixity ∷ Fixity Source #
The fixity of a binder.
The fixity of (->)
.
iterTyForallPrettyM ∷ (MonadPrettyReadable configName env m, PrettyReadableBy configName arg, PrettyReadableBy configName body) ⇒ [arg] → body → m (Doc ann) Source #
Lay out an iterated TyForall
via iterBinderPrettyM
.
iterLamAbsPrettyM ∷ (MonadPrettyReadable configName env m, PrettyReadableBy configName arg, PrettyReadableBy configName body) ⇒ [arg] → body → m (Doc ann) Source #
Lay out an iterated LamAbs
via iterBinderPrettyM
.
iterTyAbsPrettyM ∷ (MonadPrettyReadable configName env m, PrettyReadableBy configName arg, PrettyReadableBy configName body) ⇒ [arg] → body → m (Doc ann) Source #
Lay out an iterated TyAbs
via iterBinderPrettyM
.
iterArrowPrettyM ∷ (MonadPrettyReadable configName env m, PrettyReadableBy configName a) ⇒ [a] → a → m (Doc ann) Source #
Lay out an iterated ->
.
iterAppDocM ∷ MonadPrettyContext config env m ⇒ (AnyToDoc config ann → AnyToDoc config ann → NonEmpty (Doc ann)) → m (Doc ann) Source #
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.
iterInterAppPrettyM ∷ (MonadPrettyReadable configName env m, PrettyReadableBy configName fun, PrettyReadableBy configName ty, PrettyReadableBy configName term) ⇒ fun → [Either ty term] → m (Doc ann) Source #
iterAppPrettyM ∷ (MonadPrettyContext config env m, PrettyBy config fun, PrettyBy config term) ⇒ fun → [term] → m (Doc ann) Source #
Lay out iterated function applications either as
foo x y z
or as
foo x y z
iterBinderPrettyM ∷ (MonadPrettyReadable configName env m, PrettyReadableBy configName arg, PrettyReadableBy configName body) ⇒ (Doc ann → Doc ann) → [arg] → body → m (Doc ann) Source #
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