| Copyright | © 2020 James Alexander Feldman-Crough © 2022 Mission Valley Software LLC |
|---|---|
| License | MPL-2.0 |
| Safe Haskell | None |
| Language | Haskell2010 |
ProAbstract
Description
Document
Document is the root of the tree.
Tagged nodes
Tag= (name:Text) × (metadata:Metadata) × (annotation:Annotation)
Tagged nodes are branch points within a document.
TaggedBlocks= (tag:Tag) × (content:Blocks)TaggedPlainBlock= (tag:Tag) × (content:PlainBlock)TaggedLines= (tag:Tag) × (content:Lines)
Optics:
tagtargets the tag at a node; it is either a lens or an affine traversal, depending on the node type.- The
allTagstraversal targets every tag at and below a node. - The
allBlockTagsandallInlineTagsalso target tags at or below a node, but are limited to tags at the block or inline level, respectively. - Since a tag has metadata, all of the optics for targeting parts of metadata (e.g.
atSettingandhasProperty) are also available onTagand onTagged...nodes.
Operations for altering tags and/or removing tagged nodes in bulk:
- Pure:
mapMaybeTags,mapMaybeBlockTags,mapMaybeInlineTags - Monadic:
witherTags,witherBlockTags,witherInlineTags
Example: is an endofunction that removes all nodes having a tag name of "comment".mapMaybeTags (preview (filtered \x -> view name x /= "comment"))
The Block level
Block-level content is everything that appears below the document level and above the paragraph level.
Block= (fork:TaggedBlocks) ∪ (plain:TaggedPlainBlock) ∪ (bare:Paragraph)
There are three kinds of block:
Fork blocks contain more blocks.
TaggedBlocks= (tag:Tag) × (contents:Block)
Plain blocks contain text.
TaggedPlainBlock= (tag:Tag) × (content:PlainBlock)PlainBlock= (contents:Fragment) × (annotation:Annotation)
Bare blocks (paragraphs) contain inline content.
Paragraph= (contents:Line) × (annotation:Annotation)
Unenforced guideline: The Lines of a Paragraph should contain at least one Line.
BlockTag
A BlockTag is a non-paragraph Block.
BlockTag= (fork:TaggedBlocks) ∪ (plain:TaggedPlainBlock)
The Block type can be described in terms of BlockTag as:
Example: is an affine fold that targets blocks with a tag name of "h1".tagged % filtered (x -> view name x == "h1")
The BlockTag type can also be described as:
BlockTag= (tag::Tag) × (content:BlockTagContent)BlockTagContent= (fork:Blocks) ∪ (plain:PlainBlock)
The Inline level
Inline-level content is everything below the paragraph level.
Inline content is grouped into lines; we specify no particular semantics of line breaks but suggest that a typical consumer of Lines will fold them together with a single space character interspersed between the lines.
There are two kinds of inline:
Fork or tag inlines contain more inlines.
TaggedLines= (tag:Tag) × (content:Lines)Lines= (contents:Line)Line= (content:SeqInline) × (annotation:Annotation)
- Plain or bare inlines contain text.
Unenforced guideline: Each Line should contain at least one Inline.
Fragments
Fragments are all the little scraps of text that serve as the leaves of the document tree.
Fragment= (content:Text) × (annotation:Annotation)
A fragment may appear at the inline level as a plain Inline, or at the block level as a line of a PlainBlock.
Unenforced guidelines: Fragment text should be non-empty, and it should not contain any line break characters.
Metadata
Documents and tags both have metadata.
Optics:
metadatatargets the metadata of a node; it is either a lens or an affine traversal, depending on the node type.atSettingandhasPropertytarget specific parts of metadata by name.- The
allMetadatatraversal targets every metadata at and under a node. metaMapgives properties and settings combined into a singleMapTextMetaValuemetaListgives properties and settings combined into a list ofMetaItem
Content
The content of a node is whatever is nested directly under it in the document tree. The content lens is overloaded via the Content type family and HasContent class.
The contents of a node is the type of sequence element most directly nested under it. The contents lens is via the Contents type family and HasContents class.
List of nodes and their content types:
HasContent and HasContents have type aliases HasContents' and HasContents' respectively for types that only support simple optics.
Tagged or bare
At both the block and inline level, a node is either tagged or bare, a fact manifested by the taggedOrBare isomorphism of the IsTaggedOrBare class.
The tagged prism is overloaded via the TaggedType type family, and the bare prism is overloaded via the BareType family.
List of nodes and their tagged/bare types:
| x | TaggedType x | BareType x |
Block | BlockTag | Paragraph |
Inline | TaggedLines | Fragment |
Fork or plain
At both the block and inline level, a node may be a fork that contains a sequence of more content at the same level, and a node may be plain node that just contains text.
The fork prism is overloaded via the Fork type family and CanFork class.
The plain prism is overloaded via the Plain type family and CanBePlain class.
List of nodes and their fork/plain types:
| x | Fork x | Plain x |
Block | TaggedBlocks | TaggedPlainBlock |
BlockTag | TaggedBlocks | TaggedPlainBlock |
BlockTagContent | Blocks | PlainBlock |
Inline | TaggedLines | Fragment |
(Block also has a third prism, bare, which is neither fork nor plain.)
Annotation
An annotation is attached to every Tag, PlainBlock, Paragraph, Line, and Fragment. The Annotation type may be anything, but its original purpose was to map each component of a document to the location where it appeared in a text file.
Optics:
- The
annotationlens targets a single annotation at a node - The
allAnnotationstraversal targets every annotation at and under a node.
Modules
The ProAbstract module provides everything in the pro-abstract package. There are also some smaller collections of reëxports.
Organized by topic:
- ProAbstract.Annotation
- ProAbstract.Content
- ProAbstract.Metadata
- ProAbstract.Structure
- ProAbstract.Tag
- ProAbstract.Tagless
Organized by kind of thing:
- ProAbstract.Types — The essential types, exported abstractly. Includes type families and data families.
- ProAbstract.Optics — Lenses, prisms, traversals, etc. Many of these are class methods, but are exported here without their classes.
- ProAbstract.Datatypes — Datatypes including with their constructors and record fields
- ProAbstract.Families — Type families and data families.
- ProAbstract.Classes — Typeclasses, mostly for the polymorphic optics.
Synopsis
- data Document ann = Document {
- documentMetadata :: Metadata
- documentContent :: Blocks ann
- data Block ann
- = BlockPlain (TaggedPlainBlock ann)
- | BlockParagraph (Paragraph ann)
- | BlockFork (TaggedBlocks ann)
- newtype Blocks ann = Blocks (Seq (Block ann))
- data TaggedBlocks ann = TaggedBlocks {
- blocksTag :: Tag ann
- taggedBlocks :: Blocks ann
- data Paragraph ann = Paragraph {
- paragraphContent :: Lines ann
- paragraphAnnotation :: ann
- class HasManyParagraphs x where
- allParagraphs :: Traversal' x (Paragraph (Annotation x))
- data BlockTag ann
- = BlockTagFork (TaggedBlocks ann)
- | BlockTagPlain (TaggedPlainBlock ann)
- data BlockTagContent ann
- = BlockTagContent_Fork (Blocks ann)
- | BlockTagContent_Plain (PlainBlock ann)
- data Inline ann
- = InlineFork (TaggedLines ann)
- | InlinePlain (Fragment ann)
- data Line ann = Line {
- lineInlines :: Seq (Inline ann)
- lineAnnotation :: ann
- newtype Lines ann = Lines (Seq (Line ann))
- data TaggedLines ann = TaggedLines {
- linesTag :: Tag ann
- taggedLines :: Lines ann
- data Fragment ann = Fragment {
- fragmentText :: Text
- fragmentAnnotation :: ann
- data PlainBlock ann = PlainBlock {
- plainBlockLines :: Seq (Fragment ann)
- plainBlockAnnotation :: ann
- data TaggedPlainBlock ann = TaggedPlainBlock {
- plaintextTag :: Tag ann
- taggedPlaintext :: PlainBlock ann
- class HasManyPlainInlines x where
- allPlainInlines :: Traversal' x (Fragment (Annotation x))
- class HasManyPlainBlocks x where
- allPlainBlocks :: Traversal' x (TaggedPlainBlock (Annotation x))
- data Tag ann = Tag {
- tagName :: Text
- tagMetadata :: Metadata
- tagAnnotation :: ann
- name :: (HasTag x, JoinKinds (TagOpticKind x) A_Lens k) => Optic' k NoIx x Text
- class HasTag x where
- type TagOpticKind x :: OpticKind
- tag :: Optic' (TagOpticKind x) NoIx x (Tag (Annotation x))
- class HasManyTags x where
- allTags :: Traversal' x (Tag (Annotation x))
- allInlineTags :: Traversal' x (Tag (Annotation x))
- class HasManyTags x => HasManyBlockTags x where
- allBlockTags :: Traversal' x (Tag (Annotation x))
- class HasWitherableTags x where
- witherTags :: Monad f => (Tag (Annotation x) -> f (Maybe (Tag (Annotation x)))) -> x -> f x
- mapMaybeTags :: (Tag (Annotation x) -> Maybe (Tag (Annotation x))) -> x -> x
- class HasManyTags x => HasWitherableInlineTags x where
- witherInlineTags :: Monad f => (Tag (Annotation x) -> f (Maybe (Tag (Annotation x)))) -> x -> f x
- mapMaybeInlineTags :: (Tag (Annotation x) -> Maybe (Tag (Annotation x))) -> x -> x
- class HasManyBlockTags x => HasWitherableBlockTags x where
- witherBlockTags :: Monad f => (Tag (Annotation x) -> f (Maybe (Tag (Annotation x)))) -> x -> f x
- mapMaybeBlockTags :: (Tag (Annotation x) -> Maybe (Tag (Annotation x))) -> x -> x
- type family Plain a
- class CanBePlain x where
- type family Fork a
- class CanFork x where
- tagged :: IsTaggedOrBare a => Prism' a (TaggedType a)
- bare :: IsTaggedOrBare a => Prism' a (BareType a)
- class IsTaggedOrBare a where
- type TaggedType a
- type BareType a
- taggedOrBare :: Iso' a (TaggedOrBare a)
- data TaggedOrBare a
- = IsTagged (TaggedType a)
- | IsBare (BareType a)
- data Metadata = Metadata {}
- class HasMetadata x where
- type MetadataOpticKind x
- metadata :: Optic' (MetadataOpticKind x) NoIx x Metadata
- class HasManyMetadata x where
- properties :: (HasMetadata m, JoinKinds (MetadataOpticKind m) A_Lens k) => Optic' k NoIx m (Set Text)
- hasProperty :: (HasMetadata m, JoinKinds (MetadataOpticKind m) A_Lens k) => Text -> Optic' k NoIx m Bool
- settings :: (HasMetadata m, JoinKinds (MetadataOpticKind m) A_Lens k) => Optic' k NoIx m (Map Text Text)
- atSetting :: (HasMetadata m, JoinKinds (MetadataOpticKind m) A_Lens k) => Text -> Optic' k NoIx m (Maybe Text)
- data MetaItem
- metaList :: (HasMetadata m, Is (MetadataOpticKind m) An_AffineFold) => Getter m [MetaItem]
- data MetaValue
- metaMap :: (HasMetadata m, JoinKinds (MetadataOpticKind m) An_Iso k) => Optic' k NoIx m (Map Text MetaValue)
- type family Content a
- class HasContent x x' where
- type HasContent' x = HasContent x x
- type family Contents a
- class HasContents x x' where
- type HasContents' x = HasContents x x
- type family Annotation x
- class HasAnnotation x x' where
- annotation :: Lens x x' (Annotation x) (Annotation x')
- type HasAnnotation' x = HasAnnotation x x
- class HasManyAnnotations x x' where
- allAnnotations :: Traversal x x' (Annotation x) (Annotation x')
- class CanBeTagless a where
- tagless :: KindOfText txt -> AffineFold a txt
- class CanHaveTaglessContent a where
- taglessContent :: KindOfText t -> AffineFold a t
- data KindOfText txt where
- TextLine :: KindOfText Text
- TextStanza :: KindOfText (Seq Text)
- TextParagraphs :: KindOfText (Seq (Seq Text))
Document
Constructors
| Document | |
Fields
| |
Instances
Blocks
Constructors
| BlockPlain (TaggedPlainBlock ann) | |
| BlockParagraph (Paragraph ann) | |
| BlockFork (TaggedBlocks ann) |
Instances
Instances
data TaggedBlocks ann Source #
Constructors
| TaggedBlocks | |
Instances
Paragraphs
A collection of Lines. A Paragraph represents the border between block and inline contexts. All ancestors of a paragraph are block items or a document, and all children are inline items.
Constructors
| Paragraph | |
Fields
| |
Instances
class HasManyParagraphs x where Source #
Methods
allParagraphs :: Traversal' x (Paragraph (Annotation x)) Source #
Instances
Tag blocks
Constructors
| BlockTagFork (TaggedBlocks ann) | |
| BlockTagPlain (TaggedPlainBlock ann) |
Instances
data BlockTagContent ann Source #
Constructors
| BlockTagContent_Fork (Blocks ann) | |
| BlockTagContent_Plain (PlainBlock ann) |
Instances
Lines
Constructors
| InlineFork (TaggedLines ann) | |
| InlinePlain (Fragment ann) |
Instances
Constructors
| Line | |
Fields
| |
Instances
Instances
data TaggedLines ann Source #
Constructors
| TaggedLines | |
Instances
Plain text
Constructors
| Fragment | |
Fields
| |
Instances
data PlainBlock ann Source #
Constructors
| PlainBlock | |
Fields
| |
Instances
data TaggedPlainBlock ann Source #
Constructors
| TaggedPlainBlock | |
Fields
| |
Instances
class HasManyPlainInlines x where Source #
Methods
allPlainInlines :: Traversal' x (Fragment (Annotation x)) Source #
Instances
class HasManyPlainBlocks x where Source #
Methods
allPlainBlocks :: Traversal' x (TaggedPlainBlock (Annotation x)) Source #
Instances
Tags
Constructors
| Tag | |
Fields
| |
Instances
Associated Types
type TagOpticKind x :: OpticKind Source #
Methods
tag :: Optic' (TagOpticKind x) NoIx x (Tag (Annotation x)) Source #
Instances
Traversal
class HasManyTags x where Source #
Methods
allTags :: Traversal' x (Tag (Annotation x)) Source #
allInlineTags :: Traversal' x (Tag (Annotation x)) Source #
Instances
class HasManyTags x => HasManyBlockTags x where Source #
Methods
allBlockTags :: Traversal' x (Tag (Annotation x)) Source #
Instances
| HasManyBlockTags (TaggedBlocks ann) Source # | |
Defined in ProAbstract.Structure.Block Methods allBlockTags :: Traversal' (TaggedBlocks ann) (Tag (Annotation (TaggedBlocks ann))) Source # | |
| HasManyBlockTags (Blocks ann) Source # | |
Defined in ProAbstract.Structure.Block Methods allBlockTags :: Traversal' (Blocks ann) (Tag (Annotation (Blocks ann))) Source # | |
| HasManyBlockTags (Block ann) Source # | |
Defined in ProAbstract.Structure.Block Methods allBlockTags :: Traversal' (Block ann) (Tag (Annotation (Block ann))) Source # | |
| HasManyBlockTags (Document ann) Source # | |
Defined in ProAbstract.Structure.Document Methods allBlockTags :: Traversal' (Document ann) (Tag (Annotation (Document ann))) Source # | |
| HasManyBlockTags (BlockTagContent ann) Source # | |
Defined in ProAbstract.Structure.BlockTagContent Methods allBlockTags :: Traversal' (BlockTagContent ann) (Tag (Annotation (BlockTagContent ann))) Source # | |
Withering
class HasWitherableTags x where Source #
Minimal complete definition
Methods
witherTags :: Monad f => (Tag (Annotation x) -> f (Maybe (Tag (Annotation x)))) -> x -> f x Source #
mapMaybeTags :: (Tag (Annotation x) -> Maybe (Tag (Annotation x))) -> x -> x Source #
Instances
class HasManyTags x => HasWitherableInlineTags x where Source #
Minimal complete definition
Methods
witherInlineTags :: Monad f => (Tag (Annotation x) -> f (Maybe (Tag (Annotation x)))) -> x -> f x Source #
mapMaybeInlineTags :: (Tag (Annotation x) -> Maybe (Tag (Annotation x))) -> x -> x Source #
Instances
class HasManyBlockTags x => HasWitherableBlockTags x where Source #
Minimal complete definition
Methods
witherBlockTags :: Monad f => (Tag (Annotation x) -> f (Maybe (Tag (Annotation x)))) -> x -> f x Source #
mapMaybeBlockTags :: (Tag (Annotation x) -> Maybe (Tag (Annotation x))) -> x -> x Source #
Instances
Prisms
Plain/fork
Instances
| type Plain (Inline ann) Source # | |
Defined in ProAbstract.Structure.Inline | |
| type Plain (Block ann) Source # | |
Defined in ProAbstract.Structure.Block | |
| type Plain (BlockTagContent ann) Source # | |
Defined in ProAbstract.Structure.BlockTagContent | |
| type Plain (BlockTag ann) Source # | |
Defined in ProAbstract.Structure.BlockTag | |
class CanBePlain x where Source #
Instances
| CanBePlain (Inline ann) Source # | |
| CanBePlain (Block ann) Source # | |
| CanBePlain (BlockTagContent ann) Source # | |
Defined in ProAbstract.Structure.BlockTagContent Methods plain :: Prism' (BlockTagContent ann) (Plain (BlockTagContent ann)) Source # | |
| CanBePlain (BlockTag ann) Source # | |
Instances
| type Fork (Inline ann) Source # | |
Defined in ProAbstract.Structure.Inline | |
| type Fork (Block ann) Source # | |
Defined in ProAbstract.Structure.Block | |
| type Fork (BlockTagContent ann) Source # | |
Defined in ProAbstract.Structure.BlockTagContent | |
| type Fork (BlockTag ann) Source # | |
Defined in ProAbstract.Structure.BlockTag | |
Tagged/bare
tagged :: IsTaggedOrBare a => Prism' a (TaggedType a) Source #
class IsTaggedOrBare a where Source #
Methods
taggedOrBare :: Iso' a (TaggedOrBare a) Source #
Instances
| IsTaggedOrBare (Inline ann) Source # | |
Defined in ProAbstract.Structure.IsTaggedOrBare Methods taggedOrBare :: Iso' (Inline ann) (TaggedOrBare (Inline ann)) Source # | |
| IsTaggedOrBare (Block ann) Source # | |
Defined in ProAbstract.Structure.IsTaggedOrBare Methods taggedOrBare :: Iso' (Block ann) (TaggedOrBare (Block ann)) Source # | |
| IsTaggedOrBare (TaggedOrBare a) Source # | |
Defined in ProAbstract.Structure.IsTaggedOrBare Methods taggedOrBare :: Iso' (TaggedOrBare a) (TaggedOrBare (TaggedOrBare a)) Source # | |
data TaggedOrBare a Source #
Constructors
| IsTagged (TaggedType a) | |
| IsBare (BareType a) |
Instances
| IsTaggedOrBare (TaggedOrBare a) Source # | |
Defined in ProAbstract.Structure.IsTaggedOrBare Methods taggedOrBare :: Iso' (TaggedOrBare a) (TaggedOrBare (TaggedOrBare a)) Source # | |
| type TaggedType (TaggedOrBare a) Source # | |
Defined in ProAbstract.Structure.IsTaggedOrBare | |
| type BareType (TaggedOrBare a) Source # | |
Defined in ProAbstract.Structure.IsTaggedOrBare | |
Metadata
A set of properties and settings, associated with a document or tag.
The namespaces of properties and settings are distinct; a property can share a name with a setting without conflict.
Constructors
| Metadata | |
Instances
| Eq Metadata Source # | |
| Show Metadata Source # | |
| Generic Metadata Source # | |
| Semigroup Metadata Source # | |
| Monoid Metadata Source # | |
| NFData Metadata Source # | |
Defined in ProAbstract.Metadata.MetadataType | |
| Hashable Metadata Source # | |
Defined in ProAbstract.Metadata.MetadataType | |
| HasMetadata Metadata Source # | |
Defined in ProAbstract.Metadata.HasMetadata Associated Types type MetadataOpticKind Metadata Source # | |
| type Rep Metadata Source # | |
Defined in ProAbstract.Metadata.MetadataType type Rep Metadata = D1 ('MetaData "Metadata" "ProAbstract.Metadata.MetadataType" "pro-abstract-0.3.0.0-CFjEApBZPUR1EoNCheWNFg" 'False) (C1 ('MetaCons "Metadata" 'PrefixI 'True) (S1 ('MetaSel ('Just "metadataProperties") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Set Text)) :*: S1 ('MetaSel ('Just "metadataSettings") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Map Text Text)))) | |
| type MetadataOpticKind Metadata Source # | |
Defined in ProAbstract.Metadata.HasMetadata | |
class HasMetadata x where Source #
Associated Types
type MetadataOpticKind x Source #
Instances
class HasManyMetadata x where Source #
Methods
allMetadata :: Traversal' x Metadata Source #
Instances
Properties
properties :: (HasMetadata m, JoinKinds (MetadataOpticKind m) A_Lens k) => Optic' k NoIx m (Set Text) Source #
Fetch all properties from items which contain metadata.
hasProperty :: (HasMetadata m, JoinKinds (MetadataOpticKind m) A_Lens k) => Text -> Optic' k NoIx m Bool Source #
Settings
settings :: (HasMetadata m, JoinKinds (MetadataOpticKind m) A_Lens k) => Optic' k NoIx m (Map Text Text) Source #
Fetch all settings defined on items which contain metadata.
atSetting :: (HasMetadata m, JoinKinds (MetadataOpticKind m) A_Lens k) => Text -> Optic' k NoIx m (Maybe Text) Source #
Select a setting from an item attached to metadata. Returns Nothing if no value is set.
Item list
Instances
| Eq MetaItem Source # | |
| Ord MetaItem Source # | |
Defined in ProAbstract.Metadata.MetaItem | |
| Show MetaItem Source # | |
| Generic MetaItem Source # | |
| NFData MetaItem Source # | |
Defined in ProAbstract.Metadata.MetaItem | |
| Hashable MetaItem Source # | |
Defined in ProAbstract.Metadata.MetaItem | |
| type Rep MetaItem Source # | |
Defined in ProAbstract.Metadata.MetaItem type Rep MetaItem = D1 ('MetaData "MetaItem" "ProAbstract.Metadata.MetaItem" "pro-abstract-0.3.0.0-CFjEApBZPUR1EoNCheWNFg" 'False) (C1 ('MetaCons "Property" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Text)) :+: C1 ('MetaCons "Setting" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Text) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Text))) | |
metaList :: (HasMetadata m, Is (MetadataOpticKind m) An_AffineFold) => Getter m [MetaItem] Source #
Value map
Constructors
| MetaValue_Property | |
| MetaValue_Setting Text | setting value |
| MetaValue_PropertyAndSetting Text | setting value |
Instances
| Eq MetaValue Source # | |
| Ord MetaValue Source # | |
| Show MetaValue Source # | |
| Generic MetaValue Source # | |
| Semigroup MetaValue Source # | |
| NFData MetaValue Source # | |
Defined in ProAbstract.Metadata.MetaValue | |
| Hashable MetaValue Source # | |
Defined in ProAbstract.Metadata.MetaValue | |
| type Rep MetaValue Source # | |
Defined in ProAbstract.Metadata.MetaValue type Rep MetaValue = D1 ('MetaData "MetaValue" "ProAbstract.Metadata.MetaValue" "pro-abstract-0.3.0.0-CFjEApBZPUR1EoNCheWNFg" 'False) (C1 ('MetaCons "MetaValue_Property" 'PrefixI 'False) (U1 :: Type -> Type) :+: (C1 ('MetaCons "MetaValue_Setting" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Text)) :+: C1 ('MetaCons "MetaValue_PropertyAndSetting" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Text)))) | |
metaMap :: (HasMetadata m, JoinKinds (MetadataOpticKind m) An_Iso k) => Optic' k NoIx m (Map Text MetaValue) Source #
Content
type family Content a Source #
Instances
| type Content (Fragment ann) Source # | |
Defined in ProAbstract.Structure.Fragment | |
| type Content (TaggedPlainBlock ann) Source # | |
Defined in ProAbstract.Structure.PlainBlock | |
| type Content (TaggedLines ann) Source # | |
Defined in ProAbstract.Structure.Inline | |
| type Content (Paragraph ann) Source # | |
Defined in ProAbstract.Structure.Paragraph | |
| type Content (TaggedBlocks ann) Source # | |
Defined in ProAbstract.Structure.Block | |
| type Content (Document ann) Source # | |
Defined in ProAbstract.Structure.Document | |
| type Content (BlockTag ann) Source # | |
Defined in ProAbstract.Structure.BlockTag | |
class HasContent x x' where Source #
Instances
| HasContent (Fragment ann) (Fragment ann) Source # | |
| HasContent (TaggedPlainBlock ann) (TaggedPlainBlock ann) Source # | |
Defined in ProAbstract.Structure.PlainBlock Methods content :: Lens (TaggedPlainBlock ann) (TaggedPlainBlock ann) (Content (TaggedPlainBlock ann)) (Content (TaggedPlainBlock ann)) Source # | |
| HasContent (TaggedLines ann) (TaggedLines ann) Source # | |
Defined in ProAbstract.Structure.Inline Methods content :: Lens (TaggedLines ann) (TaggedLines ann) (Content (TaggedLines ann)) (Content (TaggedLines ann)) Source # | |
| HasContent (Paragraph ann) (Paragraph ann) Source # | |
| HasContent (TaggedBlocks ann) (TaggedBlocks ann) Source # | |
Defined in ProAbstract.Structure.Block Methods content :: Lens (TaggedBlocks ann) (TaggedBlocks ann) (Content (TaggedBlocks ann)) (Content (TaggedBlocks ann)) Source # | |
| HasContent (Document ann) (Document ann') Source # | |
| HasContent (BlockTag ann) (BlockTag ann) Source # | |
type HasContent' x = HasContent x x Source #
Contents
type family Contents a Source #
Instances
| type Contents (TaggedPlainBlock ann) Source # | |
Defined in ProAbstract.Structure.PlainBlock | |
| type Contents (PlainBlock ann) Source # | |
Defined in ProAbstract.Structure.PlainBlock | |
| type Contents (TaggedLines ann) Source # | |
Defined in ProAbstract.Structure.Inline | |
| type Contents (Lines ann) Source # | |
Defined in ProAbstract.Structure.Inline | |
| type Contents (Line ann) Source # | |
Defined in ProAbstract.Structure.Inline | |
| type Contents (Paragraph ann) Source # | |
Defined in ProAbstract.Structure.Paragraph | |
| type Contents (TaggedBlocks ann) Source # | |
Defined in ProAbstract.Structure.Block | |
| type Contents (Blocks ann) Source # | |
Defined in ProAbstract.Structure.Block | |
| type Contents (Document ann) Source # | |
Defined in ProAbstract.Structure.Document | |
class HasContents x x' where Source #
Instances
type HasContents' x = HasContents x x Source #
Annotation
type family Annotation x Source #
Instances
class HasAnnotation x x' where Source #
Methods
annotation :: Lens x x' (Annotation x) (Annotation x') Source #
Instances
type HasAnnotation' x = HasAnnotation x x Source #
class HasManyAnnotations x x' where Source #
Methods
allAnnotations :: Traversal x x' (Annotation x) (Annotation x') Source #
Instances
Tagless content
class CanBeTagless a where Source #
Methods
tagless :: KindOfText txt -> AffineFold a txt Source #
Instances
class CanHaveTaglessContent a where Source #
Methods
taglessContent :: KindOfText t -> AffineFold a t Source #
Instances
data KindOfText txt where Source #
Constructors
| TextLine :: KindOfText Text | |
| TextStanza :: KindOfText (Seq Text) | |
| TextParagraphs :: KindOfText (Seq (Seq Text)) |