{-# LANGUAGE CPP #-}
#if __GLASGOW_HASKELL__ >= 704
{-# OPTIONS_GHC -fsimpl-tick-factor=40000 #-}
#endif

------------------------------------------------------------------------------
-- |
-- Module:      Blaze.ByteString.Builder.Html.Utf8
-- Copyright:   (c) 2013 Leon P Smith
-- License:     BSD3
-- Maintainer:  Leon P Smith <leon@melding-monads.com>
-- Stability:   experimental
--
-- 'Write's and 'Builder's for serializing HTML escaped and UTF-8 encoded
-- characters.
--
-- This module is used by both the 'blaze-html' and the \'hamlet\' HTML
-- templating libraries. If the 'Builder' from 'blaze-builder' replaces the
-- 'Data.Binary.Builder' implementation, this module will most likely keep its
-- place, as it provides a set of very specialized functions.
--
------------------------------------------------------------------------------

module Blaze.ByteString.Builder.Html.Utf8
    (
      module Blaze.ByteString.Builder.Char.Utf8

      -- * Writing HTML escaped and UTF-8 encoded characters to a buffer
    , writeHtmlEscapedChar

      -- * Creating Builders from HTML escaped and UTF-8 encoded characters
    , fromHtmlEscapedChar
    , fromHtmlEscapedString
    , fromHtmlEscapedShow
    , fromHtmlEscapedText
    , fromHtmlEscapedLazyText
    ) where

import Data.ByteString.Char8 ()  -- for the 'IsString' instance of bytesrings

import qualified Data.Text      as TS
import qualified Data.Text.Encoding as TE
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Encoding as TLE

import Blaze.ByteString.Builder.Compat.Write ( Write, writePrimBounded )
import qualified Data.ByteString.Builder       as B
import           Data.ByteString.Builder.Prim ((>*<), (>$<), condB)
import qualified Data.ByteString.Builder.Prim  as P

import Blaze.ByteString.Builder.Char.Utf8
import Blaze.ByteString.Builder.Html.Word

-- | Write a HTML escaped and UTF-8 encoded Unicode character to a bufffer.
--
writeHtmlEscapedChar :: Char -> Write
writeHtmlEscapedChar :: Char -> Write
writeHtmlEscapedChar = BoundedPrim Char -> Char -> Write
forall a. BoundedPrim a -> a -> Write
writePrimBounded BoundedPrim Char
charUtf8HtmlEscaped
{-# INLINE writeHtmlEscapedChar #-}

-- | /O(1)./ Serialize a HTML escaped Unicode character using the UTF-8
-- encoding.
fromHtmlEscapedChar :: Char -> B.Builder
fromHtmlEscapedChar :: Char -> Builder
fromHtmlEscapedChar = BoundedPrim Char -> Char -> Builder
forall a. BoundedPrim a -> a -> Builder
P.primBounded BoundedPrim Char
charUtf8HtmlEscaped
{-# INLINE fromHtmlEscapedChar #-}

{-# INLINE charUtf8HtmlEscaped #-}
charUtf8HtmlEscaped :: P.BoundedPrim Char
charUtf8HtmlEscaped :: BoundedPrim Char
charUtf8HtmlEscaped =
    (Char -> Bool)
-> BoundedPrim Char -> BoundedPrim Char -> BoundedPrim Char
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>  '>' ) ((Char -> Bool)
-> BoundedPrim Char -> BoundedPrim Char -> BoundedPrim Char
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '\DEL') BoundedPrim Char
forall a. BoundedPrim a
P.emptyB BoundedPrim Char
P.charUtf8) (BoundedPrim Char -> BoundedPrim Char)
-> BoundedPrim Char -> BoundedPrim Char
forall a b. (a -> b) -> a -> b
$
    (Char -> Bool)
-> BoundedPrim Char -> BoundedPrim Char -> BoundedPrim Char
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '<' ) ((Char, (Char, (Char, Char))) -> BoundedPrim Char
forall a. (Char, (Char, (Char, Char))) -> BoundedPrim a
fixed4 ('&',('l',('t',';')))) (BoundedPrim Char -> BoundedPrim Char)
-> BoundedPrim Char -> BoundedPrim Char
forall a b. (a -> b) -> a -> b
$        -- &lt;
    (Char -> Bool)
-> BoundedPrim Char -> BoundedPrim Char -> BoundedPrim Char
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '>' ) ((Char, (Char, (Char, Char))) -> BoundedPrim Char
forall a. (Char, (Char, (Char, Char))) -> BoundedPrim a
fixed4 ('&',('g',('t',';')))) (BoundedPrim Char -> BoundedPrim Char)
-> BoundedPrim Char -> BoundedPrim Char
forall a b. (a -> b) -> a -> b
$        -- &gt;
    (Char -> Bool)
-> BoundedPrim Char -> BoundedPrim Char -> BoundedPrim Char
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '&' ) ((Char, (Char, (Char, (Char, Char)))) -> BoundedPrim Char
forall a. (Char, (Char, (Char, (Char, Char)))) -> BoundedPrim a
fixed5 ('&',('a',('m',('p',';'))))) (BoundedPrim Char -> BoundedPrim Char)
-> BoundedPrim Char -> BoundedPrim Char
forall a b. (a -> b) -> a -> b
$  -- &amp;
    (Char -> Bool)
