comark-0.1.0: Commonmark processing in pure haskell.

Safe HaskellSafe
LanguageHaskell2010

Comark

Contents

Description

It mostly contains reexports from the following modules:

Synopsis

Parser

parse :: [ParserOption] -> Text -> Doc Text #

Parses Commonmark document. Any sequence of characters is a valid Commonmark document.

At the moment no sanitizations are performed besides the ones defined in the spec.

data ParserOption :: * #

Constructors

Normalize

Consolidate adjacent text nodes.

LinkReferences (Text -> Maybe (Text, Maybe Text))

Predefine link reference defenitions.

References are represented with a mapping from a link text to a pair of a link destination and an optional link title.

During parsing the link references defined in a document would be collected into additional mapping. When link references are being mapping defined in options takes precedence over mapping found in the document.

TODO: Examples

HTML Rendererer

render :: Doc Text -> Text #

Render a Commonmark document as HTML.

AST types

Document

newtype Doc t :: * -> * #

A Document

Constructors

Doc (Blocks t) 

Instances

Functor Doc 

Methods

fmap :: (a -> b) -> Doc a -> Doc b #

(<$) :: a -> Doc b -> Doc a #

Foldable Doc 

Methods

fold :: Monoid m => Doc m -> m #

foldMap :: Monoid m => (a -> m) -> Doc a -> m #

foldr :: (a -> b -> b) -> b -> Doc a -> b #

foldr' :: (a -> b -> b) -> b -> Doc a -> b #

foldl :: (b -> a -> b) -> b -> Doc a -> b #

foldl' :: (b -> a -> b) -> b -> Doc a -> b #

foldr1 :: (a -> a -> a) -> Doc a -> a #

foldl1 :: (a -> a -> a) -> Doc a -> a #

toList :: Doc a -> [a] #

null :: Doc a -> Bool #

length :: Doc a -> Int #

elem :: Eq a => a -> Doc a -> Bool #

maximum :: Ord a => Doc a -> a #

minimum :: Ord a => Doc a -> a #

sum :: Num a => Doc a -> a #

product :: Num a => Doc a -> a #

Traversable Doc 

Methods

traverse :: Applicative f => (a -> f b) -> Doc a -> f (Doc b) #

sequenceA :: Applicative f => Doc (f a) -> f (Doc a) #

mapM :: Monad m => (a -> m b) -> Doc a -> m (Doc b) #

sequence :: Monad m => Doc (m a) -> m (Doc a) #

Eq t => Eq (Doc t) 

Methods

(==) :: Doc t -> Doc t -> Bool #

(/=) :: Doc t -> Doc t -> Bool #

Data t => Data (Doc t) 

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Doc t -> c (Doc t) #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c (Doc t) #

toConstr :: Doc t -> Constr #

dataTypeOf :: Doc t -> DataType #

dataCast1 :: Typeable (* -> *) t => (forall d. Data d => c (t d)) -> Maybe (c (Doc t)) #

dataCast2 :: Typeable (* -> * -> *) t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Doc t)) #

gmapT :: (forall b. Data b => b -> b) -> Doc t -> Doc t #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Doc t -> r #

gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Doc t -> r #

gmapQ :: (forall d. Data d => d -> u) -> Doc t -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> Doc t -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> Doc t -> m (Doc t) #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Doc t -> m (Doc t) #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Doc t -> m (Doc t) #

Read t => Read (Doc t) 
Show t => Show (Doc t) 

Methods

showsPrec :: Int -> Doc t -> ShowS #

show :: Doc t -> String #

showList :: [Doc t] -> ShowS #

Generic (Doc t) 

Associated Types

type Rep (Doc t) :: * -> * #

Methods

from :: Doc t -> Rep (Doc t) x #

to :: Rep (Doc t) x -> Doc t #

Monoid (Doc t) 

Methods

mempty :: Doc t #

mappend :: Doc t -> Doc t -> Doc t #

mconcat :: [Doc t] -> Doc t #

NFData t => NFData (Doc t) 

Methods

rnf :: Doc t -> () #

type Rep (Doc t) 
type Rep (Doc t) = D1 (MetaData "Doc" "Comark.Syntax" "comark-syntax-0.1.0-8JrBqAV8e8RCvtr00JYzUM" True) (C1 (MetaCons "Doc" PrefixI False) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (Blocks t))))

Blocks

type Blocks t = Seq (Block t) #

data Block t :: * -> * #

Block elements

Constructors

ThematicBreak

Thematic break

Heading HeadingLevel (Inlines t)

Heading: level, sequnce of inlines that define content

CodeBlock (Maybe t) t

Block of code: info string, literal content

HtmlBlock t

Raw HTML Block

Para (Inlines t)

Paragraph (a grouped sequence of inlines)

Quote (Blocks t)

Block Quote (a quoted sequence of blocks)

