    {-# LANGUAGE AllowAmbiguousTypes #-}
    {-# LANGUAGE ConstraintKinds #-}
    {-# LANGUAGE DataKinds #-}
    {-# LANGUAGE DeriveGeneric #-}
    {-# LANGUAGE FlexibleContexts #-}
    {-# LANGUAGE FlexibleInstances #-}
    {-# LANGUAGE MultiParamTypeClasses #-}
    {-# LANGUAGE RankNTypes #-}
    {-# LANGUAGE ScopedTypeVariables #-}
    {-# LANGUAGE TypeFamilies #-}
    {-# LANGUAGE TypeOperators #-}
    {-# LANGUAGE UndecidableInstances #-}
    {-# LANGUAGE GeneralizedNewtypeDeriving #-}

    -- | An alternative to 'Verb' for end-points that respond with a resource value of any of an
    -- open union of types, and specific status codes for each type in this union.  (`UVerb` is
    -- short for `UnionVerb`)
    --
    -- This can be used for returning (rather than throwing) exceptions in a server as in, say
    -- @'[Report, WaiError]@; or responding with either a 303 forward with a location header, or
    -- 201 created with a different body type, depending on the circumstances.  (All of this can
    -- be done with vanilla servant-server by throwing exceptions, but it can't be represented in
    -- the API types without something like `UVerb`.)
    --
    -- See <https://docs.servant.dev/en/stable/cookbook/uverb/UVerb.html> for a working example.
    module Servant.API.UVerb
      ( UVerb,
        HasStatus (StatusOf),
        statusOf,
        HasStatuses (Statuses, statuses),
        WithStatus (..),
        module Servant.API.UVerb.Union,
      )
    where

    import Data.Proxy (Proxy (Proxy))
    import GHC.TypeLits (Nat)
    import Network.HTTP.Types (Status, StdMethod)
    import Servant.API.ContentTypes (JSON, PlainText, FormUrlEncoded, OctetStream, NoContent, MimeRender(mimeRender), MimeUnrender(mimeUnrender))
    import Servant.API.Status (KnownStatus, statusVal)
    import Servant.API.UVerb.Union

    class KnownStatus (StatusOf a) => HasStatus (a :: *) where
      type StatusOf (a :: *) :: Nat

    statusOf :: forall a proxy. HasStatus a => proxy a -> Status
    statusOf :: forall a (proxy :: * -> *). HasStatus a => proxy a -> Status
    statusOf = Status -> proxy a -> Status
    forall a b. a -> b -> a
    const (Proxy (StatusOf a) -> Status
    forall (n :: Nat) (proxy :: Nat -> *).
    KnownStatus n =>
    proxy n -> Status
    forall (proxy :: Nat -> *). proxy (StatusOf a) -> Status
    statusVal (Proxy (StatusOf a)
    forall {k} (t :: k). Proxy t
    Proxy :: Proxy (StatusOf a)))

    -- | If an API can respond with 'NoContent' we assume that this will happen
    -- with the status code 204 No Content. If this needs to be overridden,
    -- 'WithStatus' can be used.
    instance HasStatus NoContent where
      type StatusOf NoContent = 204

    class HasStatuses (as :: [*]) where
      type Statuses (as :: [*]) :: [Nat]
      statuses :: Proxy as -> [Status]

    instance HasStatuses '[] where
      type Statuses '[] = '[]
      statuses :: Proxy '[] -> [Status]
    statuses Proxy '[]
    _ = []

    instance (HasStatus a, HasStatuses as) => HasStatuses (a ': as) where
      type Statuses (a ': as) = StatusOf a ': Statuses as
      statuses :: Proxy (a : as) -> [Status]
    statuses Proxy (a : as)
    _ = Proxy a -> Status
    forall a (proxy :: * -> *). HasStatus a => proxy a -> Status
    statusOf (Proxy a
    forall {k} (t :: k). Proxy t
    Proxy :: Proxy a) Status -> [Status] -> [Status]
    forall a. a -> [a] -> [a]
    : Proxy as -> [Status]
    forall (as :: [*]). HasStatuses as => Proxy as -> [Status]
    statuses (Proxy as
    forall {k} (t :: k). Proxy t
    Proxy :: Proxy as)

    -- | A simple newtype wrapper that pairs a type with its status code.  It
    -- implements all the content types that Servant ships with by default.
    newtype WithStatus (k :: Nat) a = WithStatus a
      deriving (WithStatus k a -> WithStatus k a -> Bool
    (WithStatus k a -> WithStatus k a -> Bool)
    -> (WithStatus k a -> WithStatus k a -> Bool)
    -> Eq (WithStatus k a)
    forall (k :: Nat) a.
    Eq a =>
    WithStatus k a -> WithStatus k a -> Bool
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: forall (k :: Nat) a.
    Eq a =>
    WithStatus k a -> WithStatus k a -> Bool
    == :: WithStatus k a -> WithStatus k a -> Bool
    $c/= :: forall (k :: Nat) a.
    Eq a =>
    WithStatus k a -> WithStatus k a -> Bool
    /= :: WithStatus k a -> WithStatus k a -> Bool
    Eq, Int -> WithStatus k a -> ShowS
    [WithStatus k a] -> ShowS
    WithStatus k a -> String
    (Int -> WithStatus k a -> ShowS)
    -> (WithStatus k a -> String)
    -> ([WithStatus k a] -> ShowS)
    -> Show (WithStatus k a)
    forall (k :: Nat) a. Show a => Int -> WithStatus k a -> ShowS
    forall (k :: Nat) a. Show a => [WithStatus k a] -> ShowS
    forall (k :: Nat) a. Show a => WithStatus k a -> String
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: forall (k :: Nat) a. Show a => Int -> WithStatus k a -> ShowS
    showsPrec :: Int -> WithStatus k a -> ShowS
    $cshow :: forall (k :: Nat) a. Show a => WithStatus k a -> String
    show :: WithStatus k a -> String
    $cshowList :: forall (k :: Nat) a. Show a => [WithStatus k a] -> ShowS
    showList :: [WithStatus k a] -> ShowS
    Show)

    -- | an instance of this typeclass assigns a HTTP status code to a return type
    --
    -- Example:
    --
    -- @
    --    data NotFoundError = NotFoundError String
    --
    --    instance HasStatus NotFoundError where
    --      type StatusOf NotFoundError = 404
    -- @
    --
    -- You can also use the convience newtype wrapper 'WithStatus' if you want to
    -- avoid writing a 'HasStatus' instance manually. It also has the benefit of
    -- showing the status code in the type; which might aid in readability.
    instance KnownStatus n => HasStatus (WithStatus n a) where
      type StatusOf (WithStatus n a) = n

    -- | A variant of 'Verb' that can have any of a number of response values and status codes.
    --
    -- FUTUREWORK: it would be nice to make 'Verb' a special case of 'UVerb', and only write
    -- instances for 'HasServer' etc. for the latter, getting them for the former for free.
    -- Something like:
    --
    -- @type Verb method statusCode contentTypes a = UVerb method contentTypes [WithStatus statusCode a]@
    --
    -- Backwards compatibility is tricky, though: this type alias would mean people would have to
    -- use 'respond' instead of 'pure' or 'return', so all old handlers would have to be rewritten.
    data UVerb (method :: StdMethod) (contentTypes :: [*]) (as :: [*])

    instance {-# OVERLAPPING #-} MimeRender JSON a => MimeRender JSON (WithStatus _status a) where
      mimeRender :: Proxy JSON -> WithStatus _status a -> ByteString
    mimeRender Proxy JSON
    contentTypeProxy (WithStatus a
    a) = Proxy JSON -> a -> ByteString
    forall {k} (ctype :: k) a.
    MimeRender ctype a =>
    Proxy ctype -> a -> ByteString
    mimeRender Proxy JSON
    contentTypeProxy a
    a

    instance {-# OVERLAPPING #-} MimeRender PlainText a => MimeRender PlainText (WithStatus _status a) where
      mimeRender :: Proxy PlainText -> WithStatus _status a -> ByteString
    mimeRender Proxy PlainText
    contentTypeProxy (WithStatus a
    a) = Proxy PlainText -> a -> ByteString
    forall {k} (ctype :: k) a.
    MimeRender ctype a =>
    Proxy ctype -> a -> ByteString
    mimeRender Proxy PlainText
    contentTypeProxy a
    a

    instance {-# OVERLAPPING #-} MimeRender FormUrlEncoded a => MimeRender FormUrlEncoded (WithStatus _status a) where
      mimeRender :: Proxy FormUrlEncoded -> WithStatus _status a -> ByteString
    mimeRender Proxy FormUrlEncoded
    contentTypeProxy (WithStatus a
    a) = Proxy FormUrlEncoded -> a -> ByteString
    forall {k} (ctype :: k) a.
    MimeRender ctype a =>
    Proxy ctype -> a -> ByteString
    mimeRender Proxy FormUrlEncoded
    contentTypeProxy a
    a

    instance {-# OVERLAPPING #-} MimeRender OctetStream a => MimeRender OctetStream (WithStatus _status a) where
      mimeRender :: Proxy OctetStream -> WithStatus _status a -> ByteString
    mimeRender Proxy OctetStream
    contentTypeProxy (WithStatus a
    a) = Proxy OctetStream -> a -> ByteString
    forall {k} (ctype :: k) a.
    MimeRender ctype a =>
    Proxy ctype -> a -> ByteString
    mimeRender Proxy OctetStream
    contentTypeProxy a
    a

    instance {-# OVERLAPPING #-} MimeUnrender JSON a => MimeUnrender JSON (WithStatus _status a) where
      mimeUnrender :: Proxy JSON -> ByteString -> Either String (WithStatus _status a)
    mimeUnrender Proxy JSON
    contentTypeProxy ByteString
    input = a -> WithStatus _status a
    forall (k :: Nat) a. a -> WithStatus k a
    WithStatus (a -> WithStatus _status a)
    -> Either String a -> Either String (WithStatus _status a)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Proxy JSON -> ByteString -> Either String a
    forall {k} (ctype :: k) a.
    MimeUnrender ctype a =>
    Proxy ctype -> ByteString -> Either String a
    mimeUnrender Proxy JSON
    contentTypeProxy ByteString
    input

    instance {-# OVERLAPPING #-} MimeUnrender PlainText a => MimeUnrender PlainText (WithStatus _status a) where
      mimeUnrender :: Proxy PlainText
    -> ByteString -> Either String (WithStatus _status a)
    mimeUnrender Proxy PlainText
    contentTypeProxy ByteString
    input = a -> WithStatus _status a
    forall (k :: Nat) a. a -> WithStatus k a
    WithStatus (a -> WithStatus _status a)
    -> Either String a -> Either String (WithStatus _status a)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Proxy PlainText -> ByteString -> Either String a
    forall {k} (ctype :: k) a.
    MimeUnrender ctype a =>
    Proxy ctype -> ByteString -> Either String a
    mimeUnrender Proxy PlainText
    contentTypeProxy ByteString
    input

    instance {-# OVERLAPPING #-} MimeUnrender FormUrlEncoded a => MimeUnrender FormUrlEncoded (WithStatus _status a) where
      mimeUnrender :: Proxy FormUrlEncoded
    -> ByteString -> Either String (WithStatus _status a)
    mimeUnrender Proxy FormUrlEncoded
    contentTypeProxy ByteString
    input = a -> WithStatus _status a
    forall (k :: Nat) a. a -> WithStatus k a
    WithStatus (a -> WithStatus _status a)
    -> Either String a -> Either String (WithStatus _status a)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Proxy FormUrlEncoded -> ByteString -> Either String a
    forall {k} (ctype :: k) a.
    MimeUnrender ctype a =>
    Proxy ctype -> ByteString -> Either String a
    mimeUnrender Proxy FormUrlEncoded
    contentTypeProxy ByteString
    input

    instance {-# OVERLAPPING #-} MimeUnrender OctetStream a => MimeUnrender OctetStream (WithStatus _status a) where
      mimeUnrender :: Proxy OctetStream
    -> ByteString -> Either String (WithStatus _status a)
    mimeUnrender Proxy OctetStream
    contentTypeProxy ByteString
    input = a -> WithStatus _status a
    forall (k :: Nat) a. a -> WithStatus k a
    WithStatus (a -> WithStatus _status a)
    -> Either String a -> Either String (WithStatus _status a)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Proxy OctetStream -> ByteString -> Either String a
    forall {k} (ctype :: k) a.
    MimeUnrender ctype a =>
    Proxy ctype -> ByteString -> Either String a
    mimeUnrender Proxy OctetStream
    contentTypeProxy ByteString
    input