{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeOperators #-}
module Html.Convert where
import Data.Word
import Data.Proxy
import Data.String
import GHC.TypeLits
import Html.Type
import Data.Char (ord)
import qualified Data.Monoid as M
import qualified Data.Semigroup as S
import qualified Data.ByteString.Builder as B
import qualified Data.ByteString.Builder.Prim as BP
import qualified Data.ByteString.Builder.Internal as U
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Encoding as TL
{-# INLINE escape #-}
escape :: BP.BoundedPrim Word8
escape =
BP.condB (> c2w '>' ) (BP.liftFixedToBounded BP.word8) $
BP.condB (== c2w '<' ) (fixed4 (c2w '&',(c2w 'l',(c2w 't',c2w ';')))) $
BP.condB (== c2w '>' ) (fixed4 (c2w '&',(c2w 'g',(c2w 't',c2w ';')))) $
BP.condB (== c2w '&' ) (fixed5 (c2w '&',(c2w 'a',(c2w 'm',(c2w 'p',c2w ';'))))) $
BP.condB (== c2w '"' ) (fixed5 (c2w '&',(c2w '#',(c2w '3',(c2w '4',c2w ';'))))) $
BP.condB (== c2w '\'') (fixed5 (c2w '&',(c2w '#',(c2w '3',(c2w '9',c2w ';'))))) $
BP.liftFixedToBounded BP.word8
where
{-# INLINE c2w #-}
c2w = fromIntegral . ord
{-# INLINE fixed4 #-}
fixed4 x = BP.liftFixedToBounded $ const x BP.>$<
BP.word8 BP.>*< BP.word8 BP.>*< BP.word8 BP.>*< BP.word8
{-# INLINE fixed5 #-}
fixed5 x = BP.liftFixedToBounded $ const x BP.>$<
BP.word8 BP.>*< BP.word8 BP.>*< BP.word8 BP.>*< BP.word8 BP.>*< BP.word8
newtype Converted = Converted {unConv :: B.Builder} deriving (M.Monoid,S.Semigroup)
instance IsString Converted where
fromString = convert
class Convert a where
convert :: a -> Converted
instance Convert b => Convert (a := b) where
{-# INLINE convert #-}
convert (AT x) = convert x
instance Convert (Raw String) where
{-# INLINE convert #-}
convert (Raw x) = Converted (fromString x)
instance Convert (Raw T.Text) where
{-# INLINE convert #-}
convert (Raw x) = Converted (T.encodeUtf8Builder x)
instance Convert (Raw TL.Text) where
{-# INLINE convert #-}
convert (Raw x) = Converted (TL.encodeUtf8Builder x)
instance Convert String where
{-# INLINE convert #-}
convert = convert . T.pack
instance Convert T.Text where
{-# INLINE convert #-}
convert = Converted . T.encodeUtf8BuilderEscaped escape
instance Convert TL.Text where
{-# INLINE convert #-}
convert = Converted . TL.encodeUtf8BuilderEscaped escape
instance Convert Int where
{-# INLINE convert #-}
convert = Converted . B.intDec
instance Convert Integer where
{-# INLINE convert #-}
convert = Converted . B.integerDec
instance Convert Float where
{-# INLINE convert #-}
convert = Converted . B.floatDec
instance Convert Double where
{-# INLINE convert #-}
convert = Converted . B.doubleDec
instance Convert Word where
{-# INLINE convert #-}
convert = Converted . B.wordDec
instance KnownSymbol a => Convert (Proxy a) where
{-# INLINE convert #-}
convert = Converted . U.byteStringCopy . fromString . symbolVal