thunderstrike/purescript-fetch
thunderstrike/purescript-fetch
2
0
Fork 0
generated from tpl/purs
Code Issues Pull Requests Packages Projects Releases Wiki Activity

feat: rework Request class to return high level types

Browse Source
This commit is contained in:
orion 2023-11-28 11:26:26 -06:00
parent 87ac008ea6
commit 00ec9cf08c
Signed by: orion
GPG Key ID: 6D4165AE4C928719
2 changed files with 32 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
src/HTTP.purs
View File

@ -11,7 +11,9 @@ import Effect (Effect)
import Effect.Aff.Class (class MonadAff, liftAff) import Effect.Aff.Class (class MonadAff, liftAff)
import Foreign.Object (Object) import Foreign.Object (Object)
import Foreign.Object as Object import Foreign.Object as Object
import HTTP.Header (Headers(..))
import HTTP.Header (headers) as X import HTTP.Header (headers) as X
import HTTP.Request (bodyToRaw)
import HTTP.Request (class Request, Method(..)) as X import HTTP.Request (class Request, Method(..)) as X
import HTTP.Request as Req import HTTP.Request as Req
import HTTP.Response (Response) import HTTP.Response (Response)
@ -23,7 +25,8 @@ fetch req = do
url <- Req.requestUrl req url <- Req.requestUrl req
method <- Req.requestMethod req method <- Req.requestMethod req
body <- Req.requestBody req body <- Req.requestBody req
headers <- Req.requestHeaders req bodyRaw <- bodyToRaw body
Headers headers <- Req.requestHeaders req
let let
methodStr = case method of methodStr = case method of
@ -34,4 +37,4 @@ fetch req = do
Req.DELETE -> "DELETE" Req.DELETE -> "DELETE"
headers' = Object.fromFoldableWithIndex headers headers' = Object.fromFoldableWithIndex headers
liftAff $ Promise.toAffE $ fetchImpl url methodStr headers' $ Nullable.toNullable body liftAff $ Promise.toAffE $ fetchImpl url methodStr headers' $ Nullable.toNullable bodyRaw

53
src/HTTP/Request.purs
View File

