Safe Haskell | None |
---|---|
Language | Haskell98 |
Clear to write, read and edit DSL for writing HTML
See Lucid.Html5 for a complete list of Html5 combinators. That module is re-exported from this module for your convenience.
See Lucid.Base for lower level functions like
makeElement
, makeAttribute
, termRaw
, etc.
To convert html to the lucid DSL, use the (experimental) program lucid-from-html which may eventually be integrated into lucid itself.
- renderText :: Html a -> Text
- renderBS :: Html a -> ByteString
- renderTextT :: Monad m => HtmlT m a -> m Text
- renderBST :: Monad m => HtmlT m a -> m ByteString
- renderToFile :: FilePath -> Html a -> IO ()
- execHtmlT :: Monad m => HtmlT m a -> m Builder
- evalHtmlT :: Monad m => HtmlT m a -> m a
- runHtmlT :: HtmlT m a -> m (HashMap Text Text -> Builder, a)
- type Html = HtmlT Identity
- data HtmlT m a
- data Attribute
- class Term arg result | result -> arg where
- class ToHtml a where
- class With a where
- module Lucid.Html5
Intro
HTML terms in Lucid are written with a postfix ‘_
’ to indicate data
rather than code. Some examples:
Note: If you're testing in the REPL you need to add a type annotation to indicate that you want HTML. In normal code your top-level declaration signatures handle that.
For GHCi:
:set -XOverloadedStrings -XExtendedDefaultRules@ import Lucid
In a module: {-# LANGUAGE OverloadedStrings, ExtendedDefaultRules #-}
Plain text is written like this, and is automatically escaped:
>>>
"123 < 456" :: Html ()
123 < 456
Except some elements, like script_
:
>>>
script_ "alert('Hello!' > 12)" :: Html ()
<script>alert('Hello!' > 12)</script>
Elements nest by function application:
>>>
table_ (tr_ (td_ (p_ "Hello, World!"))) :: Html ()
<table><tr><td><p>Hello, World!</p></td></tr></table>
Elements are juxtaposed via monoidal append (remember to import Data.Monoid):
>>>
p_ "hello" <> p_ "sup" :: Html ()
<p>hello</p><p>sup</p>
Or monadic sequencing:
>>>
div_ (do p_ "hello"; p_ "sup") :: Html ()
<div><p>hello</p><p>sup</p></div>
Attributes are set by providing an argument list:
>>>
p_ [class_ "brand"] "Lucid Inc" :: Html ()
<p class="brand">Lucid Inc</p>
>>>
p_ [data_ "zot" "foo",checked_] "Go!" :: Html ()
<p data-zot="foo" checked>go</p>
Attribute and element terms are not conflicting:
>>>
style_ [style_ "inception"] "Go deeper." :: Html ()
<style style="inception">Go deeper.</style>
Here is a fuller example of Lucid:
table_ [rows_ "2"] (tr_ (do td_ [class_ "top",colspan_ "2",style_ "color:red"] (p_ "Hello, attributes!") td_ "yay!"))
Elements (and some attributes) are variadic and overloaded, see the
Term
class for more explanation about that.
For proper rendering you can easily run some HTML immediately with:
>>>
renderText (p_ "Hello!")
> "<p>Hello!</p>"
>>>
renderBS (p_ [style_ "color:red"] "Hello!")
"<p style=\"color:red\">Hello!</p>"
For ease of use in GHCi, there is a Show
instance, as
demonstrated above.
renderText :: Html a -> Text Source #
Render the HTML to a lazy Text
.
This is a convenience function defined in terms of execHtmlT
,
runIdentity
and toLazyByteString
, and
decodeUtf8
. Check the source if you're interested in the
lower-level behaviour.
renderBS :: Html a -> ByteString Source #
Render the HTML to a lazy ByteString
.
This is a convenience function defined in terms of execHtmlT
,
runIdentity
and toLazyByteString
. Check the source if
you're interested in the lower-level behaviour.
renderTextT :: Monad m => HtmlT m a -> m Text Source #
Render the HTML to a lazy Text
, but in a monad.
This is a convenience function defined in terms of execHtmlT
and
toLazyByteString
, and decodeUtf8
. Check the source if
you're interested in the lower-level behaviour.
renderBST :: Monad m => HtmlT m a -> m ByteString Source #
Render the HTML to a lazy ByteString
, but in a monad.
This is a convenience function defined in terms of execHtmlT
and
toLazyByteString
. Check the source if you're interested in
the lower-level behaviour.
renderToFile :: FilePath -> Html a -> IO () Source #
Render the HTML to a lazy ByteString
.
This is a convenience function defined in terms of execHtmlT
,
runIdentity
and toLazyByteString
. Check the source if
you're interested in the lower-level behaviour.
Running
If the above rendering functions aren't suited for your purpose,
you can run the monad directly and use the more low-level blaze
Builder
, which has a plethora of output modes in
Blaze.ByteString.Builder.
Build the HTML. Analogous to execState
.
You might want to use this is if you want to do something with the
raw Builder
. Otherwise for simple cases you can just use
renderText
or renderBS
.
:: Monad m | |
=> HtmlT m a | HTML monad to evaluate. |
-> m a | Ignore the HTML output and just return the value. |
Evaluate the HTML to its return value. Analogous to evalState
.
Use this if you want to ignore the HTML output of an action completely and just get the result.
For using with the Html
type, you'll need runIdentity
e.g.
>>>
runIdentity (evalHtmlT (p_ "Hello!"))
()
Types
A monad transformer that generates HTML. Use the simpler Html
type if you don't want to transform over some other monad.
MonadTrans HtmlT Source # | Used for |
MonadError e m => MonadError e (HtmlT m) Source # | Since: 2.9.9 |
MonadReader r m => MonadReader r (HtmlT m) Source # | Since: 2.9.7 |
MonadState s m => MonadState s (HtmlT m) Source # | Since: 2.9.7 |
MonadWriter w m => MonadWriter w (HtmlT m) Source # | Since: 2.9.9 |
(Monad m, (~) * a ()) => TermRaw Text (HtmlT m a) Source # | Given children immediately, just use that and expect no attributes. |
Monad m => Monad (HtmlT m) Source # | Basically acts like Writer. |
Monad m => Functor (HtmlT m) Source # | Just re-uses Monad. |
Monad m => Applicative (HtmlT m) Source # | Based on the monad instance. |
MonadIO m => MonadIO (HtmlT m) Source # | If you want to use IO in your HTML generation. |
MFunctor * HtmlT Source # | Since: 2.9.5 |
(Monad m, ToHtml f, (~) * a ()) => TermRaw [Attribute] (f -> HtmlT m a) Source # | Given attributes, expect more child input. |
(Monad m, (~) * f (HtmlT m a)) => Term [Attribute] (f -> HtmlT m a) Source # | Given attributes, expect more child input. |
(~) (* -> *) m Identity => Show (HtmlT m a) Source # | Just calls |
(Monad m, (~) * a ()) => IsString (HtmlT m a) Source # | We pack it via string. Could possibly encode straight into a builder. That might be faster. |
((~) * a (), Monad m) => Semigroup (HtmlT m a) Source # | Since: 2.9.7 |
((~) * a (), Monad m) => Monoid (HtmlT m a) Source # | Monoid is right-associative, a la the |
Monad m => With (HtmlT m a -> HtmlT m a) Source # | For the contentful elements: |
Monad m => With (HtmlT m a) Source # | For the contentless elements: |
((~) * a (), (~) (* -> *) m Identity) => ToHtml (HtmlT m a) Source # | Since: 2.9.8 |
Monad m => Term (HtmlT m a) (HtmlT m a) Source # | Given children immediately, just use that and expect no attributes. |
A simple attribute. Don't use the constructor, use makeAttribute
.
Eq Attribute Source # | |
Show Attribute Source # | |
Hashable Attribute Source # | |
TermRaw Text Attribute Source # | Some termRaws (like |
Term Text Attribute Source # | Some terms (like |
(Monad m, ToHtml f, (~) * a ()) => TermRaw [Attribute] (f -> HtmlT m a) Source # | Given attributes, expect more child input. |
(Monad m, (~) * f (HtmlT m a)) => Term [Attribute] (f -> HtmlT m a) Source # | Given attributes, expect more child input. |
Classes
To support convenient use of HTML terms, HTML terms are overloaded. Here are the following types possible for an element term accepting attributes and/or children:
p_ :: Term arg result => arg -> result p_ :: Monad m => [Attribute] -> HtmlT m () -> HtmlT m () p_ :: Monad m => HtmlT m () -> HtmlT m ()
The first is the generic form. The latter two are the possible types for an element.
Elements that accept no content are always concrete:
input_ :: Monad m => [Attribute] -> HtmlT m ()
And some attributes share the same name as attributes, so you can also overload them as attributes:
style_ :: TermRaw arg result => arg -> result style_ :: Monad m => [Attribute] -> Text -> HtmlT m () style_ :: Monad m => Text -> HtmlT m () style_ :: Text -> Attribute
class Term arg result | result -> arg where Source #
Used to construct HTML terms.
Simplest use: p_ = term "p" yields p_
.
Very overloaded for three cases:
- The first case is the basic
arg
of[(Text,Text)]
which will return a function that wants children. - The second is an
arg
which isHtmlT m ()
, in which case the term accepts no attributes and just the children are used for the element. - Finally, this is also used for overloaded attributes, like
style_
ortitle_
. If a return type of(Text,Text)
is inferred then an attribute will be made.
The instances look intimidating but actually the constraints make
it very general so that type inference works well even in the
presence of things like OverloadedLists
and such.
term :: Text -> arg -> result Source #
Used for constructing elements e.g. term "p"
yields p_
.
termWith :: Text -> [Attribute] -> arg -> result Source #
Use this if you want to make an element which inserts some pre-prepared attributes into the element.
Term Text Attribute Source # | Some terms (like |
(Monad m, (~) * f (HtmlT m a)) => Term [Attribute] (f -> HtmlT m a) Source # | Given attributes, expect more child input. |
Monad m => Term (HtmlT m a) (HtmlT m a) Source # | Given children immediately, just use that and expect no attributes. |
Can be converted to HTML.
toHtml :: Monad m => a -> HtmlT m () Source #
Convert to HTML, doing HTML escaping.
toHtmlRaw :: Monad m => a -> HtmlT m () Source #
Convert to HTML without any escaping.
ToHtml String Source # | |
ToHtml ByteString Source # | This instance requires the ByteString to contain UTF-8 encoded
text, for the Since: 2.9.5 |
ToHtml ByteString Source # | This instance requires the ByteString to contain UTF-8 encoded
text, for the Since: 2.9.5 |
ToHtml Text Source # | |
ToHtml Text Source # | |
((~) * a (), (~) (* -> *) m Identity) => ToHtml (HtmlT m a) Source # | Since: 2.9.8 |
With an element use these attributes. An overloaded way of adding attributes either to an element accepting attributes-and-children or one that just accepts attributes. See the two instances.
Re-exports
module Lucid.Html5