From 01cf6ca842e660b4fdc00fb2bc78615439b99c5f Mon Sep 17 00:00:00 2001 From: sigma-andex <77549848+sigma-andex@users.noreply.github.com> Date: Sun, 5 Jun 2022 20:31:13 +0100 Subject: [PATCH] Relax aff to m --- src/HTTPurple/Body.purs | 9 +++++---- src/HTTPurple/Json.purs | 22 +++++++++++----------- 2 files changed, 16 insertions(+), 15 deletions(-) diff --git a/src/HTTPurple/Body.purs b/src/HTTPurple/Body.purs index d5260f6..de912b5 100644 --- a/src/HTTPurple/Body.purs +++ b/src/HTTPurple/Body.purs @@ -15,6 +15,7 @@ import Data.Either (Either(Right)) import Data.Maybe (Maybe(Just, Nothing)) import Effect (Effect) import Effect.Aff (Aff, makeAff, nonCanceler) +import Effect.Aff.Class (class MonadAff, liftAff) import Effect.Class (liftEffect) import Effect.Ref (Ref) import Effect.Ref (modify, new, read, write) as Ref @@ -48,7 +49,7 @@ read request = do -- | -- | This drains the `Readable` stream in `RequestBody` for the first time -- | and returns cached result from then on. -toString :: RequestBody -> Aff String +toString :: forall m. MonadAff m => RequestBody -> m String toString requestBody = do maybeString <- liftEffect @@ -67,7 +68,7 @@ toString requestBody = do -- | -- | This drains the `Readable` stream in `RequestBody` for the first time -- | and returns cached result from then on. -toBuffer :: RequestBody -> Aff Buffer +toBuffer :: forall m. MonadAff m => RequestBody -> m Buffer toBuffer requestBody = do maybeBuffer <- liftEffect @@ -81,9 +82,9 @@ toBuffer requestBody = do Just buffer -> pure buffer where -- | Slurp the entire `Readable` stream into a `Buffer` - streamToBuffer :: Readable () -> Aff Buffer + streamToBuffer :: MonadAff m => Readable () -> m Buffer streamToBuffer stream = - makeAff \done -> do + liftAff $ makeAff \done -> do bufs <- Ref.new [] onData stream \buf -> void $ Ref.modify (_ <> [ buf ]) bufs onEnd stream do diff --git a/src/HTTPurple/Json.purs b/src/HTTPurple/Json.purs index 543c749..f2832d1 100644 --- a/src/HTTPurple/Json.purs +++ b/src/HTTPurple/Json.purs @@ -12,11 +12,10 @@ import Control.Monad.Cont (ContT(..)) import Data.Either (Either, either) import Data.Newtype (class Newtype) import Data.Tuple (Tuple(..)) -import Effect.Aff (Aff) import Effect.Aff.Class (class MonadAff) import HTTPurple.Body (RequestBody, toString) import HTTPurple.Headers (Headers, headers) -import HTTPurple.Response (Response, ResponseM, badRequest') +import HTTPurple.Response (Response, badRequest') newtype JsonDecoder err json = JsonDecoder (String -> Either err json) @@ -29,33 +28,34 @@ jsonHeaders :: Headers jsonHeaders = headers [ jsonHeader ] fromJsonContinuation :: - forall err json. + forall err json m. + MonadAff m => JsonDecoder err json -> - (err -> ResponseM) -> + (err -> m Response) -> RequestBody -> - (json -> ResponseM) -> - ResponseM + (json -> m Response) -> + m Response fromJsonContinuation (JsonDecoder decode) errorHandler body handler = do bodyStr <- toString body let parseJson :: Either err json parseJson = decode $ bodyStr - toBadRequest err = errorHandler err - either toBadRequest handler parseJson + either errorHandler handler parseJson -defaultErrorHandler :: forall (t47 :: Type) (m :: Type -> Type). MonadAff m => t47 -> m Response +defaultErrorHandler :: forall (err :: Type) (m :: Type -> Type). MonadAff m => err -> m Response defaultErrorHandler = const $ badRequest' jsonHeaders "" -- | Parse the `RequestBody` as json using the provided `JsonDecoder`. -- | If it fails, the error handler is called. -- | Returns a continuation -fromJsonE :: forall (err :: Type) (json :: Type). JsonDecoder err json -> (err -> ResponseM) -> RequestBody -> ContT Response Aff json +fromJsonE :: forall (err :: Type) (json :: Type) (m :: Type -> Type). + MonadAff m => JsonDecoder err json -> (err -> m Response) -> RequestBody -> ContT Response m json fromJsonE driver errorHandler body = ContT $ (fromJsonContinuation driver errorHandler body) -- | Parse the `RequestBody` as json using the provided `JsonDecoder`. -- | If it fails, an empty bad request is returned -- | Returns a continuation -fromJson :: forall (err :: Type) (json :: Type). JsonDecoder err json -> RequestBody -> ContT Response Aff json +fromJson :: forall (err :: Type) (json :: Type) (m :: Type -> Type). MonadAff m => JsonDecoder err json -> RequestBody -> ContT Response m json fromJson driver = fromJsonE driver defaultErrorHandler