{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE OverloadedStrings #-}
module Yesod.Core.Content
    ( -- * Content
      Content (..)
    , emptyContent
    , ToContent (..)
    , ToFlushBuilder (..)
      -- * Mime types
      -- ** Data type
    , ContentType
    , typeHtml
    , typePlain
    , typeJson
    , typeXml
    , typeAtom
    , typeRss
    , typeJpeg
    , typePng
    , typeGif
    , typeSvg
    , typeJavascript
    , typeCss
    , typeFlv
    , typeOgv
    , typeOctet
      -- * Utilities
    , simpleContentType
    , contentTypeTypes
      -- * Evaluation strategy
    , DontFullyEvaluate (..)
      -- * Representations
    , TypedContent (..)
    , ToTypedContent (..)
    , HasContentType (..)
      -- ** Specific content types
    , RepHtml
    , RepJson (..)
    , RepPlain (..)
    , RepXml (..)
      -- ** Smart constructors
    , repJson
    , repPlain
    , repXml
    ) where

import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as L
import Data.Text.Lazy (Text, pack)
import qualified Data.Text as T
import Data.Text.Encoding (encodeUtf8Builder)
import qualified Data.Text.Lazy as TL
import Data.ByteString.Builder (Builder, byteString, lazyByteString, stringUtf8)
import Text.Hamlet (Html)
import Text.Blaze.Html.Renderer.Utf8 (renderHtmlBuilder)
import Data.Conduit (Flush (Chunk), SealedConduitT, mapOutput)
import Control.Monad (liftM)
import Control.Monad.Trans.Resource (ResourceT)
import qualified Data.Conduit.Internal as CI

import qualified Data.Aeson as J
import Data.Text.Lazy.Builder (toLazyText)
import Data.Void (Void, absurd)
import Yesod.Core.Types
import Text.Lucius (Css, renderCss)
import Text.Julius (Javascript, unJavascript)
import Data.Word8 (_semicolon, _slash)
import Control.Arrow (second)

-- | Zero-length enumerator.
emptyContent :: Content
emptyContent :: Content
emptyContent = Builder -> Maybe Int -> Content
ContentBuilder Builder
forall a. Monoid a => a
mempty (Maybe Int -> Content) -> Maybe Int -> Content
forall a b. (a -> b) -> a -> b
$ Int -> Maybe Int
forall a. a -> Maybe a
Just Int
0

-- | Anything which can be converted into 'Content'. Most of the time, you will
-- want to use the 'ContentBuilder' constructor. An easier approach will be to use
-- a pre-defined 'toContent' function, such as converting your data into a lazy
-- bytestring and then calling 'toContent' on that.
--
-- Please note that the built-in instances for lazy data structures ('String',
-- lazy 'L.ByteString', lazy 'Text' and 'Html') will not automatically include
-- the content length for the 'ContentBuilder' constructor.
class ToContent a where
    toContent :: a -> Content

instance ToContent Content where
    toContent :: Content -> Content
toContent = Content -> Content
forall a. a -> a
id
instance ToContent Builder where
    toContent :: Builder -> Content
toContent = (Builder -> Maybe Int -> Content)
-> Maybe Int -> Builder -> Content
forall a b c. (a -> b -> c) -> b -> a -> c
flip Builder -> Maybe Int -> Content
ContentBuilder Maybe Int
forall a. Maybe a
Nothing
instance ToContent B.ByteString where
    toContent :: ContentType -> Content
toContent ContentType
bs = Builder -> Maybe Int -> Content
ContentBuilder (ContentType -> Builder
byteString ContentType
bs) (Maybe Int -> Content) -> Maybe Int -> Content
forall a b. (a -> b) -> a -> b
$ Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ ContentType -> Int
B.length ContentType
bs
instance ToContent L.ByteString where
    toContent :: ByteString -> Content
toContent = (Builder -> Maybe Int -> Content)
-> Maybe Int -> Builder -> Content
forall a b c. (a -> b -> c) -> b -> a -> c
flip Builder -> Maybe Int -> Content
ContentBuilder Maybe Int
forall a. Maybe a
Nothing (Builder -> Content)
-> (ByteString -> Builder) -> ByteString -> Content
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Builder
lazyByteString
instance ToContent T.Text where
    toContent :: Text -> Content
toContent = Builder -> Content
forall a. ToContent a => a -> Content
toContent (Builder -> Content) -> (Text -> Builder) -> Text -> Content
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Builder
encodeUtf8Builder
instance ToContent Text where
    toContent :: Text -> Content
toContent = Builder -> Content
forall a. ToContent a => a -> Content
toContent (Builder -> Content) -> (Text -> Builder) -> Text -> Content
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Builder) -> [Text] -> Builder
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Text -> Builder
encodeUtf8Builder ([Text] -> Builder) -> (Text -> [Text]) -> Text -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
TL.toChunks
instance ToContent String where
    toContent :: String -> Content