List ListType Bool (Seq (Blocks t))

List: Type of the list, tightness, a sequnce of blocks (list item)

Instances

Functor Block 

Methods

fmap :: (a -> b) -> Block a -> Block b #

(<$) :: a -> Block b -> Block a #

Foldable Block 

Methods

fold :: Monoid m => Block m -> m #

foldMap :: Monoid m => (a -> m) -> Block a -> m #

foldr :: (a -> b -> b) -> b -> Block a -> b #

foldr' :: (a -> b -> b) -> b -> Block a -> b #

foldl :: (b -> a -> b) -> b -> Block a -> b #

foldl' :: (b -> a -> b) -> b -> Block a -> b #

foldr1 :: (a -> a -> a) -> Block a -> a #

foldl1 :: (a -> a -> a) -> Block a -> a #

toList :: Block a -> [a] #

null :: Block a -> Bool #

length :: Block a -> Int #

elem :: Eq a => a -> Block a -> Bool #

maximum :: Ord a => Block a -> a #

minimum :: Ord a => Block a -> a #

sum :: Num a => Block a -> a #

product :: Num a => Block a -> a #

Traversable Block 

Methods

traverse :: Applicative f => (a -> f b) -> Block a -> f (Block b) #

sequenceA :: Applicative f => Block (f a) -> f (Block a) #

mapM :: Monad m => (a -> m b) -> Block a -> m (Block b) #

sequence :: Monad m => Block (m a) -> m (Block a) #

Eq t => Eq (Block t) 

Methods

(==) :: Block t -> Block t -> Bool #

(/=) :: Block t -> Block t -> Bool #

Data t => Data (Block t) 

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Block t -> c (Block t) #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c (Block t) #

toConstr :: Block t -> Constr #

dataTypeOf :: Block t -> DataType #

dataCast1 :: Typeable (* -> *) t => (forall d. Data d => c (t d)) -> Maybe (c (Block t)) #

dataCast2 :: Typeable (* -> * -> *) t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Block t)) #

gmapT :: (forall b. Data b => b -> b) -> Block t -> Block t #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Block t -> r #

gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Block t -> r #

gmapQ :: (forall d. Data d => d -> u) -> Block t -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> Block t -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> Block t -> m (Block t) #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Block t -> m (Block t) #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Block t -> m (Block t) #

Ord t => Ord (Block t) 

Methods

compare :: Block t -> Block t -> Ordering #

(<) :: Block t -> Block t -> Bool #

(<=) :: Block t -> Block t -> Bool #

(>) :: Block t -> Block t -> Bool #

(>=) :: Block t -> Block t -> Bool #

max :: Block t -> Block t -> Block t #

min :: Block t -> Block t -> Block t #

Read t => Read (Block t) 
Show t => Show (Block t) 

Methods

showsPrec :: Int -> Block t -> ShowS #

show :: Block t -> String #

showList :: [Block t] -> ShowS #

Generic (Block t) 

Associated Types

type Rep (Block t) :: * -> * #

Methods

from :: Block t -> Rep (Block t) x #

to :: Rep (Block t) x -> Block t #

NFData t => NFData (Block t) 

Methods

rnf :: Block t -> () #

type Rep (Block t) 

data HeadingLevel :: * #

Instances

Eq HeadingLevel 
Data HeadingLevel 

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> HeadingLevel -> c HeadingLevel #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c HeadingLevel #

toConstr :: HeadingLevel -> Constr #

dataTypeOf :: HeadingLevel -> DataType #

dataCast1 :: Typeable (* -> *) t => (forall d. Data d => c (t d)) -> Maybe (c HeadingLevel) #

dataCast2 :: Typeable (* -> * -> *) t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c HeadingLevel) #

gmapT :: (forall b. Data b => b -> b) -> HeadingLevel -> HeadingLevel #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> HeadingLevel -> r #

gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> HeadingLevel -> r #

gmapQ :: (forall d. Data d => d -> u) -> HeadingLevel -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> HeadingLevel -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> HeadingLevel -> m HeadingLevel #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> HeadingLevel -> m HeadingLevel #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> HeadingLevel -> m HeadingLevel #

Ord HeadingLevel 
Read HeadingLevel 
Show HeadingLevel 
Generic HeadingLevel 

Associated Types

type Rep HeadingLevel :: * -> * #

NFData HeadingLevel 

Methods

rnf :: HeadingLevel -> () #

type Rep HeadingLevel 
type Rep HeadingLevel = D1 (MetaData "HeadingLevel" "Comark.Syntax" "comark-syntax-0.1.0-8JrBqAV8e8RCvtr00JYzUM" False) ((:+:) ((:+:) (C1 (MetaCons "Heading1" PrefixI False) U1) ((:+:) (C1 (MetaCons "Heading2" PrefixI False) U1) (C1 (MetaCons "Heading3" PrefixI False) U1))) ((:+:) (C1 (MetaCons "Heading4" PrefixI False) U1) ((:+:) (C1 (MetaCons "Heading5" PrefixI False) U1) (C1 (MetaCons "Heading6" PrefixI False) U1))))

