Safe Haskell | None |
---|---|
Language | Haskell2010 |
Provides a compatibility layer of Haskell-like terms for pretty-printers.
Synopsis
- newtype Portrayal where
- Portrayal { }
- pattern Atom :: Text -> Portrayal
- pattern Name :: Text -> Portrayal
- pattern Opaque :: Text -> Portrayal
- pattern Apply :: Portrayal -> [Portrayal] -> Portrayal
- pattern Binop :: Text -> Infixity -> Portrayal -> Portrayal -> Portrayal
- pattern Tuple :: [Portrayal] -> Portrayal
- pattern List :: [Portrayal] -> Portrayal
- pattern LambdaCase :: [(Portrayal, Portrayal)] -> Portrayal
- pattern Record :: Portrayal -> [FactorPortrayal Portrayal] -> Portrayal
- pattern TyApp :: Portrayal -> Portrayal -> Portrayal
- pattern TySig :: Portrayal -> Portrayal -> Portrayal
- pattern Quot :: Text -> Portrayal -> Portrayal
- pattern Unlines :: [Portrayal] -> Portrayal
- pattern Nest :: Int -> Portrayal -> Portrayal
- data FactorPortrayal a = FactorPortrayal {
- _fpFieldName :: !Text
- _fpPortrayal :: !a
- data Assoc
- data Infixity = Infixity !Assoc !Rational
- infix_ :: Rational -> Infixity
- infixl_ :: Rational -> Infixity
- infixr_ :: Rational -> Infixity
- data PortrayalF a
- class Portray a where
- newtype ShowAtom a = ShowAtom {
- unShowAtom :: a
- class GPortray f where
- class GPortrayProduct f where
- gportrayProduct :: f a -> [FactorPortrayal Portrayal] -> [FactorPortrayal Portrayal]
- showAtom :: Show a => a -> Portrayal
- strAtom :: String -> Portrayal
- strQuot :: String -> Portrayal -> Portrayal
- strBinop :: String -> Infixity -> Portrayal -> Portrayal -> Portrayal
- newtype Fix f = Fix (f (Fix f))
- cata :: Functor f => (f a -> a) -> Fix f -> a
- portrayCallStack :: [(String, SrcLoc)] -> Portrayal
- portrayType :: TypeRep a -> Portrayal
Syntax Tree
The portrayal of a Haskell runtime value as a pseudo-Haskell syntax tree.
This can be rendered to various pretty-printing libraries' document types relatively easily; as such, it provides a lingua franca for integrating with pretty-printers, without incurring heavyweight dependencies.
pattern Atom :: Text -> Portrayal | A single chunk of text included directly in the pretty-printed output. This is used for things like literals and constructor names. |
pattern Name :: Text -> Portrayal | Compatibility aid for portray-0.2. Use this as |
pattern Opaque :: Text -> Portrayal | Compatibility aid for portray-0.2. Use this with any Text argument to support both 0.1 and 0.2. |
pattern Apply :: Portrayal -> [Portrayal] -> Portrayal | A function or constructor application of arbitrary arity. Although we could have just unary function application, this gives backends a hint about how to format the result: for example, the "pretty" backend prints the function (parenthesized if non-atomic) followed by the arguments indented by two spaces; a chain of unary applications would be needlessly parenthesized. Given: Apply "These" ["2", "4"] We render something like These 2 4 |
pattern Binop :: Text -> Infixity -> Portrayal -> Portrayal -> Portrayal | A binary operator application. The fixity is used to avoid unnecessary parentheses, even in chains of operators of the same precedence. Given: Binop "+" (infixl_ 6) [ Binop "+" (infixl_ 6) ["2", "4"] , "6" ] We render something like: |
pattern Tuple :: [Portrayal] -> Portrayal | A tuple. Given |
pattern List :: [Portrayal] -> Portrayal | A list literal. Given: List [Apply "These" ["2", "4"], Apply "That" ["6"]] We render something like: [ These 2 4 , That 6 ] |
pattern LambdaCase :: [(Portrayal, Portrayal)] -> Portrayal | A lambda-case. Given This can be useful in cases where meaningful values effectively appear in negative position in a type, like in a total map or table with non-integral indices. |
pattern Record :: Portrayal -> [FactorPortrayal Portrayal] -> Portrayal | A record literal. Given: Record "Identity" [FactorPortrayal "runIdentity" "2"] We render something like: Identity { runIdentity = 2 } |
pattern TyApp :: Portrayal -> Portrayal -> Portrayal | A type application. Given |
pattern TySig :: Portrayal -> Portrayal -> Portrayal | An explicit type signature. Given |
pattern Quot :: Text -> Portrayal -> Portrayal | A quasiquoter expression. Given |
pattern Unlines :: [Portrayal] -> Portrayal | A series of lines arranged vertically, if supported. This is meant for use inside |
pattern Nest :: Int -> Portrayal -> Portrayal | Indent a sub-expression by the given number of spaces. This is meant for use inside |
Instances
Eq Portrayal Source # | |
Read Portrayal Source # | |
Show Portrayal Source # | |
IsString Portrayal Source # | |
Defined in Data.Portray fromString :: String -> Portrayal # | |
Generic Portrayal Source # | |
Portray Portrayal Source # | |
type Rep Portrayal Source # | |
Defined in Data.Portray type Rep Portrayal = D1 ('MetaData "Portrayal" "Data.Portray" "portray-0.1.1-HnA3u8chgE3BfaajrZVKzU" 'True) (C1 ('MetaCons "Portrayal" 'PrefixI 'True) (S1 ('MetaSel ('Just "unPortrayal") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Fix PortrayalF)))) |
data FactorPortrayal a Source #
A Portrayal
along with a field name; one piece of a record literal.
FactorPortrayal | |
|
Instances
Operator Fixity
Associativity of an infix operator.
Associativity and binding precedence of an infix operator.
Instances
Eq Infixity Source # | |
Ord Infixity Source # | |
Defined in Data.Portray | |
Read Infixity Source # | |
Show Infixity Source # | |
Generic Infixity Source # | |
Portray Infixity Source # | |
type Rep Infixity Source # | |
Defined in Data.Portray type Rep Infixity = D1 ('MetaData "Infixity" "Data.Portray" "portray-0.1.1-HnA3u8chgE3BfaajrZVKzU" 'False) (C1 ('MetaCons "Infixity" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Assoc) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Rational))) |
Base Functor
data PortrayalF a Source #
A single level of pseudo-Haskell expression; used to define Portrayal
.
AtomF !Text | Render this text directly. |
ApplyF !a [a] | Render a function application to several arguments. |
BinopF !Text !Infixity !a !a | Render a binary infix operator application to two arguments. |
TupleF [a] | Render a tuple of sub-values. |
ListF [a] | Render a list of sub-values. |
LambdaCaseF [(a, a)] | Render a lambda-case expression. |
RecordF !a [FactorPortrayal a] | Render a record construction/update syntax. |
TyAppF !a !a | Render a TypeApplication. |
TySigF !a !a | Render a term with explicit type signature. |
QuotF !Text !a | Render a quasiquoter term with the given name. |
UnlinesF [a] | Render a collection of vertically-aligned lines |
NestF !Int !a | Indent the subdocument by the given number of columns. |
Instances
Class
class Portray a where Source #
A class providing rendering to pseudo-Haskell syntax.
Instances should guarantee that they produce output that could, in principle, be parsed as Haskell source that evaluates to a value equal to the one being printed, provided the right functions, quasiquoters, plugins, extensions, etc. are available. Note this doesn't require you to /actually implement/ these functions, quasiquoters, etc; just that it would be feasible to do so.
Most of the time, this requirement is dispatched simply by portraying the datum as its actual tree of data constructors. However, since this can sometimes be unwieldy, you might wish to have more stylized portrayals.
The most basic form of stylized portrayal is to retract the datum through a
function, e.g. portraying 4 :| [2] :: NonEmpty a
as fromList [4, 2]
.
For cases where you actually want to escape the Haskell syntax, you can use
(or pretend to use) quasiquoter syntax, e.g. portray
EAdd (ELit 2) (EVar a)
as [expr| 2 + a |]
.
Instances
Via Show
ShowAtom | |
|
Via Generic
class GPortray f where Source #
Generics-based deriving of Portray
.
Exported mostly to give Haddock something to link to; use
deriving Portray via Wrapped Generic MyType
.
Instances
GPortray (V1 :: k -> Type) Source # | |
(Constructor ('MetaCons n fx 'False), GPortrayProduct f) => GPortray (C1 ('MetaCons n fx 'False) f :: k -> Type) Source # | |
(KnownSymbol n, GPortrayProduct f) => GPortray (C1 ('MetaCons n fx 'True) f :: k -> Type) Source # | |
(GPortray f, GPortray g) => GPortray (f :+: g :: k -> Type) Source # | |
GPortray f => GPortray (D1 d f :: k -> Type) Source # | |
class GPortrayProduct f where Source #
Generics-based deriving of Portray
for product types.
Exported mostly to give Haddock something to link to; use
deriving Portray via Wrapped Generic MyType
.
gportrayProduct :: f a -> [FactorPortrayal Portrayal] -> [FactorPortrayal Portrayal] Source #
Instances
GPortrayProduct (U1 :: k -> Type) Source # | |
Defined in Data.Portray gportrayProduct :: forall (a :: k0). U1 a -> [FactorPortrayal Portrayal] -> [FactorPortrayal Portrayal] Source # | |
(GPortrayProduct f, GPortrayProduct g) => GPortrayProduct (f :*: g :: k -> Type) Source # | |
Defined in Data.Portray gportrayProduct :: forall (a :: k0). (f :*: g) a -> [FactorPortrayal Portrayal] -> [FactorPortrayal Portrayal] Source # | |
(Selector s, Portray a) => GPortrayProduct (S1 s (K1 i a :: k -> Type) :: k -> Type) Source # | |
Defined in Data.Portray gportrayProduct :: forall (a0 :: k0). S1 s (K1 i a) a0 -> [FactorPortrayal Portrayal] -> [FactorPortrayal Portrayal] Source # |
Convenience
Miscellaneous
Fixed-point of a functor.
There are many packages that provide equivalent things, but we need almost nothing but the type itself, so we may as well just define one locally.
Instances
(forall a. Eq a => Eq (f a)) => Eq (Fix f) Source # | |
(forall a. Read a => Read (f a)) => Read (Fix f) Source # | |
(forall a. Show a => Show (f a)) => Show (Fix f) Source # | |
Generic (Fix f) Source # | |
(forall a. Portray a => Portray (f a)) => Portray (Fix f) Source # | |
type Rep (Fix f) Source # | |
Defined in Data.Portray |
cata :: Functor f => (f a -> a) -> Fix f -> a Source #
Fold a Fix f
to a
given a function to collapse each layer.