{-# LANGUAGE OverloadedStrings, GeneralizedNewtypeDeriving, Rank2Types,
             FlexibleInstances, ExistentialQuantification,
             DeriveDataTypeable, MultiParamTypeClasses, DeriveFunctor,
             FunctionalDependencies #-}
-- | The BlazeMarkup core, consisting of functions that offer the power to
-- generate custom markup elements. It also offers user-centric functions,
-- which are exposed through 'Text.Blaze'.
--
-- While this module is exported, usage of it is not recommended, unless you
-- know what you are doing. This module might undergo changes at any time.
--
module Text.Blaze.Front.Internal
    (
      -- * Important types.
      ChoiceString (..)
    , StaticString (..)
    , MarkupM (..)
    , Markup
    , Tag
    , Attribute (..)
    , AttributeValue(..)


      -- * Creating custom tags and attributes.
    , customParent
    , customLeaf
    , attribute
    , dataAttribute
    , customAttribute

      -- * Converting values to Markup.
    , text
    , preEscapedText
    , lazyText
    , preEscapedLazyText
    , string
    , preEscapedString
    , unsafeByteString
    , unsafeLazyByteString

      -- * Converting values to tags.
    , textTag
    , stringTag

      -- * Converting values to attribute values.
    , textValue
    , preEscapedTextValue
    , lazyTextValue
    , preEscapedLazyTextValue
    , stringValue
    , preEscapedStringValue
    , unsafeByteStringValue
    , unsafeLazyByteStringValue

      -- * Setting attributes
    , Attributable
    , (!)
    , (!?)

      -- * Modifying Markup elements
    , contents
    , external

      -- * Querying Markup elements
    , null
    ) where

import           Control.Applicative

import           Data.ByteString.Char8        (ByteString)
import qualified Data.ByteString              as B
import qualified Data.ByteString.Lazy         as BL
import qualified Data.List                    as List
import           Data.Monoid                  (Monoid, mempty)
import           Data.Semigroup               (Semigroup, sconcat)
import           Data.Text                    (Text)
import qualified Data.Text                    as T
import qualified Data.Text.Encoding           as T
import qualified Data.Text.Lazy               as LT
import           Data.Typeable                (Typeable)

import           GHC.Exts                     (IsString (..))

import           Prelude                      hiding (null)

import           Bridge
import           Text.Blaze.Internal (StaticString(..), ChoiceString(..))

import           Unsafe.Coerce (unsafeCoerce)


-- | The core Markup datatype. The 'ev' type-parameter tracks the type of
-- events that can be raised when this Markup is rendered.
--
data MarkupM act a
      -- | Map all actions created by the inner Html.
    = forall act'. MapActions (act' -> act) (MarkupM act' a)
      -- | Install event handlers for the given event on all immediate
      -- children.
    | OnEvent (EventHandler act) (MarkupM act a)
      -- | Tag, open tag, end tag, content
    | Parent StaticString StaticString StaticString (MarkupM act a)
      -- | Custom parent
    | CustomParent ChoiceString (MarkupM act a)
      -- | Tag, open tag, end tag
    | Leaf StaticString StaticString StaticString
      -- | Custom leaf
    | CustomLeaf ChoiceString Bool
      -- | HTML content
    | Content ChoiceString
      -- | Concatenation of two HTML pieces
    | forall b c. Append (MarkupM act b) (MarkupM act c)
      -- | Add an attribute to the inner HTML. Raw key, key, value, HTML to
      -- receive the attribute.
    | AddAttribute StaticString StaticString ChoiceString (MarkupM act a)
      -- | Add a custom attribute to the inner HTML.
    | AddCustomAttribute ChoiceString ChoiceString (MarkupM act a)
      -- | Empty HTML.
    | Empty
    deriving (Typeable)

-- | Simplification of the 'MarkupM' datatype.
--
type Markup e = MarkupM e ()

instance Monoid a => Monoid (MarkupM ev a) where
    mempty :: MarkupM ev a
mempty = MarkupM ev a
forall act a. MarkupM act a
Empty
    {-# INLINE mempty #-}

instance Semigroup a => Semigroup (MarkupM ev a) where
    x :: MarkupM ev a
x <> :: MarkupM ev a -> MarkupM ev a -> MarkupM ev a
<> y :: MarkupM ev a
y = MarkupM ev a -> MarkupM ev a -> MarkupM ev a
forall act a b c. MarkupM act b -> MarkupM act c -> MarkupM act a
Append MarkupM ev a
x MarkupM ev a
y
    {-# INLINE (<>) #-}
    sconcat :: NonEmpty (MarkupM ev a) -> MarkupM ev a
sconcat = (MarkupM ev a -> MarkupM ev a -> MarkupM ev a)
-> MarkupM ev a -> NonEmpty (MarkupM ev a) -> MarkupM ev a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr MarkupM ev a -> MarkupM ev a -> MarkupM ev a
forall act a b c. MarkupM act b -> MarkupM act c -> MarkupM act a
Append MarkupM ev a
forall act a. MarkupM act a
Empty
    {-# INLINE sconcat #-}

instance Functor (MarkupM ev) where
    -- Safe because it does not contain a value anyway
    fmap :: (a -> b) -> MarkupM ev a -> MarkupM ev b
fmap _ = MarkupM ev a -> MarkupM ev b
forall a b. a -> b
unsafeCoerce

instance Applicative (MarkupM ev) where
    pure :: a -> MarkupM ev a
pure _    = MarkupM ev a
forall act a. MarkupM act a
Empty
    ff :: MarkupM ev (a -> b)
ff <*> :: MarkupM ev (a -> b) -> MarkupM ev a -> MarkupM ev b
<*> fx :: MarkupM ev a
fx = MarkupM ev (a -> b) -> MarkupM ev a -> MarkupM ev b
forall act a b c. MarkupM act b -> MarkupM act c -> MarkupM act a
Append MarkupM ev (a -> b)
ff MarkupM ev a
fx

instance Monad (MarkupM ev) where
    return :: a -> MarkupM ev a
return _ = MarkupM ev a
forall act a. MarkupM act a
Empty
    {-# INLINE return #-}
    >> :: MarkupM ev a -> MarkupM ev b -> MarkupM ev b
(>>) = MarkupM ev a -> MarkupM ev b -> MarkupM ev b
forall act a b c. MarkupM act b -> MarkupM act c -> MarkupM act a
Append
    {-# INLINE (>>) #-}
    h1 :: MarkupM ev a
h1 >>= :: MarkupM ev a -> (a -> MarkupM ev b) -> MarkupM ev b
>>= f :: a -> MarkupM ev b
f = MarkupM ev a
h1 MarkupM ev a -> MarkupM ev b -> MarkupM ev b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> MarkupM ev b
f
        ([Char] -> a
forall a. HasCallStack => [Char] -> a
error "Text.Blaze.Internal.MarkupM: invalid use of monadic bind")
    {-# INLINE (>>=) #-}

instance IsString (MarkupM ev a) where
    fromString :: [Char] -> MarkupM ev a
fromString = ChoiceString -> MarkupM ev a
forall act a. ChoiceString -> MarkupM act a
Content (ChoiceString -> MarkupM ev a)
-> ([Char] -> ChoiceString) -> [Char] -> MarkupM ev a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ChoiceString
forall a. IsString a => [Char] -> a
fromString
    {-# INLINE fromString #-}

-- | Type for an HTML tag. This can be seen as an internal string type used by
-- BlazeMarkup.
--
newtype Tag = Tag { Tag -> StaticString
unTag :: StaticString }
    deriving ([Char] -> Tag
([Char] -> Tag) -> IsString Tag
forall a. ([Char] -> a) -> IsString a
fromString :: [Char] -> Tag
$cfromString :: [Char] -> Tag
IsString)

-- | Type for an attribute.
--
newtype Attribute ev = Attribute (forall a. MarkupM ev a -> MarkupM ev a)

instance Monoid (Attribute ev) where
    mempty :: Attribute ev
mempty                            = (forall a. MarkupM ev a -> MarkupM ev a) -> Attribute ev
forall ev. (forall a. MarkupM ev a -> MarkupM ev a) -> Attribute ev
Attribute forall a. a -> a
forall a. MarkupM ev a -> MarkupM ev a
id

instance Semigroup (Attribute ev) where
    Attribute f :: forall a. MarkupM ev a -> MarkupM ev a
f <> :: Attribute ev -> Attribute ev -> Attribute ev
<> Attribute g :: forall a. MarkupM ev a -> MarkupM ev a
g = (forall a. MarkupM ev a -> MarkupM ev a) -> Attribute ev
forall ev. (forall a. MarkupM ev a -> MarkupM ev a) -> Attribute ev
Attribute (MarkupM ev a -> MarkupM ev a
forall a. MarkupM ev a -> MarkupM ev a
g (MarkupM ev a -> MarkupM ev a)
-> (MarkupM ev a -> MarkupM ev a) -> MarkupM ev a -> MarkupM ev a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MarkupM ev a -> MarkupM ev a
forall a. MarkupM ev a -> MarkupM ev a
f)

-- | The type for the value part of an attribute.
--
newtype AttributeValue = AttributeValue { AttributeValue -> ChoiceString
unAttributeValue :: ChoiceString }
    deriving ([Char] -> AttributeValue
([Char] -> AttributeValue) -> IsString AttributeValue
forall a. ([Char] -> a) -> IsString a
fromString :: [Char] -> AttributeValue
$cfromString :: [Char] -> AttributeValue
IsString, Semigroup AttributeValue
AttributeValue
Semigroup AttributeValue =>
AttributeValue
-> (AttributeValue -> AttributeValue -> AttributeValue)
-> ([AttributeValue] -> AttributeValue)
-> Monoid AttributeValue
[AttributeValue] -> AttributeValue
AttributeValue -> AttributeValue -> AttributeValue
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [AttributeValue] -> AttributeValue
$cmconcat :: [AttributeValue] -> AttributeValue
mappend :: AttributeValue -> AttributeValue -> AttributeValue
$cmappend :: AttributeValue -> AttributeValue -> AttributeValue
mempty :: AttributeValue
$cmempty :: AttributeValue
$cp1Monoid :: Semigroup AttributeValue
Monoid, b -> AttributeValue -> AttributeValue
NonEmpty AttributeValue -> AttributeValue
AttributeValue -> AttributeValue -> AttributeValue
(AttributeValue -> AttributeValue -> AttributeValue)
-> (NonEmpty AttributeValue -> AttributeValue)
-> (forall b. Integral b => b -> AttributeValue -> AttributeValue)
-> Semigroup AttributeValue
forall b. Integral b => b -> AttributeValue -> AttributeValue
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> AttributeValue -> AttributeValue
$cstimes :: forall b. Integral b => b -> AttributeValue -> AttributeValue
sconcat :: NonEmpty AttributeValue -> AttributeValue
$csconcat :: NonEmpty AttributeValue -> AttributeValue
<> :: AttributeValue -> AttributeValue -> AttributeValue
$c<> :: AttributeValue -> AttributeValue -> AttributeValue
Semigroup)


-- custom tags
--------------

-- | Create a custom parent element
customParent :: Tag       -- ^ Element tag
             -> Markup ev -- ^ Content
             -> Markup ev -- ^ Resulting markup
customParent :: Tag -> Markup ev -> Markup ev
customParent tag :: Tag
tag = ChoiceString -> Markup ev -> Markup ev
forall act a. ChoiceString -> MarkupM act a -> MarkupM act a
CustomParent (StaticString -> ChoiceString
Static (StaticString -> ChoiceString) -> StaticString -> ChoiceString
forall a b. (a -> b) -> a -> b
$ Tag -> StaticString
unTag Tag
tag)

-- | Create a custom leaf element
customLeaf :: Tag       -- ^ Element tag
           -> Bool      -- ^ Close the leaf?
           -> Markup ev -- ^ Resulting markup
customLeaf :: Tag -> Bool -> Markup ev
customLeaf tag :: Tag
tag = ChoiceString -> Bool -> Markup ev
forall act a. ChoiceString -> Bool -> MarkupM act a
CustomLeaf (StaticString -> ChoiceString
Static (StaticString -> ChoiceString) -> StaticString -> ChoiceString
forall a b. (a -> b) -> a -> b
$ Tag -> StaticString
unTag Tag
tag)

-- | Create an HTML attribute that can be applied to an HTML element later using
-- the '!' operator.
--
attribute :: Tag             -- ^ Raw key
          -> Tag             -- ^ Shared key string for the HTML attribute.
          -> AttributeValue  -- ^ Value for the HTML attribute.
          -> Attribute ev    -- ^ Resulting HTML attribute.
attribute :: Tag -> Tag -> AttributeValue -> Attribute ev
attribute rawKey :: Tag
rawKey key :: Tag
key value :: AttributeValue
value = (forall a. MarkupM ev a -> MarkupM ev a) -> Attribute ev
forall ev. (forall a. MarkupM ev a -> MarkupM ev a) -> Attribute ev
Attribute ((forall a. MarkupM ev a -> MarkupM ev a) -> Attribute ev)
-> (forall a. MarkupM ev a -> MarkupM ev a) -> Attribute ev
forall a b. (a -> b) -> a -> b
$
    StaticString
-> StaticString -> ChoiceString -> MarkupM ev a -> MarkupM ev a
forall act a.
StaticString
-> StaticString -> ChoiceString -> MarkupM act a -> MarkupM act a
AddAttribute (Tag -> StaticString
unTag Tag
rawKey) (Tag -> StaticString
unTag Tag
key) (AttributeValue -> ChoiceString
unAttributeValue AttributeValue
value)
{-# INLINE attribute #-}

-- | From HTML 5 onwards, the user is able to specify custom data attributes.
--
-- An example:
--
-- > <p data-foo="bar">Hello.</p>
--
-- We support this in BlazeMarkup using this funcion. The above fragment could
-- be described using BlazeMarkup with:
--
-- > p ! dataAttribute "foo" "bar" $ "Hello."
--
dataAttribute :: Tag             -- ^ Name of the attribute.
              -> AttributeValue  -- ^ Value for the attribute.
              -> Attribute ev    -- ^ Resulting HTML attribute.
dataAttribute :: Tag -> AttributeValue -> Attribute ev
dataAttribute tag :: Tag
tag value :: AttributeValue
value = (forall a. MarkupM ev a -> MarkupM ev a) -> Attribute ev
forall ev. (forall a. MarkupM ev a -> MarkupM ev a) -> Attribute ev
Attribute ((forall a. MarkupM ev a -> MarkupM ev a) -> Attribute ev)
-> (forall a. MarkupM ev a -> MarkupM ev a) -> Attribute ev
forall a b. (a -> b) -> a -> b
$ ChoiceString -> ChoiceString -> MarkupM ev a -> MarkupM ev a
forall act a.
ChoiceString -> ChoiceString -> MarkupM act a -> MarkupM act a
AddCustomAttribute
    (StaticString -> ChoiceString
Static "data-" ChoiceString -> ChoiceString -> ChoiceString
forall a. Monoid a => a -> a -> a
`mappend` StaticString -> ChoiceString
Static (Tag -> StaticString
unTag Tag
tag))
    (AttributeValue -> ChoiceString
unAttributeValue AttributeValue
value)
{-# INLINE dataAttribute #-}

-- | Create a custom attribute. This is not specified in the HTML spec, but some
-- JavaScript libraries rely on it.
--
-- An example:
--
-- > <select dojoType="select">foo</select>
--
-- Can be produced using:
--
-- > select ! customAttribute "dojoType" "select" $ "foo"
--
customAttribute :: Tag             -- ^ Name of the attribute
                -> AttributeValue  -- ^ Value for the attribute
                -> Attribute ev    -- ^ Resulting HTML attribtue
customAttribute :: Tag -> AttributeValue -> Attribute ev
customAttribute tag :: Tag
tag value :: AttributeValue
value = (forall a. MarkupM ev a -> MarkupM ev a) -> Attribute ev
forall ev. (forall a. MarkupM ev a -> MarkupM ev a) -> Attribute ev
Attribute ((forall a. MarkupM ev a -> MarkupM ev a) -> Attribute ev)
-> (forall a. MarkupM ev a -> MarkupM ev a) -> Attribute ev
forall a b. (a -> b) -> a -> b
$ ChoiceString -> ChoiceString -> MarkupM ev a -> MarkupM ev a
forall act a.
ChoiceString -> ChoiceString -> MarkupM act a -> MarkupM act a
AddCustomAttribute
    (StaticString -> ChoiceString
Static (StaticString -> ChoiceString) -> StaticString -> ChoiceString
forall a b. (a -> b) -> a -> b
$ Tag -> StaticString
unTag Tag
tag)
    (AttributeValue -> ChoiceString
unAttributeValue AttributeValue
value)
{-# INLINE customAttribute #-}

-- | Render text. Functions like these can be used to supply content in HTML.
--
text :: Text       -- ^ Text to render.
     -> Markup ev  -- ^ Resulting HTML fragment.
text :: Text -> Markup ev
text = ChoiceString -> Markup ev
forall act a. ChoiceString -> MarkupM act a
Content (ChoiceString -> Markup ev)
-> (Text -> ChoiceString) -> Text -> Markup ev
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ChoiceString
Text
{-# INLINE text #-}

-- | Render text without escaping.
--
preEscapedText :: Text      -- ^ Text to insert
               -> Markup ev -- ^ Resulting HTML fragment
preEscapedText :: Text -> Markup ev
preEscapedText = ChoiceString -> Markup ev
forall act a. ChoiceString -> MarkupM act a
Content (ChoiceString -> Markup ev)
-> (Text -> ChoiceString) -> Text -> Markup ev
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChoiceString -> ChoiceString
PreEscaped (ChoiceString -> ChoiceString)
-> (Text -> ChoiceString) -> Text -> ChoiceString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ChoiceString
Text
{-# INLINE preEscapedText #-}

-- | A variant of 'text' for lazy 'LT.Text'.
--
lazyText :: LT.Text    -- ^ Text to insert
         -> Markup ev  -- ^ Resulting HTML fragment
lazyText :: Text -> Markup ev
lazyText = [Markup ev] -> Markup ev
forall a. Monoid a => [a] -> a
mconcat ([Markup ev] -> Markup ev)
-> (Text -> [Markup ev]) -> Text -> Markup ev
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Markup ev) -> [Text] -> [Markup ev]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Markup ev
forall ev. Text -> Markup ev
text ([Text] -> [Markup ev]) -> (Text -> [Text]) -> Text -> [Markup ev]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
LT.toChunks
{-# INLINE lazyText #-}

-- | A variant of 'preEscapedText' for lazy 'LT.Text'
--
preEscapedLazyText :: LT.Text    -- ^ Text to insert
                   -> Markup ev  -- ^ Resulting HTML fragment
preEscapedLazyText :: Text -> Markup ev
preEscapedLazyText = [Markup ev] -> Markup ev
forall a. Monoid a => [a] -> a
mconcat ([Markup ev] -> Markup ev)
-> (Text -> [Markup ev]) -> Text -> Markup ev
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Markup ev) -> [Text] -> [Markup ev]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Markup ev
forall ev. Text -> Markup ev
preEscapedText ([Text] -> [Markup ev]) -> (Text -> [Text]) -> Text -> [Markup ev]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
LT.toChunks

-- | Create an HTML snippet from a 'String'.
--
string :: String    -- ^ String to insert.
       -> Markup ev -- ^ Resulting HTML fragment.
string :: [Char] -> Markup ev
string = ChoiceString -> Markup ev
forall act a. ChoiceString -> MarkupM act a
Content (ChoiceString -> Markup ev)
-> ([Char] -> ChoiceString) -> [Char] -> Markup ev
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ChoiceString
String
{-# INLINE string #-}

-- | Create an HTML snippet from a 'String' without escaping
--
preEscapedString :: String    -- ^ String to insert.
                 -> Markup ev -- ^ Resulting HTML fragment.
preEscapedString :: [Char] -> Markup ev
preEscapedString = ChoiceString -> Markup ev
forall act a. ChoiceString -> MarkupM act a
Content (ChoiceString -> Markup ev)
-> ([Char] -> ChoiceString) -> [Char] -> Markup ev
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChoiceString -> ChoiceString
PreEscaped (ChoiceString -> ChoiceString)
-> ([Char] -> ChoiceString) -> [Char] -> ChoiceString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ChoiceString
String
{-# INLINE preEscapedString #-}

-- | Insert a 'ByteString'. This is an unsafe operation:
--
-- * The 'ByteString' could have the wrong encoding.
--
-- * The 'ByteString' might contain illegal HTML characters (no escaping is
--   done).
--
unsafeByteString :: ByteString    -- ^ Value to insert.
                 -> Markup ev     -- ^ Resulting HTML fragment.
unsafeByteString :: ByteString -> Markup ev
unsafeByteString = ChoiceString -> Markup ev
forall act a. ChoiceString -> MarkupM act a
Content (ChoiceString -> Markup ev)
-> (ByteString -> ChoiceString) -> ByteString -> Markup ev
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ChoiceString
ByteString
{-# INLINE unsafeByteString #-}

-- | Insert a lazy 'BL.ByteString'. See 'unsafeByteString' for reasons why this
-- is an unsafe operation.
--
unsafeLazyByteString :: BL.ByteString  -- ^ Value to insert
                     -> Markup ev      -- ^ Resulting HTML fragment
unsafeLazyByteString :: ByteString -> Markup ev
unsafeLazyByteString = [Markup ev] -> Markup ev
forall a. Monoid a => [a] -> a
mconcat ([Markup ev] -> Markup ev)
-> (ByteString -> [Markup ev]) -> ByteString -> Markup ev
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> Markup ev) -> [ByteString] -> [Markup ev]
forall a b. (a -> b) -> [a] -> [b]
map ByteString -> Markup ev
forall ev. ByteString -> Markup ev
unsafeByteString ([ByteString] -> [Markup ev])
-> (ByteString -> [ByteString]) -> ByteString -> [Markup ev]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
BL.toChunks
{-# INLINE unsafeLazyByteString #-}

-- | Create a 'Tag' from some 'Text'.
--
textTag :: Text  -- ^ Text to create a tag from
        -> Tag   -- ^ Resulting tag
textTag :: Text -> Tag
textTag t :: Text
t = StaticString -> Tag
Tag (StaticString -> Tag) -> StaticString -> Tag
forall a b. (a -> b) -> a -> b
$ ([Char] -> [Char]) -> ByteString -> Text -> StaticString
StaticString (Text -> [Char]
T.unpack Text
t [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++) (Text -> ByteString
T.encodeUtf8 Text
t) Text
t

-- | Create a 'Tag' from a 'String'.
--
stringTag :: String  -- ^ String to create a tag from
          -> Tag     -- ^ Resulting tag
stringTag :: [Char] -> Tag
stringTag = StaticString -> Tag
Tag (StaticString -> Tag) -> ([Char] -> StaticString) -> [Char] -> Tag
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> StaticString
forall a. IsString a => [Char] -> a
fromString

-- | Render an attribute value from 'Text'.
--
textValue :: Text            -- ^ The actual value.
          -> AttributeValue  -- ^ Resulting attribute value.
textValue :: Text -> AttributeValue
textValue = ChoiceString -> AttributeValue
AttributeValue (ChoiceString -> AttributeValue)
-> (Text -> ChoiceString) -> Text -> AttributeValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ChoiceString
Text
{-# INLINE textValue #-}

-- | Render an attribute value from 'Text' without escaping.
--
preEscapedTextValue :: Text            -- ^ The actual value
                    -> AttributeValue  -- ^ Resulting attribute value
preEscapedTextValue :: Text -> AttributeValue
preEscapedTextValue = ChoiceString -> AttributeValue
AttributeValue (ChoiceString -> AttributeValue)
-> (Text -> ChoiceString) -> Text -> AttributeValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChoiceString -> ChoiceString
PreEscaped (ChoiceString -> ChoiceString)
-> (Text -> ChoiceString) -> Text -> ChoiceString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ChoiceString
Text
{-# INLINE preEscapedTextValue #-}

-- | A variant of 'textValue' for lazy 'LT.Text'
--
lazyTextValue :: LT.Text         -- ^ The actual value
              -> AttributeValue  -- ^ Resulting attribute value
lazyTextValue :: Text -> AttributeValue
lazyTextValue = [AttributeValue] -> AttributeValue
forall a. Monoid a => [a] -> a
mconcat ([AttributeValue] -> AttributeValue)
-> (Text -> [AttributeValue]) -> Text -> AttributeValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> AttributeValue) -> [Text] -> [AttributeValue]
forall a b. (a -> b) -> [a] -> [b]
map Text -> AttributeValue
textValue ([Text] -> [AttributeValue])
-> (Text -> [Text]) -> Text -> [AttributeValue]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
LT.toChunks
{-# INLINE lazyTextValue #-}

-- | A variant of 'preEscapedTextValue' for lazy 'LT.Text'
--
preEscapedLazyTextValue :: LT.Text         -- ^ The actual value
                        -> AttributeValue  -- ^ Resulting attribute value
preEscapedLazyTextValue :: Text -> AttributeValue
preEscapedLazyTextValue = [AttributeValue] -> AttributeValue
forall a. Monoid a => [a] -> a
mconcat ([AttributeValue] -> AttributeValue)
-> (Text -> [AttributeValue]) -> Text -> AttributeValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> AttributeValue) -> [Text] -> [AttributeValue]
forall a b. (a -> b) -> [a] -> [b]
map Text -> AttributeValue
preEscapedTextValue ([Text] -> [AttributeValue])
-> (Text -> [Text]) -> Text -> [AttributeValue]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
LT.toChunks
{-# INLINE preEscapedLazyTextValue #-}

-- | Create an attribute value from a 'String'.
--
stringValue :: String -> AttributeValue
stringValue :: [Char] -> AttributeValue
stringValue = ChoiceString -> AttributeValue
AttributeValue (ChoiceString -> AttributeValue)
-> ([Char] -> ChoiceString) -> [Char] -> AttributeValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ChoiceString
String
{-# INLINE stringValue #-}

-- | Create an attribute value from a 'String' without escaping.
--
preEscapedStringValue :: String -> AttributeValue
preEscapedStringValue :: [Char] -> AttributeValue
preEscapedStringValue = ChoiceString -> AttributeValue
AttributeValue (ChoiceString -> AttributeValue)
-> ([Char] -> ChoiceString) -> [Char] -> AttributeValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChoiceString -> ChoiceString
PreEscaped (ChoiceString -> ChoiceString)
-> ([Char] -> ChoiceString) -> [Char] -> ChoiceString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ChoiceString
String
{-# INLINE preEscapedStringValue #-}

-- | Create an attribute value from a 'ByteString'. See 'unsafeByteString'
-- for reasons why this might not be a good idea.
--
unsafeByteStringValue :: ByteString      -- ^ ByteString value
                      -> AttributeValue  -- ^ Resulting attribute value
unsafeByteStringValue :: ByteString -> AttributeValue
unsafeByteStringValue = ChoiceString -> AttributeValue
AttributeValue (ChoiceString -> AttributeValue)
-> (ByteString -> ChoiceString) -> ByteString -> AttributeValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ChoiceString
ByteString
{-# INLINE unsafeByteStringValue #-}

-- | Create an attribute value from a lazy 'BL.ByteString'. See
-- 'unsafeByteString' for reasons why this might not be a good idea.
--
unsafeLazyByteStringValue :: BL.ByteString   -- ^ ByteString value
                          -> AttributeValue  -- ^ Resulting attribute value
unsafeLazyByteStringValue :: ByteString -> AttributeValue
unsafeLazyByteStringValue = [AttributeValue] -> AttributeValue
forall a. Monoid a => [a] -> a
mconcat ([AttributeValue] -> AttributeValue)
-> (ByteString -> [AttributeValue]) -> ByteString -> AttributeValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> AttributeValue) -> [ByteString] -> [AttributeValue]
forall a b. (a -> b) -> [a] -> [b]
map ByteString -> AttributeValue
unsafeByteStringValue ([ByteString] -> [AttributeValue])
-> (ByteString -> [ByteString]) -> ByteString -> [AttributeValue]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
BL.toChunks
{-# INLINE unsafeLazyByteStringValue #-}

-- | Used for applying attributes. You should not define your own instances of
-- this class.
class Attributable h ev | h -> ev where
    -- | Apply an attribute to an element.
    --
    -- Example:
    --
    -- > img ! src "foo.png"
    --
    -- Result:
    --
    -- > <img src="foo.png" />
    --
    -- This can be used on nested elements as well.
    --
    -- Example:
    --
    -- > p ! style "float: right" $ "Hello!"
    --
    -- Result:
    --
    -- > <p style="float: right">Hello!</p>
    --
    (!) :: h -> Attribute ev -> h

instance Attributable (MarkupM ev a) ev where
    h :: MarkupM ev a
h ! :: MarkupM ev a -> Attribute ev -> MarkupM ev a
! (Attribute f :: forall a. MarkupM ev a -> MarkupM ev a
f) = MarkupM ev a -> MarkupM ev a
forall a. MarkupM ev a -> MarkupM ev a
f MarkupM ev a
h
    {-# INLINE (!) #-}

instance Attributable (MarkupM ev a -> MarkupM ev b) ev where
    h :: MarkupM ev a -> MarkupM ev b
h ! :: (MarkupM ev a -> MarkupM ev b)
-> Attribute ev -> MarkupM ev a -> MarkupM ev b
! f :: Attribute ev
f = (MarkupM ev b -> Attribute ev -> MarkupM ev b
forall h ev. Attributable h ev => h -> Attribute ev -> h
! Attribute ev
f) (MarkupM ev b -> MarkupM ev b)
-> (MarkupM ev a -> MarkupM ev b) -> MarkupM ev a -> MarkupM ev b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MarkupM ev a -> MarkupM ev b
h
    {-# INLINE (!) #-}

-- | Shorthand for setting an attribute depending on a conditional.
--
-- Example:
--
-- > p !? (isBig, A.class "big") $ "Hello"
--
-- Gives the same result as:
--
-- > (if isBig then p ! A.class "big" else p) "Hello"
--
(!?) :: Attributable h ev => h -> (Bool, Attribute ev) -> h
!? :: h -> (Bool, Attribute ev) -> h
(!?) h :: h
h (c :: Bool
c, a :: Attribute ev
a) = if Bool
c then h
h h -> Attribute ev -> h
forall h ev. Attributable h ev => h -> Attribute ev -> h
! Attribute ev
a else h
h

-- | Mark HTML as external data. External data can be:
--
-- * CSS data in a @<style>@ tag;
--
-- * Script data in a @<script>@ tag.
--
-- This function is applied automatically when using the @style@ or @script@
-- combinators.
--
external :: MarkupM ev a -> MarkupM ev a
external :: MarkupM ev a -> MarkupM ev a
external (MapActions f :: act' -> ev
f x :: MarkupM act' a
x) = (act' -> ev) -> MarkupM act' a -> MarkupM ev a
forall act a act'. (act' -> act) -> MarkupM act' a -> MarkupM act a
MapActions act' -> ev
f (MarkupM act' a -> MarkupM act' a
forall ev a. MarkupM ev a -> MarkupM ev a
external MarkupM act' a
x)
external (OnEvent ev :: EventHandler ev
ev x :: MarkupM ev a
x) = EventHandler ev -> MarkupM ev a -> MarkupM ev a
forall act a. EventHandler act -> MarkupM act a -> MarkupM act a
OnEvent EventHandler ev
ev (MarkupM ev a -> MarkupM ev a
forall ev a. MarkupM ev a -> MarkupM ev a
external MarkupM ev a
x)
external (Content x :: ChoiceString
x) = ChoiceString -> MarkupM ev a
forall act a. ChoiceString -> MarkupM act a
Content (ChoiceString -> MarkupM ev a) -> ChoiceString -> MarkupM ev a
forall a b. (a -> b) -> a -> b
$ ChoiceString -> ChoiceString
External ChoiceString
x
external (Append x :: MarkupM ev b
x y :: MarkupM ev c
y) = MarkupM ev b -> MarkupM ev c -> MarkupM ev a
forall act a b c. MarkupM act b -> MarkupM act c -> MarkupM act a
Append (MarkupM ev b -> MarkupM ev b
forall ev a. MarkupM ev a -> MarkupM ev a
external MarkupM ev b
x) (MarkupM ev c -> MarkupM ev c
forall ev a. MarkupM ev a -> MarkupM ev a
external MarkupM ev c
y)
external (Parent x :: StaticString
x y :: StaticString
y z :: StaticString
z i :: MarkupM ev a
i) = StaticString
-> StaticString -> StaticString -> MarkupM ev a -> MarkupM ev a
forall act a.
StaticString
-> StaticString -> StaticString -> MarkupM act a -> MarkupM act a
Parent StaticString
x StaticString
y StaticString
z (MarkupM ev a -> MarkupM ev a) -> MarkupM ev a -> MarkupM ev a
forall a b. (a -> b) -> a -> b
$ MarkupM ev a -> MarkupM ev a
forall ev a. MarkupM ev a -> MarkupM ev a
external MarkupM ev a
i
external (CustomParent x :: ChoiceString
x i :: MarkupM ev a
i) = ChoiceString -> MarkupM ev a -> MarkupM ev a
forall act a. ChoiceString -> MarkupM act a -> MarkupM act a
CustomParent ChoiceString
x (MarkupM ev a -> MarkupM ev a) -> MarkupM ev a -> MarkupM ev a
forall a b. (a -> b) -> a -> b
$ MarkupM ev a -> MarkupM ev a
forall ev a. MarkupM ev a -> MarkupM ev a
external MarkupM ev a
i
external (AddAttribute x :: StaticString
x y :: StaticString
y z :: ChoiceString
z i :: MarkupM ev a
i) = StaticString
-> StaticString -> ChoiceString -> MarkupM ev a -> MarkupM ev a
forall act a.
StaticString
-> StaticString -> ChoiceString -> MarkupM act a -> MarkupM act a
AddAttribute StaticString
x StaticString
y ChoiceString
z (MarkupM ev a -> MarkupM ev a) -> MarkupM ev a -> MarkupM ev a
forall a b. (a -> b) -> a -> b
$ MarkupM ev a -> MarkupM ev a
forall ev a. MarkupM ev a -> MarkupM ev a
external MarkupM ev a
i
external (AddCustomAttribute x :: ChoiceString
x y :: ChoiceString
y i :: MarkupM ev a
i) = ChoiceString -> ChoiceString -> MarkupM ev a -> MarkupM ev a
forall act a.
ChoiceString -> ChoiceString -> MarkupM act a -> MarkupM act a
AddCustomAttribute ChoiceString
x ChoiceString
y (MarkupM ev a -> MarkupM ev a) -> MarkupM ev a -> MarkupM ev a
forall a b. (a -> b) -> a -> b
$ MarkupM ev a -> MarkupM ev a
forall ev a. MarkupM ev a -> MarkupM ev a
external MarkupM ev a
i
external x :: MarkupM ev a
x = MarkupM ev a
x
{-# INLINABLE external #-}

-- | Take only the text content of an HTML tree.
--
-- > contents $ do
-- >     p ! $ "Hello "
-- >     p ! $ "Word!"
--
-- Result:
--
-- > Hello World!
--
contents :: MarkupM ev a -> MarkupM ev' b
contents :: MarkupM ev a -> MarkupM ev' b
contents (MapActions _ c :: MarkupM act' a
c)           = MarkupM act' a -> MarkupM ev' b
forall ev a ev' b. MarkupM ev a -> MarkupM ev' b
contents MarkupM act' a
c
contents (OnEvent _ c :: MarkupM ev a
c)              = MarkupM ev a -> MarkupM ev' b
forall ev a ev' b. MarkupM ev a -> MarkupM ev' b
contents MarkupM ev a
c
contents (Parent _ _ _ c :: MarkupM ev a
c)           = MarkupM ev a -> MarkupM ev' b
forall ev a ev' b. MarkupM ev a -> MarkupM ev' b
contents MarkupM ev a
c
contents (CustomParent _ c :: MarkupM ev a
c)         = MarkupM ev a -> MarkupM ev' b
forall ev a ev' b. MarkupM ev a -> MarkupM ev' b
contents MarkupM ev a
c
contents (Content c :: ChoiceString
c)                = ChoiceString -> MarkupM ev' b
forall act a. ChoiceString -> MarkupM act a
Content ChoiceString
c
contents (Append c1 :: MarkupM ev b
c1 c2 :: MarkupM ev c
c2)             = MarkupM ev' Any -> MarkupM ev' Any -> MarkupM ev' b
forall act a b c. MarkupM act b -> MarkupM act c -> MarkupM act a
Append (MarkupM ev b -> MarkupM ev' Any
forall ev a ev' b. MarkupM ev a -> MarkupM ev' b
contents MarkupM ev b
c1) (MarkupM ev c -> MarkupM ev' Any
forall ev a ev' b. MarkupM ev a -> MarkupM ev' b
contents MarkupM ev c
c2)
contents (AddAttribute _ _ _ c :: MarkupM ev a
c)     = MarkupM ev a -> MarkupM ev' b
forall ev a ev' b. MarkupM ev a -> MarkupM ev' b
contents MarkupM ev a
c
contents (AddCustomAttribute _ _ c :: MarkupM ev a
c) = MarkupM ev a -> MarkupM ev' b
forall ev a ev' b. MarkupM ev a -> MarkupM ev' b
contents MarkupM ev a
c
contents _                          = MarkupM ev' b
forall act a. MarkupM act a
Empty

-- | Check if a 'Markup' value is completely empty (renders to the empty
-- string).
null :: MarkupM ev a -> Bool
null :: MarkupM ev a -> Bool
null markup :: MarkupM ev a
markup = case MarkupM ev a
markup of
    MapActions _ c :: MarkupM act' a
c           -> MarkupM act' a -> Bool
forall ev a. MarkupM ev a -> Bool
null MarkupM act' a
c
    OnEvent _ c :: MarkupM ev a
c              -> MarkupM ev a -> Bool
forall ev a. MarkupM ev a -> Bool
null MarkupM ev a
c
    Parent _ _ _ _           -> Bool
False
    CustomParent _ _         -> Bool
False
    Leaf _ _ _               -> Bool
False
    CustomLeaf _ _           -> Bool
False
    Content c :: ChoiceString
c                -> ChoiceString -> Bool
emptyChoiceString ChoiceString
c
    Append c1 :: MarkupM ev b
c1 c2 :: MarkupM ev c
c2             -> MarkupM ev b -> Bool
forall ev a. MarkupM ev a -> Bool
null MarkupM ev b
c1 Bool -> Bool -> Bool
&& MarkupM ev c -> Bool
forall ev a. MarkupM ev a -> Bool
null MarkupM ev c
c2
    AddAttribute _ _ _ c :: MarkupM ev a
c     -> MarkupM ev a -> Bool
forall ev a. MarkupM ev a -> Bool
null MarkupM ev a
c
    AddCustomAttribute _ _ c :: MarkupM ev a
c -> MarkupM ev a -> Bool
forall ev a. MarkupM ev a -> Bool
null MarkupM ev a
c
    Empty                    -> Bool
True
  where
    emptyChoiceString :: ChoiceString -> Bool
emptyChoiceString cs :: ChoiceString
cs = case ChoiceString
cs of
        Static ss :: StaticString
ss                -> StaticString -> Bool
emptyStaticString StaticString
ss
        String s :: [Char]
s                 -> [Char] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
List.null [Char]
s
        Text t :: Text
t                   -> Text -> Bool
T.null Text
t
        ByteString bs :: ByteString
bs            -> ByteString -> Bool
B.null ByteString
bs
        PreEscaped c :: ChoiceString
c             -> ChoiceString -> Bool
emptyChoiceString ChoiceString
c
        External c :: ChoiceString
c               -> ChoiceString -> Bool
emptyChoiceString ChoiceString
c
        AppendChoiceString c1 :: ChoiceString
c1 c2 :: ChoiceString
c2 -> ChoiceString -> Bool
emptyChoiceString ChoiceString
c1 Bool -> Bool -> Bool
&& ChoiceString -> Bool
emptyChoiceString ChoiceString
c2
        EmptyChoiceString        -> Bool
True

    emptyStaticString :: StaticString -> Bool
emptyStaticString = ByteString -> Bool
B.null (ByteString -> Bool)
-> (StaticString -> ByteString) -> StaticString -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StaticString -> ByteString
getUtf8ByteString