@@ -0,0 +1,47 @@
1+{-# LANGUAGE FlexibleContexts #-}
2+{-# LANGUAGE OverloadedStrings #-}
3+module Reflex.Dom.Xhr.FormData
4+ ( postForms
5+ , FormValue (..)
6+ , fileToFormValue
7+ )
8+ where
9+
10+import Control.Lens
11+import Data.Default
12+import Data.Map (Map)
13+import Data.Text (Text)
14+import Data.Traversable
15+import qualified GHCJS.DOM.FormData as FD
16+import Foreign.JavaScript.TH
17+import GHCJS.DOM.File (getName)
18+import GHCJS.DOM.Types (File, IsBlob)
19+import Language.Javascript.JSaddle.Monad (MonadJSM, liftJSM)
20+import Reflex
21+import Reflex.Dom.Xhr
22+
23+-- | A FormData value may be a blob/file or a string. The file can optionally be provided with filename.
24+data FormValue blob = FormValue_Text Text
25+ | FormValue_File blob (Maybe Text) -- maybe filename
26+
27+-- | Performs a POST request with the provided FormData payload
28+postForms
29+ :: ( IsBlob blob, HasJSContext (Performable m), MonadJSM (Performable m)
30+ , PerformEvent t m, TriggerEvent t m
31+ , Traversable f)
32+ => Text -- ^ The target url
33+ -> Event t (f (Map Text (FormValue blob))) -- ^ Maps of text keys and values that will be sent as "FormData"
34+ -> m (Event t (f XhrResponse))
35+postForms url payload = do
36+ performMkRequestsAsync $ ffor payload $ \fs -> for fs $ \u -> liftJSM $ do
37+ fd <- FD.newFormData Nothing
38+ iforM_ u $ \k v -> case v of
39+ FormValue_Text t -> FD.append fd k t
40+ FormValue_File b fn -> FD.appendBlob fd k b fn
41+ return $ xhrRequest "POST" url $ def & xhrRequestConfig_sendData .~ fd
42+
43+-- | Converts a File (e.g., the output of a 'FileInput') into a 'FormValue'. The filename will be included if it is available.
44+fileToFormValue :: MonadJSM m => File -> m (FormValue File)
45+fileToFormValue f = do
46+ fn <- getName f
47+ return $ FormValue_File f $ Just fn