generated from tpl/purs
fix: effect shenanigans
This commit is contained in:
parent
0445113850
commit
a5182dd45a
@ -8,7 +8,7 @@ import Data.Tuple.Nested (type (/\), (/\))
|
|||||||
-- | given a tuple of any size with at least 1 value
|
-- | given a tuple of any size with at least 1 value
|
||||||
-- | of type `a`, `extract` the first occurence of `a`
|
-- | of type `a`, `extract` the first occurence of `a`
|
||||||
-- | from the tuple
|
-- | from the tuple
|
||||||
class TupleContaining a tup where
|
class TupleContaining @a tup where
|
||||||
extract :: tup -> a
|
extract :: tup -> a
|
||||||
|
|
||||||
instance TupleContaining a a where
|
instance TupleContaining a a where
|
||||||
|
@ -69,7 +69,7 @@ instance Monoid Headers where
|
|||||||
mempty = wrap $ Map.empty
|
mempty = wrap $ Map.empty
|
||||||
|
|
||||||
class IntoHeaders a where
|
class IntoHeaders a where
|
||||||
headers :: forall m. MonadEffect m => a -> m Headers
|
headers :: a -> Effect Headers
|
||||||
|
|
||||||
instance IntoHeaders Headers where
|
instance IntoHeaders Headers where
|
||||||
headers = pure
|
headers = pure
|
||||||
|
@ -84,7 +84,7 @@ bodyHeaders (BodyEmpty) = pure mempty
|
|||||||
bodyHeaders (BodyString _ ct) = liftEffect $ Header.headers ct
|
bodyHeaders (BodyString _ ct) = liftEffect $ Header.headers ct
|
||||||
bodyHeaders (BodyBuffer _ ct) = liftEffect $ Header.headers ct
|
bodyHeaders (BodyBuffer _ ct) = liftEffect $ Header.headers ct
|
||||||
bodyHeaders (BodyArrayBuffer _ ct) = liftEffect $ Header.headers ct
|
bodyHeaders (BodyArrayBuffer _ ct) = liftEffect $ Header.headers ct
|
||||||
bodyHeaders (BodyBlob b) = 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 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
|
||||||
@ -109,6 +109,20 @@ class Request a where
|
|||||||
requestHeaders :: forall m. MonadAff m => a -> m (Map String String)
|
requestHeaders :: forall m. MonadAff m => a -> m (Map String String)
|
||||||
|
|
||||||
instance
|
instance
|
||||||
|
( TupleContaining Body a
|
||||||
|
, TupleContaining URL a
|
||||||
|
, TupleContaining Method a
|
||||||
|
, TupleContaining (Effect Headers) a
|
||||||
|
) =>
|
||||||
|
Request a where
|
||||||
|
requestUrl = pure <<< extract
|
||||||
|
requestMethod = pure <<< extract
|
||||||
|
requestBody = map Just <<< bodyToRaw <<< extract
|
||||||
|
requestHeaders req = do
|
||||||
|
(Headers hs) <- liftEffect $ extract req
|
||||||
|
(Headers bodyHs) <- bodyHeaders $ extract req
|
||||||
|
pure $ Map.union hs bodyHs
|
||||||
|
else instance
|
||||||
( TupleContaining Body a
|
( TupleContaining Body a
|
||||||
, TupleContaining URL a
|
, TupleContaining URL a
|
||||||
, TupleContaining Method a
|
, TupleContaining Method a
|
||||||
@ -142,6 +156,17 @@ else instance
|
|||||||
requestMethod = pure <<< extract
|
requestMethod = pure <<< extract
|
||||||
requestBody _ = Just <$> bodyToRaw BodyEmpty
|
requestBody _ = Just <$> bodyToRaw BodyEmpty
|
||||||
requestHeaders = (\(Headers h) -> pure h) <<< extract
|
requestHeaders = (\(Headers h) -> pure h) <<< extract
|
||||||
|
else instance
|
||||||
|
( MonadEffect m
|
||||||
|
, TupleContaining (Effect Headers) a
|
||||||
|
, TupleContaining URL a
|
||||||
|
, TupleContaining Method a
|
||||||
|
) =>
|
||||||
|
Request a where
|
||||||
|
requestUrl = pure <<< extract
|
||||||
|
requestMethod = pure <<< extract
|
||||||
|
requestBody _ = Just <$> bodyToRaw BodyEmpty
|
||||||
|
requestHeaders = liftEffect <<< map (\(Headers h) -> h) <<< extract @(Effect Headers)
|
||||||
else instance
|
else instance
|
||||||
( TupleContaining URL a
|
( TupleContaining URL a
|
||||||
, TupleContaining Method a
|
, TupleContaining Method a
|
||||||
|
Loading…
Reference in New Issue
Block a user