-- Disabling for `(Monad m, AllMime cs, HasClient m (MultiVerb method cs as r)) =>`
{-# OPTIONS_GHC -Wno-redundant-constraints #-}

-- This file is part of the Wire Server implementation.
--
-- Copyright (C) 2022 Wire Swiss GmbH <opensource@wire.com>
--
-- This program is free software: you can redistribute it and/or modify it under
-- the terms of the GNU Affero General Public License as published by the Free
-- Software Foundation, either version 3 of the License, or (at your option) any
-- later version.
--
-- This program is distributed in the hope that it will be useful, but WITHOUT
-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
-- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more
-- details.
--
-- You should have received a copy of the GNU Affero General Public License along
-- with this program. If not, see <https://www.gnu.org/licenses/>.

module Wire.API.Routes.ClientAlgebra where

import GHC.TypeLits
import Imports
import Servant
import Servant.API.ContentTypes
import Servant.Client.Core
import Wire.API.Routes.MultiVerb

-- | The type of a Servant client is always an algebra over the underlying
-- monad. Such an algebra structure can easily be constructed by induction over
-- the structure of the API. The base case is an API consisting of only a
-- response, in which case @Client m api = m R@, where @R@ is the response
-- type, and @m R@ is always an algebra over @m@.
--
-- Minimal definition: 'joinClient' | 'bindClient'.
class (HasClient m api) => HasClientAlgebra m api where
  joinClient :: m (Client m api) -> Client m api
  joinClient m (Client m api)
x = forall (m :: * -> *) api a.
HasClientAlgebra m api =>
m a -> (a -> Client m api) -> Client m api
bindClient @m @api m (Client m api)
x Client m api -> Client m api
forall a. a -> a
id

  bindClient :: m a -> (a -> Client m api) -> Client m api
  bindClient m a
x a -> Client m api
f = forall (m :: * -> *) api.
HasClientAlgebra m api =>
m (Client m api) -> Client m api
joinClient @m @api ((a -> Client m api) -> m a -> m (Client m api)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Client m api
f m a
x)

instance (HasClient m (Verb method s cs a)) => HasClientAlgebra m (Verb method s cs a) where
  joinClient :: m (Client m (Verb method s cs a)) -> Client m (Verb method s cs a)
joinClient = m (m a) -> m a
m (Client m (Verb method s cs a)) -> Client m (Verb method s cs a)
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join
  bindClient :: forall a.
m a
-> (a -> Client m (Verb method s cs a))
-> Client m (Verb method s cs a)
bindClient = m a -> (a -> m a) -> m a
m a
-> (a -> Client m (Verb method s cs a))
-> Client m (Verb method s cs a)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
(>>=)

instance
  (Monad m, AllMime cs, HasClient m (MultiVerb method cs as r)) =>
  HasClientAlgebra m (MultiVerb method cs as r)
  where
  joinClient :: m (Client m (MultiVerb method cs as r))
-> Client m (MultiVerb method cs as r)
joinClient = m (m r) -> m r
m (Client m (MultiVerb method cs as r))
-> Client m (MultiVerb method cs as r)
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join
  bindClient :: forall a.
m a
-> (a -> Client m (MultiVerb method cs as r))
-> Client m (MultiVerb method cs as r)
bindClient = m a -> (a -> m r) -> m r
m a
-> (a -> Client m (MultiVerb method cs as r))
-> Client m (MultiVerb method cs as r)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
(>>=)

instance
  ( HasClientAlgebra m api,
    HasClient m (ReqBody' mods (ct ': cts) a :> api)
  ) =>
  HasClientAlgebra m (ReqBody' mods (ct ': cts) a :> api)
  where
  joinClient :: m (Client m (ReqBody' mods (ct : cts) a :> api))
-> Client m (ReqBody' mods (ct : cts) a :> api)
joinClient m (Client m (ReqBody' mods (ct : cts) a :> api))
x a
a = forall (m :: * -> *) api.
HasClientAlgebra m api =>
m (Client m api) -> Client m api
joinClient @m @api (m (Client m api) -> Client m api)
-> m (Client m api) -> Client m api
forall a b. (a -> b) -> a -> b
$ m (Client m (ReqBody' mods (ct : cts) a :> api))
m (a -> Client m api)
x m (a -> Client m api) -> m a -> m (Client m api)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> m a
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a

instance
  ( HasClientAlgebra m api,
    KnownSymbol sym
  ) =>
  HasClientAlgebra m ((sym :: Symbol) :> api)
  where
  joinClient :: m (Client m (sym :> api)) -> Client m (sym :> api)
joinClient = forall (m :: * -> *) api.
HasClientAlgebra m api =>
m (Client m api) -> Client m api
joinClient @m @api
  bindClient :: forall a.
m a -> (a -> Client m (sym :> api)) -> Client m (sym :> api)
bindClient = forall (m :: * -> *) api a.
HasClientAlgebra m api =>
m a -> (a -> Client m api) -> Client m api
bindClient @m @api