    {-# LANGUAGE ApplicativeDo #-}
    module Servant.Client.Core.MultiVerb.ResponseUnrender where

    import Control.Applicative
    import Control.Monad
    import Data.Kind (Type)
    import Data.SOP
    import Data.Typeable
    import GHC.TypeLits
    import Network.HTTP.Types.Status (Status)
    import qualified Data.ByteString.Lazy as BSL
    import qualified Network.HTTP.Media as M

    import Servant.API.ContentTypes
    import Servant.API.MultiVerb
    import Servant.API.Status
    import Servant.API.UVerb.Union (Union)
    import Servant.Client.Core.Response (ResponseF(..))
    import qualified Servant.Client.Core.Response as Response
    import Servant.API.Stream (SourceIO)
    import Data.ByteString (ByteString)

    data SomeClientResponse = forall a. Typeable a => SomeClientResponse (ResponseF a)

    fromSomeClientResponse
      :: forall a m. (Alternative m, Typeable a)
      => SomeClientResponse
      -> m (ResponseF a)
    fromSomeClientResponse :: forall a (m :: Type -> Type).
    (Alternative m, Typeable a) =>
    SomeClientResponse -> m (ResponseF a)
    fromSomeClientResponse (SomeClientResponse Response {a
    Seq Header
    Status
    HttpVersion
    responseStatusCode :: Status
    responseHeaders :: Seq Header
    responseHttpVersion :: HttpVersion
    responseBody :: a
    responseBody :: forall a. ResponseF a -> a
    responseHttpVersion :: forall a. ResponseF a -> HttpVersion
    responseHeaders :: forall a. ResponseF a -> Seq Header
    responseStatusCode :: forall a. ResponseF a -> Status
    ..}) = do
      a
    body <- m a -> (a -> m a) -> Maybe a -> m a
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe m a
    forall a. m a
    forall (f :: Type -> Type) a. Alternative f => f a
    empty a -> m a
    forall a. a -> m a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure (Maybe a -> m a) -> Maybe a -> m a
    forall a b. (a -> b) -> a -> b
    $ forall a b. (Typeable a, Typeable b) => a -> Maybe b
    cast @_ @a a
    responseBody
      pure $
        Response
          { responseBody :: a
    responseBody = a
    body,
            Seq Header
    Status
    HttpVersion
    responseStatusCode :: Status
    responseHeaders :: Seq Header
    responseHttpVersion :: HttpVersion
    responseHttpVersion :: HttpVersion
    responseHeaders :: Seq Header
    responseStatusCode :: Status
    ..
          }

    class ResponseUnrender cs a where
      type ResponseBody a :: Type
      type ResponseStatus a :: Nat
      responseUnrender
        :: M.MediaType
        -> ResponseF (ResponseBody a)
        -> UnrenderResult (ResponseType a)

    class (Typeable as) => ResponseListUnrender cs as where
      responseListUnrender
        :: M.MediaType
        -> SomeClientResponse
        -> UnrenderResult (Union (ResponseTypes as))

      responseListStatuses :: [Status]

    instance ResponseListUnrender cs '[] where
      responseListUnrender :: MediaType
    -> SomeClientResponse -> UnrenderResult (Union (ResponseTypes '[]))
    responseListUnrender MediaType
    _ SomeClientResponse
    _ = UnrenderResult (Union '[])
    UnrenderResult (Union (ResponseTypes '[]))
    forall a. UnrenderResult a
    StatusMismatch
      responseListStatuses :: [Status]
    responseListStatuses = []

    instance
      ( Typeable a,
        Typeable (ResponseBody a),
        ResponseUnrender cs a,
        ResponseListUnrender cs as,
        KnownStatus (ResponseStatus a)
      ) =>
      ResponseListUnrender cs (a ': as)
      where
      responseListUnrender :: MediaType
    -> SomeClientResponse
    -> UnrenderResult (Union (ResponseTypes (a : as)))
    responseListUnrender MediaType
    c SomeClientResponse
    output =
        I (ResponseType a) -> NS I (ResponseType a : ResponseTypes as)
    forall {k} (a :: k -> Type) (x :: k) (xs :: [k]).
    a x -> NS a (x : xs)
    Z (I (ResponseType a) -> NS I (ResponseType a : ResponseTypes as))
    -> (ResponseType a -> I (ResponseType a))
    -> ResponseType a
    -> NS I (ResponseType a : ResponseTypes as)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ResponseType a -> I (ResponseType a)
    forall a. a -> I a
    I (ResponseType a -> NS I (ResponseType a : ResponseTypes as))
    -> UnrenderResult (ResponseType a)
    -> UnrenderResult (NS I (ResponseType a : ResponseTypes as))
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> (forall (cs :: k) a.
    ResponseUnrender cs a =>
    MediaType
    -> ResponseF (ResponseBody a) -> UnrenderResult (ResponseType a)
    forall {k} (cs :: k) a.
    ResponseUnrender cs a =>
    MediaType
    -> ResponseF (ResponseBody a) -> UnrenderResult (ResponseType a)
    responseUnrender @cs @a MediaType
    c (ResponseF (ResponseBody a) -> UnrenderResult (ResponseType a))
    -> UnrenderResult (ResponseF (ResponseBody a))
    -> UnrenderResult (ResponseType a)
    forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
    =<< SomeClientResponse -> UnrenderResult (ResponseF (ResponseBody a))
    forall a (m :: Type -> Type).
    (Alternative m, Typeable a) =>
    SomeClientResponse -> m (ResponseF a)
    fromSomeClientResponse SomeClientResponse
    output)
          UnrenderResult (NS I (ResponseType a : ResponseTypes as))
    -> UnrenderResult (NS I (ResponseType a : ResponseTypes as))
    -> UnrenderResult (NS I (ResponseType a : ResponseTypes as))
    forall a. UnrenderResult a -> UnrenderResult a -> UnrenderResult a
    forall (f :: Type -> Type) a. Alternative f => f a -> f a -> f a
    <|> NS I (ResponseTypes as) -> NS I (ResponseType a : ResponseTypes as)
    forall {k} (a :: k -> Type) (xs :: [k]) (x :: k).
    NS a xs -> NS a (x : xs)
    S (NS I (ResponseTypes as)
     -> NS I (ResponseType a : ResponseTypes as))
    -> UnrenderResult (NS I (ResponseTypes as))
    -> UnrenderResult (NS I (ResponseType a : ResponseTypes as))
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> forall (cs :: k) (as :: [Type]).
    ResponseListUnrender cs as =>
    MediaType
    -> SomeClientResponse -> UnrenderResult (Union (ResponseTypes as))
    forall {k} (cs :: k) (as :: [Type]).
    ResponseListUnrender cs as =>
    MediaType
    -> SomeClientResponse -> UnrenderResult (Union (ResponseTypes as))
    responseListUnrender @cs @as MediaType
    c SomeClientResponse
    output

      responseListStatuses :: [Status]
    responseListStatuses = Proxy (ResponseStatus a) -> Status
    forall (n :: Nat) (proxy :: Nat -> Type).
    KnownStatus n =>
    proxy n -> Status
    forall (proxy :: Nat -> Type). proxy (ResponseStatus a) -> Status
    statusVal (forall (t :: Nat). Proxy t
    forall {k} (t :: k). Proxy t
    Proxy @(ResponseStatus a)) Status -> [Status] -> [Status]
    forall a. a -> [a] -> [a]
    : forall (cs :: k) (as :: [Type]).
    ResponseListUnrender cs as =>
    [Status]
    forall {k} (cs :: k) (as :: [Type]).
    ResponseListUnrender cs as =>
    [Status]
    responseListStatuses @cs @as

    instance
      ( KnownStatus s,
        MimeUnrender ct a
      ) =>
      ResponseUnrender cs (RespondAs (ct :: Type) s desc a)
      where
      type ResponseStatus (RespondAs ct s desc a) = s
      type ResponseBody (RespondAs ct s desc a) = BSL.ByteString

      responseUnrender :: MediaType
    -> ResponseF (ResponseBody (RespondAs ct s desc a))
    -> UnrenderResult (ResponseType (RespondAs ct s desc a))
    responseUnrender MediaType
    _ ResponseF (ResponseBody (RespondAs ct s desc a))
    output = do
        Bool -> UnrenderResult ()
    forall (f :: Type -> Type). Alternative f => Bool -> f ()
    guard (ResponseF ByteString -> Status
    forall a. ResponseF a -> Status
    responseStatusCode ResponseF ByteString
    ResponseF (ResponseBody (RespondAs ct s desc a))
    output Status -> Status -> Bool
    forall a. Eq a => a -> a -> Bool
    == Proxy s -> Status
    forall (n :: Nat) (proxy :: Nat -> Type).
    KnownStatus n =>
    proxy n -> Status
    forall (proxy :: Nat -> Type). proxy s -> Status
    statusVal (forall (t :: Nat). Proxy t
    forall {k} (t :: k). Proxy t
    Proxy @s))
        (String -> UnrenderResult a)
    -> (a -> UnrenderResult a) -> Either String a -> UnrenderResult a
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either String -> UnrenderResult a
    forall a. String -> UnrenderResult a
    UnrenderError a -> UnrenderResult a
    forall a. a -> UnrenderResult a
    UnrenderSuccess (Either String a -> UnrenderResult a)
    -> Either String a -> UnrenderResult a
    forall a b. (a -> b) -> a -> b
    $
          Proxy ct -> ByteString -> Either String a
    forall {k} (ctype :: k) a.
    MimeUnrender ctype a =>
    Proxy ctype -> ByteString -> Either String a
    mimeUnrender (forall t. Proxy t
    forall {k} (t :: k). Proxy t
    Proxy @ct) (ResponseF ByteString -> ByteString
    forall a. ResponseF a -> a
    Response.responseBody ResponseF ByteString
    ResponseF (ResponseBody (RespondAs ct s desc a))
    output)

    instance (KnownStatus s) => ResponseUnrender cs (RespondAs '() s desc ()) where
      type ResponseStatus (RespondAs '() s desc ()) = s
      type ResponseBody (RespondAs '() s desc ()) = ()

      responseUnrender :: MediaType
    -> ResponseF (ResponseBody (RespondAs '() s desc ()))
    -> UnrenderResult (ResponseType (RespondAs '() s desc ()))
    responseUnrender MediaType
    _ ResponseF (ResponseBody (RespondAs '() s desc ()))
    output =
        Bool -> UnrenderResult ()
    forall (f :: Type -> Type). Alternative f => Bool -> f ()
    guard (ResponseF () -> Status
    forall a. ResponseF a -> Status
    responseStatusCode ResponseF ()
    ResponseF (ResponseBody (RespondAs '() s desc ()))
    output Status -> Status -> Bool
    forall a. Eq a => a -> a -> Bool
    == Proxy s -> Status
    forall (n :: Nat) (proxy :: Nat -> Type).
    KnownStatus n =>
    proxy n -> Status
    forall (proxy :: Nat -> Type). proxy s -> Status
    statusVal (forall (t :: Nat). Proxy t
    forall {k} (t :: k). Proxy t
    Proxy @s))

    instance
      (KnownStatus s)
      => ResponseUnrender cs (RespondStreaming s desc framing ct)
      where
      type ResponseStatus (RespondStreaming s desc framing ct) = s
      type ResponseBody (RespondStreaming s desc framing ct) = SourceIO ByteString

      responseUnrender :: MediaType
    -> ResponseF (ResponseBody (RespondStreaming s desc framing ct))
    -> UnrenderResult
         (ResponseType (RespondStreaming s desc framing ct))
    responseUnrender MediaType
    _ ResponseF (ResponseBody (RespondStreaming s desc framing ct))
    resp = do
        Bool -> UnrenderResult ()
    forall (f :: Type -> Type). Alternative f => Bool -> f ()
    guard (ResponseF (SourceIO ByteString) -> Status
    forall a. ResponseF a -> Status
    Response.responseStatusCode ResponseF (SourceIO ByteString)
    ResponseF (ResponseBody (RespondStreaming s desc framing ct))
    resp Status -> Status -> Bool
    forall a. Eq a => a -> a -> Bool
    == Proxy s -> Status
    forall (n :: Nat) (proxy :: Nat -> Type).
    KnownStatus n =>
    proxy n -> Status
    forall (proxy :: Nat -> Type). proxy s -> Status
    statusVal (forall (t :: Nat). Proxy t
    forall {k} (t :: k). Proxy t
    Proxy @s))
        pure $ ResponseF (SourceIO ByteString) -> SourceIO ByteString
    forall a. ResponseF a -> a
    Response.responseBody ResponseF (SourceIO ByteString)
    ResponseF (ResponseBody (RespondStreaming s desc framing ct))
    resp

    instance
      (AllMimeUnrender cs a, KnownStatus s)
      => ResponseUnrender cs (Respond s desc a) where
      type ResponseStatus (Respond s desc a) = s
      type ResponseBody (Respond s desc a) = BSL.ByteString

      responseUnrender :: MediaType
    -> ResponseF (ResponseBody (Respond s desc a))
    -> UnrenderResult (ResponseType (Respond s desc a))
    responseUnrender MediaType
    c ResponseF (ResponseBody (Respond s desc a))
    output = do
        Bool -> UnrenderResult ()
    forall (f :: Type -> Type). Alternative f => Bool -> f ()
    guard (ResponseF ByteString -> Status
    forall a. ResponseF a -> Status
    responseStatusCode ResponseF ByteString
    ResponseF (ResponseBody (Respond s desc a))
    output Status -> Status -> Bool
    forall a. Eq a => a -> a -> Bool
    == Proxy s -> Status
    forall (n :: Nat) (proxy :: Nat -> Type).
    KnownStatus n =>
    proxy n -> Status
    forall (proxy :: Nat -> Type). proxy s -> Status
    statusVal (forall (t :: Nat). Proxy t
    forall {k} (t :: k). Proxy t
    Proxy @s))
        let results :: [(MediaType, ByteString -> Either String a)]
    results = Proxy cs -> [(MediaType, ByteString -> Either String a)]
    forall (list :: [Type]) a.
    AllMimeUnrender list a =>
    Proxy list -> [(MediaType, ByteString -> Either String a)]
    allMimeUnrender (forall (t :: [Type]). Proxy t
    forall {k} (t :: k). Proxy t
    Proxy @cs)
        case MediaType
    -> [(MediaType, ByteString -> Either String a)]
    -> Maybe (ByteString -> Either String a)
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup MediaType
    c [(MediaType, ByteString -> Either String a)]
    results of
          Maybe (ByteString -> Either String a)
    Nothing -> UnrenderResult a
    forall a. UnrenderResult a
    forall (f :: Type -> Type) a. Alternative f => f a
    empty
          Just ByteString -> Either String a
    f -> (String -> UnrenderResult a)
    -> (a -> UnrenderResult a) -> Either String a -> UnrenderResult a
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either String -> UnrenderResult a
    forall a. String -> UnrenderResult a
    UnrenderError a -> UnrenderResult a
    forall a. a -> UnrenderResult a
    UnrenderSuccess (ByteString -> Either String a
    f (ResponseF ByteString -> ByteString
    forall a. ResponseF a -> a
    responseBody ResponseF ByteString
    ResponseF (ResponseBody (Respond s desc a))
    output))

    instance
      ( AsHeaders xs (ResponseType r) a,
        ServantHeaders hs xs,
        ResponseUnrender cs r
      ) =>
      ResponseUnrender cs (WithHeaders hs a r)
      where
      type ResponseStatus (WithHeaders hs a r) = ResponseStatus r
      type ResponseBody (WithHeaders hs a r) = ResponseBody r

      responseUnrender :: MediaType
    -> ResponseF (ResponseBody (WithHeaders hs a r))
    -> UnrenderResult (ResponseType (WithHeaders hs a r))
    responseUnrender MediaType
    c ResponseF (ResponseBody (WithHeaders hs a r))
    output = do
        ResponseType r
    x <- forall (cs :: k) a.
    ResponseUnrender cs a =>
    MediaType
    -> ResponseF (ResponseBody a) -> UnrenderResult (ResponseType a)
    forall {k} (cs :: k) a.
    ResponseUnrender cs a =>
    MediaType
    -> ResponseF (ResponseBody a) -> UnrenderResult (ResponseType a)
    responseUnrender @cs @r MediaType
    c ResponseF (ResponseBody r)
    ResponseF (ResponseBody (WithHeaders hs a r))
    output
        case forall (headers :: [Type]) (xs :: [Type]).
    ServantHeaders headers xs =>
    Seq Header -> Maybe (NP I xs)
    forall {k} (headers :: k) (xs :: [Type]).
    ServantHeaders headers xs =>
    Seq Header -> Maybe (NP I xs)
    extractHeaders @hs (ResponseF (ResponseBody r) -> Seq Header
    forall a. ResponseF a -> Seq Header
    responseHeaders ResponseF (ResponseBody r)
    ResponseF (ResponseBody (WithHeaders hs a r))
    output) of
          Maybe (NP I xs)
    Nothing -> String -> UnrenderResult a
    forall a. String -> UnrenderResult a
    UnrenderError String
    "Failed to parse headers"
          Just NP I xs
    hs -> a -> UnrenderResult a
    forall a. a -> UnrenderResult a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure (a -> UnrenderResult a) -> a -> UnrenderResult a
    forall a b. (a -> b) -> a -> b
    $ forall (headers :: [Type]) response returnType.
    AsHeaders headers response returnType =>
    (NP I headers, response) -> returnType
    fromHeaders @xs (NP I xs
    hs, ResponseType r
    x)