{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MagicHash #-}
module Html.Convert where
import Data.Proxy
import Data.String
import GHC.TypeLits
import Html.Type
import Data.Char (ord)
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
{-# INLINE escape #-}
escape :: T.Text -> B.Builder
escape = T.encodeUtf8BuilderEscaped $
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
class Convert a where
convert :: a -> Converted B.Builder
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 String where
{-# INLINE convert #-}
convert = Converted . escape . fromString
instance Convert T.Text where
{-# INLINE convert #-}
convert = Converted . 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