toContent = Builder -> Content
forall a. ToContent a => a -> Content
toContent (Builder -> Content) -> (String -> Builder) -> String -> Content
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Builder
stringUtf8
instance ToContent Html where
    toContent :: Html -> Content
toContent Html
bs = Builder -> Maybe Int -> Content
ContentBuilder (Html -> Builder
renderHtmlBuilder Html
bs) Maybe Int
forall a. Maybe a
Nothing
instance ToContent () where
    toContent :: () -> Content
toContent () = ContentType -> Content
forall a. ToContent a => a -> Content
toContent ContentType
B.empty
instance ToContent Void where
    toContent :: Void -> Content
toContent = Void -> Content
forall a. Void -> a
absurd
instance ToContent (ContentType, Content) where
    toContent :: (ContentType, Content) -> Content
toContent = (ContentType, Content) -> Content
forall a b. (a, b) -> b
snd
instance ToContent TypedContent where
    toContent :: TypedContent -> Content
toContent (TypedContent ContentType
_ Content
c) = Content
c
instance ToContent (JSONResponse a) where
    toContent :: JSONResponse a -> Content
toContent (JSONResponse a
a) = Encoding -> Content
forall a. ToContent a => a -> Content
toContent (Encoding -> Content) -> Encoding -> Content
forall a b. (a -> b) -> a -> b
$ a -> Encoding
forall a. ToJSON a => a -> Encoding
J.toEncoding a
a

instance ToContent Css where
    toContent :: Css -> Content
toContent = Text -> Content
forall a. ToContent a => a -> Content
toContent (Text -> Content) -> (Css -> Text) -> Css -> Content
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Css -> Text
renderCss
instance ToContent Javascript where
    toContent :: Javascript -> Content
toContent = Text -> Content
forall a. ToContent a => a -> Content
toContent (Text -> Content) -> (Javascript -> Text) -> Javascript -> Content
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
toLazyText (Builder -> Text) -> (Javascript -> Builder) -> Javascript -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Javascript -> Builder
unJavascript

instance ToFlushBuilder builder => ToContent (CI.Pipe () () builder () (ResourceT IO) ()) where
    toContent :: Pipe () () builder () (ResourceT IO) () -> Content
toContent Pipe () () builder () (ResourceT IO) ()
src = ConduitT () (Flush Builder) (ResourceT IO) () -> Content
ContentSource (ConduitT () (Flush Builder) (ResourceT IO) () -> Content)
-> ConduitT () (Flush Builder) (ResourceT IO) () -> Content
forall a b. (a -> b) -> a -> b
$ (forall b.
 (() -> Pipe () () (Flush Builder) () (ResourceT IO) b)
 -> Pipe () () (Flush Builder) () (ResourceT IO) b)
