{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Rank2Types #-}
module Text.Blaze.Internal
(
ChoiceString (..)
, StaticString (..)
, MarkupM (..)
, Markup
, Tag
, Attribute
, AttributeValue
, customParent
, customLeaf
, attribute
, dataAttribute
, customAttribute
, text
, preEscapedText
, lazyText
, preEscapedLazyText
, textBuilder
, preEscapedTextBuilder
, string
, preEscapedString
, unsafeByteString
, unsafeLazyByteString
, textComment
, lazyTextComment
, stringComment
, unsafeByteStringComment
, unsafeLazyByteStringComment
, textTag
, stringTag
, textValue
, preEscapedTextValue
, lazyTextValue
, preEscapedLazyTextValue
, textBuilderValue
, preEscapedTextBuilderValue
, stringValue
, preEscapedStringValue
, unsafeByteStringValue
, unsafeLazyByteStringValue
, Attributable
, (!)
, (!?)
, contents
, external
, 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
data StaticString = StaticString
{ StaticString -> String -> String
getString :: String -> String
, StaticString -> ByteString
getUtf8ByteString :: B.ByteString
, StaticString -> Text
getText :: Text
}
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 String -> String -> String
forall a. [a] -> [a] -> [a]
++) (Text -> ByteString
T.encodeUtf8 Text
t) Text
t
data ChoiceString
= Static {-# UNPACK #-} !StaticString
| String String
| Text Text
| ByteString B.ByteString
| PreEscaped ChoiceString
| External ChoiceString
| AppendChoiceString ChoiceString ChoiceString
| 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 #-}
data MarkupM a
= Parent StaticString StaticString StaticString (MarkupM a)
| CustomParent ChoiceString (MarkupM a)
| Leaf StaticString StaticString StaticString a
| CustomLeaf ChoiceString Bool a
| Content ChoiceString a
| ChoiceString a
| forall b. Append (MarkupM b) (MarkupM a)
| AddAttribute StaticString StaticString ChoiceString (MarkupM a)
| AddCustomAttribute ChoiceString ChoiceString (MarkupM a)
| Empty a
deriving (Typeable)
type Markup = MarkupM ()
instance Monoid a => Monoid (MarkupM a) where
mempty :: MarkupM a
mempty = a -> MarkupM a
forall a. a -> MarkupM a
Empty a
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 = MarkupM a -> MarkupM a -> MarkupM a
forall a b. MarkupM b -> MarkupM a -> MarkupM a
Append MarkupM a
x MarkupM a
y
{-# INLINE (<>) #-}
sconcat :: NonEmpty (MarkupM a) -> MarkupM a
sconcat = (MarkupM a -> MarkupM a -> MarkupM a)
-> MarkupM a -> NonEmpty (MarkupM a) -> MarkupM a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr MarkupM a -> MarkupM a -> MarkupM a
forall a b. MarkupM b -> MarkupM a -> MarkupM a
Append (a -> MarkupM a
forall a. a -> MarkupM a
Empty a
forall a. Monoid a => a
mempty)
{-# INLINE sconcat #-}
#endif
instance Functor MarkupM where
fmap :: (a -> b) -> MarkupM a -> MarkupM b
fmap a -> b
f MarkupM a
x =
MarkupM a -> MarkupM b -> MarkupM b
forall a b. MarkupM b -> MarkupM a -> MarkupM a
Append MarkupM a
x (b -> MarkupM b
forall a. a -> MarkupM a
Empty (a -> b
f (MarkupM a -> a
forall a. MarkupM a -> a
markupValue MarkupM a
x)))
instance Applicative MarkupM where
pure :: a -> MarkupM a
pure a
x = a -> MarkupM a
forall a. a -> MarkupM a
Empty a
x
{-# INLINE pure #-}
<*> :: MarkupM (a -> b) -> MarkupM a -> MarkupM b
(<*>) MarkupM (a -> b)
x MarkupM a
y =
MarkupM a -> MarkupM b -> MarkupM b
forall a b. MarkupM b -> MarkupM a -> MarkupM a
Append (MarkupM (a -> b) -> MarkupM a -> MarkupM a
forall a b. MarkupM b -> MarkupM a -> MarkupM a
Append MarkupM (a -> b)
x MarkupM a
y) (b -> MarkupM b
forall a. a -> MarkupM a
Empty (MarkupM (a -> b) -> a -> b
forall a. MarkupM a -> a
markupValue MarkupM (a -> b)
x (MarkupM a -> a
forall a. MarkupM a -> a
markupValue MarkupM a
y)))
{-# INLINE (<*>) #-}
*> :: MarkupM a -> MarkupM b -> MarkupM b
(*>) = MarkupM a -> MarkupM b -> MarkupM b
forall a b. MarkupM b -> MarkupM a -> MarkupM a
Append
{-# INLINE (*>) #-}
instance Monad MarkupM where
return :: a -> MarkupM a
return a
x = a -> MarkupM a
forall a. a -> MarkupM a
Empty a
x
{-# INLINE return #-}
>> :: MarkupM a -> MarkupM b -> MarkupM b
(>>) = MarkupM a -> MarkupM b -> MarkupM b
forall a b. MarkupM b -> MarkupM a -> MarkupM a
Append
{-# INLINE (>>) #-}
MarkupM a
h1 >>= :: MarkupM a -> (a -> MarkupM b) -> MarkupM b
>>= a -> MarkupM b
f = MarkupM a -> MarkupM b -> MarkupM b
forall a b. MarkupM b -> MarkupM a -> MarkupM a
Append MarkupM a
h1 (a -> MarkupM b
f (MarkupM a -> a
forall a. MarkupM a -> a
markupValue MarkupM a
h1))
{-# INLINE (>>=) #-}
instance (a ~ ()) => IsString (MarkupM a) where
fromString :: String -> MarkupM a
fromString String
x = ChoiceString -> a -> MarkupM a
forall a. ChoiceString -> a -> MarkupM a
Content (String -> ChoiceString
forall a. IsString a => String -> a
fromString String
x) a
forall a. Monoid a => a
mempty
{-# INLINE fromString #-}
markupValue :: MarkupM a -> a
markupValue :: MarkupM a -> a
markupValue MarkupM a
m0 = case MarkupM a
m0 of
Parent StaticString
_ StaticString
_ StaticString
_ MarkupM a
m1 -> MarkupM a -> a
forall a. MarkupM a -> a
markupValue MarkupM a
m1
CustomParent ChoiceString
_ MarkupM a
m1 -> MarkupM a -> a
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 -> MarkupM a -> a
forall a. MarkupM a -> a
markupValue MarkupM a
m1
AddAttribute StaticString
_ StaticString
_ ChoiceString
_ MarkupM a
m1 -> MarkupM a -> a
forall a. MarkupM a -> a
markupValue MarkupM a
m1
AddCustomAttribute ChoiceString
_ ChoiceString
_ MarkupM a
m1 -> MarkupM a -> a
forall a. MarkupM a -> a
markupValue MarkupM a
m1
Empty a
x -> a
x
newtype Tag = Tag { Tag -> StaticString
unTag :: StaticString }
deriving (String -> Tag
(String -> Tag) -> IsString Tag
forall a. (String -> a) -> IsString a
fromString :: String -> Tag
$cfromString :: String -> Tag
IsString)
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 (MarkupM a -> MarkupM a
forall a. MarkupM a -> MarkupM a
g (MarkupM a -> MarkupM a)
-> (MarkupM a -> MarkupM a) -> MarkupM a -> MarkupM a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MarkupM a -> MarkupM a
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
forall a. MarkupM a -> MarkupM a
id
#if !(MIN_VERSION_base(4,11,0))
Attribute f `mappend` Attribute g = Attribute (g . f)
#endif
newtype AttributeValue = AttributeValue { AttributeValue -> ChoiceString
unAttributeValue :: ChoiceString }
deriving (String -> AttributeValue
(String -> AttributeValue) -> IsString AttributeValue
forall a. (String -> a) -> IsString a
fromString :: String -> AttributeValue
$cfromString :: String -> 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
#if MIN_VERSION_base(4,9,0)
,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
#endif
)
customParent :: Tag
-> Markup
-> Markup
customParent :: Tag -> Markup -> Markup
customParent Tag
tag Markup
cont = ChoiceString -> Markup -> Markup
forall a. ChoiceString -> MarkupM a -> MarkupM a
CustomParent (StaticString -> ChoiceString
Static (StaticString -> ChoiceString) -> StaticString -> ChoiceString
forall a b. (a -> b) -> a -> b
$ Tag -> StaticString
unTag Tag
tag) Markup
cont
customLeaf :: Tag
-> Bool
-> Markup
customLeaf :: Tag -> Bool -> Markup
customLeaf Tag
tag Bool
close = ChoiceString -> Bool -> () -> Markup
forall a. ChoiceString -> Bool -> a -> MarkupM a
CustomLeaf (StaticString -> ChoiceString
Static (StaticString -> ChoiceString) -> StaticString -> ChoiceString
forall a b. (a -> b) -> a -> b
$ Tag -> StaticString
unTag Tag
tag) Bool
close ()
attribute :: Tag
-> Tag
-> AttributeValue
-> Attribute
attribute :: Tag -> Tag -> AttributeValue -> Attribute
attribute Tag
rawKey Tag
key AttributeValue
value = (forall a. MarkupM a -> MarkupM a) -> Attribute
Attribute ((forall a. MarkupM a -> MarkupM a) -> Attribute)
-> (forall a. MarkupM a -> MarkupM a) -> Attribute
forall a b. (a -> b) -> a -> b
$
StaticString
-> StaticString -> ChoiceString -> MarkupM a -> MarkupM a
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 #-}
dataAttribute :: Tag
-> AttributeValue
-> Attribute
dataAttribute :: Tag -> AttributeValue -> Attribute
dataAttribute Tag
tag AttributeValue
value = (forall a. MarkupM a -> MarkupM a) -> Attribute
Attribute ((forall a. MarkupM a -> MarkupM a) -> Attribute)
-> (forall a. MarkupM a -> MarkupM a) -> Attribute
forall a b. (a -> b) -> a -> b
$ ChoiceString -> ChoiceString -> MarkupM a -> MarkupM a
forall a. ChoiceString -> ChoiceString -> MarkupM a -> MarkupM a
AddCustomAttribute
(StaticString -> ChoiceString
Static StaticString
"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 #-}
customAttribute :: Tag
-> AttributeValue
-> Attribute
customAttribute :: Tag -> AttributeValue -> Attribute
customAttribute Tag
tag AttributeValue
value = (forall a. MarkupM a -> MarkupM a) -> Attribute
Attribute ((forall a. MarkupM a -> MarkupM a) -> Attribute)
-> (forall a. MarkupM a -> MarkupM a) -> Attribute
forall a b. (a -> b) -> a -> b
$ ChoiceString -> ChoiceString -> MarkupM a -> MarkupM a
forall a. ChoiceString -> ChoiceString -> MarkupM a -> MarkupM 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 #-}
text :: Text
-> Markup
text :: Text -> Markup
text = ChoiceString -> Markup
content (ChoiceString -> Markup)
-> (Text -> ChoiceString) -> Text -> Markup
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ChoiceString
Text
{-# INLINE text #-}
preEscapedText :: Text
-> Markup
preEscapedText :: Text -> Markup
preEscapedText = ChoiceString -> Markup
content (ChoiceString -> Markup)
-> (Text -> ChoiceString) -> Text -> Markup
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 #-}
lazyText :: LT.Text
-> Markup
lazyText :: Text -> Markup
lazyText = [Markup] -> Markup
forall a. Monoid a => [a] -> a
mconcat ([Markup] -> Markup) -> (Text -> [Markup]) -> Text -> Markup
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Markup) -> [Text] -> [Markup]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Markup
text ([Text] -> [Markup]) -> (Text -> [Text]) -> Text -> [Markup]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
LT.toChunks
{-# INLINE lazyText #-}
preEscapedLazyText :: LT.Text
-> Markup
preEscapedLazyText :: Text -> Markup
preEscapedLazyText = [Markup] -> Markup
forall a. Monoid a => [a] -> a
mconcat ([Markup] -> Markup) -> (Text -> [Markup]) -> Text -> Markup
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Markup) -> [Text] -> [Markup]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Markup
preEscapedText ([Text] -> [Markup]) -> (Text -> [Text]) -> Text -> [Markup]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
LT.toChunks
{-# INLINE preEscapedLazyText #-}
textBuilder :: LTB.Builder
-> Markup
textBuilder :: Builder -> Markup
textBuilder = Text -> Markup
lazyText (Text -> Markup) -> (Builder -> Text) -> Builder -> Markup
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
LTB.toLazyText
{-# INLINE textBuilder #-}
preEscapedTextBuilder :: LTB.Builder
-> Markup
preEscapedTextBuilder :: Builder -> Markup
preEscapedTextBuilder = Text -> Markup
preEscapedLazyText (Text -> Markup) -> (Builder -> Text) -> Builder -> Markup
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 = ChoiceString -> () -> Markup
forall a. ChoiceString -> a -> MarkupM a
Content ChoiceString
cs ()
{-# INLINE content #-}
string :: String
-> Markup
string :: String -> Markup
string = ChoiceString -> Markup
content (ChoiceString -> Markup)
-> (String -> ChoiceString) -> String -> Markup
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ChoiceString
String
{-# INLINE string #-}
preEscapedString :: String
-> Markup
preEscapedString :: String -> Markup
preEscapedString = ChoiceString -> Markup
content (ChoiceString -> Markup)
-> (String -> ChoiceString) -> String -> Markup
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChoiceString -> ChoiceString
PreEscaped (ChoiceString -> ChoiceString)
-> (String -> ChoiceString) -> String -> ChoiceString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ChoiceString
String
{-# INLINE preEscapedString #-}
unsafeByteString :: ByteString
-> Markup
unsafeByteString :: ByteString -> Markup
unsafeByteString = ChoiceString -> Markup
content (ChoiceString -> Markup)
-> (ByteString -> ChoiceString) -> ByteString -> Markup
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ChoiceString
ByteString
{-# INLINE unsafeByteString #-}
unsafeLazyByteString :: BL.ByteString
-> Markup
unsafeLazyByteString :: ByteString -> Markup
unsafeLazyByteString = [Markup] -> Markup
forall a. Monoid a => [a] -> a
mconcat ([Markup] -> Markup)
-> (ByteString -> [Markup]) -> ByteString -> Markup
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> Markup) -> [ByteString] -> [Markup]
forall a b. (a -> b) -> [a] -> [b]
map ByteString -> Markup
unsafeByteString ([ByteString] -> [Markup])
-> (ByteString -> [ByteString]) -> ByteString -> [Markup]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
BL.toChunks
{-# INLINE unsafeLazyByteString #-}
comment :: ChoiceString -> Markup
ChoiceString
cs = ChoiceString -> () -> Markup
forall a. ChoiceString -> a -> MarkupM a
Comment ChoiceString
cs ()
{-# INLINE comment #-}
textComment :: Text -> Markup
= ChoiceString -> Markup
comment (ChoiceString -> Markup)
-> (Text -> ChoiceString) -> Text -> Markup
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
lazyTextComment :: LT.Text -> Markup
= ChoiceString -> Markup
comment (ChoiceString -> Markup)
-> (Text -> ChoiceString) -> Text -> Markup
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ChoiceString] -> ChoiceString
forall a. Monoid a => [a] -> a
mconcat ([ChoiceString] -> ChoiceString)
-> (Text -> [ChoiceString]) -> Text -> ChoiceString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> ChoiceString) -> [Text] -> [ChoiceString]
forall a b. (a -> b) -> [a] -> [b]
map (ChoiceString -> ChoiceString
PreEscaped (ChoiceString -> ChoiceString)
-> (Text -> ChoiceString) -> Text -> ChoiceString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ChoiceString
Text) ([Text] -> [ChoiceString])
-> (Text -> [Text]) -> Text -> [ChoiceString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
LT.toChunks
stringComment :: String -> Markup
= ChoiceString -> Markup
comment (ChoiceString -> Markup)
-> (String -> ChoiceString) -> String -> Markup
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChoiceString -> ChoiceString
PreEscaped (ChoiceString -> ChoiceString)
-> (String -> ChoiceString) -> String -> ChoiceString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ChoiceString
String
unsafeByteStringComment :: ByteString -> Markup
= ChoiceString -> Markup
comment (ChoiceString -> Markup)
-> (ByteString -> ChoiceString) -> ByteString -> Markup
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChoiceString -> ChoiceString
PreEscaped (ChoiceString -> ChoiceString)
-> (ByteString -> ChoiceString) -> ByteString -> ChoiceString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ChoiceString
ByteString
unsafeLazyByteStringComment :: BL.ByteString -> Markup
=
ChoiceString -> Markup
comment (ChoiceString -> Markup)
-> (ByteString -> ChoiceString) -> ByteString -> Markup
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ChoiceString] -> ChoiceString
forall a. Monoid a => [a] -> a
mconcat ([ChoiceString] -> ChoiceString)
-> (ByteString -> [ChoiceString]) -> ByteString -> ChoiceString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> ChoiceString) -> [ByteString] -> [ChoiceString]
forall a b. (a -> b) -> [a] -> [b]
map (ChoiceString -> ChoiceString
PreEscaped (ChoiceString -> ChoiceString)
-> (ByteString -> ChoiceString) -> ByteString -> ChoiceString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ChoiceString
ByteString) ([ByteString] -> [ChoiceString])
-> (ByteString -> [ByteString]) -> ByteString -> [ChoiceString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
BL.toChunks
textTag :: Text
-> Tag
textTag :: Text -> Tag
textTag Text
t = StaticString -> Tag
Tag (StaticString -> Tag) -> StaticString -> Tag
forall a b. (a -> b) -> a -> b
$ (String -> String) -> ByteString -> Text -> StaticString
StaticString (Text -> String
T.unpack Text
t String -> String -> String
forall a. [a] -> [a] -> [a]
++) (Text -> ByteString
T.encodeUtf8 Text
t) Text
t
stringTag :: String
-> Tag
stringTag :: String -> Tag
stringTag = StaticString -> Tag
Tag (StaticString -> Tag) -> (String -> StaticString) -> String -> Tag
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> StaticString
forall a. IsString a => String -> a
fromString
textValue :: Text
-> AttributeValue
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 #-}
preEscapedTextValue :: Text
-> AttributeValue
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 #-}
lazyTextValue :: LT.Text
-> AttributeValue
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 #-}
preEscapedLazyTextValue :: LT.Text
-> AttributeValue
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 #-}
textBuilderValue :: LTB.Builder
-> AttributeValue
textBuilderValue :: Builder -> AttributeValue
textBuilderValue = Text -> AttributeValue
lazyTextValue (Text -> AttributeValue)
-> (Builder -> Text) -> Builder -> AttributeValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
LTB.toLazyText
{-# INLINE textBuilderValue #-}
preEscapedTextBuilderValue :: LTB.Builder
-> AttributeValue
preEscapedTextBuilderValue :: Builder -> AttributeValue
preEscapedTextBuilderValue = Text -> AttributeValue
preEscapedLazyTextValue (Text -> AttributeValue)
-> (Builder -> Text) -> Builder -> AttributeValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
LTB.toLazyText
{-# INLINE preEscapedTextBuilderValue #-}
stringValue :: String -> AttributeValue
stringValue :: String -> AttributeValue
stringValue = ChoiceString -> AttributeValue
AttributeValue (ChoiceString -> AttributeValue)
-> (String -> ChoiceString) -> String -> AttributeValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ChoiceString
String
{-# INLINE stringValue #-}
preEscapedStringValue :: String -> AttributeValue
preEscapedStringValue :: String -> AttributeValue
preEscapedStringValue = ChoiceString -> AttributeValue
AttributeValue (ChoiceString -> AttributeValue)
-> (String -> ChoiceString) -> String -> AttributeValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChoiceString -> ChoiceString
PreEscaped (ChoiceString -> ChoiceString)
-> (String -> ChoiceString) -> String -> ChoiceString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ChoiceString
String
{-# INLINE preEscapedStringValue #-}
unsafeByteStringValue :: ByteString
-> AttributeValue
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 #-}
unsafeLazyByteStringValue :: BL.ByteString
-> AttributeValue
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 #-}
class Attributable h where
(!) :: h -> Attribute -> h
instance Attributable (MarkupM a) where
MarkupM a
h ! :: MarkupM a -> Attribute -> MarkupM a
! (Attribute forall a. MarkupM a -> MarkupM a
f) = MarkupM a -> MarkupM a
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 = (MarkupM b -> Attribute -> MarkupM b
forall h. Attributable h => h -> Attribute -> h
! Attribute
f) (MarkupM b -> MarkupM b)
-> (MarkupM a -> MarkupM b) -> MarkupM a -> MarkupM b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MarkupM a -> MarkupM b
h
{-# INLINE (!) #-}
(!?) :: Attributable h => h -> (Bool, Attribute) -> h
!? :: h -> (Bool, Attribute) -> h
(!?) h
h (Bool
c, Attribute
a) = if Bool
c then h
h h -> Attribute -> h
forall h. Attributable h => h -> Attribute -> h
! Attribute
a else h
h
external :: MarkupM a -> MarkupM a
external :: MarkupM a -> MarkupM a
external (Content ChoiceString
x a
a) = ChoiceString -> a -> MarkupM a
forall a. ChoiceString -> a -> MarkupM a
Content (ChoiceString -> ChoiceString
External ChoiceString
x) a
a
external (Append MarkupM b
x MarkupM a
y) = MarkupM b -> MarkupM a -> MarkupM a
forall a b. MarkupM b -> MarkupM a -> MarkupM a
Append (MarkupM b -> MarkupM b
forall a. MarkupM a -> MarkupM a
external MarkupM b
x) (MarkupM a -> MarkupM a
forall a. MarkupM a -> MarkupM a
external MarkupM a
y)
external (Parent StaticString
x StaticString
y StaticString
z MarkupM a
i) = StaticString
-> StaticString -> StaticString -> MarkupM a -> MarkupM a
forall a.
StaticString
-> StaticString -> StaticString -> MarkupM a -> MarkupM a
Parent StaticString
x StaticString
y StaticString
z (MarkupM a -> MarkupM a) -> MarkupM a -> MarkupM a
forall a b. (a -> b) -> a -> b
$ MarkupM a -> MarkupM a
forall a. MarkupM a -> MarkupM a
external MarkupM a
i
external (CustomParent ChoiceString
x MarkupM a
i) = ChoiceString -> MarkupM a -> MarkupM a
forall a. ChoiceString -> MarkupM a -> MarkupM a
CustomParent ChoiceString
x (MarkupM a -> MarkupM a) -> MarkupM a -> MarkupM a
forall a b. (a -> b) -> a -> b
$ MarkupM a -> MarkupM a
forall a. MarkupM a -> MarkupM a
external MarkupM a
i
external (AddAttribute StaticString
x StaticString
y ChoiceString
z MarkupM a
i) = StaticString
-> StaticString -> ChoiceString -> MarkupM a -> MarkupM a
forall a.
StaticString
-> StaticString -> ChoiceString -> MarkupM a -> MarkupM a
AddAttribute StaticString
x StaticString
y ChoiceString
z (MarkupM a -> MarkupM a) -> MarkupM a -> MarkupM a
forall a b. (a -> b) -> a -> b
$ MarkupM a -> MarkupM a
forall a. MarkupM a -> MarkupM a
external MarkupM a
i
external (AddCustomAttribute ChoiceString
x ChoiceString
y MarkupM a
i) = ChoiceString -> ChoiceString -> MarkupM a -> MarkupM a
forall a. ChoiceString -> ChoiceString -> MarkupM a -> MarkupM a
AddCustomAttribute ChoiceString
x ChoiceString
y (MarkupM a -> MarkupM a) -> MarkupM a -> MarkupM a
forall a b. (a -> b) -> a -> b
$ MarkupM a -> MarkupM a
forall a. MarkupM a -> MarkupM a
external MarkupM a
i
external MarkupM a
x = MarkupM a
x
{-# INLINE external #-}
contents :: MarkupM a -> MarkupM a
contents :: MarkupM a -> MarkupM a
contents (Parent StaticString
_ StaticString
_ StaticString
_ MarkupM a
c) = MarkupM a -> MarkupM a
forall a. MarkupM a -> MarkupM a
contents MarkupM a
c
contents (CustomParent ChoiceString
_ MarkupM a
c) = MarkupM a -> MarkupM a
forall a. MarkupM a -> MarkupM a
contents MarkupM a
c
contents (Content ChoiceString
c a
x) = ChoiceString -> a -> MarkupM a
forall a. ChoiceString -> a -> MarkupM a
Content ChoiceString
c a
x
contents (Append MarkupM b
c1 MarkupM a
c2) = MarkupM b -> MarkupM a -> MarkupM a
forall a b. MarkupM b -> MarkupM a -> MarkupM a
Append (MarkupM b -> MarkupM b
forall a. MarkupM a -> MarkupM a
contents MarkupM b
c1) (MarkupM a -> MarkupM a
forall a. MarkupM a -> MarkupM a
contents MarkupM a
c2)
contents (AddAttribute StaticString
_ StaticString
_ ChoiceString
_ MarkupM a
c) = MarkupM a -> MarkupM a
forall a. MarkupM a -> MarkupM a
contents MarkupM a
c
contents (AddCustomAttribute ChoiceString
_ ChoiceString
_ MarkupM a
c) = MarkupM a -> MarkupM a
forall a. MarkupM a -> MarkupM a
contents MarkupM a
c
contents MarkupM a
m = a -> MarkupM a
forall a. a -> MarkupM a
Empty (MarkupM a -> a
forall a. MarkupM a -> a
markupValue MarkupM a
m)
null :: MarkupM a -> Bool
null :: 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 -> MarkupM b -> Bool
forall a. MarkupM a -> Bool
null MarkupM b
c1 Bool -> Bool -> Bool
&& MarkupM a -> Bool
forall a. MarkupM a -> Bool
null MarkupM a
c2
AddAttribute StaticString
_ StaticString
_ ChoiceString
_ MarkupM a
c -> MarkupM a -> Bool
forall a. MarkupM a -> Bool
null MarkupM a
c
AddCustomAttribute ChoiceString
_ ChoiceString
_ MarkupM a
c -> MarkupM a -> Bool
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 -> String -> Bool
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 (ByteString -> Bool)
-> (StaticString -> ByteString) -> StaticString -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StaticString -> ByteString
getUtf8ByteString