data ListType :: * #

Instances

Eq ListType 
Data ListType 

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> ListType -> c ListType #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c ListType #

toConstr :: ListType -> Constr #

dataTypeOf :: ListType -> DataType #

dataCast1 :: Typeable (* -> *) t => (forall d. Data d => c (t d)) -> Maybe (c ListType) #

dataCast2 :: Typeable (* -> * -> *) t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ListType) #

gmapT :: (forall b. Data b => b -> b) -> ListType -> ListType #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> ListType -> r #

gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> ListType -> r #

gmapQ :: (forall d. Data d => d -> u) -> ListType -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> ListType -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> ListType -> m ListType #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> ListType -> m ListType #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> ListType -> m ListType #

Ord ListType 
Read ListType 
Show ListType 
Generic ListType 

Associated Types

type Rep ListType :: * -> * #

Methods

from :: ListType -> Rep ListType x #

to :: Rep ListType x -> ListType #

NFData ListType 

Methods

rnf :: ListType -> () #

type Rep ListType 

data Delimiter :: * #

Constructors

Period 
Paren 

Instances

Eq Delimiter 
Data Delimiter 

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Delimiter -> c Delimiter #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c Delimiter #

toConstr :: Delimiter -> Constr #

dataTypeOf :: Delimiter -> DataType #

dataCast1 :: Typeable (* -> *) t => (forall d. Data d => c (t d)) -> Maybe (c Delimiter) #

dataCast2 :: Typeable (* -> * -> *) t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Delimiter) #

gmapT :: (forall b. Data b => b -> b) -> Delimiter -> Delimiter #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Delimiter -> r #

gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Delimiter -> r #

gmapQ :: (forall d. Data d => d -> u) -> Delimiter -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> Delimiter -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> Delimiter -> m Delimiter #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Delimiter -> m Delimiter #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Delimiter -> m Delimiter #

Ord Delimiter 
Read Delimiter 
Show Delimiter 
Generic Delimiter 

Associated Types

type Rep Delimiter :: * -> * #

NFData Delimiter 

Methods

rnf :: Delimiter -> () #

type Rep Delimiter 
type Rep Delimiter = D1 (MetaData "Delimiter" "Comark.Syntax" "comark-syntax-0.1.0-8JrBqAV8e8RCvtr00JYzUM" False) ((:+:) (C1 (MetaCons "Period" PrefixI False) U1) (C1 (MetaCons "Paren" PrefixI False) U1))

data BulletMarker :: * #

Constructors

Minus
-
Plus
+
Asterisk
*

Instances

Eq BulletMarker 
Data BulletMarker 

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> BulletMarker -> c BulletMarker #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c BulletMarker #

toConstr :: BulletMarker -> Constr #

dataTypeOf :: BulletMarker -> DataType #

dataCast1 :: Typeable (* -> *) t => (forall d. Data d => c (t d)) -> Maybe (c BulletMarker) #

dataCast2 :: Typeable (* -> * -> *) t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c BulletMarker) #

gmapT :: (forall b. Data b => b -> b) -> BulletMarker -> BulletMarker #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> BulletMarker -> r #

gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> BulletMarker -> r #

gmapQ :: (forall d. Data d => d -> u) -> BulletMarker -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> BulletMarker -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> BulletMarker -> m BulletMarker #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> BulletMarker -> m BulletMarker #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> BulletMarker -> m BulletMarker #

Ord BulletMarker 
Read BulletMarker 
Show BulletMarker 
Generic BulletMarker 

Associated Types

type Rep BulletMarker :: * -> * #

NFData BulletMarker 

Methods

rnf :: BulletMarker -> () #

type Rep BulletMarker 
type Rep BulletMarker = D1 (MetaData "BulletMarker" "Comark.Syntax" "comark-syntax-0.1.0-8JrBqAV8e8RCvtr00JYzUM" False) ((:+:) (C1 (MetaCons "Minus" PrefixI False) U1) ((:+:) (C1 (MetaCons "Plus" PrefixI False) U1) (C1 (MetaCons "Asterisk" PrefixI False) U1)))

Inlines

type Inlines t = Seq (Inline t) #

data Inline t :: * -> * #

Inline elements

Constructors

Str t

Text (string)

Code t

Inline code

Emph (Inlines t)

Emphasized text (a sequence of inlines)

Strong (Inlines t)

Strongly emphasized text (a sequence of inlines)

Link (Inlines t) t (Maybe t)

Hyperlink: visible link text (sequence of inlines), destination, title

Image (Inlines t) t (Maybe t)

