Madness

Blap.hs

newtype ClientInterpreter params m
  = ClientInterpreter
  (  forall response
   . params
  -> ClientEnv
  -> ClientF response
  -> ExceptT ServantError m response
  )

class HasClientInterpreter (context :: Type -> (Type -> Type) -> Type) where
  clientInterpreterL :: Lens' (context params m) (ClientInterpreter params m)

instance HasClientInterpreter ClientInterpreter where
  clientInterpreterL :: Lens' (ClientInterpreter params m) (ClientInterpreter params m)
  clientInterpreterL = identity

interpretClient
  :: ( Monad m
     , MonadTrans t
     , MonadReader (context clientParams m) (t m)
     , HasClientInterpreter context
     )
  => ClientEnv
  -> clientParams
  -> Free ClientF response
  -> (t m) (Either ServantError response)
interpretClient clientEnv clientParams clientF = do
    (ClientInterpreter interpreter) <- view clientInterpreterL
    lift . runExceptT $ foldFree (interpreter clientParams clientEnv) clientF

interpretWithAuthParams
  :: MonadIO m
  => Maybe AuthParams
  -> ClientEnv
  -> ClientF response
  -> ExceptT ServantError m response
interpretWithAuthParams mbAuthParams clientEnv = ...

runClientUsingAuthparams
  :: MonadIO m  
  => ClientEnv
  -> Maybe AuthParams
  -> Free ClientF response
  -> m (Either ServantError response)
runClientUsingAuthparams clientEnv mbAuthParams clientF = do
  let interpreter = ClientInterpreter interpretWithAuthParams
  flip runReaderT interpreter $ interpretClient clientEnv mbAuthParams clientF