-> ConduitT () (Flush Builder) (ResourceT IO) ()
forall i o (m :: * -> *) r.
(forall b. (r -> Pipe i i o () m b) -> Pipe i i o () m b)
-> ConduitT i o m r
CI.ConduitT ((builder -> Flush Builder)
-> Pipe () () builder () (ResourceT IO) ()
-> Pipe () () (Flush Builder) () (ResourceT IO) ()
forall (m :: * -> *) o1 o2 l i u r.
Monad m =>
(o1 -> o2) -> Pipe l i o1 u m r -> Pipe l i o2 u m r
CI.mapOutput builder -> Flush Builder
forall a. ToFlushBuilder a => a -> Flush Builder
toFlushBuilder Pipe () () builder () (ResourceT IO) ()
src Pipe () () (Flush Builder) () (ResourceT IO) ()
-> (() -> Pipe () () (Flush Builder) () (ResourceT IO) b)
-> Pipe () () (Flush Builder) () (ResourceT IO) b
forall a b.
Pipe () () (Flush Builder) () (ResourceT IO) a
-> (a -> Pipe () () (Flush Builder) () (ResourceT IO) b)
-> Pipe () () (Flush Builder) () (ResourceT IO) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=)

instance ToFlushBuilder builder => ToContent (CI.ConduitT () builder (ResourceT IO) ()) where
    toContent :: ConduitT () builder (ResourceT IO) () -> Content
toContent ConduitT () builder (ResourceT IO) ()
src = ConduitT () (Flush Builder) (ResourceT IO) () -> Content
ContentSource (ConduitT () (Flush Builder) (ResourceT IO) () -> Content)
-> ConduitT () (Flush Builder) (ResourceT IO) () -> Content
forall a b. (a -> b) -> a -> b
$ (builder -> Flush Builder)
-> ConduitT () builder (ResourceT IO) ()
-> ConduitT () (Flush Builder) (ResourceT IO) ()
forall (m :: * -> *) o1 o2 i r.
Monad m =>
(o1 -> o2) -> ConduitT i o1 m r -> ConduitT i o2 m r
mapOutput builder -> Flush Builder
forall a. ToFlushBuilder a => a -> Flush Builder
toFlushBuilder ConduitT () builder (ResourceT IO) ()
src
instance ToFlushBuilder builder => ToContent (SealedConduitT () builder (ResourceT IO) ()) where
    toContent :: SealedConduitT () builder (ResourceT IO) () -> Content
toContent (CI.SealedConduitT Pipe () () builder () (ResourceT IO) ()
src) = Pipe () () builder () (ResourceT IO) () -> Content
forall a. ToContent a => a -> Content
toContent Pipe () () builder () (ResourceT IO) ()
src

-- | A class for all data which can be sent in a streaming response. Note that
-- for textual data, instances must use UTF-8 encoding.
--
-- Since 1.2.0
class ToFlushBuilder a where toFlushBuilder :: a -> Flush Builder
instance ToFlushBuilder (Flush Builder) where toFlushBuilder :: Flush Builder -> Flush Builder
toFlushBuilder = Flush Builder -> Flush Builder
forall a. a -> a
id
instance ToFlushBuilder Builder where toFlushBuilder :: Builder -> Flush Builder
toFlushBuilder = Builder -> Flush Builder
forall a. a -> Flush a
Chunk
instance ToFlushBuilder (Flush B.ByteString) where toFlushBuilder :: Flush ContentType -> Flush Builder
toFlushBuilder = (ContentType -> Builder) -> Flush ContentType -> Flush Builder
forall a b. (a -> b) -> Flush a -> Flush b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ContentType -> Builder
byteString
instance ToFlushBuilder B.ByteString where toFlushBuilder :: ContentType -> Flush Builder
toFlushBuilder = Builder -> Flush Builder
forall a. a -> Flush a
Chunk (Builder -> Flush Builder)
-> (ContentType -> Builder) -> ContentType -> Flush Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContentType -> Builder
byteString
instance ToFlushBuilder (Flush L.ByteString) where toFlushBuilder :: Flush ByteString -> Flush Builder
toFlushBuilder = (ByteString -> Builder) -> Flush ByteString -> Flush Builder
forall a b. (a -> b) -> Flush a -> Flush b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> Builder
lazyByteString
instance ToFlushBuilder L.ByteString where toFlushBuilder :: ByteString -> Flush Builder
toFlushBuilder = Builder -> Flush Builder
forall a. a -> Flush a
Chunk (Builder -> Flush Builder)
-> (ByteString -> Builder) -> ByteString -> Flush Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Builder
lazyByteString
instance ToFlushBuilder (Flush Text) where toFlushBuilder :: Flush Text -> Flush Builder
toFlushBuilder = (Text -> Builder) -> Flush Text -> Flush Builder
forall a b. (a -> b) -> Flush a -> Flush b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Text -> Builder) -> [Text] -> Builder
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Text -> Builder
encodeUtf8Builder ([Text] -> Builder) -> (Text -> [Text]) -> Text -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
TL.toChunks)
instance ToFlushBuilder Text where toFlushBuilder :: Text -> Flush Builder
toFlushBuilder = Builder -> Flush Builder
forall a. a -> Flush a
Chunk (Builder -> Flush Builder)
-> (Text -> Builder) -> Text -> Flush Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Builder) -> [Text] -> Builder
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Text -> Builder
encodeUtf8Builder ([Text] -> Builder) -> (Text -> [Text]) -> Text -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
TL.toChunks
instance ToFlushBuilder (Flush T.Text) where toFlushBuilder :: Flush Text -> Flush Builder
toFlushBuilder = (Text -> Builder) -> Flush Text -> Flush Builder
forall a b. (a -> b) -> Flush a -> Flush b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Builder
encodeUtf8Builder
instance ToFlushBuilder T.Text where toFlushBuilder :: Text -> Flush Builder
toFlushBuilder = Builder -> Flush Builder
forall a. a -> Flush a
Chunk (Builder -> Flush Builder)
-> (Text -> Builder) -> Text -> Flush Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Builder
encodeUtf8Builder
instance ToFlushBuilder (Flush String) where toFlushBuilder :: Flush String -> Flush Builder
toFlushBuilder = (String -> Builder) -> Flush String -> Flush Builder
forall a b. (a -> b) -> Flush a -> Flush b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Builder
stringUtf8
instance ToFlushBuilder String where toFlushBuilder :: String -> Flush Builder
toFlushBuilder = Builder -> Flush Builder
forall a. a -> Flush a
Chunk (Builder -> Flush Builder)
-> (String -> Builder) -> String -> Flush Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Builder
stringUtf8
instance ToFlushBuilder (Flush Html) where toFlushBuilder :: Flush Html -> Flush Builder
toFlushBuilder = (Html -> Builder) -> Flush Html -> Flush Builder
forall a b. (a -> b) -> Flush a -> Flush b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Html -> Builder
renderHtmlBuilder
instance ToFlushBuilder Html where toFlushBuilder :: Html -> Flush Builder
toFlushBuilder = Builder -> Flush Builder
forall a. a -> Flush a
Chunk (Builder -> Flush Builder)
-> (Html -> Builder) -> Html -> Flush Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Html -> Builder
renderHtmlBuilder

repJson :: ToContent a => a -> RepJson
repJson :: forall a. ToContent a => a -> RepJson
repJson = Content -> RepJson
RepJson (Content -> RepJson) -> (a -> Content) -> a -> RepJson
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Content
forall a. ToContent a => a -> Content
toContent

repPlain :: ToContent a => a -> RepPlain
repPlain :: forall a. ToContent a => a -> RepPlain
repPlain = Content -> RepPlain
RepPlain (Content -> RepPlain) -> (a -> Content) -> a -> RepPlain
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Content
forall a. ToContent a => a -> Content
toContent

repXml :: ToContent a => a -> RepXml
repXml :: forall a. ToContent a => a -> RepXml
repXml = Content -> RepXml
RepXml (Content -> RepXml) -> (a -> Content) -> a -> RepXml
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Content
forall a. ToContent a => a -> Content
toContent

class ToTypedContent a => HasContentType a where
    getContentType :: Monad m => m a -> ContentType

instance HasContentType RepJson where
    getContentType :: forall (m :: * -> *). Monad m => m RepJson -> ContentType
getContentType m RepJson
_ = ContentType
typeJson
deriving instance ToContent RepJson

instance HasContentType RepPlain where
    getContentType :: forall (m :: * -> *). Monad m => m RepPlain -> ContentType
getContentType m RepPlain
_ = ContentType
typePlain
deriving instance ToContent RepPlain
instance HasContentType (JSONResponse a) where
    getContentType :: forall (m :: * -> *). Monad m => m (JSONResponse a) -> ContentType
