{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeApplications #-} {- | Html5 formatting. The API is similar to < https://hackage.haskell.org/package/blaze-html >. -} module Data.Fmt.Html ( -- * Html Html, Attr, toHtml, comment, Element (..), (!?), numbers, -- * Elements docType, docTypeHtml, a, abbr, address, area, article, aside, audio, b, base, bdo, blockquote, body, br, button, canvas, caption, cite, code, col, colgroup, command, datalist, dd, del, details, dfn, div, dl, dt, em, embed, fieldset, figcaption, figure, footer, form, h1, h2, h3, h4, h5, h6, head, header, hgroup, hr, html, i, iframe, img, input, ins, kbd, keygen, label, legend, li, link, main, map, mark, menu, menuitem, meta, meter, nav, noscript, object, ol, optgroup, option, output, p, param, pre, progress, q, rp, rt, ruby, samp, script, section, select, small, source, span, strong, style, sub, summary, sup, table, tbody, td, textarea, tfoot, th, thead, time, title, tr, track, u, ul, var, video, wbr, contact ) where import Data.Fmt import Prelude hiding (div, head, map, span) import Data.Fmt.Attr (href) contact :: Html LogStr contact = p "You can reach me at" % ul . spr . li $ do c1 <- a ! href @String "https://example.com" $ "Website" c2 <- a ! href @String "mailto:cmk@example.com" $ "Email" pure $ c1 <> c2 -- "

You can reach me at

" -- | Run a monadic expression. -- -- This executes the formatting commands contained in the expression and -- returns the result as a variable. run :: Fmt m m n -> Fmt n a a run = fmt . runFmt -- > runLogFmt $ numbers 2 -- "

A list of numbers:

The end.

" numbers :: Int -> Html LogStr numbers n = html $ do l <- ul . cat $ li . toHtml <$> [1 .. n] cat [ p "A list of numbers:" , fmt l , p "The end." ] -- | Create a < https://en.wikipedia.org/wiki/HTML_element#Syntax tag > for an element. element :: String -> Html a -> Html a element = enclose <$> (enclose "<" ">" . toHtml) <*> (enclose "" . toHtml) element_ :: String -> Html a element_ = enclose "<" " />" . toHtml -- Elements ------------------------- {- | Combinator for the document type. This should be placed at the top of every HTML page. Example: > docType Result: > -} docType :: -- | The document type HTML. Html a docType = "\n" {-# INLINE docType #-} {- | Combinator for the @\@ element. This combinator will also insert the correct doctype. Example: > docTypeHtml $ span $ fmt "foo" Result: > > foo -} docTypeHtml :: -- | Inner HTML. Html a -> -- | Resulting HTML. Html a docTypeHtml inner = docType % html inner {-# INLINE docTypeHtml #-} {- | Combinator for the @\@ element. Example: > a $ span $ fmt "foo" Result: > foo -} a :: -- | Inner HTML. Html a -> -- | Resulting HTML. Html a a = element "a" {-# INLINE a #-} {- | Combinator for the @\@ element. Example: > abbr $ span $ fmt "foo" Result: > foo -} abbr :: -- | Inner HTML. Html a -> -- | Resulting HTML. Html a abbr = element "abbr" {-# INLINE abbr #-} {- | Combinator for the @\
@ element. Example: > address $ span $ fmt "foo" Result: >
foo
-} address :: -- | Inner HTML. Html a -> -- | Resulting HTML. Html a address = element "address" {-# INLINE address #-} {- | Combinator for the @\@ element. Example: > area Result: > -} area :: -- | Resulting HTML. Html a area = element_ "area" {-# INLINE area #-} {- | Combinator for the @\
@ element. Example: > article $ span $ fmt "foo" Result: >
foo
-} article :: -- | Inner HTML. Html a -> -- | Resulting HTML. Html a article = element "article" {-# INLINE article #-} {- | Combinator for the @\