nice-html-0.4.1: A fast and nice HTML templating library with distinct compilation/rendering phases.

Safe HaskellNone
LanguageHaskell2010

Text.Html.Nice.FreeMonad

Contents

Description

A Free monad-based HTML markup monad. Unlike the writer-like monad in Text.Html.Nice.Writer, sequencing bits of markup together results in them being nested, rather than concatenated.

There is no kitchen-sink of HTML5 elements provided. Use OverloadedLabels instead: #div :: Markup n () and #div :: MakeNode n () .

Since the monad and applicative of Markup here nests rather than concatenates, the function nodes is provided to put a list of nodes in sequence. You can use OverloadedLists for convenient syntax here.

Example Markup:

#html >>
[ title >> "Title goes here"
, #body >>
  [ #h1 >> "heading goes here"
  , #p >> "i am a paragraph below the heading"
  , do i <- branch [0..100]
       builder (decimal i)
  ]
]

Synopsis

Markup

data Markup n a Source #

Markup is a free monad based on the base functor to 'Markup\'F'

Beware: this is a wacky monad. >> does *not* sequence nodes together; instead, it nests them. To lay out nodes sequentially, use nodes.

Syntactic sugar

Markup supports OverloadedLabels, OverloadedStrings and OverloadedLists.

OverloadedStrings

("foo" :: Markup n a) = text "foo"

OverloadedLists

([a,b,c] :: Markup n a) = nodes [a,b,c]

OverloadedLabels

The IsLabel instances give a convenient way to write nodes.