getContentType m (JSONResponse a)
_ = ContentType
typeJson

instance HasContentType RepXml where
    getContentType :: forall (m :: * -> *). Monad m => m RepXml -> ContentType
getContentType m RepXml
_ = ContentType
typeXml
deriving instance ToContent RepXml


typeHtml :: ContentType
typeHtml :: ContentType
typeHtml = ContentType
"text/html; charset=utf-8"

typePlain :: ContentType
typePlain :: ContentType
typePlain = ContentType
"text/plain; charset=utf-8"

typeJson :: ContentType
typeJson :: ContentType
typeJson = ContentType
"application/json; charset=utf-8"

typeXml :: ContentType
typeXml :: ContentType
typeXml = ContentType
"text/xml"

typeAtom :: ContentType
typeAtom :: ContentType
typeAtom = ContentType
"application/atom+xml"

typeRss :: ContentType
typeRss :: ContentType
typeRss = ContentType
"application/rss+xml"

typeJpeg :: ContentType
typeJpeg :: ContentType
typeJpeg = ContentType
"image/jpeg"

typePng :: ContentType
typePng :: ContentType
typePng = ContentType
"image/png"

typeGif :: ContentType
typeGif :: ContentType
typeGif = ContentType
"image/gif"

typeSvg :: ContentType
typeSvg :: ContentType
typeSvg = ContentType
"image/svg+xml"

typeJavascript :: ContentType
typeJavascript :: ContentType
typeJavascript = ContentType
"text/javascript; charset=utf-8"

typeCss :: ContentType
typeCss :: ContentType
typeCss = ContentType
"text/css; charset=utf-8"

typeFlv :: ContentType
typeFlv :: ContentType
typeFlv = ContentType
"video/x-flv"

typeOgv :: ContentType
typeOgv :: ContentType
typeOgv = ContentType
"video/ogg"

typeOctet :: ContentType
typeOctet :: ContentType
typeOctet = ContentType
"application/octet-stream"

-- | Removes \"extra\" information at the end of a content type string. In
-- particular, removes everything after the semicolon, if present.
--
-- For example, \"text/html; charset=utf-8\" is commonly used to specify the
-- character encoding for HTML data. This function would return \"text/html\".
simpleContentType :: ContentType -> ContentType
simpleContentType :: ContentType -> ContentType
simpleContentType = (ContentType, ContentType) -> ContentType
forall a b. (a, b) -> a
fst ((ContentType, ContentType) -> ContentType)
-> (ContentType -> (ContentType, ContentType))
-> ContentType
-> ContentType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Bool) -> ContentType -> (ContentType, ContentType)
B.break (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
_semicolon)

-- | Give just the media types as a pair.
--
-- For example, \"text/html; charset=utf-8\" returns ("text", "html")
contentTypeTypes :: ContentType -> (B.ByteString, B.ByteString)
contentTypeTypes :: ContentType -> (ContentType, ContentType)
contentTypeTypes = (ContentType -> ContentType)
-> (ContentType, ContentType) -> (ContentType, ContentType)
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second ContentType -> ContentType
tailEmpty ((ContentType, ContentType) -> (ContentType, ContentType))
-> (ContentType -> (ContentType, ContentType))
-> ContentType
-> (ContentType, ContentType)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Bool) -> ContentType -> (ContentType, ContentType)
B.break (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
_slash) (ContentType -> (ContentType, ContentType))
-> (ContentType -> ContentType)
-> ContentType
-> (ContentType, ContentType)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContentType -> ContentType
simpleContentType
  where
    tailEmpty :: ContentType -> ContentType
tailEmpty ContentType
x = if ContentType -> Bool
B.null ContentType
x then ContentType
"" else HasCallStack => ContentType -> ContentType
ContentType -> ContentType
B.tail ContentType
x

instance HasContentType a => HasContentType (DontFullyEvaluate a) where
    getContentType :: forall (m :: * -> *).
