    {-# LANGUAGE ConstraintKinds       #-}
    {-# LANGUAGE DataKinds             #-}
    {-# LANGUAGE DeriveDataTypeable    #-}
    {-# LANGUAGE DeriveGeneric         #-}
    {-# LANGUAGE FlexibleContexts      #-}
    {-# LANGUAGE FlexibleInstances     #-}
    {-# LANGUAGE MultiParamTypeClasses #-}
    {-# LANGUAGE OverloadedStrings     #-}
    {-# LANGUAGE PolyKinds             #-}
    {-# LANGUAGE ScopedTypeVariables   #-}
    {-# LANGUAGE TupleSections         #-}
    {-# LANGUAGE TypeFamilies          #-}
    {-# LANGUAGE TypeOperators         #-}
    {-# LANGUAGE UndecidableInstances  #-}
    {-# OPTIONS_HADDOCK not-home       #-}

    -- | A collection of basic Content-Types (also known as Internet Media
    -- Types, or MIME types). Additionally, this module provides classes that
    -- encapsulate how to serialize or deserialize values to or from
    -- a particular Content-Type.
    --
    -- Content-Types are used in `ReqBody` and the method combinators:
    --
    -- >>> type MyEndpoint = ReqBody '[JSON, PlainText] Book :> Put '[JSON, PlainText] Book
    --
    -- Meaning the endpoint accepts requests of Content-Type @application/json@
    -- or @text/plain;charset-utf8@, and returns data in either one of those
    -- formats (depending on the @Accept@ header).
    --
    -- If you would like to support Content-Types beyond those provided here,
    -- then:
    --
    --      (1) Declare a new data type with no constructors (e.g. @data HTML@).
    --      (2) Make an instance of it for `Accept`.
    --      (3) If you want to be able to serialize data *into* that
    --      Content-Type, make an instance of it for `MimeRender`.
    --      (4) If you want to be able to deserialize data *from* that
    --      Content-Type, make an instance of it for `MimeUnrender`.
    --
    -- Note that roles are reversed in @servant-server@ and @servant-client@:
    -- to be able to serve (or even typecheck) a @Get '[JSON, XML] MyData@,
    -- you'll need to have the appropriate `MimeRender` instances in scope,
    -- whereas to query that endpoint with @servant-client@, you'll need
    -- a `MimeUnrender` instance in scope.
    module Servant.API.ContentTypes
        (
        -- * Provided Content-Types
          JSON
        , PlainText
        , FormUrlEncoded
        , OctetStream

        -- * Building your own Content-Type
        , Accept(..)
        , MimeRender(..)
        , MimeUnrender(..)

        -- * NoContent
        , NoContent(..)

        -- * Internal
        , AcceptHeader(..)
        , AllCTRender(..)
        , AllCTUnrender(..)
        , AllMime(..)
        , AllMimeRender(..)
        , AllMimeUnrender(..)
        , eitherDecodeLenient
        , canHandleAcceptH
        ) where

    import           Control.Arrow
                     (left)
    import           Control.Monad.Compat
    import           Control.DeepSeq
                     (NFData)
    import           Data.Aeson
                     (FromJSON (..), ToJSON (..), encode)
    import           Data.Aeson.Parser
                     (value)
    import           Data.Aeson.Types
                     (parseEither)
    import           Data.Attoparsec.ByteString.Char8
                     (endOfInput, parseOnly, skipSpace, (<?>))
    import qualified Data.ByteString                  as BS
    import           Data.ByteString.Lazy
                     (ByteString, fromStrict, toStrict)
    import qualified Data.ByteString.Lazy.Char8       as BC
    import qualified Data.List.NonEmpty               as NE
    import           Data.Maybe
                     (isJust)
    import           Data.String.Conversions
                     (cs)
    import qualified Data.Text                        as TextS
    import qualified Data.Text.Encoding               as TextS
    import qualified Data.Text.Lazy                   as TextL
    import qualified Data.Text.Lazy.Encoding          as TextL
    import           Data.Typeable
    import           GHC.Generics
                     (Generic)
    import qualified GHC.TypeLits                     as TL
    import qualified Network.HTTP.Media               as M
    import           Prelude ()
    import           Prelude.Compat
    import           Web.FormUrlEncoded
                     (FromForm, ToForm, urlDecodeAsForm, urlEncodeAsForm)

    -- * Provided content types
    data JSON deriving Typeable
    data PlainText deriving Typeable
    data FormUrlEncoded deriving Typeable
    data OctetStream deriving Typeable

    -- * Accept class

    -- | Instances of 'Accept' represent mimetypes. They are used for matching
    -- against the @Accept@ HTTP header of the request, and for setting the
    -- @Content-Type@ header of the response
    --
    -- Example:
    --
    -- >>> import Network.HTTP.Media ((//), (/:))
    -- >>> data HTML
    -- >>> :{
    --instance Accept HTML where
    --    contentType _ = "text" // "html" /: ("charset", "utf-8")
    -- :}
    --
    class Accept ctype where
        contentType   :: Proxy ctype -> M.MediaType
        contentType = NonEmpty MediaType -> MediaType
    forall a. NonEmpty a -> a
    NE.head (NonEmpty MediaType -> MediaType)
    -> (Proxy ctype -> NonEmpty MediaType) -> Proxy ctype -> MediaType
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Proxy ctype -> NonEmpty MediaType
    forall {k} (ctype :: k).
    Accept ctype =>
    Proxy ctype -> NonEmpty MediaType
    contentTypes

        contentTypes  :: Proxy ctype -> NE.NonEmpty M.MediaType
        contentTypes  =  (MediaType -> [MediaType] -> NonEmpty MediaType
    forall a. a -> [a] -> NonEmpty a
    NE.:| []) (MediaType -> NonEmpty MediaType)
    -> (Proxy ctype -> MediaType) -> Proxy ctype -> NonEmpty MediaType
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Proxy ctype -> MediaType
    forall {k} (ctype :: k). Accept ctype => Proxy ctype -> MediaType
    contentType

        {-# MINIMAL contentType | contentTypes #-}

    -- | @application/json@
    instance Accept JSON where
        contentTypes :: Proxy JSON -> NonEmpty MediaType
    contentTypes Proxy JSON
    _ =
          ByteString
    "application" ByteString -> ByteString -> MediaType
    M.// ByteString
    "json" MediaType -> (ByteString, ByteString) -> MediaType
    M./: (ByteString
    "charset", ByteString
    "utf-8") MediaType -> [MediaType] -> NonEmpty MediaType
    forall a. a -> [a] -> NonEmpty a
    NE.:|
          [ ByteString
    "application" ByteString -> ByteString -> MediaType
    M.// ByteString
    "json" ]

    -- | @application/x-www-form-urlencoded@
    instance Accept FormUrlEncoded where
        contentType :: Proxy FormUrlEncoded -> MediaType
    contentType Proxy FormUrlEncoded
    _ = ByteString
    "application" ByteString -> ByteString -> MediaType
    M.// ByteString
    "x-www-form-urlencoded"

    -- | @text/plain;charset=utf-8@
    instance Accept PlainText where
        contentType :: Proxy PlainText -> MediaType
    contentType Proxy PlainText
    _ = ByteString
    "text" ByteString -> ByteString -> MediaType
    M.// ByteString
    "plain" MediaType -> (ByteString, ByteString) -> MediaType
    M./: (ByteString
    "charset", ByteString
    "utf-8")

    -- | @application/octet-stream@
    instance Accept OctetStream where
        contentType :: Proxy OctetStream -> MediaType
    contentType Proxy OctetStream
    _ = ByteString
    "application" ByteString -> ByteString -> MediaType
    M.// ByteString
    "octet-stream"

    newtype AcceptHeader = AcceptHeader BS.ByteString
        deriving (AcceptHeader -> AcceptHeader -> Bool
    (AcceptHeader -> AcceptHeader -> Bool)
    -> (AcceptHeader -> AcceptHeader -> Bool) -> Eq AcceptHeader
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: AcceptHeader -> AcceptHeader -> Bool
    == :: AcceptHeader -> AcceptHeader -> Bool
    $c/= :: AcceptHeader -> AcceptHeader -> Bool
    /= :: AcceptHeader -> AcceptHeader -> Bool
    Eq, Int -> AcceptHeader -> ShowS
    [AcceptHeader] -> ShowS
    AcceptHeader -> String
    (Int -> AcceptHeader -> ShowS)
    -> (AcceptHeader -> String)
    -> ([AcceptHeader] -> ShowS)
    -> Show AcceptHeader
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> AcceptHeader -> ShowS
    showsPrec :: Int -> AcceptHeader -> ShowS
    $cshow :: AcceptHeader -> String
    show :: AcceptHeader -> String
    $cshowList :: [AcceptHeader] -> ShowS
    showList :: [AcceptHeader] -> ShowS
    Show, ReadPrec [AcceptHeader]
    ReadPrec AcceptHeader
    Int -> ReadS AcceptHeader
    ReadS [AcceptHeader]
    (Int -> ReadS AcceptHeader)
    -> ReadS [AcceptHeader]
    -> ReadPrec AcceptHeader
    -> ReadPrec [AcceptHeader]
    -> Read AcceptHeader
    forall a.
    (Int -> ReadS a)
    -> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
    $creadsPrec :: Int -> ReadS AcceptHeader
    readsPrec :: Int -> ReadS AcceptHeader
    $creadList :: ReadS [AcceptHeader]
    readList :: ReadS [AcceptHeader]
    $creadPrec :: ReadPrec AcceptHeader
    readPrec :: ReadPrec AcceptHeader
    $creadListPrec :: ReadPrec [AcceptHeader]
    readListPrec :: ReadPrec [AcceptHeader]
    Read, Typeable, (forall x. AcceptHeader -> Rep AcceptHeader x)
    -> (forall x. Rep AcceptHeader x -> AcceptHeader)
    -> Generic AcceptHeader
    forall x. Rep AcceptHeader x -> AcceptHeader
    forall x. AcceptHeader -> Rep AcceptHeader x
    forall a.
    (forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
    $cfrom :: forall x. AcceptHeader -> Rep AcceptHeader x
    from :: forall x. AcceptHeader -> Rep AcceptHeader x
    $cto :: forall x. Rep AcceptHeader x -> AcceptHeader
    to :: forall x. Rep AcceptHeader x -> AcceptHeader
    Generic)

    -- * Render (serializing)

    -- | Instantiate this class to register a way of serializing a type based
    -- on the @Accept@ header.
    --
    -- Example:
    --
    -- > data MyContentType
    -- >
    -- > instance Accept MyContentType where
    -- >    contentType _ = "example" // "prs.me.mine" /: ("charset", "utf-8")
    -- >
    -- > instance Show a => MimeRender MyContentType a where
    -- >    mimeRender _ val = pack ("This is MINE! " ++ show val)
    -- >
    -- > type MyAPI = "path" :> Get '[MyContentType] Int
    --
    class Accept ctype => MimeRender ctype a where
        mimeRender  :: Proxy ctype -> a -> ByteString

    class (AllMime list) => AllCTRender (list :: [*]) a where
        -- If the Accept header can be matched, returns (Just) a tuple of the
        -- Content-Type and response (serialization of @a@ into the appropriate
        -- mimetype).
        handleAcceptH :: Proxy list -> AcceptHeader -> a -> Maybe (ByteString, ByteString)

    instance {-# OVERLAPPABLE #-}
             (Accept ct, AllMime cts, AllMimeRender (ct ': cts) a) => AllCTRender (ct ': cts) a where
        handleAcceptH :: Proxy (ct : cts)
    -> AcceptHeader -> a -> Maybe (ByteString, ByteString)
    handleAcceptH Proxy (ct : cts)
    _ (AcceptHeader ByteString
    accept) a
    val = [(MediaType, (ByteString, ByteString))]
    -> ByteString -> Maybe (ByteString, ByteString)
    forall b. [(MediaType, b)] -> ByteString -> Maybe b
    M.mapAcceptMedia [(MediaType, (ByteString, ByteString))]
    lkup ByteString
    accept
          where pctyps :: Proxy (ct : cts)
    pctyps = Proxy (ct : cts)
    forall {k} (t :: k). Proxy t
    Proxy :: Proxy (ct ': cts)
                amrs :: [(MediaType, ByteString)]
    amrs = Proxy (ct : cts) -> a -> [(MediaType, ByteString)]
    forall (list :: [*]) a.
    AllMimeRender list a =>
    Proxy list -> a -> [(MediaType, ByteString)]
    allMimeRender Proxy (ct : cts)
    pctyps a
    val
                lkup :: [(MediaType, (ByteString, ByteString))]
    lkup = ((MediaType, ByteString) -> (MediaType, (ByteString, ByteString)))
    -> [(MediaType, ByteString)]
    -> [(MediaType, (ByteString, ByteString))]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (\(MediaType
    a,ByteString
    b) -> (MediaType
    a, (ByteString -> ByteString
    fromStrict (ByteString -> ByteString) -> ByteString -> ByteString
    forall a b. (a -> b) -> a -> b
    $ MediaType -> ByteString
    forall h. RenderHeader h => h -> ByteString
    M.renderHeader MediaType
    a, ByteString
    b))) [(MediaType, ByteString)]
    amrs

    instance TL.TypeError ('TL.Text "No instance for (), use NoContent instead.")
      => AllCTRender '[] () where
      handleAcceptH :: Proxy '[] -> AcceptHeader -> () -> Maybe (ByteString, ByteString)
    handleAcceptH Proxy '[]
    _ AcceptHeader
    _ ()
    _ = String -> Maybe (ByteString, ByteString)
    forall a. HasCallStack => String -> a
    error String
    "unreachable"

    --------------------------------------------------------------------------
    -- * Unrender

    -- | Instantiate this class to register a way of deserializing a type based
    -- on the request's @Content-Type@ header.
    --
    -- >>> import Network.HTTP.Media hiding (Accept)
    -- >>> import qualified Data.ByteString.Lazy.Char8 as BSC
    -- >>> data MyContentType = MyContentType String
    --
    -- >>> :{
    --instance Accept MyContentType where
    --    contentType _ = "example" // "prs.me.mine" /: ("charset", "utf-8")
    -- :}
    --
    -- >>> :{
    --instance Read a => MimeUnrender MyContentType a where
    --    mimeUnrender _ bs = case BSC.take 12 bs of
    --      "MyContentType" -> return . read . BSC.unpack $ BSC.drop 12 bs
    --      _ -> Left "didn't start with the magic incantation"
    -- :}
    --
    -- >>> type MyAPI = "path" :> ReqBody '[MyContentType] Int :> Get '[JSON] Int
    --
    class Accept ctype => MimeUnrender ctype a where
        mimeUnrender :: Proxy ctype -> ByteString -> Either String a
        mimeUnrender Proxy ctype
    p = Proxy ctype -> MediaType -> ByteString -> Either String a
    forall {k} (ctype :: k) a.
    MimeUnrender ctype a =>
    Proxy ctype -> MediaType -> ByteString -> Either String a
    mimeUnrenderWithType Proxy ctype
    p (Proxy ctype -> MediaType
    forall {k} (ctype :: k). Accept ctype => Proxy ctype -> MediaType
    contentType Proxy ctype
    p)

        -- | Variant which is given the actual 'M.MediaType' provided by the other party.
        --
        -- In the most cases you don't want to branch based on the 'M.MediaType'.
        -- See <https://github.com/haskell-servant/servant/pull/552 pr552> for a motivating example.
        mimeUnrenderWithType :: Proxy ctype -> M.MediaType -> ByteString -> Either String a
        mimeUnrenderWithType Proxy ctype
    p MediaType
    _ = Proxy ctype -> ByteString -> Either String a
    forall {k} (ctype :: k) a.
    MimeUnrender ctype a =>
    Proxy ctype -> ByteString -> Either String a
    mimeUnrender Proxy ctype
    p

        {-# MINIMAL mimeUnrender | mimeUnrenderWithType #-}

    class AllCTUnrender (list :: [*]) a where
        canHandleCTypeH
            :: Proxy list
            -> ByteString  -- Content-Type header
            -> Maybe (ByteString -> Either String a)

        handleCTypeH :: Proxy list
                     -> ByteString     -- Content-Type header
                     -> ByteString     -- Request body
                     -> Maybe (Either String a)
        handleCTypeH Proxy list
    p ByteString
    ctypeH ByteString
    body = ((ByteString -> Either String a) -> ByteString -> Either String a
    forall a b. (a -> b) -> a -> b
    $ ByteString
    body) ((ByteString -> Either String a) -> Either String a)
    -> Maybe (ByteString -> Either String a) -> Maybe (Either String a)
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    `fmap` Proxy list -> ByteString -> Maybe (ByteString -> Either String a)
    forall (list :: [*]) a.
    AllCTUnrender list a =>
    Proxy list -> ByteString -> Maybe (ByteString -> Either String a)
    canHandleCTypeH Proxy list
    p ByteString
    ctypeH

    instance ( AllMimeUnrender ctyps a ) => AllCTUnrender ctyps a where
        canHandleCTypeH :: Proxy ctyps -> ByteString -> Maybe (ByteString -> Either String a)
    canHandleCTypeH Proxy ctyps
    p ByteString
    ctypeH =
            [(MediaType, ByteString -> Either String a)]
    -> ByteString -> Maybe (ByteString -> Either String a)
    forall b. [(MediaType, b)] -> ByteString -> Maybe b
    M.mapContentMedia (Proxy ctyps -> [(MediaType, ByteString -> Either String a)]
    forall (list :: [*]) a.
    AllMimeUnrender list a =>
    Proxy list -> [(MediaType, ByteString -> Either String a)]
    allMimeUnrender Proxy ctyps
    p) (ByteString -> ByteString
    forall a b. ConvertibleStrings a b => a -> b
    cs ByteString
    ctypeH)

    --------------------------------------------------------------------------
    -- * Utils (Internal)

    class AllMime (list :: [*]) where
        allMime :: Proxy list -> [M.MediaType]

    instance AllMime '[] where
        allMime :: Proxy '[] -> [MediaType]
    allMime Proxy '[]
    _ = []

    instance (Accept ctyp, AllMime ctyps) => AllMime (ctyp ': ctyps) where
        allMime :: Proxy (ctyp : ctyps) -> [MediaType]
    allMime Proxy (ctyp : ctyps)
    _ = NonEmpty MediaType -> [MediaType]
    forall a. NonEmpty a -> [a]
    NE.toList (Proxy ctyp -> NonEmpty MediaType
    forall {k} (ctype :: k).
    Accept ctype =>
    Proxy ctype -> NonEmpty MediaType
    contentTypes Proxy ctyp
    pctyp) [MediaType] -> [MediaType] -> [MediaType]
    forall a. [a] -> [a] -> [a]
    ++ Proxy ctyps -> [MediaType]
    forall (list :: [*]). AllMime list => Proxy list -> [MediaType]
    allMime Proxy ctyps
    pctyps
          where
            pctyp :: Proxy ctyp
    pctyp  = Proxy ctyp
    forall {k} (t :: k). Proxy t
    Proxy :: Proxy ctyp
            pctyps :: Proxy ctyps
    pctyps = Proxy ctyps
    forall {k} (t :: k). Proxy t
    Proxy :: Proxy ctyps

    canHandleAcceptH :: AllMime list => Proxy list -> AcceptHeader -> Bool
    canHandleAcceptH :: forall (list :: [*]).
    AllMime list =>
    Proxy list -> AcceptHeader -> Bool
    canHandleAcceptH Proxy list
    p (AcceptHeader ByteString
    h ) = Maybe MediaType -> Bool
    forall a. Maybe a -> Bool
    isJust (Maybe MediaType -> Bool) -> Maybe MediaType -> Bool
    forall a b. (a -> b) -> a -> b
    $ [MediaType] -> ByteString -> Maybe MediaType
    forall a. Accept a => [a] -> ByteString -> Maybe a
    M.matchAccept (Proxy list -> [MediaType]
    forall (list :: [*]). AllMime list => Proxy list -> [MediaType]
    allMime Proxy list
    p) ByteString
    h

    --------------------------------------------------------------------------
    -- Check that all elements of list are instances of MimeRender
    --------------------------------------------------------------------------
    class (AllMime list) => AllMimeRender (list :: [*]) a where
        allMimeRender :: Proxy list
                      -> a                              -- value to serialize
                      -> [(M.MediaType, ByteString)]    -- content-types/response pairs

    instance {-# OVERLAPPABLE #-} ( MimeRender ctyp a ) => AllMimeRender '[ctyp] a where
        allMimeRender :: Proxy '[ctyp] -> a -> [(MediaType, ByteString)]
    allMimeRender Proxy '[ctyp]
    _ a
    a = (MediaType -> (MediaType, ByteString))
    -> [MediaType] -> [(MediaType, ByteString)]
    forall a b. (a -> b) -> [a] -> [b]
    map (, ByteString
    bs) ([MediaType] -> [(MediaType, ByteString)])
    -> [MediaType] -> [(MediaType, ByteString)]
    forall a b. (a -> b) -> a -> b
    $ NonEmpty MediaType -> [MediaType]
    forall a. NonEmpty a -> [a]
    NE.toList (NonEmpty MediaType -> [MediaType])
    -> NonEmpty MediaType -> [MediaType]
    forall a b. (a -> b) -> a -> b
    $ Proxy ctyp -> NonEmpty MediaType
    forall {k} (ctype :: k).
    Accept ctype =>
    Proxy ctype -> NonEmpty MediaType
    contentTypes Proxy ctyp
    pctyp
          where
            bs :: ByteString
    bs    = Proxy ctyp -> a -> ByteString
    forall {k} (ctype :: k) a.
    MimeRender ctype a =>
    Proxy ctype -> a -> ByteString
    mimeRender Proxy ctyp
    pctyp a
    a
            pctyp :: Proxy ctyp
    pctyp = Proxy ctyp
    forall {k} (t :: k). Proxy t
    Proxy :: Proxy ctyp

    instance {-# OVERLAPPABLE #-}
             ( MimeRender ctyp a
             , AllMimeRender (ctyp' ': ctyps) a
             ) => AllMimeRender (ctyp ': ctyp' ': ctyps) a where
        allMimeRender :: Proxy (ctyp : ctyp' : ctyps) -> a -> [(MediaType, ByteString)]
    allMimeRender Proxy (ctyp : ctyp' : ctyps)
    _ a
    a =
            (MediaType -> (MediaType, ByteString))
    -> [MediaType] -> [(MediaType, ByteString)]
    forall a b. (a -> b) -> [a] -> [b]
    map (, ByteString
    bs) (NonEmpty MediaType -> [MediaType]
    forall a. NonEmpty a -> [a]
    NE.toList (NonEmpty MediaType -> [MediaType])
    -> NonEmpty MediaType -> [MediaType]
    forall a b. (a -> b) -> a -> b
    $ Proxy ctyp -> NonEmpty MediaType
    forall {k} (ctype :: k).
    Accept ctype =>
    Proxy ctype -> NonEmpty MediaType
    contentTypes Proxy ctyp
    pctyp)
            [(MediaType, ByteString)]
    -> [(MediaType, ByteString)] -> [(MediaType, ByteString)]
    forall a. [a] -> [a] -> [a]
    ++ Proxy (ctyp' : ctyps) -> a -> [(MediaType, ByteString)]
    forall (list :: [*]) a.
    AllMimeRender list a =>
    Proxy list -> a -> [(MediaType, ByteString)]
    allMimeRender Proxy (ctyp' : ctyps)
    pctyps a
    a
          where
            bs :: ByteString
    bs     = Proxy ctyp -> a -> ByteString
    forall {k} (ctype :: k) a.
    MimeRender ctype a =>
    Proxy ctype -> a -> ByteString
    mimeRender Proxy ctyp
    pctyp a
    a
            pctyp :: Proxy ctyp
    pctyp  = Proxy ctyp
    forall {k} (t :: k). Proxy t
    Proxy :: Proxy ctyp
            pctyps :: Proxy (ctyp' : ctyps)
    pctyps = Proxy (ctyp' : ctyps)
    forall {k} (t :: k). Proxy t
    Proxy :: Proxy (ctyp' ': ctyps)

    -- Ideally we would like to declare a 'MimeRender a NoContent' instance, and
    -- then this would be taken care of. However there is no more specific instance
    -- between that and 'MimeRender JSON a', so we do this instead
    instance {-# OVERLAPPING #-} ( Accept ctyp ) => AllMimeRender '[ctyp] NoContent where
        allMimeRender :: Proxy '[ctyp] -> NoContent -> [(MediaType, ByteString)]
    allMimeRender Proxy '[ctyp]
    _ NoContent
    NoContent = (MediaType -> (MediaType, ByteString))
    -> [MediaType] -> [(MediaType, ByteString)]
    forall a b. (a -> b) -> [a] -> [b]
    map (, ByteString
    "") ([MediaType] -> [(MediaType, ByteString)])
    -> [MediaType] -> [(MediaType, ByteString)]
    forall a b. (a -> b) -> a -> b
    $ NonEmpty MediaType -> [MediaType]
    forall a. NonEmpty a -> [a]
    NE.toList (NonEmpty MediaType -> [MediaType])
    -> NonEmpty MediaType -> [MediaType]
    forall a b. (a -> b) -> a -> b
    $ Proxy ctyp -> NonEmpty MediaType
    forall {k} (ctype :: k).
    Accept ctype =>
    Proxy ctype -> NonEmpty MediaType
    contentTypes Proxy ctyp
    pctyp
          where
            pctyp :: Proxy ctyp
    pctyp = Proxy ctyp
    forall {k} (t :: k). Proxy t
    Proxy :: Proxy ctyp

    instance {-# OVERLAPPING #-}
             ( AllMime (ctyp ': ctyp' ': ctyps)
             ) => AllMimeRender (ctyp ': ctyp' ': ctyps) NoContent where
        allMimeRender :: Proxy (ctyp : ctyp' : ctyps)
    -> NoContent -> [(MediaType, ByteString)]
    allMimeRender Proxy (ctyp : ctyp' : ctyps)
    p NoContent
    _ = [MediaType] -> [ByteString] -> [(MediaType, ByteString)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip (Proxy (ctyp : ctyp' : ctyps) -> [MediaType]
    forall (list :: [*]). AllMime list => Proxy list -> [MediaType]
    allMime Proxy (ctyp : ctyp' : ctyps)
    p) (ByteString -> [ByteString]
    forall a. a -> [a]
    repeat ByteString
    "")

    --------------------------------------------------------------------------
    -- Check that all elements of list are instances of MimeUnrender
    --------------------------------------------------------------------------
    class (AllMime list) => AllMimeUnrender (list :: [*]) a where
        allMimeUnrender :: Proxy list
                        -> [(M.MediaType, ByteString -> Either String a)]

    instance AllMimeUnrender '[] a where
        allMimeUnrender :: Proxy '[] -> [(MediaType, ByteString -> Either String a)]
    allMimeUnrender Proxy '[]
    _ = []

    instance ( MimeUnrender ctyp a
             , AllMimeUnrender ctyps a
             ) => AllMimeUnrender (ctyp ': ctyps) a where
        allMimeUnrender :: Proxy (ctyp : ctyps)
    -> [(MediaType, ByteString -> Either String a)]
    allMimeUnrender Proxy (ctyp : ctyps)
    _ =
            (MediaType -> (MediaType, ByteString -> Either String a))
    -> [MediaType] -> [(MediaType, ByteString -> Either String a)]
    forall a b. (a -> b) -> [a] -> [b]
    map MediaType -> (MediaType, ByteString -> Either String a)
    mk (NonEmpty MediaType -> [MediaType]
    forall a. NonEmpty a -> [a]
    NE.toList (NonEmpty MediaType -> [MediaType])
    -> NonEmpty MediaType -> [MediaType]
    forall a b. (a -> b) -> a -> b
    $ Proxy ctyp -> NonEmpty MediaType
    forall {k} (ctype :: k).
    Accept ctype =>
    Proxy ctype -> NonEmpty MediaType
    contentTypes Proxy ctyp
    pctyp)
            [(MediaType, ByteString -> Either String a)]
    -> [(MediaType, ByteString -> Either String a)]
    -> [(MediaType, ByteString -> Either String a)]
    forall a. [a] -> [a] -> [a]
    ++ Proxy ctyps -> [(MediaType, ByteString -> Either String a)]
    forall (list :: [*]) a.
    AllMimeUnrender list a =>
    Proxy list -> [(MediaType, ByteString -> Either String a)]
    allMimeUnrender Proxy ctyps
    pctyps
          where
            mk :: MediaType -> (MediaType, ByteString -> Either String a)
    mk MediaType
    ct   = (MediaType
    ct, Proxy ctyp -> MediaType -> ByteString -> Either String a
    forall {k} (ctype :: k) a.
    MimeUnrender ctype a =>
    Proxy ctype -> MediaType -> ByteString -> Either String a
    mimeUnrenderWithType Proxy ctyp
    pctyp MediaType
    ct)
            pctyp :: Proxy ctyp
    pctyp  = Proxy ctyp
    forall {k} (t :: k). Proxy t
    Proxy :: Proxy ctyp
            pctyps :: Proxy ctyps
    pctyps = Proxy ctyps
    forall {k} (t :: k). Proxy t
    Proxy :: Proxy ctyps

    --------------------------------------------------------------------------
    -- * MimeRender Instances

    -- | `encode`
    instance {-# OVERLAPPABLE #-}
             ToJSON a => MimeRender JSON a where
        mimeRender :: Proxy JSON -> a -> ByteString
    mimeRender Proxy JSON
    _ = a -> ByteString
    forall a. ToJSON a => a -> ByteString
    encode

    -- | @urlEncodeAsForm@
    -- Note that the @mimeUnrender p (mimeRender p x) == Right x@ law only
    -- holds if every element of x is non-null (i.e., not @("", "")@)
    instance {-# OVERLAPPABLE #-}
             ToForm a => MimeRender FormUrlEncoded a where
        mimeRender :: Proxy FormUrlEncoded -> a -> ByteString
    mimeRender Proxy FormUrlEncoded
    _ = a -> ByteString
    forall a. ToForm a => a -> ByteString
    urlEncodeAsForm

    -- | `TextL.encodeUtf8`
    instance MimeRender PlainText TextL.Text where
        mimeRender :: Proxy PlainText -> Text -> ByteString
    mimeRender Proxy PlainText
    _ = Text -> ByteString
    TextL.encodeUtf8

    -- | @fromStrict . TextS.encodeUtf8@
    instance MimeRender PlainText TextS.Text where
        mimeRender :: Proxy PlainText -> Text -> ByteString
    mimeRender Proxy PlainText
    _ = ByteString -> ByteString
    fromStrict (ByteString -> ByteString)
    -> (Text -> ByteString) -> Text -> ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> ByteString
    TextS.encodeUtf8

    -- | @BC.pack@
    instance MimeRender PlainText String where
        mimeRender :: Proxy PlainText -> String -> ByteString
    mimeRender Proxy PlainText
    _ = String -> ByteString
    BC.pack

    -- | @id@
    instance MimeRender OctetStream ByteString where
        mimeRender :: Proxy OctetStream -> ByteString -> ByteString
    mimeRender Proxy OctetStream
    _ = ByteString -> ByteString
    forall a. a -> a
    id

    -- | `fromStrict`
    instance MimeRender OctetStream BS.ByteString where
        mimeRender :: Proxy OctetStream -> ByteString -> ByteString
    mimeRender Proxy OctetStream
    _ = ByteString -> ByteString
    fromStrict

    -- | A type for responses without content-body.
    data NoContent = NoContent
      deriving (Int -> NoContent -> ShowS
    [NoContent] -> ShowS
    NoContent -> String
    (Int -> NoContent -> ShowS)
    -> (NoContent -> String)
    -> ([NoContent] -> ShowS)
    -> Show NoContent
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> NoContent -> ShowS
    showsPrec :: Int -> NoContent -> ShowS
    $cshow :: NoContent -> String
    show :: NoContent -> String
    $cshowList :: [NoContent] -> ShowS
    showList :: [NoContent] -> ShowS
    Show, NoContent -> NoContent -> Bool
    (NoContent -> NoContent -> Bool)
    -> (NoContent -> NoContent -> Bool) -> Eq NoContent
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: NoContent -> NoContent -> Bool
    == :: NoContent -> NoContent -> Bool
    $c/= :: NoContent -> NoContent -> Bool
    /= :: NoContent -> NoContent -> Bool
    Eq, ReadPrec [NoContent]
    ReadPrec NoContent
    Int -> ReadS NoContent
    ReadS [NoContent]
    (Int -> ReadS NoContent)
    -> ReadS [NoContent]
    -> ReadPrec NoContent
    -> ReadPrec [NoContent]
    -> Read NoContent
    forall a.
    (Int -> ReadS a)
    -> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
    $creadsPrec :: Int -> ReadS NoContent
    readsPrec :: Int -> ReadS NoContent
    $creadList :: ReadS [NoContent]
    readList :: ReadS [NoContent]
    $creadPrec :: ReadPrec NoContent
    readPrec :: ReadPrec NoContent
    $creadListPrec :: ReadPrec [NoContent]
    readListPrec :: ReadPrec [NoContent]
    Read, (forall x. NoContent -> Rep NoContent x)
    -> (forall x. Rep NoContent x -> NoContent) -> Generic NoContent
    forall x. Rep NoContent x -> NoContent
    forall x. NoContent -> Rep NoContent x
    forall a.
    (forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
    $cfrom :: forall x. NoContent -> Rep NoContent x
    from :: forall x. NoContent -> Rep NoContent x
    $cto :: forall x. Rep NoContent x -> NoContent
    to :: forall x. Rep NoContent x -> NoContent
    Generic)

    instance NFData NoContent

    --------------------------------------------------------------------------
    -- * MimeUnrender Instances

    -- | Like 'Data.Aeson.eitherDecode' but allows all JSON values instead of just
    -- objects and arrays.
    --
    -- Will handle trailing whitespace, but not trailing junk. ie.
    --
    -- >>> eitherDecodeLenient "1 " :: Either String Int
    -- Right 1
    --
    -- >>> eitherDecodeLenient "1 junk" :: Either String Int
    -- Left "trailing junk after valid JSON: endOfInput"
    eitherDecodeLenient :: FromJSON a => ByteString -> Either String a
    eitherDecodeLenient :: forall a. FromJSON a => ByteString -> Either String a
    eitherDecodeLenient ByteString
    input =
        Parser Value -> ByteString -> Either String Value
    forall a. Parser a -> ByteString -> Either String a
    parseOnly Parser Value
    parser (ByteString -> ByteString
    forall a b. ConvertibleStrings a b => a -> b
    cs ByteString
    input) Either String Value
    -> (Value -> Either String a) -> Either String a
    forall a b.
    Either String a -> (a -> Either String b) -> Either String b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= (Value -> Parser a) -> Value -> Either String a
    forall a b. (a -> Parser b) -> a -> Either String b
    parseEither Value -> Parser a
    forall a. FromJSON a => Value -> Parser a
    parseJSON
      where
        parser :: Parser Value
    parser = Parser ()
    skipSpace
              Parser () -> Parser Value -> Parser Value
    forall a b.
    Parser ByteString a -> Parser ByteString b -> Parser ByteString b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> Parser Value
    Data.Aeson.Parser.value
              Parser Value -> Parser () -> Parser Value
    forall a b.
    Parser ByteString a -> Parser ByteString b -> Parser ByteString a
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
    <* Parser ()
    skipSpace
              Parser Value -> Parser () -> Parser Value
    forall a b.
    Parser ByteString a -> Parser ByteString b -> Parser ByteString a
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
    <* (Parser ()
    forall t. Chunk t => Parser t ()
    endOfInput Parser () -> String -> Parser ()
    forall i a. Parser i a -> String -> Parser i a
    <?> String
    "trailing junk after valid JSON")

    -- | `eitherDecode`
    instance FromJSON a => MimeUnrender JSON a where
        mimeUnrender :: Proxy JSON -> ByteString -> Either String a
    mimeUnrender Proxy JSON
    _ = ByteString -> Either String a
    forall a. FromJSON a => ByteString -> Either String a
    eitherDecodeLenient

    -- | @urlDecodeAsForm@
    -- Note that the @mimeUnrender p (mimeRender p x) == Right x@ law only
    -- holds if every element of x is non-null (i.e., not @("", "")@)
    instance FromForm a => MimeUnrender FormUrlEncoded a where
        mimeUnrender :: Proxy FormUrlEncoded -> ByteString -> Either String a
    mimeUnrender Proxy FormUrlEncoded
    _ = (Text -> String) -> Either Text a -> Either String a
    forall b c d. (b -> c) -> Either b d -> Either c d
    forall (a :: * -> * -> *) b c d.
    ArrowChoice a =>
    a b c -> a (Either b d) (Either c d)
    left Text -> String
    TextS.unpack (Either Text a -> Either String a)
    -> (ByteString -> Either Text a) -> ByteString -> Either String a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> Either Text a
    forall a. FromForm a => ByteString -> Either Text a
    urlDecodeAsForm

    -- | @left show . TextL.decodeUtf8'@
    instance MimeUnrender PlainText TextL.Text where
        mimeUnrender :: Proxy PlainText -> ByteString -> Either String Text
    mimeUnrender Proxy PlainText
    _ = (UnicodeException -> String)
    -> Either UnicodeException Text -> Either String Text
    forall b c d. (b -> c) -> Either b d -> Either c d
    forall (a :: * -> * -> *) b c d.
    ArrowChoice a =>
    a b c -> a (Either b d) (Either c d)
    left UnicodeException -> String
    forall a. Show a => a -> String
    show (Either UnicodeException Text -> Either String Text)
    -> (ByteString -> Either UnicodeException Text)
    -> ByteString
    -> Either String Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> Either UnicodeException Text
    TextL.decodeUtf8'

    -- | @left show . TextS.decodeUtf8' . toStrict@
    instance MimeUnrender PlainText TextS.Text where
        mimeUnrender :: Proxy PlainText -> ByteString -> Either String Text
    mimeUnrender Proxy PlainText
    _ = (UnicodeException -> String)
    -> Either UnicodeException Text -> Either String Text
    forall b c d. (b -> c) -> Either b d -> Either c d
    forall (a :: * -> * -> *) b c d.
    ArrowChoice a =>
    a b c -> a (Either b d) (Either c d)
    left UnicodeException -> String
    forall a. Show a => a -> String
    show (Either UnicodeException Text -> Either String Text)
    -> (ByteString -> Either UnicodeException Text)
    -> ByteString
    -> Either String Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> Either UnicodeException Text
    TextS.decodeUtf8' (ByteString -> Either UnicodeException Text)
    -> (ByteString -> ByteString)
    -> ByteString
    -> Either UnicodeException Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> ByteString
    toStrict

    -- | @Right . BC.unpack@
    instance MimeUnrender PlainText String where
        mimeUnrender :: Proxy PlainText -> ByteString -> Either String String
    mimeUnrender Proxy PlainText
    _ = String -> Either String String
    forall a b. b -> Either a b
    Right (String -> Either String String)
    -> (ByteString -> String) -> ByteString -> Either String String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> String
    BC.unpack

    -- | @Right . id@
    instance MimeUnrender OctetStream ByteString where
        mimeUnrender :: Proxy OctetStream -> ByteString -> Either String ByteString
    mimeUnrender Proxy OctetStream
    _ = ByteString -> Either String ByteString
    forall a b. b -> Either a b
    Right (ByteString -> Either String ByteString)
    -> (ByteString -> ByteString)
    -> ByteString
    -> Either String ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> ByteString
    forall a. a -> a
    id

    -- | @Right . toStrict@
    instance MimeUnrender OctetStream BS.ByteString where
        mimeUnrender :: Proxy OctetStream -> ByteString -> Either String ByteString
    mimeUnrender Proxy OctetStream
    _ = ByteString -> Either String ByteString
    forall a b. b -> Either a b
    Right (ByteString -> Either String ByteString)
    -> (ByteString -> ByteString)
    -> ByteString
    -> Either String ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> ByteString
    toStrict

    -- $setup
    -- >>> :set -XFlexibleInstances
    -- >>> :set -XMultiParamTypeClasses
    -- >>> :set -XOverloadedStrings
    -- >>> import Servant.API
    -- >>> import Data.Aeson
    -- >>> import Data.Text
    -- >>> data Book
    -- >>> instance ToJSON Book where { toJSON = undefined }