Moving FileEvents to Web.Event.Extra, and generalising preventDefault.

marlowe-playground-client/src/MarloweEditor/State.purs

@@ -20,8 +20,6 @@ import Data.String as String
 import Data.Tuple (Tuple(..))
 import Effect.Aff.Class (class MonadAff, liftAff)
 import Effect.Class (class MonadEffect)
-import FileEvents (readFileFromDragEvent)
-import FileEvents as FileEvents
 import Halogen (HalogenM, liftEffect, modify_, query)
 import Halogen.Monaco (Message(..), Query(..)) as Monaco
 import LocalStorage as LocalStorage
@@ -45,6 +43,7 @@ import StaticData (marloweBufferLocalStorageKey)
 import StaticData as StaticData
 import Text.Pretty (pretty)
 import Types (WebData)
+import Web.Event.Extra (preventDefault, readFileFromDragEvent)
 
 handleAction ::
   forall m.
@@ -81,10 +80,10 @@ handleAction _ (HandleEditorMessage (Monaco.TextChanged text)) = do
     Just { codeActionProvider: Just caProvider, completionItemProvider: Just ciProvider } -> pure $ updateAdditionalContext caProvider ciProvider additionalContext
     _ -> pure unit
 
-handleAction _ (HandleDragEvent event) = liftEffect $ FileEvents.preventDefault event
+handleAction _ (HandleDragEvent event) = liftEffect $ preventDefault event
 
 handleAction settings (HandleDropEvent event) = do
-  liftEffect $ FileEvents.preventDefault event
+  liftEffect $ preventDefault event
   contents <- liftAff $ readFileFromDragEvent event
   void $ editorSetValue contents
 

plutus-playground-client/src/Editor/State.purs

@@ -7,7 +7,6 @@ import Data.Ord (clamp)
 import Editor.Types (State(State), Action(..), keybindingsLocalStorageKey, readKeyBindings, _currentCodeIsCompiled, _feedbackPaneDragStart, _feedbackPaneExtend, _feedbackPaneMinimised, _feedbackPanePreviousExtend, _keyBindings, _lastCompiledCode)
 import Effect.Aff.Class (class MonadAff, liftAff)
 import Effect.Class (class MonadEffect)
-import FileEvents (preventDefault, readFileFromDragEvent)
 import Halogen (HalogenM, liftEffect, query, tell)
 import Halogen.Monaco (KeyBindings(..))
 import Halogen.Monaco (Message(..), Query(..)) as Monaco
@@ -17,6 +16,7 @@ import LocalStorage as LocalStorage
 import Monaco (Editor, getModel, layout, focus, setPosition, setValue) as Monaco
 import Prelude (Unit, bind, discard, not, pure, show, unit, void, (+), (-), ($), (<$>), (==))
 import Types (ChildSlots, _editorSlot)
+import Web.Event.Extra (preventDefault, readFileFromDragEvent)
 
 initialState :: forall m. MonadEffect m => m State
 initialState =

plutus-playground-client/src/MonadApp.purs

@@ -18,7 +18,6 @@ import Editor.State (handleAction, saveBuffer) as Editor
 import Editor.Types (Action) as Editor
 import Effect.Aff.Class (class MonadAff, liftAff)
 import Effect.Class (class MonadEffect, liftEffect)
-import FileEvents as FileEvents
 import Gist (Gist, GistId, NewGist)
 import Halogen (HalogenM, RefLabel, query, tell)
 import Halogen as H
@@ -35,6 +34,8 @@ import Servant.PureScript.Ajax (AjaxError)
 import Servant.PureScript.Settings (SPSettings_)
 import StaticData (bufferLocalStorageKey)
 import Types (ChildSlots, HAction, State, WebData, _balancesChartSlot, _editorSlot, _editorState)
+import Web.Event.Extra (class IsEvent)
+import Web.Event.Extra as WebEvent
 import Web.HTML.Event.DataTransfer (DropEffect)
 import Web.HTML.Event.DataTransfer as DataTransfer
 import Web.HTML.Event.DragEvent (DragEvent, dataTransfer)
@@ -47,7 +48,7 @@ class
   editorSetAnnotations :: Array IMarkerData -> m Unit
   --
   saveBuffer :: String -> m Unit