@ -1,8 +1,9 @@
module HTTP.Request module HTTP.Request
( class Request ( class Request
, Body , Body(..)
, RawRequestBody , RawRequestBody
, Method(..) , Method(..)
, bodyToRaw
, json , json
, form , form
, blob , blob
@ -96,13 +97,13 @@ bodyHeaders (BodyBuffer _ ct) = liftEffect $ Header.headers ct
bodyHeaders (BodyArrayBuffer _ ct) = liftEffect $ Header.headers ct bodyHeaders (BodyArrayBuffer _ ct) = liftEffect $ Header.headers ct
bodyHeaders (BodyBlob b) = liftEffect $ Header.headers <<< map (ContentType <<< MIME.fromString <<< unwrap) $ Blob.type_ b bodyHeaders (BodyBlob b) = liftEffect $ Header.headers <<< map (ContentType <<< MIME.fromString <<< unwrap) $ Blob.type_ b
bodyToRaw :: forall m. MonadAff m => Body -> m RawRequestBody bodyToRaw :: forall m. MonadAff m => Body -> m (Maybe RawRequestBody)
bodyToRaw (BodyString body ct) = flip bind bodyToRaw $ liftEffect $ map (flip BodyBuffer ct) $ Buffer.fromString body UTF8 bodyToRaw (BodyString body ct) = flip bind bodyToRaw $ liftEffect $ map (flip BodyBuffer ct) $ Buffer.fromString body UTF8
bodyToRaw (BodyBuffer body ct) = flip bind bodyToRaw $ liftEffect $ map (flip BodyArrayBuffer ct) $ Buffer.toArrayBuffer body bodyToRaw (BodyBuffer body ct) = flip bind bodyToRaw $ liftEffect $ map (flip BodyArrayBuffer ct) $ Buffer.toArrayBuffer body
bodyToRaw (BodyArrayBuffer body _) = pure $ unsafeArrayBufferToRawRequestBody body bodyToRaw (BodyArrayBuffer body _) = pure $ Just $ unsafeArrayBufferToRawRequestBody body
bodyToRaw (BodyForm form') = map unsafeFormDataToRawRequestBody $ Form.toRawFormData form' bodyToRaw (BodyForm form') = map Just $ map unsafeFormDataToRawRequestBody $ Form.toRawFormData form'
bodyToRaw (BodyBlob body) = unsafeBlobToRawRequestBody body bodyToRaw (BodyBlob body) = map Just $ unsafeBlobToRawRequestBody body
bodyToRaw BodyEmpty = pure $ unsafeEmptyRawRequestBody bodyToRaw BodyEmpty = pure Nothing
data Method data Method
= GET = GET
@ -122,53 +123,53 @@ class Request :: Type -> Constraint
class Request a where class Request a where
requestUrl :: forall m. MonadAff m => a -> m URL requestUrl :: forall m. MonadAff m => a -> m URL
requestMethod :: forall m. MonadAff m => a -> m Method requestMethod :: forall m. MonadAff m => a -> m Method
requestBody :: forall m. MonadAff m => a -> m (Maybe RawRequestBody) requestBody :: forall m. MonadAff m => a -> m Body
requestHeaders :: forall m. MonadAff m => a -> m (Map String String) requestHeaders :: forall m. MonadAff m => a -> m Headers
instance Request (Method /\ URL /\ Body /\ Effect Headers) where instance Request (Method /\ URL /\ Body /\ Effect Headers) where
requestUrl = pure <<< extract requestUrl = pure <<< extract
requestMethod = pure <<< extract requestMethod = pure <<< extract
requestBody = map Just <<< bodyToRaw <<< extract requestBody = pure <<< extract
requestHeaders req = do requestHeaders req = do
(Headers hs) <- liftEffect $ extract req hs <- liftEffect $ extract req
(Headers bodyHs) <- bodyHeaders $ extract req bodyHs <- bodyHeaders $ extract req
pure $ Map.union hs bodyHs pure $ hs <> bodyHs
instance Request (Method /\ URL /\ Body /\ Headers) where instance Request (Method /\ URL /\ Body /\ Headers) where
requestUrl = pure <<< extract requestUrl = pure <<< extract
requestMethod = pure <<< extract requestMethod = pure <<< extract
requestBody = map Just <<< bodyToRaw <<< extract requestBody = pure <<< extract
requestHeaders req = do requestHeaders req = do
let (Headers hs) = extract req let hs = extract req
(Headers bodyHs) <- bodyHeaders $ extract req bodyHs <- bodyHeaders $ extract req
pure $ Map.union hs bodyHs pure $ hs <> bodyHs
instance Request (Method /\ URL /\ Body) where instance Request (Method /\ URL /\ Body) where
requestUrl = pure <<< extract requestUrl = pure <<< extract
requestMethod = pure <<< extract requestMethod = pure <<< extract
requestBody = map Just <<< bodyToRaw <<< extract requestBody = pure <<< extract
requestHeaders _ = pure Map.empty requestHeaders _ = pure mempty
instance Request (Method /\ URL /\ Headers) where instance Request (Method /\ URL /\ Headers) where
requestUrl = pure <<< extract requestUrl = pure <<< extract
requestMethod = pure <<< extract requestMethod = pure <<< extract
requestBody _ = Just <$> bodyToRaw BodyEmpty requestBody _ = pure BodyEmpty
requestHeaders = (\(Headers h) -> pure h) <<< extract requestHeaders = pure <<< extract
instance Request (Method /\ URL /\ Effect Headers) where instance Request (Method /\ URL /\ Effect Headers) where
requestUrl = pure <<< extract requestUrl = pure <<< extract
requestMethod = pure <<< extract requestMethod = pure <<< extract
requestBody _ = Just <$> bodyToRaw BodyEmpty requestBody _ = pure BodyEmpty
requestHeaders = liftEffect <<< map (\(Headers h) -> h) <<< extract @(Effect Headers) requestHeaders = liftEffect <<< extract @(Effect Headers)
instance Request (Method /\ URL) where instance Request (Method /\ URL) where
requestUrl = pure <<< extract requestUrl = pure <<< extract
requestMethod = pure <<< extract requestMethod = pure <<< extract
requestBody _ = Just <$> bodyToRaw BodyEmpty requestBody _ = pure BodyEmpty
requestHeaders _ = pure Map.empty requestHeaders _ = pure mempty
instance Request URL where instance Request URL where
requestUrl = pure requestUrl = pure
requestMethod _ = pure GET requestMethod _ = pure GET
requestBody _ = Just <$> bodyToRaw BodyEmpty requestBody _ = pure BodyEmpty
requestHeaders _ = pure Map.empty requestHeaders _ = pure mempty