{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}

module Yesod.Core.Types.TypedContent
  (
    ContentType
  , TypedContent (..)
  , typedContentToSnippet
  ) where

import Control.Applicative ((<|>))
import Control.Monad (void, guard)
import Data.Maybe (fromMaybe)

import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as L
import qualified Data.ByteString.Builder as BB

import qualified Data.Int as I

#if MIN_VERSION_text(2,1,0)
import qualified Data.Text.Encoding as TE (decodeASCIIPrefix)
#else
import qualified Data.Text.Encoding as TE (decodeLatin1)
#endif
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Encoding as LE (decodeUtf8With, decodeLatin1)
import qualified Data.Text.Encoding.Error as EE (lenientDecode)

import qualified Data.Encoding as Enc
import qualified Data.Encoding.GB18030 as Enc
import qualified Data.Encoding.CP1251 as Enc
import qualified Data.Encoding.ShiftJIS as Enc
import qualified Data.Encoding.CP932 as Enc

import qualified Network.Wai.Parse as NWP

import Yesod.Core.Types.Content (Content (..))

type ContentType = B.ByteString -- FIXME Text?
data TypedContent = TypedContent !ContentType !Content

decoderForCharset :: Maybe B.ByteString -> L.ByteString -> TL.Text
decoderForCharset :: Maybe ByteString -> ByteString -> Text
decoderForCharset (Just ByteString
encodingSymbol)
  | ByteString
encodingSymbol ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"utf-8" =
      OnDecodeError -> ByteString -> Text
LE.decodeUtf8With OnDecodeError
EE.lenientDecode
  | ByteString
encodingSymbol ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"US-ASCII" =
#if MIN_VERSION_text(2,1,0)
      StrictText -> Text
