{-# LANGUAGE CPP                        #-}
{-# LANGUAGE DeriveDataTypeable         #-}
{-# LANGUAGE ExistentialQuantification  #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GADTs                      #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE Rank2Types                 #-}
-- | 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.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
    , textBuilder
    , preEscapedTextBuilder
    , string
    , preEscapedString
    , unsafeByteString
    , unsafeLazyByteString

      -- * Comments
    , textComment
    , lazyTextComment
    , stringComment
    , unsafeByteStringComment
    , unsafeLazyByteStringComment

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

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

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

      -- * Modifying Markup elements
    , contents
    , external

      -- * Querying Markup elements
    , null
    ) where

import           Control.Applicative    (Applicative (..))
import qualified Data.List              as List
import           Data.Monoid            (Monoid, mappend, mconcat, mempty)
import           Prelude                hiding (null)

import qualified Data.ByteString        as B
import           Data.ByteString.Char8  (ByteString)
import qualified Data.ByteString.Lazy   as BL
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 qualified Data.Text.Lazy.Builder as LTB
import           Data.Typeable          (Typeable)
import           GHC.Exts               (IsString (..))

#if MIN_VERSION_base(4,9,0)
import           Data.Semigroup         (Semigroup(..))
#endif

-- | A static string that supports efficient output to all possible backends.
--
data StaticString = StaticString
    { StaticString -> String -> String
getString         :: String -> String  -- ^ Appending haskell string
    , StaticString -> ByteString
getUtf8ByteString :: B.ByteString      -- ^ UTF-8 encoded bytestring
    , StaticString -> Text
getText           :: Text              -- ^ Text value
    }

-- 'StaticString's should only be converted from string literals, as far as I
-- can see.
--
instance IsString StaticString where
    fromString :: String -> StaticString
fromString String
s = let t :: Text
t = String -> Text
T.pack String
s
                   in (String -> String) -> ByteString -> Text -> StaticString
StaticString (String
s forall a. [a] -> [a] -> [a]
++) (Text -> ByteString
T.encodeUtf8 Text
t) Text
t

-- | A string denoting input from different string representations.
--
data ChoiceString
    -- | Static data
    = Static {-# UNPACK #-} !StaticString
    -- | A Haskell String
    | String String
    -- | A Text value
    | Text Text
    -- | An encoded bytestring
    | ByteString B.ByteString
    -- | A pre-escaped string
    | PreEscaped ChoiceString
    -- | External data in style/script tags, should be checked for validity
    | External ChoiceString
    -- | Concatenation
    | AppendChoiceString ChoiceString ChoiceString
    -- | Empty string
    | EmptyChoiceString

#if MIN_VERSION_base(4,9,0)
instance Semigroup ChoiceString where
    <> :: ChoiceString -> ChoiceString -> ChoiceString
(<>) = ChoiceString -> ChoiceString -> ChoiceString
AppendChoiceString
    {-# INLINE (<>) #-}
#endif

instance Monoid ChoiceString where
    mempty :: ChoiceString
mempty = ChoiceString
EmptyChoiceString
    {-# INLINE mempty #-}
#if !(MIN_VERSION_base(4,11,0))
    mappend = AppendChoiceString
    {-# INLINE mappend #-}
#endif

instance IsString ChoiceString where
    fromString :: String -> ChoiceString
fromString = String -> ChoiceString
String
    {-# INLINE fromString #-}

-- | The core Markup datatype.
--
data MarkupM a
    -- | Tag, open tag, end tag, content
    = Parent StaticString StaticString StaticString (MarkupM a)
    -- | Custom parent
    | CustomParent ChoiceString (MarkupM a)
    -- | Tag, open tag, end tag
    | Leaf StaticString StaticString StaticString a
    -- | Custom leaf
    | CustomLeaf ChoiceString Bool a
    -- | HTML content
    | Content ChoiceString a
    -- | HTML comment. Note: you should wrap the 'ChoiceString' in a
    -- 'PreEscaped'.
    | Comment ChoiceString a
    -- | Concatenation of two HTML pieces
    | forall b. Append (MarkupM b) (MarkupM a)
    -- | Add an attribute to the inner HTML. Raw key, key, value, HTML to
    -- receive the attribute.
    | AddAttribute StaticString StaticString ChoiceString (MarkupM a)
    -- | Add a custom attribute to the inner HTML.
    | AddCustomAttribute ChoiceString ChoiceString (MarkupM a)
    -- | Empty HTML.
    | Empty a
    deriving (Typeable)

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

instance Monoid a => Monoid (MarkupM a) where
    mempty :: MarkupM a
mempty = forall a. a -> MarkupM a
Empty forall a. Monoid a => a
mempty
    {-# INLINE mempty #-}
#if !(MIN_VERSION_base(4,11,0))
    mappend x y = Append x y
    {-# INLINE mappend #-}
    mconcat = foldr Append (Empty mempty)
    {-# INLINE mconcat #-}
#endif

#if MIN_VERSION_base(4,9,0)
instance Monoid a => Semigroup (MarkupM a) where
    MarkupM a
x <> :: MarkupM a -> MarkupM a -> MarkupM a
<> MarkupM a
y = forall a b. MarkupM b -> MarkupM a -> MarkupM a
Append MarkupM a
x MarkupM a
y
    {-# INLINE (<>) #-}
    sconcat :: NonEmpty (MarkupM a) -> MarkupM a
sconcat = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall a b. MarkupM b -> MarkupM a -> MarkupM a
Append (forall a. a -> MarkupM a
Empty forall a. Monoid a => a
mempty)
    {-# INLINE sconcat #-}
#endif

instance Functor MarkupM where
    fmap :: forall a b. (a -> b) -> MarkupM a -> MarkupM b
fmap a -> b
f MarkupM a
x =
        -- Instead of traversing through all the nodes, we just store an extra
        -- 'Empty' node with the new result.
        forall a b. MarkupM b -> MarkupM a -> MarkupM a
Append MarkupM a
x (forall a. a -> MarkupM a
Empty (a -> b
f (forall a. MarkupM a -> a
markupValue MarkupM a
x)))

instance Applicative MarkupM where
    pure :: forall a. a -> MarkupM a
pure a
x = forall a. a -> MarkupM a
Empty a
x
    {-# INLINE pure #-}
    <*> :: forall a b. MarkupM (a -> b) -> MarkupM a -> MarkupM b
(<*>) MarkupM (a -> b)
x MarkupM a
y =
        -- We need to add an extra 'Empty' node to store the result.
        forall a b. MarkupM b -> MarkupM a -> MarkupM a
Append (forall a b. MarkupM b -> MarkupM a -> MarkupM a
Append MarkupM (a -> b)
x MarkupM a
y) (forall a. a -> MarkupM a
Empty (forall a. MarkupM a -> a
markupValue MarkupM (a -> b)
x (forall a. MarkupM a -> a
markupValue MarkupM a
y)))
    {-# INLINE (<*>) #-}
    *> :: forall a b. MarkupM a -> MarkupM b -> MarkupM b
(*>) = forall a b. MarkupM b -> MarkupM a -> MarkupM a
Append
    {-# INLINE (*>) #-}
    -- (<*) = Append
    -- {-# INLINE (<*) #-}

instance Monad MarkupM where
    return :: forall a. a -> MarkupM a
return a
x = forall a. a -> MarkupM a
Empty a
x
    {-# INLINE return #-}
    >> :: forall a b. MarkupM a -> MarkupM b -> MarkupM b
(>>) = forall a b. MarkupM b -> MarkupM a -> MarkupM a
Append
    {-# INLINE (>>) #-}
    MarkupM a
h1 >>= :: forall a b. MarkupM a -> (a -> MarkupM b) -> MarkupM b
>>= a -> MarkupM b
f = forall a b. MarkupM b -> MarkupM a -> MarkupM a
Append MarkupM a
h1 (a -> MarkupM b
f (forall a. MarkupM a -> a
markupValue MarkupM a
h1))
    {-# INLINE (>>=) #-}

instance (a ~ ()) => IsString (MarkupM a) where
    fromString :: String -> MarkupM a
fromString String
x = forall a. ChoiceString -> a -> MarkupM a
Content (forall a. IsString a => String -> a
fromString String
x) forall a. Monoid a => a
mempty
    {-# INLINE fromString #-}

-- | Get the value from a 'MarkupM'.
--
markupValue :: MarkupM a -> a
markupValue :: forall a. MarkupM a -> a
markupValue MarkupM a
m0 = case MarkupM a
m0 of
    Parent StaticString
_ StaticString
_ StaticString
_ MarkupM a
m1           -> forall a. MarkupM a -> a
markupValue MarkupM a
m1
    CustomParent ChoiceString
_ MarkupM a
m1         -> forall a. MarkupM a -> a
markupValue MarkupM a
m1
    Leaf StaticString
_ StaticString
_ StaticString
_ a
x              -> a
x
    CustomLeaf ChoiceString
_ Bool
_ a
x          -> a
x
    Content ChoiceString
_ a
x               -> a
x
    Comment ChoiceString
_ a
x               -> a
x
    Append MarkupM b
_ MarkupM a
m1               -> forall a. MarkupM a -> a
markupValue MarkupM a
m1
    AddAttribute StaticString
_ StaticString
_ ChoiceString
_ MarkupM a
m1     -> forall a. MarkupM a -> a
markupValue MarkupM a
m1
    AddCustomAttribute ChoiceString
_ ChoiceString
_ MarkupM a
m1 -> forall a. MarkupM a -> a
markupValue MarkupM a
m1
    Empty a
x                   -> a
x

-- | 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 (String -> Tag
forall a. (String -> a) -> IsString a
fromString :: String -> Tag
$cfromString :: String -> Tag
IsString)

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

#if MIN_VERSION_base(4,9,0)
instance Semigroup Attribute where
    Attribute forall a. MarkupM a -> MarkupM a
f <> :: Attribute -> Attribute -> Attribute
<> Attribute forall a. MarkupM a -> MarkupM a
g = (forall a. MarkupM a -> MarkupM a) -> Attribute
Attribute (forall a. MarkupM a -> MarkupM a
g forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. MarkupM a -> MarkupM a
f)
#endif

instance Monoid Attribute where
    mempty :: Attribute
mempty                            = (forall a. MarkupM a -> MarkupM a) -> Attribute
Attribute forall a. a -> a
id
#if !(MIN_VERSION_base(4,11,0))
    Attribute f `mappend` Attribute g = Attribute (g . f)
#endif

-- | The type for the value part of an attribute.
--
newtype AttributeValue = AttributeValue { AttributeValue -> ChoiceString
unAttributeValue :: ChoiceString }
    deriving (String -> AttributeValue
forall a. (String -> a) -> IsString a
fromString :: String -> AttributeValue
$cfromString :: String -> AttributeValue
IsString, Semigroup AttributeValue
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
Monoid
#if MIN_VERSION_base(4,9,0)
             ,NonEmpty AttributeValue -> AttributeValue
AttributeValue -> AttributeValue -> 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 :: forall b. Integral b => 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
#endif
             )

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

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

-- | 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       -- ^ Resulting HTML attribute.
attribute :: Tag -> Tag -> AttributeValue -> Attribute
attribute Tag
rawKey Tag
key AttributeValue
value = (forall a. MarkupM a -> MarkupM a) -> Attribute
Attribute forall a b. (a -> b) -> a -> b
$
    forall a.
StaticString
-> StaticString -> ChoiceString -> MarkupM a -> MarkupM 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 function. 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       -- ^ Resulting HTML attribute.
dataAttribute :: Tag -> AttributeValue -> Attribute
dataAttribute Tag
tag AttributeValue
value = (forall a. MarkupM a -> MarkupM a) -> Attribute
Attribute forall a b. (a -> b) -> a -> b
$ forall a. ChoiceString -> ChoiceString -> MarkupM a -> MarkupM a
AddCustomAttribute
    (StaticString -> ChoiceString
Static StaticString
"data-" 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       -- ^ Resulting HTML attribtue
customAttribute :: Tag -> AttributeValue -> Attribute
customAttribute Tag
tag AttributeValue
value = (forall a. MarkupM a -> MarkupM a) -> Attribute
Attribute forall a b. (a -> b) -> a -> b
$ forall a. ChoiceString -> ChoiceString -> MarkupM a -> MarkupM a
AddCustomAttribute
    (StaticString -> ChoiceString
Static 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  -- ^ Resulting HTML fragment.
text :: Text -> Markup
text = ChoiceString -> Markup
content 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  -- ^ Resulting HTML fragment
preEscapedText :: Text -> Markup
preEscapedText = ChoiceString -> Markup
content forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChoiceString -> ChoiceString
PreEscaped 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   -- ^ Resulting HTML fragment
lazyText :: Text -> Markup
lazyText = forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Text -> Markup
text 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   -- ^ Resulting HTML fragment
preEscapedLazyText :: Text -> Markup
preEscapedLazyText = forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Text -> Markup
preEscapedText forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
LT.toChunks
{-# INLINE preEscapedLazyText #-}

-- | A variant of 'text' for text 'LTB.Builder'.
--
textBuilder :: LTB.Builder -- ^ Text to insert
            -> Markup      -- ^ Resulting HTML fragment
textBuilder :: Builder -> Markup
textBuilder = Text -> Markup
lazyText forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
LTB.toLazyText
{-# INLINE textBuilder #-}

-- | A variant of 'preEscapedText' for lazy 'LT.Text'
--
preEscapedTextBuilder :: LTB.Builder -- ^ Text to insert
                      -> Markup      -- ^ Resulting HTML fragment
preEscapedTextBuilder :: Builder -> Markup
preEscapedTextBuilder = Text -> Markup
preEscapedLazyText forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
LTB.toLazyText
{-# INLINE preEscapedTextBuilder #-}

content :: ChoiceString -> Markup
content :: ChoiceString -> Markup
content ChoiceString
cs = forall a. ChoiceString -> a -> MarkupM a
Content ChoiceString
cs ()
{-# INLINE content #-}

-- | Create an HTML snippet from a 'String'.
--
string :: String  -- ^ String to insert.
       -> Markup  -- ^ Resulting HTML fragment.
string :: String -> Markup
string = ChoiceString -> Markup
content forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ChoiceString
String
{-# INLINE string #-}

-- | Create an HTML snippet from a 'String' without escaping
--
preEscapedString :: String  -- ^ String to insert.
                 -> Markup  -- ^ Resulting HTML fragment.
preEscapedString :: String -> Markup
preEscapedString = ChoiceString -> Markup
content forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChoiceString -> ChoiceString
PreEscaped forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> 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      -- ^ Resulting HTML fragment.
unsafeByteString :: ByteString -> Markup
unsafeByteString = ChoiceString -> Markup
content 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         -- ^ Resulting HTML fragment
unsafeLazyByteString :: ByteString -> Markup
unsafeLazyByteString = forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map ByteString -> Markup
unsafeByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
BL.toChunks
{-# INLINE unsafeLazyByteString #-}

comment :: ChoiceString -> Markup
comment :: ChoiceString -> Markup
comment ChoiceString
cs = forall a. ChoiceString -> a -> MarkupM a
Comment ChoiceString
cs ()
{-# INLINE comment #-}

-- | Create a comment from a 'Text' value.
-- The text should not contain @"--"@.
-- This is not checked by the library.
textComment :: Text -> Markup
textComment :: Text -> Markup
textComment = ChoiceString -> Markup
comment forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChoiceString -> ChoiceString
PreEscaped forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ChoiceString
Text

-- | Create a comment from a 'LT.Text' value.
-- The text should not contain @"--"@.
-- This is not checked by the library.
lazyTextComment :: LT.Text -> Markup
lazyTextComment :: Text -> Markup
lazyTextComment = ChoiceString -> Markup
comment forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (ChoiceString -> ChoiceString
PreEscaped forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ChoiceString
Text) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
LT.toChunks

-- | Create a comment from a 'String' value.
-- The text should not contain @"--"@.
-- This is not checked by the library.
stringComment :: String -> Markup
stringComment :: String -> Markup
stringComment = ChoiceString -> Markup
comment forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChoiceString -> ChoiceString
PreEscaped forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ChoiceString
String

-- | Create a comment from a 'ByteString' value.
-- The text should not contain @"--"@.
-- This is not checked by the library.
unsafeByteStringComment :: ByteString -> Markup
unsafeByteStringComment :: ByteString -> Markup
unsafeByteStringComment = ChoiceString -> Markup
comment forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChoiceString -> ChoiceString
PreEscaped forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ChoiceString
ByteString

-- | Create a comment from a 'BL.ByteString' value.
-- The text should not contain @"--"@.
-- This is not checked by the library.
unsafeLazyByteStringComment :: BL.ByteString -> Markup
unsafeLazyByteStringComment :: ByteString -> Markup
unsafeLazyByteStringComment =
    ChoiceString -> Markup
comment forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (ChoiceString -> ChoiceString
PreEscaped forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ChoiceString
ByteString) forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
BL.toChunks

-- | Create a 'Tag' from some 'Text'.
--
textTag :: Text  -- ^ Text to create a tag from
        -> Tag   -- ^ Resulting tag
textTag :: Text -> Tag
textTag Text
t = StaticString -> Tag
Tag forall a b. (a -> b) -> a -> b
$ (String -> String) -> ByteString -> Text -> StaticString
StaticString (Text -> String
T.unpack Text
t 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 :: String -> Tag
stringTag = StaticString -> Tag
Tag forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IsString a => String -> a
fromString

-- | Render an attribute value from 'Text'.
--
textValue :: Text            -- ^ The actual value.
          -> AttributeValue  -- ^ Resulting attribute value.
textValue :: Text -> AttributeValue
textValue = ChoiceString -> AttributeValue
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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChoiceString -> ChoiceString
PreEscaped 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 = forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Text -> AttributeValue
textValue 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 = forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Text -> AttributeValue
preEscapedTextValue forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
LT.toChunks
{-# INLINE preEscapedLazyTextValue #-}

-- | A variant of 'textValue' for text 'LTB.Builder'
--
textBuilderValue :: LTB.Builder    -- ^ The actual value
                 -> AttributeValue -- ^ Resulting attribute value
textBuilderValue :: Builder -> AttributeValue
textBuilderValue = Text -> AttributeValue
lazyTextValue forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
LTB.toLazyText
{-# INLINE textBuilderValue #-}

-- | A variant of 'preEscapedTextValue' for text 'LTB.Builder'
--
preEscapedTextBuilderValue :: LTB.Builder    -- ^ The actual value
                           -> AttributeValue -- ^ Resulting attribute value
preEscapedTextBuilderValue :: Builder -> AttributeValue
preEscapedTextBuilderValue = Text -> AttributeValue
preEscapedLazyTextValue forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
LTB.toLazyText
{-# INLINE preEscapedTextBuilderValue #-}

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

-- | Create an attribute value from a 'String' without escaping.
--
preEscapedStringValue :: String -> AttributeValue
preEscapedStringValue :: String -> AttributeValue
preEscapedStringValue = ChoiceString -> AttributeValue
AttributeValue forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChoiceString -> ChoiceString
PreEscaped forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> 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 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 = forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map ByteString -> AttributeValue
unsafeByteStringValue 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 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 -> h

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

instance Attributable (MarkupM a -> MarkupM b) where
    MarkupM a -> MarkupM b
h ! :: (MarkupM a -> MarkupM b) -> Attribute -> MarkupM a -> MarkupM b
! Attribute
f = (forall h. Attributable h => h -> Attribute -> h
! Attribute
f) forall b c a. (b -> c) -> (a -> b) -> a -> c
. MarkupM a -> MarkupM 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 => h -> (Bool, Attribute) -> h
!? :: forall h. Attributable h => h -> (Bool, Attribute) -> h
(!?) h
h (Bool
c, Attribute
a) = if Bool
c then h
h forall h. Attributable h => h -> Attribute -> h
! Attribute
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 a -> MarkupM a
external :: forall a. MarkupM a -> MarkupM a
external (Content ChoiceString
x a
a)              = forall a. ChoiceString -> a -> MarkupM a
Content (ChoiceString -> ChoiceString
External ChoiceString
x) a
a
external (Append MarkupM b
x MarkupM a
y)               = forall a b. MarkupM b -> MarkupM a -> MarkupM a
Append (forall a. MarkupM a -> MarkupM a
external MarkupM b
x) (forall a. MarkupM a -> MarkupM a
external MarkupM a
y)
external (Parent StaticString
x StaticString
y StaticString
z MarkupM a
i)           = forall a.
StaticString
-> StaticString -> StaticString -> MarkupM a -> MarkupM a
Parent StaticString
x StaticString
y StaticString
z forall a b. (a -> b) -> a -> b
$ forall a. MarkupM a -> MarkupM a
external MarkupM a
i
external (CustomParent ChoiceString
x MarkupM a
i)         = forall a. ChoiceString -> MarkupM a -> MarkupM a
CustomParent ChoiceString
x forall a b. (a -> b) -> a -> b
$ forall a. MarkupM a -> MarkupM a
external MarkupM a
i
external (AddAttribute StaticString
x StaticString
y ChoiceString
z MarkupM a
i)     = forall a.
StaticString
-> StaticString -> ChoiceString -> MarkupM a -> MarkupM a
AddAttribute StaticString
x StaticString
y ChoiceString
z forall a b. (a -> b) -> a -> b
$ forall a. MarkupM a -> MarkupM a
external MarkupM a
i
external (AddCustomAttribute ChoiceString
x ChoiceString
y MarkupM a
i) = forall a. ChoiceString -> ChoiceString -> MarkupM a -> MarkupM a
AddCustomAttribute ChoiceString
x ChoiceString
y forall a b. (a -> b) -> a -> b
$ forall a. MarkupM a -> MarkupM a
external MarkupM a
i
external MarkupM a
x                          = MarkupM a
x
{-# INLINE external #-}

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

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

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