Monad m =>
m (DontFullyEvaluate a) -> ContentType
getContentType = m a -> ContentType
forall a (m :: * -> *).
(HasContentType a, Monad m) =>
m a -> ContentType
forall (m :: * -> *). Monad m => m a -> ContentType
getContentType (m a -> ContentType)
-> (m (DontFullyEvaluate a) -> m a)
-> m (DontFullyEvaluate a)
-> ContentType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DontFullyEvaluate a -> a) -> m (DontFullyEvaluate a) -> m a
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM DontFullyEvaluate a -> a
forall a. DontFullyEvaluate a -> a
unDontFullyEvaluate

instance ToContent a => ToContent (DontFullyEvaluate a) where
    toContent :: DontFullyEvaluate a -> Content
toContent (DontFullyEvaluate a
a) = Content -> Content
ContentDontEvaluate (Content -> Content) -> Content -> Content
forall a b. (a -> b) -> a -> b
$ a -> Content
forall a. ToContent a => a -> Content
toContent a
a

instance ToContent J.Value where
    toContent :: Value -> Content
toContent = (Builder -> Maybe Int -> Content)
-> Maybe Int -> Builder -> Content
forall a b c. (a -> b -> c) -> b -> a -> c
flip Builder -> Maybe Int -> Content
ContentBuilder Maybe Int
forall a. Maybe a
Nothing
              (Builder -> Content) -> (Value -> Builder) -> Value -> Content
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Encoding -> Builder
forall tag. Encoding' tag -> Builder
J.fromEncoding
              (Encoding -> Builder) -> (Value -> Encoding) -> Value -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Encoding
forall a. ToJSON a => a -> Encoding
J.toEncoding

instance ToContent J.Encoding where
    toContent :: Encoding -> Content
toContent = (Builder -> Maybe Int -> Content)
-> Maybe Int -> Builder -> Content
forall a b c. (a -> b -> c) -> b -> a -> c
flip Builder -> Maybe Int -> Content
ContentBuilder Maybe Int
forall a. Maybe a
Nothing (Builder -> Content)
-> (Encoding -> Builder) -> Encoding -> Content
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Encoding -> Builder
forall tag. Encoding' tag -> Builder
J.fromEncoding

instance HasContentType J.Value where
    getContentType :: forall (m :: * -> *). Monad m => m Value -> ContentType
getContentType m Value
_ = ContentType
typeJson

instance HasContentType J.Encoding where
    getContentType :: forall (m :: * -> *). Monad m => m Encoding -> ContentType
getContentType m Encoding
_ = ContentType
typeJson

instance HasContentType Html where
    getContentType :: forall (m :: * -> *). Monad m => m Html -> ContentType
getContentType m Html
_ = ContentType
typeHtml

instance HasContentType Text where
    getContentType :: forall (m :: * -> *). Monad m => m Text -> ContentType
getContentType m Text
_ = ContentType
typePlain

instance HasContentType T.Text where
    getContentType :: forall (m :: * -> *). Monad m => m Text -> ContentType
getContentType m Text
_ = ContentType
typePlain

instance HasContentType Css where
    getContentType :: forall (m :: * -> *). Monad m => m Css -> ContentType
getContentType m Css
_ = ContentType
typeCss

instance HasContentType Javascript where
    getContentType :: forall (m :: * -> *). Monad m => m Javascript -> ContentType
getContentType m Javascript
_ = ContentType
typeJavascript

-- | Any type which can be converted to 'TypedContent'.
--
-- Since 1.2.0
class ToContent a => ToTypedContent a where
    toTypedContent :: a -> TypedContent

instance ToTypedContent TypedContent where
    toTypedContent :: TypedContent -> TypedContent
toTypedContent = TypedContent -> TypedContent
forall a. a -> a
id
instance ToTypedContent () where
    toTypedContent :: () -> TypedContent
toTypedContent () = ContentType -> Content -> TypedContent
TypedContent ContentType
typePlain (() -> Content
forall a. ToContent a => a -> Content
toContent ())
instance ToTypedContent Void where
    toTypedContent :: Void -> TypedContent
