on develop help sign in
Add file upload test
commit3a8590feef4ff4944d383af39b59d9a3364744c7 authorTom Smalley <tfsmalley@gmail.com> dateMon 3 Dec 2018, 20:05 (8 years ago) parent6fa489c
3 files changed+35−9
reflex-dom-core/reflex-dom-core.cabal+2 reflex-dom-core/src/Reflex/Dom/Builder/Hydration.hs+12−6 reflex-dom-core/test/hydration.hs+21−3
reflex-dom-core/reflex-dom-core.cabal+2
@@ -156,6 +156,8 @@ test-suite hydration
156156 , aeson
157157 , bytestring
158158 , containers
159+ , directory
160+ , filepath
159161 , exceptions
160162 , ghcjs-dom
161163 , hspec
reflex-dom-core/src/Reflex/Dom/Builder/Hydration.hs+12−6
@@ -657,6 +657,8 @@ instance (SupportsHydrationDomBuilder t m) => DomBuilder t (HydrationDomBuilderT
657657 (checkedChangedByUI, triggerCheckedChangedByUI) <- newTriggerEvent
658658 (checkedChangedBySetChecked, triggerCheckedChangedBySetChecked) <- newTriggerEvent
659659
660+ (fileChange, triggerFileChange) <- newTriggerEvent
661+
660662 -- Expected initial value from config
661663 let v0 = _inputElementConfig_initialValue cfg
662664
@@ -697,10 +699,12 @@ instance (SupportsHydrationDomBuilder t m) => DomBuilder t (HydrationDomBuilderT
697699 Input.setChecked domInputElement newChecked
698700 when (newChecked /= oldChecked) $ liftIO $ triggerCheckedChangedBySetChecked newChecked
699701
700−-- files <- holdDyn mempty <=< wrapDomEvent domInputElement (`on` Events.change) $ do
701−-- mfiles <- Input.getFiles domInputElement
702−-- let getMyFiles xs = fmap catMaybes . mapM (FileList.item xs) . flip take [0..] . fromIntegral =<< FileList.getLength xs
703−-- maybe (return []) getMyFiles mfiles
702+ liftJSM $ domInputElement `on` Events.change $ do
703+ mfiles <- Input.getFiles domInputElement
704+ let getMyFiles xs = fmap catMaybes . mapM (FileList.item xs) . flip take [0..] . fromIntegral =<< FileList.getLength xs
705+ liftIO . triggerFileChange =<< maybe (return []) getMyFiles mfiles
706+
707+ return ()
704708
705709 checked' <- holdDyn (_inputElementConfig_initialChecked cfg) $ leftmost
706710 [ checkedChangedBySetChecked
@@ -716,6 +720,8 @@ instance (SupportsHydrationDomBuilder t m) => DomBuilder t (HydrationDomBuilderT
716720 , valueChangedByUI
717721 ]
718722
723+ files <- holdDyn mempty fileChange
724+
719725 return $ InputElement
720726 { _inputElement_value = v
721727 , _inputElement_checked = checked
@@ -723,8 +729,8 @@ instance (SupportsHydrationDomBuilder t m) => DomBuilder t (HydrationDomBuilderT
723729 , _inputElement_input = valueChangedByUI
724730 , _inputElement_hasFocus = hasFocus
725731 , _inputElement_element = e
726− , _inputElement_raw = undefined -- domInputElement
727− , _inputElement_files = undefined -- files
732+ , _inputElement_raw = undefined -- TODO domInputElement
733+ , _inputElement_files = files
728734 }
729735
730736 {-# INLINABLE textAreaElement #-}
reflex-dom-core/test/hydration.hs+21−3
@@ -19,7 +19,7 @@ import Data.IORef
1919import Data.Maybe (fromMaybe)
2020import Data.Proxy
2121import Data.Text (Text)
22−import Language.Javascript.JSaddle (JSException(..), syncPoint)
22+import Language.Javascript.JSaddle (JSException(..), syncPoint, liftJSM)
2323import Language.Javascript.JSaddle.Warp
2424import Network.HTTP.Types (status200)
2525import Network.Wai
@@ -31,11 +31,13 @@ import System.Timeout
3131import Test.Hspec
3232import Test.HUnit
3333import Test.WebDriver (WD)
34+import qualified GHCJS.DOM.Types as DOM (File)
35+import qualified GHCJS.DOM.File as File
3436
3537--import System.IO.Silently
3638import System.IO.Temp
37−import System.IO
38−import GHC.IO.Handle (hDuplicate, hDuplicateTo)
39+import System.Directory
40+import qualified System.FilePath as FilePath
3941
4042import qualified Data.ByteString.Lazy as LBS
4143import qualified Data.Text as T
@@ -265,6 +267,22 @@ main = hspec $ parallel $ do
265267 & inputElementConfig_setChecked .~ setChecked
266268 performEvent_ $ liftIO . writeIORef checkedByUIRef <$> _inputElement_checkedChange e
267269 performEvent_ $ liftIO . writeIORef checkedRef <$> updated (_inputElement_checked e)
270+ it "captures file uploads" $ do
271+ filesRef :: IORef [Text] <- newIORef []
272+ let uploadFile = do
273+ e <- WD.findElem $ WD.ByTag "input"
274+ path <- liftIO $ writeSystemTempFile "testFile" "file contents"
275+ WD.sendKeys (T.pack path) e
276+ WD.click <=< WD.findElem $ WD.ByTag "button"
277+ liftIO $ removeFile path
278+ input <- liftIO $ readIORef filesRef
279+ liftIO $ input `shouldBe` [T.pack $ FilePath.takeFileName path]
280+ testWidget (pure ()) uploadFile $ do
281+ e <- inputElement $ def & initialAttributes .~ "type" =: "file"
282+ click <- button "save"
283+ prerender (pure ()) $ performEvent_ $ ffor (tag (current (_inputElement_files e)) click) $ \fs -> do
284+ names <- liftJSM $ traverse File.getName fs
285+ liftIO $ writeIORef filesRef names
268286
269287 describe "prerender" $ parallel $ do
270288 it "works in simple case" $ do