{-# LANGUAGE OverloadedStrings #-}
module Yesod.Test.Internal
( getBodyTextPreview
, contentTypeHeaderIsUtf8
, assumedUTF8ContentTypes
) where
import qualified Data.ByteString.Char8 as BS8
import qualified Data.ByteString.Lazy as LBS
import qualified Data.Set as Set
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Encoding as DTLE
import qualified Yesod.Core.Content as Content
import Data.Semigroup (Semigroup(..))
getBodyTextPreview :: LBS.ByteString -> T.Text
getBodyTextPreview :: ByteString -> Text
getBodyTextPreview ByteString
body =
let characterLimit :: Int
characterLimit = Int
1024
textBody :: Text
textBody = Text -> Text
TL.toStrict (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
DTLE.decodeUtf8 ByteString
body
in if Text -> Int
T.length Text
textBody Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
characterLimit
then Text
textBody
else Int -> Text -> Text
T.take Int
characterLimit Text
textBody Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"... (use `printBody` to see complete response body)"
contentTypeHeaderIsUtf8 :: BS8.ByteString -> Bool
ContentType
contentTypeBS =
let contentTypeText :: Text
contentTypeText = Text -> Text
T.toLower (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ ContentType -> Text
TE.decodeUtf8 ContentType
contentTypeBS
isUTF8FromCharset :: Bool
isUTF8FromCharset = case Text -> Text -> [Text]
T.splitOn Text
"charset=" Text
contentTypeText of
[Text
_, Text
charSet] -> (Text -> Bool) -> [Text] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Text -> Text -> Bool
`T.isInfixOf` Text
charSet) [Text
"utf-8", Text
"us-ascii"]
[Text]
_ -> Bool
False
isInferredUTF8FromContentType :: Bool
isInferredUTF8FromContentType = (Char -> Bool) -> ContentType -> ContentType
BS8.takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
';') ContentType
contentTypeBS ContentType -> Set ContentType -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set ContentType
assumedUTF8ContentTypes
in Bool
isUTF8FromCharset Bool -> Bool -> Bool
|| Bool
isInferredUTF8FromContentType
assumedUTF8ContentTypes :: Set.Set BS8.ByteString
assumedUTF8ContentTypes :: Set ContentType
assumedUTF8ContentTypes = [ContentType] -> Set ContentType
forall a. Ord a => [a] -> Set a
Set.fromList ([ContentType] -> Set ContentType)
-> [ContentType] -> Set ContentType
forall a b. (a -> b) -> a -> b
$ (ContentType -> ContentType) -> [ContentType] -> [ContentType]
forall a b. (a -> b) -> [a] -> [b]
map ContentType -> ContentType
Content.simpleContentType
[ ContentType
Content.typeHtml
, ContentType
Content.typePlain
, ContentType
Content.typeJson
, ContentType
Content.typeXml
, ContentType
Content.typeAtom
, ContentType
Content.typeRss
, ContentType
Content.typeSvg
, ContentType
Content.typeJavascript
, ContentType
Content.typeCss
]