toTypedContent = Void -> TypedContent
forall a. Void -> a
absurd
instance ToTypedContent (ContentType, Content) where
    toTypedContent :: (ContentType, Content) -> TypedContent
toTypedContent (ContentType
ct, Content
content) = ContentType -> Content -> TypedContent
TypedContent ContentType
ct Content
content
instance ToTypedContent RepJson where
    toTypedContent :: RepJson -> TypedContent
toTypedContent (RepJson Content
c) = ContentType -> Content -> TypedContent
TypedContent ContentType
typeJson Content
c
instance ToTypedContent RepPlain where
    toTypedContent :: RepPlain -> TypedContent
toTypedContent (RepPlain Content
c) = ContentType -> Content -> TypedContent
TypedContent ContentType
typePlain Content
c
instance ToTypedContent RepXml where
    toTypedContent :: RepXml -> TypedContent
toTypedContent (RepXml Content
c) = ContentType -> Content -> TypedContent
TypedContent ContentType
typeXml Content
c
instance ToTypedContent J.Value where
    toTypedContent :: Value -> TypedContent
toTypedContent Value
v = ContentType -> Content -> TypedContent
TypedContent ContentType
typeJson (Value -> Content
forall a. ToContent a => a -> Content
toContent Value
v)
instance ToTypedContent J.Encoding where
    toTypedContent :: Encoding -> TypedContent
toTypedContent Encoding
e = ContentType -> Content -> TypedContent
TypedContent ContentType
typeJson (Encoding -> Content
forall a. ToContent a => a -> Content
toContent Encoding
e)
instance ToTypedContent Html where
    toTypedContent :: Html -> TypedContent
toTypedContent Html
h = ContentType -> Content -> TypedContent
TypedContent ContentType
typeHtml (Html -> Content
forall a. ToContent a => a -> Content
toContent Html
h)
instance ToTypedContent T.Text where
    toTypedContent :: Text -> TypedContent
toTypedContent Text
t = ContentType -> Content -> TypedContent
TypedContent ContentType
typePlain (Text -> Content
forall a. ToContent a => a -> Content
toContent Text
t)
instance ToTypedContent [Char] where
    toTypedContent :: String -> TypedContent
toTypedContent = Text -> TypedContent
forall a. ToTypedContent a => a -> TypedContent
toTypedContent (Text -> TypedContent)
-> (String -> Text) -> String -> TypedContent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack
instance ToTypedContent Text where
    toTypedContent :: Text -> TypedContent
toTypedContent Text
t = ContentType -> Content -> TypedContent
TypedContent ContentType
typePlain (Text -> Content
forall a. ToContent a => a -> Content
toContent Text
t)
instance ToTypedContent (JSONResponse a) where
    toTypedContent :: JSONResponse a -> TypedContent
toTypedContent JSONResponse a
c = ContentType -> Content -> TypedContent
TypedContent ContentType
typeJson (JSONResponse a -> Content
forall a. ToContent a => a -> Content
toContent JSONResponse a
c)
instance ToTypedContent a => ToTypedContent (DontFullyEvaluate a) where
    toTypedContent :: DontFullyEvaluate a -> TypedContent
toTypedContent (DontFullyEvaluate a
a) =
        let TypedContent ContentType
ct Content
c = a -> TypedContent
forall a. ToTypedContent a => a -> TypedContent
toTypedContent a
a
         in ContentType -> Content -> TypedContent
TypedContent ContentType
ct (Content -> Content
ContentDontEvaluate Content
c)

instance ToTypedContent Css where
    toTypedContent :: Css -> TypedContent
toTypedContent = ContentType -> Content -> TypedContent
TypedContent ContentType
typeCss (Content -> TypedContent)
-> (Css -> Content) -> Css -> TypedContent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Css -> Content
forall a. ToContent a => a -> Content
toContent
instance ToTypedContent Javascript where
    toTypedContent :: Javascript -> TypedContent
toTypedContent = ContentType -> Content -> TypedContent
TypedContent ContentType
typeJavascript (Content -> TypedContent)
-> (Javascript -> Content) -> Javascript -> TypedContent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Javascript -> Content
forall a. ToContent a => a -> Content
toContent