{-# LANGUAGE CPP, OverloadedStrings #-}
{-# LANGUAGE BangPatterns, RankNTypes #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving #-}
{-# LANGUAGE UndecidableInstances #-}
module Lucid.Base
(
renderText
,renderBS
,renderTextT
,renderBST
,renderToFile
,execHtmlT
,evalHtmlT
,runHtmlT
,generalizeHtmlT
,commuteHtmlT2
,hoistHtmlT
,makeElement
,makeElementNoEnd
,makeAttributes
,makeAttributesRaw
,Attributes
,Html
,HtmlT
,Term(..)
,TermRaw(..)
,ToHtml(..)
,relaxHtmlT
,commuteHtmlT
)
where
import Data.ByteString.Builder (Builder)
import qualified Data.ByteString.Builder as Blaze
import qualified Blaze.ByteString.Builder.Html.Utf8 as Blaze
import Control.Applicative
import Control.Monad
import Control.Monad.Fix (MonadFix(..))
import Control.Monad.IO.Class (MonadIO(..))
import Control.Monad.Reader (MonadReader(..))
import Control.Monad.State.Class (MonadState(..))
import Control.Monad.Trans (MonadTrans(..))
import Control.Monad.Trans.State.Strict (StateT(..), modify', mapStateT)
import qualified Data.ByteString as S
import Data.ByteString.Lazy (ByteString)
import qualified Data.ByteString.Lazy as L
import Data.Foldable (toList)
import Data.Functor.Identity
import qualified Data.Map.Strict as M
import Data.Maybe
import Data.Sequence (Seq)
import qualified Data.Set as Set
import Data.String
import Data.Text (Text)
import qualified Data.Text.Encoding as T
import qualified Data.Text.Lazy as LT
import qualified Data.Text.Lazy.Encoding as LT
import Data.Tuple (swap)
import Prelude
data Attribute = Attribute !Text !Builder
newtype Attributes = Attributes { Attributes -> Seq Attribute
unAttributes :: Seq Attribute }
deriving (Semigroup Attributes
Attributes
[Attributes] -> Attributes
Attributes -> Attributes -> Attributes
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [Attributes] -> Attributes
$cmconcat :: [Attributes] -> Attributes
mappend :: Attributes -> Attributes -> Attributes
$cmappend :: Attributes -> Attributes -> Attributes
mempty :: Attributes
$cmempty :: Attributes
Monoid, NonEmpty Attributes -> Attributes
Attributes -> Attributes -> Attributes
forall b. Integral b => b -> Attributes -> Attributes
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: forall b. Integral b => b -> Attributes -> Attributes
$cstimes :: forall b. Integral b => b -> Attributes -> Attributes
sconcat :: NonEmpty Attributes -> Attributes
$csconcat :: NonEmpty Attributes -> Attributes
<> :: Attributes -> Attributes -> Attributes
$c<> :: Attributes -> Attributes -> Attributes
Semigroup)
type Html = HtmlT Identity
newtype HtmlT m a = HtmlT { forall (m :: * -> *) a. HtmlT m a -> StateT Builder m a
unHtmlT :: StateT Builder m a }
deriving (forall a. a -> HtmlT m a
forall a b. HtmlT m a -> HtmlT m b -> HtmlT m b
forall a b. HtmlT m a -> (a -> HtmlT m b) -> HtmlT m b
forall {m :: * -> *}. Monad m => Applicative (HtmlT m)
forall (m :: * -> *) a. Monad m => a -> HtmlT m a
forall (m :: * -> *) a b.
Monad m =>
HtmlT m a -> HtmlT m b -> HtmlT m b
forall (m :: * -> *) a b.
Monad m =>
HtmlT m a -> (a -> HtmlT m b) -> HtmlT m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> HtmlT m a
$creturn :: forall (m :: * -> *) a. Monad m => a -> HtmlT m a
>> :: forall a b. HtmlT m a -> HtmlT m b -> HtmlT m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
HtmlT m a -> HtmlT m b -> HtmlT m b
>>= :: forall a b. HtmlT m a -> (a -> HtmlT m b) -> HtmlT m b
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
HtmlT m a -> (a -> HtmlT m b) -> HtmlT m b
Monad, forall a b. a -> HtmlT m b -> HtmlT m a
forall a b. (a -> b) -> HtmlT m a -> HtmlT m b
forall (m :: * -> *) a b. Functor m => a -> HtmlT m b -> HtmlT m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> HtmlT m a -> HtmlT m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> HtmlT m b -> HtmlT m a
$c<$ :: forall (m :: * -> *) a b. Functor m => a -> HtmlT m b -> HtmlT m a
fmap :: forall a b. (a -> b) -> HtmlT m a -> HtmlT m b
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> HtmlT m a -> HtmlT m b
Functor, forall a. a -> HtmlT m a
forall a b. HtmlT m a -> HtmlT m b -> HtmlT m a
forall a b. HtmlT m a -> HtmlT m b -> HtmlT m b
forall a b. HtmlT m (a -> b) -> HtmlT m a -> HtmlT m b
forall a b c. (a -> b -> c) -> HtmlT m a -> HtmlT m b -> HtmlT m c
forall {m :: * -> *}. Monad m => Functor (HtmlT m)
forall (m :: * -> *) a. Monad m => a -> HtmlT m a
forall (m :: * -> *) a b.
Monad m =>
HtmlT m a -> HtmlT m b -> HtmlT m a
forall (m :: * -> *) a b.
Monad m =>
HtmlT m a -> HtmlT m b -> HtmlT m b
forall (m :: * -> *) a b.
Monad m =>
HtmlT m (a -> b) -> HtmlT m a -> HtmlT m b
forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> HtmlT m a -> HtmlT m b -> HtmlT m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b. HtmlT m a -> HtmlT m b -> HtmlT m a
$c<* :: forall (m :: * -> *) a b.
Monad m =>
HtmlT m a -> HtmlT m b -> HtmlT m a
*> :: forall a b. HtmlT m a -> HtmlT m b -> HtmlT m b
$c*> :: forall (m :: * -> *) a b.
Monad m =>
HtmlT m a -> HtmlT m b -> HtmlT m b
liftA2 :: forall a b c. (a -> b -> c) -> HtmlT m a -> HtmlT m b -> HtmlT m c
$cliftA2 :: forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> HtmlT m a -> HtmlT m b -> HtmlT m c
<*> :: forall a b. HtmlT m (a -> b) -> HtmlT m a -> HtmlT m b
$c<*> :: forall (m :: * -> *) a b.
Monad m =>
HtmlT m (a -> b) -> HtmlT m a -> HtmlT m b
pure :: forall a. a -> HtmlT m a
$cpure :: forall (m :: * -> *) a. Monad m => a -> HtmlT m a
Applicative, forall (m :: * -> *) a. Monad m => m a -> HtmlT m a
forall (t :: (* -> *) -> * -> *).
(forall (m :: * -> *) a. Monad m => m a -> t m a) -> MonadTrans t
lift :: forall (m :: * -> *) a. Monad m => m a -> HtmlT m a
$clift :: forall (m :: * -> *) a. Monad m => m a -> HtmlT m a
MonadTrans, forall a. (a -> HtmlT m a) -> HtmlT m a
forall (m :: * -> *).
Monad m -> (forall a. (a -> m a) -> m a) -> MonadFix m
forall {m :: * -> *}. MonadFix m => Monad (HtmlT m)
forall (m :: * -> *) a. MonadFix m => (a -> HtmlT m a) -> HtmlT m a
mfix :: forall a. (a -> HtmlT m a) -> HtmlT m a
$cmfix :: forall (m :: * -> *) a. MonadFix m => (a -> HtmlT m a) -> HtmlT m a
MonadFix)
instance MonadReader r m => MonadReader r (HtmlT m) where
ask :: HtmlT m r
ask = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall r (m :: * -> *). MonadReader r m => m r
ask
local :: forall a. (r -> r) -> HtmlT m a -> HtmlT m a
local r -> r
f (HtmlT StateT Builder m a
a) = forall (m :: * -> *) a. StateT Builder m a -> HtmlT m a
HtmlT (forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local r -> r
f StateT Builder m a
a)
instance MonadState s m => MonadState s (HtmlT m) where
get :: HtmlT m s
get = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall s (m :: * -> *). MonadState s m => m s
get
put :: s -> HtmlT m ()
put = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *). MonadState s m => s -> m ()
put
state :: forall a. (s -> (a, s)) -> HtmlT m a
state = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state
runHtmlT :: Monad m => HtmlT m a -> m (Builder, a)
runHtmlT :: forall (m :: * -> *) a. Monad m => HtmlT m a -> m (Builder, a)
runHtmlT = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> (b, a)
swap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT forall a. Monoid a => a
mempty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. HtmlT m a -> StateT Builder m a
unHtmlT
hoistHtmlT :: (Monad m, Monad n) => (forall a. m a -> n a) -> HtmlT m b -> HtmlT n b
hoistHtmlT :: forall (m :: * -> *) (n :: * -> *) b.
(Monad m, Monad n) =>
(forall a. m a -> n a) -> HtmlT m b -> HtmlT n b
hoistHtmlT forall a. m a -> n a
f (HtmlT StateT Builder m b
xs) = forall (m :: * -> *) a. StateT Builder m a -> HtmlT m a
HtmlT (forall (m :: * -> *) a s (n :: * -> *) b.
(m (a, s) -> n (b, s)) -> StateT s m a -> StateT s n b
mapStateT forall a. m a -> n a
f StateT Builder m b
xs)
instance (a ~ (),Monad m) => Semigroup (HtmlT m a) where
<> :: HtmlT m a -> HtmlT m a -> HtmlT m a
(<>) = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. Semigroup a => a -> a -> a
(<>)
instance (a ~ (),Monad m) => Monoid (HtmlT m a) where
mempty :: HtmlT m a
mempty = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty
mappend :: HtmlT m a -> HtmlT m a -> HtmlT m a
mappend = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. Monoid a => a -> a -> a
mappend
instance MonadIO m => MonadIO (HtmlT m) where
liftIO :: forall a. IO a -> HtmlT m a
liftIO = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
instance (Monad m,a ~ ()) => IsString (HtmlT m a) where
fromString :: String -> HtmlT m a
fromString = forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
toHtml
instance (m ~ Identity) => Show (HtmlT m a) where
show :: HtmlT m a -> String
show = Text -> String
LT.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Html a -> Text
renderText
class ToHtml a where
toHtml :: Monad m => a -> HtmlT m ()
toHtmlRaw :: Monad m => a -> HtmlT m ()
instance (a ~ (), m ~ Identity) => ToHtml (HtmlT m a) where
toHtml :: forall (m :: * -> *). Monad m => HtmlT m a -> HtmlT m ()
toHtml = forall (m :: * -> *) a. Monad m => HtmlT Identity a -> HtmlT m a
generalizeHtmlT
toHtmlRaw :: forall (m :: * -> *). Monad m => HtmlT m a -> HtmlT m ()
toHtmlRaw = forall (m :: * -> *) a. Monad m => HtmlT Identity a -> HtmlT m a
generalizeHtmlT
instance ToHtml String where
toHtml :: forall (m :: * -> *). Monad m => String -> HtmlT m ()
toHtml = forall (m :: * -> *). Monad m => Builder -> HtmlT m ()
write forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Builder
Blaze.fromHtmlEscapedString
toHtmlRaw :: forall (m :: * -> *). Monad m => String -> HtmlT m ()
toHtmlRaw = forall (m :: * -> *). Monad m => Builder -> HtmlT m ()
write forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Builder
Blaze.fromString
instance ToHtml Text where
toHtml :: forall (m :: * -> *). Monad m => Text -> HtmlT m ()
toHtml = forall (m :: * -> *). Monad m => Builder -> HtmlT m ()
write forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Builder
Blaze.fromHtmlEscapedText
toHtmlRaw :: forall (m :: * -> *). Monad m => Text -> HtmlT m ()
toHtmlRaw = forall (m :: * -> *). Monad m => Builder -> HtmlT m ()
write forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Builder
Blaze.fromText
instance ToHtml LT.Text where
toHtml :: forall (m :: * -> *). Monad m => Text -> HtmlT m ()
toHtml = forall (m :: * -> *). Monad m => Builder -> HtmlT m ()
write forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Builder
Blaze.fromHtmlEscapedLazyText
toHtmlRaw :: forall (m :: * -> *). Monad m => Text -> HtmlT m ()
toHtmlRaw = forall (m :: * -> *). Monad m => Builder -> HtmlT m ()
write forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Builder
Blaze.fromLazyText
instance ToHtml S.ByteString where
toHtml :: forall (m :: * -> *). Monad m => ByteString -> HtmlT m ()
toHtml = forall (m :: * -> *). Monad m => Builder -> HtmlT m ()
write forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Builder
Blaze.fromHtmlEscapedText forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
T.decodeUtf8
toHtmlRaw :: forall (m :: * -> *). Monad m => ByteString -> HtmlT m ()
toHtmlRaw = forall (m :: * -> *). Monad m => Builder -> HtmlT m ()
write forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Builder
Blaze.byteString
instance ToHtml L.ByteString where
toHtml :: forall (m :: * -> *). Monad m => ByteString -> HtmlT m ()
toHtml = forall (m :: * -> *). Monad m => Builder -> HtmlT m ()
write forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Builder
Blaze.fromHtmlEscapedLazyText forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
LT.decodeUtf8
toHtmlRaw :: forall (m :: * -> *). Monad m => ByteString -> HtmlT m ()
toHtmlRaw = forall (m :: * -> *). Monad m => Builder -> HtmlT m ()
write forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Builder
Blaze.lazyByteString
class Term arg result | result -> arg where
term :: Text
-> arg
-> result
instance (Monad m,f ~ HtmlT m a) => Term [Attributes] (f -> HtmlT m a) where
term :: Text -> [Attributes] -> f -> HtmlT m a
term Text
name = forall (m :: * -> *) a.
Monad m =>
Text -> [Attributes] -> HtmlT m a -> HtmlT m a
makeElement Text
name
instance (Monad m) => Term (HtmlT m a) (HtmlT m a) where
term :: Text -> HtmlT m a -> HtmlT m a
term Text
name = forall (m :: * -> *) a.
Monad m =>
Text -> [Attributes] -> HtmlT m a -> HtmlT m a
makeElement Text
name forall a. Monoid a => a
mempty
{-# INLINE term #-}
instance Term Text Attributes where
term :: Text -> Text -> Attributes
term Text
key Text
value = Text -> Text -> Attributes
makeAttributes Text
key Text
value
class TermRaw arg result | result -> arg where
termRaw :: Text
-> arg
-> result
instance (Monad m,ToHtml f, a ~ ()) => TermRaw [Attributes] (f -> HtmlT m a) where
termRaw :: Text -> [Attributes] -> f -> HtmlT m a
termRaw Text
name [Attributes]
attrs = forall (m :: * -> *) a.
Monad m =>
Text -> [Attributes] -> HtmlT m a -> HtmlT m a
makeElement Text
name [Attributes]
attrs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
toHtmlRaw
instance (Monad m,a ~ ()) => TermRaw Text (HtmlT m a) where
termRaw :: Text -> Text -> HtmlT m a
termRaw Text
name = forall (m :: * -> *) a.
Monad m =>
Text -> [Attributes] -> HtmlT m a -> HtmlT m a
makeElement Text
name forall a. Monoid a => a
mempty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
toHtmlRaw
instance TermRaw Text Attributes where
termRaw :: Text -> Text -> Attributes
termRaw Text
key Text
value = Text -> Text -> Attributes
makeAttributesRaw Text
key Text
value
renderToFile :: FilePath -> Html a -> IO ()
renderToFile :: forall a. String -> Html a -> IO ()
renderToFile String
fp = String -> ByteString -> IO ()
L.writeFile String
fp forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
Blaze.toLazyByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Identity a -> a
runIdentity forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => HtmlT m a -> m Builder
execHtmlT
renderBS :: Html a -> ByteString
renderBS :: forall a. Html a -> ByteString
renderBS = Builder -> ByteString
Blaze.toLazyByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Identity a -> a
runIdentity forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => HtmlT m a -> m Builder
execHtmlT
renderText :: Html a -> LT.Text
renderText :: forall a. Html a -> Text
renderText = ByteString -> Text
LT.decodeUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
Blaze.toLazyByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Identity a -> a
runIdentity forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => HtmlT m a -> m Builder
execHtmlT
renderBST :: Monad m => HtmlT m a -> m ByteString
renderBST :: forall (m :: * -> *) a. Monad m => HtmlT m a -> m ByteString
renderBST = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Builder -> ByteString
Blaze.toLazyByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => HtmlT m a -> m Builder
execHtmlT
renderTextT :: Monad m => HtmlT m a -> m LT.Text
renderTextT :: forall (m :: * -> *) a. Monad m => HtmlT m a -> m Text
renderTextT = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ByteString -> Text
LT.decodeUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
Blaze.toLazyByteString) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => HtmlT m a -> m Builder
execHtmlT
execHtmlT :: Monad m
=> HtmlT m a
-> m Builder
execHtmlT :: forall (m :: * -> *) a. Monad m => HtmlT m a -> m Builder
execHtmlT HtmlT m a
m =
do (Builder
builder,a
_) <- forall (m :: * -> *) a. Monad m => HtmlT m a -> m (Builder, a)
runHtmlT HtmlT m a
m
forall (m :: * -> *) a. Monad m => a -> m a
return Builder
builder
{-# inline execHtmlT #-}
generalizeHtmlT ::
Monad m
=> HtmlT Identity a
-> HtmlT m a
generalizeHtmlT :: forall (m :: * -> *) a. Monad m => HtmlT Identity a -> HtmlT m a
generalizeHtmlT = forall (m :: * -> *) (n :: * -> *) b.
(Monad m, Monad n) =>
(forall a. m a -> n a) -> HtmlT m b -> HtmlT n b
hoistHtmlT forall (m :: * -> *) a. Monad m => Identity a -> m a
go
where
go :: Monad m => Identity a -> m a
go :: forall (m :: * -> *) a. Monad m => Identity a -> m a
go = forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Identity a -> a
runIdentity
commuteHtmlT2 :: (Monad m, Monad n)
=> HtmlT m a
-> m (HtmlT n a)
commuteHtmlT2 :: forall (m :: * -> *) (n :: * -> *) a.
(Monad m, Monad n) =>
HtmlT m a -> m (HtmlT n a)
commuteHtmlT2 HtmlT m a
h = do
(Builder
builder, a
a) <- forall (m :: * -> *) a. Monad m => HtmlT m a -> m (Builder, a)
runHtmlT HtmlT m a
h
forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. StateT Builder m a -> HtmlT m a
HtmlT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify' (forall a. Semigroup a => a -> a -> a
<> Builder
builder) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return a
a
evalHtmlT :: Monad m
=> HtmlT m a
-> m a
evalHtmlT :: forall (m :: * -> *) a. Monad m => HtmlT m a -> m a
evalHtmlT HtmlT m a
m =
do (Builder
_,a
a) <- forall (m :: * -> *) a. Monad m => HtmlT m a -> m (Builder, a)
runHtmlT HtmlT m a
m
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
makeAttributes :: Text
-> Text
-> Attributes
makeAttributes :: Text -> Text -> Attributes
makeAttributes Text
x Text
y = Seq Attribute -> Attributes
Attributes (forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Builder -> Attribute
Attribute Text
x (Text -> Builder
Blaze.fromHtmlEscapedText Text
y)))
makeAttributesRaw ::
Text
-> Text
-> Attributes
makeAttributesRaw :: Text -> Text -> Attributes
makeAttributesRaw Text
x Text
y = Seq Attribute -> Attributes
Attributes (forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Builder -> Attribute
Attribute Text
x (Text -> Builder
Blaze.fromText Text
y)))
makeElement :: Monad m
=> Text
-> [Attributes]
-> HtmlT m a
-> HtmlT m a
{-# INLINE[1] makeElement #-}
makeElement :: forall (m :: * -> *) a.
Monad m =>
Text -> [Attributes] -> HtmlT m a -> HtmlT m a
makeElement Text
name [Attributes]
attr HtmlT m a
children = do
forall (m :: * -> *). Monad m => Builder -> HtmlT m ()
write
(String -> Builder
s String
"<" forall a. Semigroup a => a -> a -> a
<> Text -> Builder
Blaze.fromText Text
name forall a. Semigroup a => a -> a -> a
<> (Text -> Builder -> Builder) -> Seq Attribute -> Builder
foldlMapWithKey Text -> Builder -> Builder
buildAttr ([Attributes] -> Seq Attribute
attributeList [Attributes]
attr) forall a. Semigroup a => a -> a -> a
<> String -> Builder
s String
">")
a
v <- HtmlT m a
children
forall (m :: * -> *). Monad m => Builder -> HtmlT m ()
write (String -> Builder
s String
"</" forall a. Semigroup a => a -> a -> a
<> Text -> Builder
Blaze.fromText Text
name forall a. Semigroup a => a -> a -> a
<> String -> Builder
s String
">")
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
v
makeElementNoEnd :: Monad m
=> Text
-> [Attributes]
-> HtmlT m ()
makeElementNoEnd :: forall (m :: * -> *). Monad m => Text -> [Attributes] -> HtmlT m ()
makeElementNoEnd Text
name [Attributes]
attr =
forall (m :: * -> *). Monad m => Builder -> HtmlT m ()
write
(String -> Builder
s String
"<" forall a. Semigroup a => a -> a -> a
<> Text -> Builder
Blaze.fromText Text
name forall a. Semigroup a => a -> a -> a
<> (Text -> Builder -> Builder) -> Seq Attribute -> Builder
foldlMapWithKey Text -> Builder -> Builder
buildAttr ([Attributes] -> Seq Attribute
attributeList [Attributes]
attr) forall a. Semigroup a => a -> a -> a
<> String -> Builder
s String
">")
buildAttr :: Text -> Builder -> Builder
buildAttr :: Text -> Builder -> Builder
buildAttr Text
key Builder
val = String -> Builder
s String
" " forall a. Semigroup a => a -> a -> a
<> Text -> Builder
Blaze.fromText Text
key forall a. Semigroup a => a -> a -> a
<> String -> Builder
s String
"=\"" forall a. Semigroup a => a -> a -> a
<> Builder
val forall a. Semigroup a => a -> a -> a
<> String -> Builder
s String
"\""
foldlMapWithKey :: (Text -> Builder -> Builder) -> Seq Attribute -> Builder
foldlMapWithKey :: (Text -> Builder -> Builder) -> Seq Attribute -> Builder
foldlMapWithKey Text -> Builder -> Builder
f Seq Attribute
attributes =
case forall a. Ord a => [a] -> Maybe [a]
nubOrdMaybe (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(Text, Builder)]
pairs) of
Just [Text]
keyList ->
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\Text
k -> forall a. a -> Maybe a -> a
fromMaybe forall a. Monoid a => a
mempty (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> Builder -> Builder
f Text
k) (forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
k Map Text Builder
values))) [Text]
keyList
where values :: Map Text Builder
values = forall k a. Ord k => (k -> a -> a -> a) -> [(k, a)] -> Map k a
M.fromListWithKey Text -> Builder -> Builder -> Builder
combineAttributes [(Text, Builder)]
pairs
Maybe [Text]
Nothing -> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\(Attribute Text
k Builder
v) -> Text -> Builder -> Builder
f Text
k Builder
v) Seq Attribute
attributes
where
pairs :: [(Text, Builder)]
pairs = forall a b. (a -> b) -> [a] -> [b]
map (\(Attribute Text
k Builder
v) -> (Text
k,Builder
v)) (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq Attribute
attributes)
combineAttributes :: Text -> Builder -> Builder -> Builder
combineAttributes :: Text -> Builder -> Builder -> Builder
combineAttributes Text
"class" Builder
v2 Builder
v1 = Builder
v1 forall a. Semigroup a => a -> a -> a
<> Builder
" " forall a. Semigroup a => a -> a -> a
<> Builder
v2
combineAttributes Text
"style" Builder
v2 Builder
v1 = Builder
v1 forall a. Semigroup a => a -> a -> a
<> Builder
";" forall a. Semigroup a => a -> a -> a
<> Builder
v2
combineAttributes Text
_ Builder
v2 Builder
v1 = Builder
v1 forall a. Semigroup a => a -> a -> a
<> Builder
v2
nubOrdMaybe :: Ord a => [a] -> Maybe [a]
nubOrdMaybe :: forall a. Ord a => [a] -> Maybe [a]
nubOrdMaybe = forall {a}. Ord a => Bool -> Set a -> [a] -> [a] -> Maybe [a]
go Bool
False forall a. Set a
Set.empty []
where
go :: Bool -> Set a -> [a] -> [a] -> Maybe [a]
go (!Bool
removed) Set a
set [a]
acc (a
x:[a]
xs)
| a
x forall a. Ord a => a -> Set a -> Bool
`Set.member` Set a
set = Bool -> Set a -> [a] -> [a] -> Maybe [a]
go Bool
True Set a
set [a]
acc [a]
xs
| Bool
otherwise = Bool -> Set a -> [a] -> [a] -> Maybe [a]
go Bool
removed (forall a. Ord a => a -> Set a -> Set a
Set.insert a
x Set a
set) (a
x forall a. a -> [a] -> [a]
: [a]
acc) [a]
xs
go Bool
removed Set a
_set [a]
acc [] =
if Bool
removed
then forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. [a] -> [a]
reverse [a]
acc)
else forall a. Maybe a
Nothing
s :: String -> Builder
s :: String -> Builder
s = String -> Builder
Blaze.fromString
{-# INLINE s #-}
write :: Monad m => Builder -> HtmlT m ()
write :: forall (m :: * -> *). Monad m => Builder -> HtmlT m ()
write Builder
b = forall (m :: * -> *) a. StateT Builder m a -> HtmlT m a
HtmlT (forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify' (forall a. Semigroup a => a -> a -> a
<> Builder
b))
{-# inline write #-}
attributeList :: [Attributes] -> Seq Attribute
attributeList :: [Attributes] -> Seq Attribute
attributeList = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Attributes -> Seq Attribute
unAttributes
relaxHtmlT :: Monad m => HtmlT Identity a -> HtmlT m a
relaxHtmlT :: forall (m :: * -> *) a. Monad m => HtmlT Identity a -> HtmlT m a
relaxHtmlT = forall a. HasCallStack => a
undefined
{-# DEPRECATED relaxHtmlT "DO NOT USE. This was exported accidentally and throws an exception." #-}
commuteHtmlT :: (Monad m, Monad n)
=> HtmlT m a
-> m (HtmlT n a)
commuteHtmlT :: forall (m :: * -> *) (n :: * -> *) a.
(Monad m, Monad n) =>
HtmlT m a -> m (HtmlT n a)
commuteHtmlT HtmlT m a
h = do
(Builder
builder, a
a) <- forall (m :: * -> *) a. Monad m => HtmlT m a -> m (Builder, a)
runHtmlT HtmlT m a
h
forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. StateT Builder m a -> HtmlT m a
HtmlT forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *). MonadState s m => s -> m ()
put Builder
builder forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return a
a
{-# DEPRECATED commuteHtmlT "This has incorrect behavior and will lose HTML output. See commuteHtmlT2." #-}