-> BoundedPrim Char -> BoundedPrim Char -> BoundedPrim Char
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '"' ) ((Char, (Char, (Char, (Char, (Char, Char))))) -> BoundedPrim Char
forall a.
(Char, (Char, (Char, (Char, (Char, Char))))) -> BoundedPrim a
fixed6 ('&',('q',('u',('o',('t',';')))))) (BoundedPrim Char -> BoundedPrim Char)
-> BoundedPrim Char -> BoundedPrim Char
forall a b. (a -> b) -> a -> b
$  -- &#quot;
    (Char -> Bool)
-> BoundedPrim Char -> BoundedPrim Char -> BoundedPrim Char
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '\'') ((Char, (Char, (Char, (Char, Char)))) -> BoundedPrim Char
forall a. (Char, (Char, (Char, (Char, Char)))) -> BoundedPrim a
fixed5 ('&',('#',('3',('9',';'))))) (BoundedPrim Char -> BoundedPrim Char)
-> BoundedPrim Char -> BoundedPrim Char
forall a b. (a -> b) -> a -> b
$  -- &#39;
    (Char -> Bool)
-> BoundedPrim Char -> BoundedPrim Char -> BoundedPrim Char
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (\c :: Char
c -> Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= ' ' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '\t' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '\n' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '\r')
          (FixedPrim Char -> BoundedPrim Char
forall a. FixedPrim a -> BoundedPrim a
P.liftFixedToBounded FixedPrim Char
P.char7) (BoundedPrim Char -> BoundedPrim Char)
-> BoundedPrim Char -> BoundedPrim Char
forall a b. (a -> b) -> a -> b
$
    BoundedPrim Char