Image hyperlink: image description, destination, title

RawHtml t

Inline Raw HTML tag

SoftBreak

A regular linebreak. A conforming renderer may render a soft line break in HTML either as line break or as a space.

HardBreak

A line break that is marked as hard (either with spaces or backslash, see the spec for details). In html it would be rendered as /

Instances

Functor Inline 

Methods

fmap :: (a -> b) -> Inline a -> Inline b #

(<$) :: a -> Inline b -> Inline a #

Foldable Inline 

Methods

fold :: Monoid m => Inline m -> m #

foldMap :: Monoid m => (a -> m) -> Inline a -> m #

foldr :: (a -> b -> b) -> b -> Inline a -> b #

foldr' :: (a -> b -> b) -> b -> Inline a -> b #

foldl :: (b -> a -> b) -> b -> Inline a -> b #

foldl' :: (b -> a -> b) -> b -> Inline a -> b #

foldr1 :: (a -> a -> a) -> Inline a -> a #

foldl1 :: (a -> a -> a) -> Inline a -> a #

toList :: Inline a -> [a] #

null :: Inline a -> Bool #

length :: Inline a -> Int #

elem :: Eq a => a -> Inline a -> Bool #

maximum :: Ord a => Inline a -> a #

minimum :: Ord a => Inline a -> a #

sum :: Num a => Inline a -> a #

product :: Num a => Inline a -> a #

Traversable Inline 

Methods

traverse :: Applicative f => (a -> f b) -> Inline a -> f (Inline b) #

sequenceA :: Applicative f => Inline (f a) -> f (Inline a) #

mapM :: Monad m => (a -> m b) -> Inline a -> m (Inline b) #

sequence :: Monad m => Inline (m a) -> m (Inline a) #

Eq t => Eq (Inline t) 

Methods

(==) :: Inline t -> Inline t -> Bool #

(/=) :: Inline t -> Inline t -> Bool #

Data t => Data (Inline t) 

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Inline t -> c (Inline t) #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c (Inline t) #

toConstr :: Inline t -> Constr #

dataTypeOf :: Inline t -> DataType #

dataCast1 :: Typeable (* -> *) t => (forall d. Data d => c (t d)) -> Maybe (c (Inline t)) #

dataCast2 :: Typeable (* -> * -> *) t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Inline t)) #

gmapT :: (forall b. Data b => b -> b) -> Inline t -> Inline t #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Inline t -> r #

gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Inline t -> r #

gmapQ :: (forall d. Data d => d -> u) -> Inline t -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> Inline t -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> Inline t -> m (Inline t) #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Inline t -> m (Inline t) #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Inline t -> m (Inline t) #

Ord t => Ord (Inline t) 

Methods

compare :: Inline t -> Inline t -> Ordering #

(<) :: Inline t -> Inline t -> Bool #

(<=) :: Inline t -> Inline t -> Bool #

(>) :: Inline t -> Inline t -> Bool #

(>=) :: Inline t -> Inline t -> Bool #

max :: Inline t -> Inline t -> Inline t #

min :: Inline t -> Inline t -> Inline t #

Read t => Read (Inline t) 
Show t => Show (Inline t) 

Methods

showsPrec :: Int -> Inline t -> ShowS #

show :: Inline t -> String #

showList :: [Inline t] -> ShowS #

IsString t => IsString (Inline t) 

Methods

fromString :: String -> Inline t #

Generic (Inline t) 

Associated Types

type Rep (Inline t) :: * -> * #

Methods

from :: Inline t -> Rep (Inline t) x #

to :: Rep (Inline t) x -> Inline t #

NFData t => NFData (Inline t) 

Methods

rnf :: Inline t -> () #

type Rep (Inline t) 
type Rep (Inline t) = D1 (MetaData "Inline" "Comark.Syntax" "comark-syntax-0.1.0-8JrBqAV8e8RCvtr00JYzUM" False) ((:+:) ((:+:) ((:+:) (C1 (MetaCons "Str" PrefixI False) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 t))) (C1 (MetaCons "Code" PrefixI False) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 t)))) ((:+:) (C1 (MetaCons "Emph" PrefixI False) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (Inlines t)))) (C1 (MetaCons "Strong" PrefixI False) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (Inlines t)))))) ((:+:) ((:+:) (C1 (MetaCons "Link" PrefixI False) ((:*:) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (Inlines t))) ((:*:) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 t)) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (Maybe t)))))) (C1 (MetaCons "Image" PrefixI False) ((:*:) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (Inlines t))) ((:*:) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 t)) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (Maybe t))))))) ((:+:) (C1 (MetaCons "RawHtml" PrefixI False) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 t))) ((:+:) (C1 (MetaCons "SoftBreak" PrefixI False) U1) (C1 (MetaCons "HardBreak" PrefixI False) U1)))))