{-# LANGUAGE TypeFamilies         #-}
{-# LANGUAGE ScopedTypeVariables  #-}
module Gargantext.API.Routes.Types where

import Data.List qualified as L
import Data.Proxy
import Gargantext.API.Errors
import Network.Wai
import Prelude
import Servant.Client
import Servant.Ekg
import Servant.Server
import Servant.Server.Internal.Delayed
import Servant.Server.Internal.DelayedIO

data WithCustomErrorScheme a

instance (HasServer subApi ctx) => HasServer (WithCustomErrorScheme subApi) ctx where
  type ServerT (WithCustomErrorScheme subApi) m = GargErrorScheme -> ServerT subApi m
  hoistServerWithContext _ pc nt s = hoistServerWithContext (Proxy :: Proxy subApi) pc nt . s
  route Proxy ctx d = route (Proxy :: Proxy subApi) ctx (d `addHeaderCheck` getErrorScheme)
    where
      getErrorScheme :: DelayedIO GargErrorScheme
      getErrorScheme = withRequest $ \rq -> do
        let hdrs = requestHeaders rq
            in case L.lookup "X-Garg-Error-Scheme" hdrs of
                 Nothing     -> pure GES_old
                 Just "new"  -> pure GES_new
                 Just _      -> pure GES_old

instance HasEndpoint sub => HasEndpoint (WithCustomErrorScheme sub) where
  getEndpoint _ = getEndpoint (Proxy :: Proxy sub)
  enumerateEndpoints _ = enumerateEndpoints (Proxy :: Proxy sub)

instance HasClient m sub => HasClient m (WithCustomErrorScheme sub) where
  type Client m (WithCustomErrorScheme sub) = GargErrorScheme -> Client m sub
  clientWithRoute m _ req _mgr = clientWithRoute m (Proxy :: Proxy sub) req

  hoistClientMonad pm _ nt cl = hoistClientMonad pm (Proxy :: Proxy sub) nt . cl
