{-# LANGUAGE LambdaCase #-}
-----------------------------------------------------------------------------
{-# LANGUAGE OverloadedStrings #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Miso.Fetch
-- Copyright   :  (C) 2016-2025 David M. Johnson
-- License     :  BSD3-style (see the file LICENSE)
-- Maintainer  :  David M. Johnson <code@dmj.io>
-- Stability   :  experimental
-- Portability :  non-portable
--
-- Module for interacting with the Fetch API <https://developer.mozilla.org/en-US/docs/Web/API/Fetch_API>
-- manually.
--
-- Refer to the miso README if you want to automatically interact with a Servant
-- API.
--
----------------------------------------------------------------------------
module Miso.Fetch
  ( -- ** JSON
    getJSON
  , postJSON
  , putJSON
  -- ** Text
  , getText
  , postText
  , putText
  -- ** Blob
  , getBlob
  , postBlob
  , putBlob
  -- ** Image
  , postImage
  , putImage
  -- ** ArrayBuffer
  , getArrayBuffer
  , postArrayBuffer
  , putArrayBuffer
    -- ** Header helpers
  , accept
  , contentType
  , applicationJSON
    -- ** Types
  , Body
  ) where
----------------------------------------------------------------------------
import qualified Data.Map.Strict as M
import           Control.Monad
import           Data.Aeson (FromJSON, ToJSON, Result(..), fromJSON)
import           Language.Javascript.JSaddle (fromJSValUnchecked, toJSVal)
----------------------------------------------------------------------------
import qualified Miso.FFI.Internal as FFI
import           Miso.Effect (Effect, withSink)
import           Miso.String (MisoString, ms)
import           Miso.Util ((=:))
import           Miso.FFI
----------------------------------------------------------------------------
-- | See <https://developer.mozilla.org/en-US/docs/Web/API/Fetch_API>
--
-- @
--
-- data Action
--  = FetchGitHub
--  | SetGitHub GitHub
--  | ErrorHandler MisoString
--  deriving (Show, Eq)
--
-- updateModel :: Action -> Effect Model Action
-- updateModel FetchGitHub =
--   getJSON "https://api.github.com" [] SetGitHub ErrorHandler
-- updateModel (SetGitHub apiInfo) =
--   info ?= apiInfo
-- updateModel (ErrorHandler msg) =
--  io_ (consoleError msg)
--
-- @
--
getJSON
  :: FromJSON result
  => MisoString
  -- ^ url
  -> [(MisoString, MisoString)]
  -- ^ headers
  -> (result -> action)
  -- ^ successful callback
  -> (MisoString -> action)
  -- ^ errorful callback
  -> Effect parent model action
getJSON :: forall result action parent model.
FromJSON result =>
MisoString
-> [(MisoString, MisoString)]
-> (result -> action)
-> (MisoString -> action)
-> Effect parent model action
getJSON MisoString
url [(MisoString, MisoString)]
headers result -> action
successful MisoString -> action
errorful =
  (Sink action -> JSM ()) -> Effect parent model action
forall action parent model.
(Sink action -> JSM ()) -> Effect parent model action
withSink ((Sink action -> JSM ()) -> Effect parent model action)
-> (Sink action -> JSM ()) -> Effect parent model action
forall a b. (a -> b) -> a -> b
$ \Sink action
sink ->
    MisoString
-> MisoString
-> Maybe JSVal
-> [(MisoString, MisoString)]
-> (JSVal -> JSM ())
-> (MisoString -> JSM ())
-> MisoString
-> JSM ()
FFI.fetch MisoString
url MisoString
"GET" Maybe JSVal
forall a. Maybe a
Nothing [(MisoString, MisoString)]
jsonHeaders
      (\JSVal
e -> 
         Value -> Result result
forall a. FromJSON a => Value -> Result a
fromJSON (Value -> Result result) -> JSM Value -> JSM (Result result)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JSVal -> JSM Value
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked JSVal
e JSM (Result result) -> (Result result -> JSM ()) -> JSM ()
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          Error String
decodeFailure ->
            Sink action
sink Sink action -> Sink action
forall a b. (a -> b) -> a -> b
$ MisoString -> action
errorful (String -> MisoString
forall str. ToMisoString str => str -> MisoString
ms String
decodeFailure)
          Success result
result -> do
            Sink action
sink Sink action -> Sink action
forall a b. (a -> b) -> a -> b
$ result -> action
successful result
result)
      (Sink action
sink Sink action -> (MisoString -> action) -> MisoString -> JSM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MisoString -> action
errorful)
      MisoString
"json" -- dmj: expected return type
  where
    jsonHeaders :: [(MisoString, MisoString)]
jsonHeaders = [(MisoString, MisoString)]
-> [(MisoString, MisoString)] -> [(MisoString, MisoString)]
forall k a. Ord k => [(k, a)] -> [(k, a)] -> [(k, a)]
biasHeaders [(MisoString, MisoString)]
headers [MisoString
accept MisoString -> MisoString -> (MisoString, MisoString)
forall k v. k -> v -> (k, v)
=: MisoString
applicationJSON]
----------------------------------------------------------------------------
postJSON
  :: ToJSON body
  => MisoString
  -- ^ url
  -> body
  -- ^ Body
  -> [(MisoString, MisoString)]
  -- ^ headers
  -> action
  -- ^ successful callback
  -> (MisoString -> action)
  -- ^ errorful callback
  -> Effect parent model action
postJSON :: forall body action parent model.
ToJSON body =>
MisoString
-> body
-> [(MisoString, MisoString)]
-> action
-> (MisoString -> action)
-> Effect parent model action
postJSON MisoString
url body
body [(MisoString, MisoString)]
headers action
successful MisoString -> action
errorful =
  (Sink action -> JSM ()) -> Effect parent model action
forall action parent model.
(Sink action -> JSM ()) -> Effect parent model action
withSink ((Sink action -> JSM ()) -> Effect parent model action)
-> (Sink action -> JSM ()) -> Effect parent model action
forall a b. (a -> b) -> a -> b
$ \Sink action
sink -> do
    bodyVal <- body -> JSM JSVal
forall json. ToJSON json => json -> JSM JSVal
FFI.jsonStringify body
body
    FFI.fetch url "POST" (Just bodyVal) jsonHeaders
      (const (sink successful))
      (sink . errorful)
      "none"
  where
    jsonHeaders :: [(MisoString, MisoString)]
jsonHeaders =
      [MisoString
contentType MisoString -> MisoString -> (MisoString, MisoString)
forall k v. k -> v -> (k, v)
=: MisoString
applicationJSON] [(MisoString, MisoString)]
-> [(MisoString, MisoString)] -> [(MisoString, MisoString)]
forall a. Semigroup a => a -> a -> a
<> [(MisoString, MisoString)]
headers
----------------------------------------------------------------------------
putJSON
  :: ToJSON body
  => MisoString
  -- ^ url
  -> body
  -- ^ Body
  -> [(MisoString, MisoString)]
  -- ^ headers
  -> action
  -- ^ successful callback
  -> (MisoString -> action)
  -- ^ errorful callback
  -> Effect parent model action
putJSON :: forall body action parent model.
ToJSON body =>
MisoString
-> body
-> [(MisoString, MisoString)]
-> action
-> (MisoString -> action)
-> Effect parent model action
putJSON MisoString
url body
body [(MisoString, MisoString)]
headers action
successful MisoString -> action
errorful =
  (Sink action -> JSM ()) -> Effect parent model action
forall action parent model.
(Sink action -> JSM ()) -> Effect parent model action
withSink ((Sink action -> JSM ()) -> Effect parent model action)
-> (Sink action -> JSM ()) -> Effect parent model action
forall a b. (a -> b) -> a -> b
$ \Sink action
sink -> do
    bodyVal <- body -> JSM JSVal
forall json. ToJSON json => json -> JSM JSVal
FFI.jsonStringify body
body
    FFI.fetch url "PUT" (Just bodyVal) jsonHeaders
      (const (sink successful))
      (sink . errorful)
      "none"
  where
    jsonHeaders :: [(MisoString, MisoString)]
jsonHeaders = [(MisoString, MisoString)]
-> [(MisoString, MisoString)] -> [(MisoString, MisoString)]
forall k a. Ord k => [(k, a)] -> [(k, a)] -> [(k, a)]
biasHeaders [(MisoString, MisoString)]
headers [MisoString
contentType MisoString -> MisoString -> (MisoString, MisoString)
forall k v. k -> v -> (k, v)
=: MisoString
applicationJSON]
----------------------------------------------------------------------------
getText
  :: MisoString
  -- ^ url
  -> [(MisoString, MisoString)]
  -- ^ headers
  -> (MisoString -> action)
  -- ^ successful callback
  -> (MisoString -> action)
  -- ^ errorful callback
  -> Effect parent model action
getText :: forall action parent model.
MisoString
-> [(MisoString, MisoString)]
-> (MisoString -> action)
-> (MisoString -> action)
-> Effect parent model action
getText MisoString
url [(MisoString, MisoString)]
headers MisoString -> action
successful MisoString -> action
errorful =
  (Sink action -> JSM ()) -> Effect parent model action
forall action parent model.
(Sink action -> JSM ()) -> Effect parent model action
withSink ((Sink action -> JSM ()) -> Effect parent model action)
-> (Sink action -> JSM ()) -> Effect parent model action
forall a b. (a -> b) -> a -> b
$ \Sink action
sink ->
    MisoString
-> MisoString
-> Maybe JSVal
-> [(MisoString, MisoString)]
-> (JSVal -> JSM ())
-> (MisoString -> JSM ())
-> MisoString
-> JSM ()
FFI.fetch MisoString
url MisoString
"GET" Maybe JSVal
forall a. Maybe a
Nothing [(MisoString, MisoString)]
textHeaders
      (Sink action
sink Sink action -> (MisoString -> action) -> MisoString -> JSM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MisoString -> action
successful (MisoString -> JSM ())
-> (JSVal -> JSM MisoString) -> JSVal -> JSM ()
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< JSVal -> JSM MisoString
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked)
      (Sink action
sink Sink action -> (MisoString -> action) -> MisoString -> JSM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MisoString -> action
errorful)
      MisoString
"text" -- dmj: expected return type
  where
    textHeaders :: [(MisoString, MisoString)]
textHeaders = [(MisoString, MisoString)]
-> [(MisoString, MisoString)] -> [(MisoString, MisoString)]
forall k a. Ord k => [(k, a)] -> [(k, a)] -> [(k, a)]
biasHeaders [(MisoString, MisoString)]
headers [MisoString
accept MisoString -> MisoString -> (MisoString, MisoString)
forall k v. k -> v -> (k, v)
=: MisoString
applicationText]
----------------------------------------------------------------------------
postText
  :: MisoString
  -- ^ url
  -> MisoString
  -- ^ Body
  -> [(MisoString, MisoString)]
  -- ^ headers
  -> action
  -- ^ successful callback
  -> (MisoString -> action)
  -- ^ errorful callback
  -> Effect parent model action
postText :: forall action parent model.
MisoString
-> MisoString
-> [(MisoString, MisoString)]
-> action
-> (MisoString -> action)
-> Effect parent model action
postText MisoString
url MisoString
body [(MisoString, MisoString)]
headers action
successful MisoString -> action
errorful =
  (Sink action -> JSM ()) -> Effect parent model action
forall action parent model.
(Sink action -> JSM ()) -> Effect parent model action
withSink ((Sink action -> JSM ()) -> Effect parent model action)
-> (Sink action -> JSM ()) -> Effect parent model action
forall a b. (a -> b) -> a -> b
$ \Sink action
sink -> do
    bodyVal <- MisoString -> JSM JSVal
forall json. ToJSON json => json -> JSM JSVal
FFI.jsonStringify MisoString
body
    FFI.fetch url "POST" (Just bodyVal) textHeaders
      (const (sink successful))
      (sink . errorful)
      "none"
  where
    textHeaders :: [(MisoString, MisoString)]
textHeaders = [(MisoString, MisoString)]
-> [(MisoString, MisoString)] -> [(MisoString, MisoString)]
forall k a. Ord k => [(k, a)] -> [(k, a)] -> [(k, a)]
biasHeaders [(MisoString, MisoString)]
headers [MisoString
contentType MisoString -> MisoString -> (MisoString, MisoString)
forall k v. k -> v -> (k, v)
=: MisoString
applicationText]
----------------------------------------------------------------------------
putText
  :: MisoString
  -- ^ url
  -> MisoString
  -- ^ Body
  -> [(MisoString, MisoString)]
  -- ^ headers
  -> action
  -- ^ successful callback
  -> (MisoString -> action)
  -- ^ errorful callback
  -> Effect parent model action
putText :: forall action parent model.
MisoString
-> MisoString
-> [(MisoString, MisoString)]
-> action
-> (MisoString -> action)
-> Effect parent model action
putText MisoString
url MisoString
body [(MisoString, MisoString)]
headers action
successful MisoString -> action
errorful =
  (Sink action -> JSM ()) -> Effect parent model action
forall action parent model.
(Sink action -> JSM ()) -> Effect parent model action
withSink ((Sink action -> JSM ()) -> Effect parent model action)
-> (Sink action -> JSM ()) -> Effect parent model action
forall a b. (a -> b) -> a -> b
$ \Sink action
sink -> do
    body_ <- MisoString -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal MisoString
body
    FFI.fetch url "PUT" (Just body_) textHeaders
      (const (sink successful))
      (sink . errorful)
      "none"
  where
    textHeaders :: [(MisoString, MisoString)]
textHeaders = [(MisoString, MisoString)]
-> [(MisoString, MisoString)] -> [(MisoString, MisoString)]
forall k a. Ord k => [(k, a)] -> [(k, a)] -> [(k, a)]
biasHeaders [(MisoString, MisoString)]
headers [MisoString
contentType MisoString -> MisoString -> (MisoString, MisoString)
forall k v. k -> v -> (k, v)
=: MisoString
applicationText]
----------------------------------------------------------------------------
getBlob
  :: MisoString
  -- ^ url
  -> [(MisoString, MisoString)]
  -- ^ headers
  -> (Blob -> action)
  -- ^ successful callback
  -> (MisoString -> action)
  -- ^ errorful callback
  -> Effect parent model action
getBlob :: forall action parent model.
MisoString
-> [(MisoString, MisoString)]
-> (Blob -> action)
-> (MisoString -> action)
-> Effect parent model action
getBlob MisoString
url [(MisoString, MisoString)]
headers Blob -> action
successful MisoString -> action
errorful =
  (Sink action -> JSM ()) -> Effect parent model action
forall action parent model.
(Sink action -> JSM ()) -> Effect parent model action
withSink ((Sink action -> JSM ()) -> Effect parent model action)
-> (Sink action -> JSM ()) -> Effect parent model action
forall a b. (a -> b) -> a -> b
$ \Sink action
sink ->
    MisoString
-> MisoString
-> Maybe JSVal
-> [(MisoString, MisoString)]
-> (JSVal -> JSM ())
-> (MisoString -> JSM ())
-> MisoString
-> JSM ()
FFI.fetch MisoString
url MisoString
"GET" Maybe JSVal
forall a. Maybe a
Nothing [(MisoString, MisoString)]
blobHeaders
      (Sink action
sink Sink action -> (Blob -> action) -> Blob -> JSM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Blob -> action
successful (Blob -> JSM ()) -> (JSVal -> JSM Blob) -> JSVal -> JSM ()
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< JSVal -> JSM Blob
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked)
      (Sink action
sink Sink action -> (MisoString -> action) -> MisoString -> JSM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MisoString -> action
errorful)
      MisoString
"blob" -- dmj: expected return type
  where
    blobHeaders :: [(MisoString, MisoString)]
blobHeaders = [(MisoString, MisoString)]
-> [(MisoString, MisoString)] -> [(MisoString, MisoString)]
forall k a. Ord k => [(k, a)] -> [(k, a)] -> [(k, a)]
biasHeaders [(MisoString, MisoString)]
headers [MisoString
accept MisoString -> MisoString -> (MisoString, MisoString)
forall k v. k -> v -> (k, v)
=: MisoString
octetStream]
----------------------------------------------------------------------------
postBlob
  :: MisoString
  -- ^ url
  -> Blob
  -- ^ Body
  -> [(MisoString, MisoString)]
  -- ^ headers
  -> action
  -- ^ successful callback
  -> (MisoString -> action)
  -- ^ errorful callback
  -> Effect parent model action
postBlob :: forall action parent model.
MisoString
-> Blob
-> [(MisoString, MisoString)]
-> action
-> (MisoString -> action)
-> Effect parent model action
postBlob MisoString
url Blob
body [(MisoString, MisoString)]
headers action
successful MisoString -> action
errorful =
  (Sink action -> JSM ()) -> Effect parent model action
forall action parent model.
(Sink action -> JSM ()) -> Effect parent model action
withSink ((Sink action -> JSM ()) -> Effect parent model action)
-> (Sink action -> JSM ()) -> Effect parent model action
forall a b. (a -> b) -> a -> b
$ \Sink action
sink -> do
    bodyVal <- Blob -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Blob
body
    FFI.fetch url "POST" (Just bodyVal) blobHeaders
      (const (sink successful))
      (sink . errorful)
      "none"
  where
    blobHeaders :: [(MisoString, MisoString)]
blobHeaders = [(MisoString, MisoString)]
-> [(MisoString, MisoString)] -> [(MisoString, MisoString)]
forall k a. Ord k => [(k, a)] -> [(k, a)] -> [(k, a)]
biasHeaders [(MisoString, MisoString)]
headers [MisoString
contentType MisoString -> MisoString -> (MisoString, MisoString)
forall k v. k -> v -> (k, v)
=: MisoString
octetStream]
----------------------------------------------------------------------------
putBlob
  :: MisoString
  -- ^ url
  -> Blob
  -- ^ Body
  -> [(MisoString, MisoString)]
  -- ^ headers
  -> action
  -- ^ successful callback
  -> (MisoString -> action)
  -- ^ errorful callback
  -> Effect parent model action
putBlob :: forall action parent model.
MisoString
-> Blob
-> [(MisoString, MisoString)]
-> action
-> (MisoString -> action)
-> Effect parent model action
putBlob MisoString
url Blob
body [(MisoString, MisoString)]
headers action
successful MisoString -> action
errorful =
  (Sink action -> JSM ()) -> Effect parent model action
forall action parent model.
(Sink action -> JSM ()) -> Effect parent model action
withSink ((Sink action -> JSM ()) -> Effect parent model action)
-> (Sink action -> JSM ()) -> Effect parent model action
forall a b. (a -> b) -> a -> b
$ \Sink action
sink -> do
    body_ <- Blob -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Blob
body
    FFI.fetch url "PUT" (Just body_) blobHeaders
      (const (sink successful))
      (sink . errorful)
      "none"
  where
    blobHeaders :: [(MisoString, MisoString)]
blobHeaders = [(MisoString, MisoString)]
-> [(MisoString, MisoString)] -> [(MisoString, MisoString)]
forall k a. Ord k => [(k, a)] -> [(k, a)] -> [(k, a)]
biasHeaders [(MisoString, MisoString)]
headers [MisoString
contentType MisoString -> MisoString -> (MisoString, MisoString)
forall k v. k -> v -> (k, v)
=: MisoString
octetStream]
----------------------------------------------------------------------------
getArrayBuffer
  :: MisoString
  -- ^ url
  -> [(MisoString, MisoString)]
  -- ^ headers
  -> (ArrayBuffer -> action)
  -- ^ successful callback
  -> (MisoString -> action)
  -- ^ errorful callback
  -> Effect parent model action
getArrayBuffer :: forall action parent model.
MisoString
-> [(MisoString, MisoString)]
-> (ArrayBuffer -> action)
-> (MisoString -> action)
-> Effect parent model action
getArrayBuffer MisoString
url [(MisoString, MisoString)]
headers ArrayBuffer -> action
successful MisoString -> action
errorful =
  (Sink action -> JSM ()) -> Effect parent model action
forall action parent model.
(Sink action -> JSM ()) -> Effect parent model action
withSink ((Sink action -> JSM ()) -> Effect parent model action)
-> (Sink action -> JSM ()) -> Effect parent model action
forall a b. (a -> b) -> a -> b
$ \Sink action
sink ->
    MisoString
-> MisoString
-> Maybe JSVal
-> [(MisoString, MisoString)]
-> (JSVal -> JSM ())
-> (MisoString -> JSM ())
-> MisoString
-> JSM ()
FFI.fetch MisoString
url MisoString
"GET" Maybe JSVal
forall a. Maybe a
Nothing [(MisoString, MisoString)]
arrayBufferHeaders
      (Sink action
sink Sink action -> (ArrayBuffer -> action) -> ArrayBuffer -> JSM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ArrayBuffer -> action
successful (ArrayBuffer -> JSM ())
-> (JSVal -> JSM ArrayBuffer) -> JSVal -> JSM ()
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< JSVal -> JSM ArrayBuffer
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked)
      (Sink action
sink Sink action -> (MisoString -> action) -> MisoString -> JSM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MisoString -> action
errorful)
      MisoString
"arrayBuffer" -- dmj: expected return type
  where
    arrayBufferHeaders :: [(MisoString, MisoString)]
arrayBufferHeaders = [(MisoString, MisoString)]
-> [(MisoString, MisoString)] -> [(MisoString, MisoString)]
forall k a. Ord k => [(k, a)] -> [(k, a)] -> [(k, a)]
biasHeaders [(MisoString, MisoString)]
headers [MisoString
accept MisoString -> MisoString -> (MisoString, MisoString)
forall k v. k -> v -> (k, v)
=: MisoString
octetStream]
----------------------------------------------------------------------------
postArrayBuffer
  :: MisoString
  -- ^ url
  -> ArrayBuffer
  -- ^ Body
  -> [(MisoString, MisoString)]
  -- ^ headers
  -> action
  -- ^ successful callback
  -> (MisoString -> action)
  -- ^ errorful callback
  -> Effect parent model action
postArrayBuffer :: forall action parent model.
MisoString
-> ArrayBuffer
-> [(MisoString, MisoString)]
-> action
-> (MisoString -> action)
-> Effect parent model action
postArrayBuffer MisoString
url ArrayBuffer
body [(MisoString, MisoString)]
headers action
successful MisoString -> action
errorful =
  (Sink action -> JSM ()) -> Effect parent model action
forall action parent model.
(Sink action -> JSM ()) -> Effect parent model action
withSink ((Sink action -> JSM ()) -> Effect parent model action)
-> (Sink action -> JSM ()) -> Effect parent model action
forall a b. (a -> b) -> a -> b
$ \Sink action
sink -> do
    bodyVal <- ArrayBuffer -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal ArrayBuffer
body
    FFI.fetch url "POST" (Just bodyVal) arrayBufferHeaders
      (const (sink successful))
      (sink . errorful)
      "none"
  where
    arrayBufferHeaders :: [(MisoString, MisoString)]
arrayBufferHeaders = [(MisoString, MisoString)]
-> [(MisoString, MisoString)] -> [(MisoString, MisoString)]
forall k a. Ord k => [(k, a)] -> [(k, a)] -> [(k, a)]
biasHeaders [(MisoString, MisoString)]
headers [MisoString
contentType MisoString -> MisoString -> (MisoString, MisoString)
forall k v. k -> v -> (k, v)
=: MisoString
octetStream]
----------------------------------------------------------------------------
putArrayBuffer
  :: MisoString
  -- ^ url
  -> ArrayBuffer
  -- ^ Body
  -> [(MisoString, MisoString)]
  -- ^ headers
  -> action
  -- ^ successful callback
  -> (MisoString -> action)
  -- ^ errorful callback
  -> Effect parent model action
putArrayBuffer :: forall action parent model.
MisoString
-> ArrayBuffer
-> [(MisoString, MisoString)]
-> action
-> (MisoString -> action)
-> Effect parent model action
putArrayBuffer MisoString
url ArrayBuffer
body [(MisoString, MisoString)]
headers action
successful MisoString -> action
errorful =
  (Sink action -> JSM ()) -> Effect parent model action
forall action parent model.
(Sink action -> JSM ()) -> Effect parent model action
withSink ((Sink action -> JSM ()) -> Effect parent model action)
-> (Sink action -> JSM ()) -> Effect parent model action
forall a b. (a -> b) -> a -> b
$ \Sink action
sink -> do
    body_ <- ArrayBuffer -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal ArrayBuffer
body
    FFI.fetch url "PUT" (Just body_) arrayBufferHeaders
      (const (sink successful))
      (sink . errorful)
      "none"
  where
    arrayBufferHeaders :: [(MisoString, MisoString)]
arrayBufferHeaders = [(MisoString, MisoString)]
-> [(MisoString, MisoString)] -> [(MisoString, MisoString)]
forall k a. Ord k => [(k, a)] -> [(k, a)] -> [(k, a)]
biasHeaders [(MisoString, MisoString)]
headers [MisoString
contentType MisoString -> MisoString -> (MisoString, MisoString)
forall k v. k -> v -> (k, v)
=: MisoString
octetStream]
----------------------------------------------------------------------------
postImage
  :: MisoString
  -- ^ url
  -> Image
  -- ^ Body
  -> [(MisoString, MisoString)]
  -- ^ headers
  -> action
  -- ^ successful callback
  -> (MisoString -> action)
  -- ^ errorful callback
  -> Effect parent model action
postImage :: forall action parent model.
MisoString
-> Image
-> [(MisoString, MisoString)]
-> action
-> (MisoString -> action)
-> Effect parent model action
postImage MisoString
url Image
body [(MisoString, MisoString)]
headers action
successful MisoString -> action
errorful =
  (Sink action -> JSM ()) -> Effect parent model action
forall action parent model.
(Sink action -> JSM ()) -> Effect parent model action
withSink ((Sink action -> JSM ()) -> Effect parent model action)
-> (Sink action -> JSM ()) -> Effect parent model action
forall a b. (a -> b) -> a -> b
$ \Sink action
sink -> do
    bodyVal <- Image -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Image
body
    FFI.fetch url "POST" (Just bodyVal) headers
      (const (sink successful))
      (sink . errorful)
      "none"
----------------------------------------------------------------------------
putImage
  :: MisoString
  -- ^ url
  -> Image
  -- ^ Body
  -> [(MisoString, MisoString)]
  -- ^ headers
  -> action
  -- ^ successful callback
  -> (MisoString -> action)
  -- ^ errorful callback
  -> Effect parent model action
putImage :: forall action parent model.
MisoString
-> Image
-> [(MisoString, MisoString)]
-> action
-> (MisoString -> action)
-> Effect parent model action
putImage MisoString
url Image
body [(MisoString, MisoString)]
headers action
successful MisoString -> action
errorful =
  (Sink action -> JSM ()) -> Effect parent model action
forall action parent model.
(Sink action -> JSM ()) -> Effect parent model action
withSink ((Sink action -> JSM ()) -> Effect parent model action)
-> (Sink action -> JSM ()) -> Effect parent model action
forall a b. (a -> b) -> a -> b
$ \Sink action
sink -> do
    body_ <- Image -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Image
body
    FFI.fetch url "PUT" (Just body_) headers
      (const (sink successful))
      (sink . errorful)
      "none"
----------------------------------------------------------------------------
type Body = JSVal
----------------------------------------------------------------------------
accept :: MisoString
accept :: MisoString
accept = MisoString
"Accept"
----------------------------------------------------------------------------
contentType :: MisoString
contentType :: MisoString
contentType = MisoString
"Content-Type"
----------------------------------------------------------------------------
applicationJSON :: MisoString
applicationJSON :: MisoString
applicationJSON = MisoString
"application/json"
----------------------------------------------------------------------------
applicationText :: MisoString
applicationText :: MisoString
applicationText = MisoString
"text/plain"
----------------------------------------------------------------------------
octetStream :: MisoString
octetStream :: MisoString
octetStream = MisoString
"application/octect-stream"
----------------------------------------------------------------------------
biasHeaders :: Ord k => [(k, a)] -> [(k, a)] -> [(k, a)]
biasHeaders :: forall k a. Ord k => [(k, a)] -> [(k, a)] -> [(k, a)]
biasHeaders [(k, a)]
userDefined [(k, a)]
contentSpecific
  = Map k a -> [(k, a)]
forall k a. Map k a -> [(k, a)]
M.toList
  (Map k a -> [(k, a)]) -> Map k a -> [(k, a)]
forall a b. (a -> b) -> a -> b
$ [(k, a)] -> Map k a
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(k, a)]
userDefined Map k a -> Map k a -> Map k a
forall a. Semigroup a => a -> a -> a
<> [(k, a)] -> Map k a
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(k, a)]
contentSpecific
----------------------------------------------------------------------------