{- This file is part of Vervis.
 -
 - Written in 2022 by fr33domlover <fr33domlover@riseup.net>.
 -
 - ♡ Copying is an act of love. Please copy, reuse and share.
 -
 - The author(s) have dedicated all copyright and related and neighboring
 - rights to this software to the public domain worldwide. This software is
 - distributed without any warranty.
 -
 - You should have received a copy of the CC0 Public Domain Dedication along
 - with this software. If not, see
 - <http://creativecommons.org/publicdomain/zero/1.0/>.
 -}

module Web.Text
    ( HTML ()
    , PandocMarkdown ()
    , Escaped ()
    , renderHTML
    , markupHTML
    , encodeEntities
    , decodeEntities
    )
where

import Data.Aeson
import Data.Text (Text)
import Database.Persist
import Database.Persist.Sql
import HTMLEntities.Decoder
import Text.Blaze (preEscapedText)
import Text.Blaze.Html (Html)
import Text.Blaze.Html.Renderer.Text
import Text.HTML.SanitizeXSS

import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Builder as TLB
import qualified HTMLEntities.Text as HET

newtype HTML = HTML { unHTML :: Text }
    deriving (ToJSON, PersistField, PersistFieldSql)

instance FromJSON HTML where
    parseJSON = fmap (HTML . sanitizeBalance) . parseJSON

newtype PandocMarkdown = PandocMarkdown { _unPandocMarkdown :: Text }
    deriving (FromJSON, ToJSON, PersistField, PersistFieldSql)

newtype Escaped = Escaped { unEscaped :: Text }
    deriving (ToJSON, PersistField, PersistFieldSql)

escape :: Text -> Text
escape = HET.text

unescape :: Text -> Text
unescape = TL.toStrict . TLB.toLazyText . htmlEncodedText

instance FromJSON Escaped where
    parseJSON =
        withText "Escaped" $ \ t ->
            let decoded = unescape t
            in  if escape decoded == t
                    then return $ Escaped t
                    else fail "HTML contains more than just HTML-escaped plain text"

renderHTML :: Html -> HTML
renderHTML = HTML . TL.toStrict . renderHtml

markupHTML :: HTML -> Html
markupHTML = preEscapedText . unHTML

encodeEntities :: Text -> Escaped
encodeEntities = Escaped . escape

decodeEntities :: Escaped -> Text
decodeEntities = unescape . unEscaped