forall a. BoundedPrim a
P.emptyB
  where
    {-# INLINE fixed4 #-}
    fixed4 :: (Char, (Char, (Char, Char))) -> BoundedPrim a
fixed4 x :: (Char, (Char, (Char, Char)))
x = FixedPrim a -> BoundedPrim a
forall a. FixedPrim a -> BoundedPrim a
P.liftFixedToBounded (FixedPrim a -> BoundedPrim a) -> FixedPrim a -> BoundedPrim a
forall a b. (a -> b) -> a -> b
$ (Char, (Char, (Char, Char))) -> a -> (Char, (Char, (Char, Char)))
forall a b. a -> b -> a
const (Char, (Char, (Char, Char)))
x (a -> (Char, (Char, (Char, Char))))
-> FixedPrim (Char, (Char, (Char, Char))) -> FixedPrim a
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$<
      FixedPrim Char
P.char7 FixedPrim Char
-> FixedPrim (Char, (Char, Char))
-> FixedPrim (Char, (Char, (Char, Char)))
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< FixedPrim Char
P.char7 FixedPrim Char
-> FixedPrim (Char, Char) -> FixedPrim (Char, (Char, Char))
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< FixedPrim Char
P.char7 FixedPrim Char -> FixedPrim Char -> FixedPrim (Char, Char)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< FixedPrim Char
P.char7

    {-# INLINE fixed5 #-}
    fixed5 :: (Char, (Char, (Char, (Char, Char)))) -> BoundedPrim a
fixed5 x :: (Char, (Char, (Char, (Char, Char))))
x = FixedPrim a -> BoundedPrim a
forall a. FixedPrim a -> BoundedPrim a
P.liftFixedToBounded (FixedPrim a -> BoundedPrim a) -> FixedPrim a -> BoundedPrim a
forall a b. (a -> b) -> a -> b
$ (Char, (Char, (Char, (Char, Char))))
-> a -> (Char, (Char, (Char, (Char, Char))))
forall a b. a -> b -> a
const (Char, (Char, (Char, (Char, Char))))
x (a -> (Char, (Char, (Char, (Char, Char)))))
-> FixedPrim (Char, (Char, (Char, (Char, Char)))) -> FixedPrim a
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$<
      FixedPrim Char
P.char7 FixedPrim Char
-> FixedPrim (Char, (Char, (Char, Char)))
-> FixedPrim (Char, (Char, (Char, (Char, Char))))
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< FixedPrim Char
P.char7 FixedPrim Char
-> FixedPrim (Char, (Char, Char))
-> FixedPrim (Char, (Char, (Char, Char)))
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< FixedPrim Char
P.char7 FixedPrim Char
-> FixedPrim (Char, Char) -> FixedPrim (Char, (Char, Char))
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< FixedPrim Char
P.char7 FixedPrim Char -> FixedPrim Char -> FixedPrim (Char, Char)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< FixedPrim Char
P.char7

    {-# INLINE fixed6 #-}
    fixed6 :: (Char, (Char, (Char, (Char, (Char, Char))))) -> BoundedPrim a
fixed6 x :: (Char, (Char, (Char, (Char, (Char, Char)))))
x = FixedPrim a -> BoundedPrim a
forall a. FixedPrim a -> BoundedPrim a
P.liftFixedToBounded (FixedPrim a -> BoundedPrim a) -> FixedPrim a -> BoundedPrim a
forall a b. (a -> b) -> a -> b
$ (Char, (Char, (Char, (Char, (Char, Char)))))
-> a -> (Char, (Char, (Char, (Char, (Char, Char)))))
forall a b. a -> b -> a
const (Char, (Char, (Char, (Char, (Char, Char)))))
x (a -> (Char, (Char, (Char, (Char, (Char, Char))))))
-> FixedPrim (Char, (Char, (Char, (Char, (Char, Char)))))
-> FixedPrim a
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$<
      FixedPrim Char
P.char7 FixedPrim Char
-> FixedPrim (Char, (Char, (Char, (Char, Char))))
-> FixedPrim (Char, (Char, (Char, (Char, (Char, Char)))))
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< FixedPrim Char
P.char7 FixedPrim Char
-> FixedPrim (Char, (Char, (Char, Char)))
-> FixedPrim (Char, (Char, (Char, (Char, Char))))
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< FixedPrim Char
P.char7 FixedPrim Char
-> FixedPrim (Char, (Char, Char))
-> FixedPrim (Char, (Char, (Char, Char)))
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< FixedPrim Char
P.char7 FixedPrim Char
-> FixedPrim (Char, Char) -> FixedPrim (Char, (Char, Char))
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< FixedPrim Char
P.char7 FixedPrim Char -> FixedPrim Char -> FixedPrim (Char, Char)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< FixedPrim Char
P.char7

-- | /O(n)/. Serialize a HTML escaped Unicode 'String' using the UTF-8
-- encoding.
--
fromHtmlEscapedString :: String -> B.Builder
fromHtmlEscapedString :: String -> Builder
fromHtmlEscapedString = BoundedPrim Char -> String -> Builder
forall a. BoundedPrim a -> [a] -> Builder
P.primMapListBounded BoundedPrim Char
charUtf8HtmlEscaped

-- | /O(n)/. Serialize a value by 'Show'ing it and then, HTML escaping and
-- UTF-8 encoding the resulting 'String'.
--
fromHtmlEscapedShow :: Show a => a -> B.Builder
fromHtmlEscapedShow :: a -> Builder
fromHtmlEscapedShow = String -> Builder
fromHtmlEscapedString (String -> Builder) -> (a -> String) -> a -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show

-- | /O(n)/. Serialize a HTML escaped strict Unicode 'TS.Text' value using the
-- UTF-8 encoding.
--
fromHtmlEscapedText :: TS.Text -> B.Builder
#if MIN_VERSION_text(1,1,2) && MIN_VERSION_bytestring(0,10,4)
fromHtmlEscapedText :: Text -> Builder
fromHtmlEscapedText = BoundedPrim Word8 -> Text -> Builder
TE.encodeUtf8BuilderEscaped BoundedPrim Word8
wordHtmlEscaped
#else
fromHtmlEscapedText = fromHtmlEscapedString . TS.unpack
#endif

-- | /O(n)/. Serialize a HTML escaped Unicode 'TL.Text' using the UTF-8 encoding.
--
fromHtmlEscapedLazyText :: TL.Text -> B.Builder
#if MIN_VERSION_text(1,1,2) && MIN_VERSION_bytestring(0,10,4)
fromHtmlEscapedLazyText :: Text -> Builder
fromHtmlEscapedLazyText = BoundedPrim Word8 -> Text -> Builder
TLE.encodeUtf8BuilderEscaped BoundedPrim Word8
wordHtmlEscaped
#else
fromHtmlEscapedLazyText = fromHtmlEscapedString . TL.unpack
#endif