TL.fromStrict (StrictText -> Text)
-> (ByteString -> StrictText) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictText, ByteString) -> StrictText
forall a b. (a, b) -> a
fst ((StrictText, ByteString) -> StrictText)
-> (ByteString -> (StrictText, ByteString))
-> ByteString
-> StrictText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> (StrictText, ByteString)
TE.decodeASCIIPrefix (ByteString -> (StrictText, ByteString))
-> (ByteString -> ByteString)
-> ByteString
-> (StrictText, ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
L.toStrict
#else
      TL.fromStrict . TE.decodeLatin1 . L.toStrict
#endif
  | ByteString
encodingSymbol ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"latin1" =
      ByteString -> Text
LE.decodeLatin1
  | ByteString
encodingSymbol ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"GB18030" =
      String -> Text
TL.pack (String -> Text) -> (ByteString -> String) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GB18030 -> ByteString -> String
forall enc. Encoding enc => enc -> ByteString -> String
Enc.decodeLazyByteString GB18030
Enc.GB18030
  | ByteString
encodingSymbol ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"windows-1251" =
      String -> Text
TL.pack (String -> Text) -> (ByteString -> String) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CP1251 -> ByteString -> String
forall enc. Encoding enc => enc -> ByteString -> String
Enc.decodeLazyByteString CP1251
Enc.CP1251
  | ByteString
encodingSymbol ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"Shift_JIS" =
      String -> Text
TL.pack (String -> Text) -> (ByteString -> String) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShiftJIS -> ByteString -> String
forall enc. Encoding enc => enc -> ByteString -> String
Enc.decodeLazyByteString ShiftJIS
Enc.ShiftJIS
  | ByteString
encodingSymbol ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"Windows-31J" =
      String -> Text
TL.pack (String -> Text) -> (ByteString -> String) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CP932 -> ByteString -> String
forall enc. Encoding enc => enc -> ByteString -> String
Enc.decodeLazyByteString CP932
Enc.CP932
  | Bool
otherwise =
      OnDecodeError -> ByteString -> Text
LE.decodeUtf8With OnDecodeError
EE.lenientDecode
decoderForCharset Maybe ByteString
Nothing = OnDecodeError -> ByteString -> Text
LE.decodeUtf8With OnDecodeError
EE.lenientDecode

decodeForContentType :: ContentType -> L.ByteString -> Maybe TL.Text
decodeForContentType :: ByteString -> ByteString -> Maybe Text
decodeForContentType ByteString
ct ByteString
bytes = do
  let (ByteString
t, [(ByteString, ByteString)]
params) =
        ByteString -> (ByteString, [(ByteString, ByteString)])
NWP.parseContentType ByteString
ct
      charset :: Maybe ByteString
charset =
        ByteString -> [(ByteString, ByteString)] -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup ByteString
"charset" [(ByteString, ByteString)]
params
      typeIsText :: Bool
typeIsText =
        ByteString -> ByteString -> Bool
B.isPrefixOf ByteString
"text" ByteString
t
            Bool -> Bool -> Bool
|| ByteString -> ByteString -> Bool
B.isPrefixOf ByteString
"application/json" ByteString
t
            Bool -> Bool -> Bool
|| ByteString -> ByteString -> Bool
B.isPrefixOf ByteString
"application/rss"  ByteString
t
            Bool -> Bool -> Bool
|| ByteString -> ByteString -> Bool
B.isPrefixOf ByteString
"application/atom" ByteString
t
      decoder :: ByteString -> Text
decoder = Maybe ByteString -> ByteString -> Text
decoderForCharset Maybe ByteString
charset
  Maybe ByteString -> Maybe ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Maybe ByteString
charset Maybe () -> Maybe () -> Maybe ()
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard Bool
typeIsText
  Text -> Maybe Text
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
decoder ByteString
bytes

contentToSnippet :: Content -> I.Int64 -> Maybe L.ByteString
contentToSnippet :: Content -> Int64 -> Maybe ByteString
contentToSnippet (ContentBuilder Builder
builder Maybe Int
maybeLength) Int64
maxLength =
  ByteString -> Maybe ByteString
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ ByteString
truncatedText ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
excessLengthMsg
  where
    truncatedText :: ByteString
truncatedText = Int64 -> ByteString -> ByteString
L.take Int64
maxLength (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Builder -> ByteString
BB.toLazyByteString Builder
builder
    excessLength :: Int
excessLength = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ (Int -> Int -> Int
forall a. Num a => a -> a -> a
subtract (Int -> Int -> Int) -> Int -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
maxLength) (Int -> Int) -> Maybe Int -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Int
maybeLength
    excessLengthMsg :: ByteString
excessLengthMsg = case Int
excessLength Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 of
      Bool
False -> ByteString
""
      Bool
True -> ByteString
"...+ " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Builder -> ByteString
BB.toLazyByteString (Int -> Builder
BB.intDec Int
excessLength)
contentToSnippet (ContentSource ConduitT () (Flush Builder) (ResourceT IO) ()
_) Int64
_ = Maybe ByteString
forall a. Maybe a
Nothing
contentToSnippet (ContentFile String
_ Maybe FilePart
_) Int64
_ = Maybe ByteString
forall a. Maybe a
Nothing
contentToSnippet (ContentDontEvaluate Content
_) Int64
_ = Maybe ByteString
forall a. Maybe a
Nothing

-- | Represents TypedContent as a String, rendering at most a specified number of
-- bytes of the content, and annotating it with the remaining length. Returns Nothing
-- if the content type indicates the content is binary data.
--
-- @since 1.6.28.0
typedContentToSnippet :: TypedContent -> I.Int64 -> Maybe TL.Text
typedContentToSnippet :: TypedContent -> Int64 -> Maybe Text
typedContentToSnippet (TypedContent ByteString
t Content
c) Int64
maxLength = ByteString -> ByteString -> Maybe Text
decodeForContentType ByteString
t (ByteString -> Maybe Text) -> Maybe ByteString -> Maybe Text
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Content -> Int64 -> Maybe ByteString
contentToSnippet Content
c Int64
maxLength