Nodes without attributes

 (#foo :: Markup n a) = node "foo" []

Nodes with attributes

 attr #foo [a,b,c] = node "foo" [a,b,c]

Instances

Bifunctor Markup Source # 

Methods

bimap :: (a -> b) -> (c -> d) -> Markup a c -> Markup b d #

first :: (a -> b) -> Markup a c -> Markup b c #

second :: (b -> c) -> Markup a b -> Markup a c #

((~) * a (), KnownSymbol s) => IsLabel s (Markup n a) Source # 

Methods

fromLabel :: Markup n a #

Monad (Markup n) Source # 

Methods

(>>=) :: Markup n a -> (a -> Markup n b) -> Markup n b #

(>>) :: Markup n a -> Markup n b -> Markup n b #

return :: a -> Markup n a #

fail :: String -> Markup n a #

Functor (Markup n) Source # 

Methods

fmap :: (a -> b) -> Markup n a -> Markup n b #

(<$) :: a -> Markup n b -> Markup n a #

Applicative (Markup n) Source # 

Methods

pure :: a -> Markup n a #

(<*>) :: Markup n (a -> b) -> Markup n a -> Markup n b #

liftA2 :: (a -> b -> c) -> Markup n a -> Markup n b -> Markup n c #

(*>) :: Markup n a -> Markup n b -> Markup n b #

(<*) :: Markup n a -> Markup n b -> Markup n a #

MonadFree (Markup'F n) (Markup n) Source # 

Methods

wrap :: Markup'F n (Markup n a) -> Markup n a #

IsList (Markup n a) Source # 

Associated Types

type Item (Markup n a) :: * #

Methods

fromList :: [Item (Markup n a)] -> Markup n a #

fromListN :: Int -> [Item (Markup n a)] -> Markup n a #

toList :: Markup n a -> [Item (Markup n a)] #

IsString (Markup n a) Source # 

Methods

fromString :: String -> Markup n a #

Monoid (Markup n a) Source # 

Methods

mempty :: Markup n a #

mappend :: Markup n a -> Markup n a -> Markup n a #

mconcat :: [Markup n a] -> Markup n a #

Default (Markup n a) Source # 

Methods

def :: Markup n a #

type Item (Markup n a) Source # 
type Item (Markup n a) = Markup n a

data FastMarkup a Source #

Instances

Functor FastMarkup Source # 

Methods

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

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

Foldable FastMarkup Source # 

Methods

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

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

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

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

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

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

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

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

toList :: FastMarkup a -> [a] #

null :: FastMarkup a -> Bool #

length :: FastMarkup a -> Int #

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

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

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

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

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

Eq a => Eq (FastMarkup a) Source # 

Methods

(==) :: FastMarkup a -> FastMarkup a -> Bool #

(/=) :: FastMarkup a -> FastMarkup a -> Bool #

Show a => Show (FastMarkup a) Source # 
Generic (FastMarkup a) Source # 

Associated Types

type Rep (FastMarkup a) :: * -> * #

Methods

from :: FastMarkup a -> Rep (FastMarkup a) x #

to :: Rep (FastMarkup a) x -> FastMarkup a #

Monoid (FastMarkup a) Source # 
NFData a => NFData (FastMarkup a) Source # 

Methods

rnf :: FastMarkup a -> () #

ToFastMarkup (FastMarkup Void) Source # 
(Render a m, Monad m) => Render (FastMarkup a) m Source # 

Methods

r :: FastMarkup a -> m Builder Source #

type Rep (FastMarkup a) Source # 

Compiling

compile :: Markup n a -> FastMarkup n Source #

Compile a Html for use with render and its friends.

See also: compile_.

Rendering

Rendering through some monad

renderM :: Monad m => (a -> m Builder) -> FastMarkup a -> m Builder Source #

Render FastMarkup

renderMs :: Monad m => (a -> m (FastMarkup Void)) -> FastMarkup a -> m Builder Source #

Render FastMarkup by recursively rendering any sub-markup.

Pure rendering

render :: FastMarkup Void -> Builder Source #

Render FastMarkup that has no holes.

newtype Identity a :: * -> * #

Identity functor and monad. (a non-strict monad)

Since: 4.8.0.0

Constructors

Identity 

Fields

Instances

Monad Identity

Since: 4.8.0.0

Methods

(>>=) :: Identity a -> (a -> Identity b) -> Identity b #

(>>) :: Identity a -> Identity b -> Identity b #

return :: a -> Identity a #

fail :: String -> Identity a #

Functor Identity

Since: 4.8.0.0

Methods

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

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

MonadFix Identity

Since: 4.8.0.0

Methods

mfix :: (a -> Identity a) -> Identity a #

Applicative Identity

Since: 4.8.0.0

Methods

pure :: a -> Identity a #

(<*>) :: Identity (a -> b) -> Identity a -> Identity b #

liftA2 :: (a -> b -> c) -> Identity a -> Identity b -> Identity c #

(*>) :: Identity a -> Identity b -> Identity b #

(<*) :: Identity a -> Identity b -> Identity a #

Foldable Identity

Since: 4.8.0.0

Methods

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

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

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

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

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

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

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

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

toList :: Identity a -> [a] #

null :: Identity a -> Bool #

length :: Identity a -> Int #

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

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

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

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

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

Traversable Identity 

Methods

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

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

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

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

Eq1 Identity

Since: 4.9.0.0

Methods

liftEq :: (a -> b -> Bool) -> Identity a -> Identity b -> Bool #

Ord1 Identity

Since: 4.9.0.0

Methods

liftCompare :: (a -> b -> Ordering) -> Identity a -> Identity b -> Ordering #

Read1 Identity

Since: 4.9.0.0

Methods

liftReadsPrec :: (Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (Identity a) #

liftReadList :: (Int -> ReadS a) -> ReadS [a] -> ReadS [Identity a] #

liftReadPrec :: ReadPrec a -> ReadPrec [a] -> ReadPrec (Identity a) #

liftReadListPrec :: ReadPrec a -> ReadPrec [a] -> ReadPrec [Identity a] #

Show1 Identity

Since: 4.9.0.0

Methods

liftShowsPrec :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> Identity a -> ShowS #

liftShowList :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> [Identity a] -> ShowS #

Comonad Identity 

Methods

extract :: Identity a -> a #

duplicate :: Identity a -> Identity (Identity a) #

extend :: (Identity a -> b) -> Identity a -> Identity b #

ComonadApply Identity 

Methods

(<@>) :: Identity (a -> b) -> Identity a -> Identity b #

(@>) :: Identity a -> Identity b -> Identity b #

(<@) :: Identity a -> Identity b -> Identity a #

NFData1 Identity

Since: 1.4.3.0

Methods

liftRnf :: (a -> ()) -> Identity a -> () #

Bounded a => Bounded (Identity a) 
Enum a => Enum (Identity a) 
Eq a => Eq (Identity a) 

Methods

(==) :: Identity a -> Identity a -> Bool #

(/=) :: Identity a -> Identity a -> Bool #

Floating a => Floating (Identity a) 
Fractional a => Fractional (Identity a) 
Integral a => Integral (Identity a) 
Num a => Num (Identity a) 
Ord a => Ord (Identity a) 

Methods

compare :: Identity a -> Identity a -> Ordering #

(<) :: Identity a -> Identity a -> Bool #

(<=) :: Identity a -> Identity a -> Bool #

(>) :: Identity a -> Identity a -> Bool #

(>=) :: Identity a -> Identity a -> Bool #

max :: Identity a -> Identity a -> Identity a #

min :: Identity a -> Identity a -> Identity a #

Read a => Read (Identity a)

This instance would be equivalent to the derived instances of the Identity newtype if the runIdentity field were removed

Since: 4.8.0.0

Real a => Real (Identity a) 

Methods

toRational :: Identity a -> Rational #

RealFloat a => RealFloat (Identity a) 
RealFrac a => RealFrac (Identity a) 

Methods

properFraction :: Integral b => Identity a -> (b, Identity a) #

truncate :: Integral b => Identity a -> b #

round :: Integral b => Identity a -> b #

ceiling :: Integral b => Identity a -> b #

floor :: Integral b => Identity a -> b #

Show a => Show (Identity a)

This instance would be equivalent to the derived instances of the Identity newtype if the runIdentity field were removed

Since: 4.8.0.0

Methods

showsPrec :: Int -> Identity a -> ShowS #

show :: Identity a -> String #

showList :: [Identity a] -> ShowS #

Ix a => Ix (Identity a) 
IsString a => IsString (Identity a) 

Methods

fromString :: String -> Identity a #

Generic (Identity a) 

Associated Types

type Rep (Identity a) :: * -> * #

Methods

from :: Identity a -> Rep (Identity a) x #

to :: Rep (Identity a) x -> Identity a #

Semigroup a => Semigroup (Identity a)

Since: 4.9.0.0

Methods

(<>) :: Identity a -> Identity a -> Identity a #

sconcat :: NonEmpty (Identity a) -> Identity a #

stimes :: Integral b => b -> Identity a -> Identity a #

Monoid a => Monoid (Identity a) 

Methods

mempty :: Identity a #

mappend :: Identity a -> Identity a -> Identity a #

mconcat :: [Identity a] -> Identity a #

Storable a => Storable (Identity a) 

Methods

sizeOf :: Identity a -> Int #

alignment :: Identity a -> Int #

peekElemOff :: Ptr (Identity a) -> Int -> IO (Identity a) #

pokeElemOff :: Ptr (Identity a) -> Int -> Identity a -> IO () #

peekByteOff :: Ptr b -> Int -> IO (Identity a) #

pokeByteOff :: Ptr b -> Int -> Identity a -> IO () #

peek :: Ptr (Identity a) -> IO (Identity a) #

poke :: Ptr (Identity a) -> Identity a -> IO () #

Bits a => Bits (Identity a) 
FiniteBits a => FiniteBits (Identity a) 
NFData a => NFData (Identity a)

Since: 1.4.0.0

Methods

rnf :: Identity a -> () #

Generic1 * Identity 

Associated Types

type Rep1 Identity (f :: Identity -> *) :: k -> * #

Methods

from1 :: f a -> Rep1 Identity f a #

to1 :: Rep1 Identity f a -> f a #

type Rep (Identity a) 
type Rep (Identity a) = D1 * (MetaData "Identity" "Data.Functor.Identity" "base" True) (C1 * (MetaCons "Identity" PrefixI True) (S1 * (MetaSel (Just Symbol "runIdentity") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 * a)))
type Rep1 * Identity 
type Rep1 * Identity = D1 * (MetaData "Identity" "Data.Functor.Identity" "base" True) (C1 * (MetaCons "Identity" PrefixI True) (S1 * (MetaSel (Just Symbol "runIdentity") NoSourceUnpackedness NoSourceStrictness DecidedLazy) Par1))

Util

toLazyText :: Builder -> Text #

O(n). Extract a lazy Text from a Builder with a default buffer size. The construction work takes place if and when the relevant part of the lazy Text is demanded.

Special HTML elements

Basic node types

node :: Text -> [Attr n] -> Markup n () Source #

Make a node with some attributes.

data Attr a Source #

Constructors

(:=) 

Fields

(:-) 

Fields

Instances

Functor Attr Source # 

Methods

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

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

Foldable Attr Source # 

Methods

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

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

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

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

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

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

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

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

toList :: Attr a -> [a] #

null :: Attr a -> Bool #

length :: Attr a -> Int #

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

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

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

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

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

Traversable Attr Source # 

Methods

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

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

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

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

Eq a => Eq (Attr a) Source # 

Methods

(==) :: Attr a -> Attr a -> Bool #

(/=) :: Attr a -> Attr a -> Bool #

Show a => Show (Attr a) Source # 

Methods

showsPrec :: Int -> Attr a -> ShowS #

show :: Attr a -> String #

showList :: [Attr a] -> ShowS #

attr :: MakeNode n a -> [Attr n] -> Markup n a Source #

For use with OverloadedLabels.

 attr #x [a,b,c] = node "x" [a,b,c]

empty :: Markup n a Source #

Empty node. Terminates Markup to this point

Text types

text :: Text -> Markup n a Source #

Insert text and escape it

lazyText :: Text -> Markup n a Source #

Insert text and escape it

builder :: Builder -> Markup n a Source #

Insert text and escape it

unescape :: Text -> Markup n a Source #

Insert text and don't escape it

string :: String -> Markup n a Source #

Insert text and escape it

Dynamic nodes

dynamic :: n -> Markup n a Source #

Insert a dynamic value.

hole :: Markup (a -> a) t Source #

embed :: (t -> FastMarkup n) -> Markup (t -> FastMarkup n) a Source #

Insert a sub-template.

Sequential nodes

nodes :: [Markup n a] -> Markup n a Source #

For each element of a list, generate sequential markup

branch :: [a] -> Markup n a Source #

For each element of a list of branches, generate sequential markup

Streamed dynamic nodes

stream :: Foldable f => Markup (a -> n) r' -> Markup (f a -> FastMarkup n) r Source #

Combinators

sub :: Markup n a -> Markup (FastMarkup n) a Source #

Insert a sub-template.

Useful exports

Useful Builder functions

decimal :: Integral a => a -> Builder #

realFloat :: RealFloat a => a -> Builder #

Show a signed RealFloat value to full precision, using standard decimal notation for arguments whose absolute value lies between 0.1 and 9,999,999, and scientific notation otherwise.

fromText :: Text -> Builder #

O(1). A Builder taking a Text, satisfying

fromString :: String -> Builder #

O(1). A Builder taking a String, satisfying

fromLazyText :: Text -> Builder #

O(1). A Builder taking a lazy Text, satisfying

Text builder

data Builder :: * #

A Builder is an efficient way to build lazy Text values. There are several functions for constructing builders, but only one to inspect them: to extract any data, you have to turn them into lazy Text values using toLazyText.

Internally, a builder constructs a lazy Text by filling arrays piece by piece. As each buffer is filled, it is 'popped' off, to become a new chunk of the resulting lazy Text. All this is hidden from the user of the Builder.

Void type

data Void :: * #

Uninhabited data type

Since: 4.8.0.0

Instances

Eq Void

Since: 4.8.0.0

Methods

(==) :: Void -> Void -> Bool #

(/=) :: Void -> Void -> Bool #

Data Void 

Methods

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

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

toConstr :: Void -> Constr #

dataTypeOf :: Void -> DataType #

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

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

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

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

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

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

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

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

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

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

Ord Void

Since: 4.8.0.0

Methods

compare :: Void -> Void -> Ordering #

(<) :: Void -> Void -> Bool #

(<=) :: Void -> Void -> Bool #

(>) :: Void -> Void -> Bool #

(>=) :: Void -> Void -> Bool #

max :: Void -> Void -> Void #

min :: Void -> Void -> Void #

Read Void

Reading a Void value is always a parse error, considering Void as a data type with no constructors. | @since 4.8.0.0

Show Void

Since: 4.8.0.0

Methods

showsPrec :: Int -> Void -> ShowS #

show :: Void -> String #

showList :: [Void] -> ShowS #

Ix Void

Since: 4.8.0.0

Methods

range :: (Void, Void) -> [Void] #

index :: (Void, Void) -> Void -> Int #

unsafeIndex :: (Void, Void) -> Void -> Int

inRange :: (Void, Void) -> Void -> Bool #

rangeSize :: (Void, Void) -> Int #

unsafeRangeSize :: (Void, Void) -> Int

Generic Void 

Associated Types

type Rep Void :: * -> * #

Methods

from :: Void -> Rep Void x #

to :: Rep Void x -> Void #

Semigroup Void

Since: 4.9.0.0

Methods

(<>) :: Void -> Void -> Void #

sconcat :: NonEmpty Void -> Void #

stimes :: Integral b => b -> Void -> Void #

Exception Void

Since: 4.8.0.0

NFData Void

Defined as rnf = absurd.

Since: 1.4.0.0

Methods

rnf :: Void -> () #

Monad m => Render Void m Source # 

Methods

r :: Void -> m Builder Source #

ToFastMarkup (FastMarkup Void) Source # 
type Rep Void 
type Rep Void = D1 * (MetaData "Void" "Data.Void" "base" False) (V1 *)