Skip to content

Instantly share code, notes, and snippets.

@jkachmar
Last active October 9, 2019 04:02
Show Gist options
  • Save jkachmar/fd0c7f8d3fbd79dd36af267b723c72c6 to your computer and use it in GitHub Desktop.
Save jkachmar/fd0c7f8d3fbd79dd36af267b723c72c6 to your computer and use it in GitHub Desktop.
Madness
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
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment