-- | A HTML type, useful for implementing type-safe conversion between plain
-- text and HTML.
-- The HTML representation used here assumed Unicode throughout, and UTF-8
-- should be used as the encoding when sending @Html@ objects as responses to a
-- HTTP client.
{-#LANGUAGE GeneralizedNewtypeDeriving #-}
{-#LANGUAGE OverloadedStrings #-}
{-#LANGUAGE FlexibleInstances #-}
module Text.Ginger.Html
( Html
, unsafeRawHtml
, html
, htmlSource
, ToHtml (..)
)
where

import Data.Text (Text)
import qualified Data.Text as Text
import Data.Semigroup as Semigroup

-- | A chunk of HTML source.
newtype Html = Html { Html -> Text
unHtml :: Text }
    deriving (b -> Html -> Html
NonEmpty Html -> Html
Html -> Html -> Html
(Html -> Html -> Html)
-> (NonEmpty Html -> Html)
-> (forall b. Integral b => b -> Html -> Html)
-> Semigroup Html
forall b. Integral b => b -> Html -> Html
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> Html -> Html
$cstimes :: forall b. Integral b => b -> Html -> Html
sconcat :: NonEmpty Html -> Html
$csconcat :: NonEmpty Html -> Html
<> :: Html -> Html -> Html
$c<> :: Html -> Html -> Html
Semigroup.Semigroup, Semigroup Html
Html
Semigroup Html
-> Html
-> (Html -> Html -> Html)
-> ([Html] -> Html)
-> Monoid Html
[Html] -> Html
Html -> Html -> Html
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [Html] -> Html
$cmconcat :: [Html] -> Html
mappend :: Html -> Html -> Html
$cmappend :: Html -> Html -> Html
mempty :: Html
$cmempty :: Html
$cp1Monoid :: Semigroup Html
Monoid, Int -> Html -> ShowS
[Html] -> ShowS
Html -> String
(Int -> Html -> ShowS)
-> (Html -> String) -> ([Html] -> ShowS) -> Show Html
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Html] -> ShowS
$cshowList :: [Html] -> ShowS
show :: Html -> String
$cshow :: Html -> String
showsPrec :: Int -> Html -> ShowS
$cshowsPrec :: Int -> Html -> ShowS
Show, Html -> Html -> Bool
(Html -> Html -> Bool) -> (Html -> Html -> Bool) -> Eq Html
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Html -> Html -> Bool
$c/= :: Html -> Html -> Bool
== :: Html -> Html -> Bool
$c== :: Html -> Html -> Bool
Eq, Eq Html
Eq Html
-> (Html -> Html -> Ordering)
-> (Html -> Html -> Bool)
-> (Html -> Html -> Bool)
-> (Html -> Html -> Bool)
-> (Html -> Html -> Bool)
-> (Html -> Html -> Html)
-> (Html -> Html -> Html)
-> Ord Html
Html -> Html -> Bool
Html -> Html -> Ordering
Html -> Html -> Html
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Html -> Html -> Html
$cmin :: Html -> Html -> Html
max :: Html -> Html -> Html
$cmax :: Html -> Html -> Html
>= :: Html -> Html -> Bool
$c>= :: Html -> Html -> Bool
> :: Html -> Html -> Bool
$c> :: Html -> Html -> Bool
<= :: Html -> Html -> Bool
$c<= :: Html -> Html -> Bool
< :: Html -> Html -> Bool
$c< :: Html -> Html -> Bool
compare :: Html -> Html -> Ordering
$ccompare :: Html -> Html -> Ordering
$cp1Ord :: Eq Html
Ord)

-- | Types that support conversion to HTML.
class ToHtml s where
    toHtml :: s -> Html

-- | Text is automatically HTML-encoded
instance ToHtml Text where
    toHtml :: Text -> Html
toHtml = Text -> Html
html

-- | String is automatically HTML-encoded and converted to 'Text'
instance ToHtml [Char] where
    toHtml :: String -> Html
toHtml = [Html] -> Html
forall a. Monoid a => [a] -> a
mconcat ([Html] -> Html) -> (String -> [Html]) -> String -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Html) -> String -> [Html]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Html
htmlEncodeChar

-- | Html itself is a trivial instance
instance ToHtml Html where
    toHtml :: Html -> Html
toHtml = Html -> Html
forall a. a -> a
id

-- | Extract HTML source code from an @Html@ value.
htmlSource :: Html -> Text
htmlSource :: Html -> Text
htmlSource = Html -> Text
unHtml

-- | Convert a chunk of HTML source code into an @Html@ value as-is. Note that
-- this bypasses any and all HTML encoding; the caller is responsible for
-- taking appropriate measures against XSS and other potential vulnerabilities.
-- In other words, the input to this function is considered pre-sanitized.
unsafeRawHtml :: Text -> Html
unsafeRawHtml :: Text -> Html
unsafeRawHtml = Text -> Html
Html

-- | Safely convert plain text to HTML.
html :: Text -> Html
html :: Text -> Html
html = [Html] -> Html
forall a. Monoid a => [a] -> a
mconcat ([Html] -> Html) -> (Text -> [Html]) -> Text -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Html) -> String -> [Html]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Html
htmlEncodeChar (String -> [Html]) -> (Text -> String) -> Text -> [Html]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Text.unpack

-- | HTML-encode an individual character.
htmlEncodeChar :: Char -> Html
htmlEncodeChar :: Char -> Html
htmlEncodeChar Char
'&' = Text -> Html
Html Text
"&amp;"
htmlEncodeChar Char
'"' = Text -> Html
Html Text
"&quot;"
htmlEncodeChar Char
'\'' = Text -> Html
Html Text
"&apos;"
htmlEncodeChar Char
'<' = Text -> Html
Html Text
"&lt;"
htmlEncodeChar Char
'>' = Text -> Html
Html Text
"&gt;"
htmlEncodeChar Char
c = Text -> Html
Html (Text -> Html) -> Text -> Html
forall a b. (a -> b) -> a -> b
$ Char -> Text
Text.singleton Char
c