-  preventDefault :: DragEvent -> m Unit
+  preventDefault :: forall e. IsEvent e => e -> m Unit
   setDropEffect :: DropEffect -> DragEvent -> m Unit
   setDataTransferData :: DragEvent -> MediaType -> String -> m Unit
   readFileFromDragEvent :: DragEvent -> m String
@@ -112,10 +113,10 @@ instance monadAppHalogenApp ::
   editorSetContents (SourceCode contents) cursor = wrap $ void $ query _editorSlot unit $ tell $ Monaco.SetText contents
   editorHandleAction action = wrap $ HE.imapState _editorState $ Editor.handleAction bufferLocalStorageKey action
   editorSetAnnotations annotations = wrap $ void $ query _editorSlot unit $ Monaco.SetModelMarkers annotations identity
-  preventDefault event = wrap $ liftEffect $ FileEvents.preventDefault event
+  preventDefault event = wrap $ liftEffect $ WebEvent.preventDefault event
   setDropEffect dropEffect event = wrap $ liftEffect $ DataTransfer.setDropEffect dropEffect $ dataTransfer event
   setDataTransferData event mimeType value = wrap $ liftEffect $ DataTransfer.setData mimeType value $ dataTransfer event
-  readFileFromDragEvent event = wrap $ liftAff $ FileEvents.readFileFromDragEvent event
+  readFileFromDragEvent event = wrap $ liftAff $ WebEvent.readFileFromDragEvent event
   saveBuffer text = wrap $ Editor.saveBuffer bufferLocalStorageKey text
   getOauthStatus = runAjax Server.getOauthStatus
   getGistByGistId gistId = runAjax $ Server.getGistsByGistId gistId

web-common/src/FileEvents.js → web-common/src/Web/Event/Extra.js

@@ -1,12 +1,6 @@
 /*global FileReader, exports*/
 'use strict';
 
-exports.preventDefault = function(e) {
-    return function() {
-        e.preventDefault();
-    };
-};
-
 exports._readFileFromDragEvent = function(onLoad, onError, e) {
     var i, item, files, file, reader;
 

web-common/src/Web/Event/Extra.purs

@@ -0,0 +1,53 @@
+module Web.Event.Extra
+  ( class IsEvent
+  , toEvent
+  , preventDefault
+  , readFileFromDragEvent
+  ) where
+
+import Data.Either (Either(..))
+import Effect (Effect)
+import Effect.Aff (Aff, Canceler, Error, makeAff)
+import Effect.Uncurried (EffectFn3, runEffectFn3)
+import Prelude (Unit, ($), (<<<))
+import Web.Event.Event (Event)
+import Web.Event.Event (preventDefault) as WebEvent
+import Web.HTML.Event.DragEvent (DragEvent)
+import Web.HTML.Event.DragEvent (toEvent) as DragEvent
+import Web.UIEvent.FocusEvent (FocusEvent)
+import Web.UIEvent.FocusEvent (toEvent) as FocusEvent
+import Web.UIEvent.KeyboardEvent (KeyboardEvent)
+import Web.UIEvent.KeyboardEvent (toEvent) as KeyboardEvent
+import Web.UIEvent.MouseEvent (MouseEvent)
+import Web.UIEvent.MouseEvent (toEvent) as MouseEvent
+
+class IsEvent e where
+  toEvent :: e -> Event
+
+instance eventIsEvent :: IsEvent Event where
+  toEvent event = event
+
+instance dragEventIsEvent :: IsEvent DragEvent where
+  toEvent = DragEvent.toEvent
+
+instance focusEventIsEvent :: IsEvent FocusEvent where
+  toEvent = FocusEvent.toEvent
+
+instance keyboardEventIsEvent :: IsEvent KeyboardEvent where
+  toEvent = KeyboardEvent.toEvent
+
+instance mouseEventIsEvent :: IsEvent MouseEvent where
+  toEvent = MouseEvent.toEvent
+
+preventDefault :: forall e. IsEvent e => e -> Effect Unit
+preventDefault = WebEvent.preventDefault <<< toEvent
+
+foreign import _readFileFromDragEvent ::
+  EffectFn3
+    (String -> Effect Unit)
+    (Error -> Effect Unit)
+    DragEvent
+    Canceler
+
+readFileFromDragEvent :: DragEvent -> Aff String
+readFileFromDragEvent event = makeAff $ \callback -> runEffectFn3 _readFileFromDragEvent (callback <<< Right) (callback <<< Left) event