78 lines
2.1 KiB
Haskell
78 lines
2.1 KiB
Haskell
|
{- 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
|