{-|
Module      : $Header$
Description : Types and conversions
Copyright   : (c) Justus Adam, 2015
License     : BSD3
Maintainer  : dev@justus.science
Stability   : experimental
Portability : POSIX

escapeXML and xmlEntities curtesy to the tagsoup library.
-}
module Text.Mustache.Internal (uncons, escapeXMLText) where


import           Data.Char   (ord)
import qualified Data.IntMap as IntMap
import qualified Data.Text   as T


uncons :: [α] -> Maybe (α, [α])
uncons :: forall α. [α] -> Maybe (α, [α])
uncons []     = forall a. Maybe a
Nothing
uncons (α
x:[α]
xs) = forall (m :: * -> *) a. Monad m => a -> m a
return (α
x, [α]
xs)


escapeXMLText :: T.Text -> T.Text
escapeXMLText :: Text -> Text
escapeXMLText = String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
escapeXML forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack


escapeXML :: String -> String
escapeXML :: String -> String
escapeXML = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a b. (a -> b) -> a -> b
$ \Char
x -> forall a. a -> Key -> IntMap a -> a
IntMap.findWithDefault [Char
x] (Char -> Key
ord Char
x) IntMap String
mp
    where mp :: IntMap String
mp = forall a. [(Key, a)] -> IntMap a
IntMap.fromList [(Char -> Key
ord Char
b, String
"&"forall a. [a] -> [a] -> [a]
++String
aforall a. [a] -> [a] -> [a]
++String
";") | (String
a,[Char
b]) <- [(String, String)]
xmlEntities]


xmlEntities :: [(String, String)]
xmlEntities :: [(String, String)]
xmlEntities =
  [ (String
"quot", String
"\"")
  , (String
"#39", String
"'")
  , (String
"amp" , String
"&")
  , (String
"lt"  , String
"<")
  , (String
"gt"  , String
">")
  ]