FileDrop event added

monomer.cabal

@@ -179,6 +179,7 @@ library
     , data-default >=0.5 && <0.8
     , exceptions ==0.10.*
     , extra >=1.6 && <1.9
+    , filepath ==1.4.*
     , foreign-store >=0.2 && <1.0
     , formatting >=6.0 && <8.0
     , http-client >=0.6 && <0.9
@@ -225,6 +226,7 @@ executable books
     , data-default >=0.5 && <0.8
     , exceptions ==0.10.*
     , extra >=1.6 && <1.9
+    , filepath ==1.4.*
     , foreign-store >=0.2 && <1.0
     , formatting >=6.0 && <8.0
     , http-client >=0.6 && <0.9
@@ -268,6 +270,7 @@ executable dev-test-app
     , data-default >=0.5 && <0.8
     , exceptions ==0.10.*
     , extra >=1.6 && <1.9
+    , filepath ==1.4.*
     , foreign-store >=0.2 && <1.0
     , formatting >=6.0 && <8.0
     , http-client >=0.6 && <0.9
@@ -310,6 +313,7 @@ executable generative
     , data-default >=0.5 && <0.8
     , exceptions ==0.10.*
     , extra >=1.6 && <1.9
+    , filepath ==1.4.*
     , foreign-store >=0.2 && <1.0
     , formatting >=6.0 && <8.0
     , http-client >=0.6 && <0.9
@@ -355,6 +359,7 @@ executable opengl
     , data-default >=0.5 && <0.8
     , exceptions ==0.10.*
     , extra >=1.6 && <1.9
+    , filepath ==1.4.*
     , foreign-store >=0.2 && <1.0
     , formatting >=6.0 && <8.0
     , http-client >=0.6 && <0.9
@@ -402,6 +407,7 @@ executable ticker
     , data-default >=0.5 && <0.8
     , exceptions ==0.10.*
     , extra >=1.6 && <1.9
+    , filepath ==1.4.*
     , foreign-store >=0.2 && <1.0
     , formatting >=6.0 && <8.0
     , http-client >=0.6 && <0.9
@@ -448,6 +454,7 @@ executable todo
     , data-default >=0.5 && <0.8
     , exceptions ==0.10.*
     , extra >=1.6 && <1.9
+    , filepath ==1.4.*
     , foreign-store >=0.2 && <1.0
     , formatting >=6.0 && <8.0
     , http-client >=0.6 && <0.9
@@ -499,6 +506,7 @@ executable tutorial
     , data-default >=0.5 && <0.8
     , exceptions ==0.10.*
     , extra >=1.6 && <1.9
+    , filepath ==1.4.*
     , foreign-store >=0.2 && <1.0
     , formatting >=6.0 && <8.0
     , http-client >=0.6 && <0.9
@@ -597,6 +605,7 @@ test-suite monomer-test
     , data-default >=0.5 && <0.8
     , exceptions ==0.10.*
     , extra >=1.6 && <1.9
+    , filepath ==1.4.*
     , foreign-store >=0.2 && <1.0
     , formatting >=6.0 && <8.0
     , hspec >=2.4 && <3.0

package.yaml

@@ -52,6 +52,8 @@ dependencies:
   - transformers >= 0.5 && < 0.7
   - vector >= 0.12 && < 0.14
   - wreq >= 0.5.2 && < 0.6
+#  - filepath >= 1.4.100.1 && < 1.5
+  - filepath >= 1.4 && < 1.5
 
 flags:
   examples:

src/Monomer/Event/Core.hs

@@ -15,12 +15,20 @@ module Monomer.Event.Core (
   translateEvent
 ) where
 
-import Control.Applicative ((<|>))
+--import Control.Applicative ((<|>))
+import Control.Monad (forM)
 import Data.Maybe (catMaybes)
 import Data.Text (Text)
 
 import qualified SDL
 
+-- 'OsPath' is not part of current LTS snapshot, yet.
+--import System.IO (utf8, utf16le, EncodingException(..))
+--import System.OsPath
+--import System.OsString.Internal (encodeWith)
+import System.FilePath
+import Foreign.C.String
+
 import Monomer.Common
 import Monomer.Event.Types
 
@@ -36,6 +44,7 @@ isActionEvent SDL.MouseWheelEvent{} = True
 isActionEvent SDL.KeyboardEvent{} = True
 isActionEvent SDL.TextEditingEvent{} = True
 isActionEvent SDL.TextInputEvent{} = True
+isActionEvent SDL.DropEvent{} = True
 isActionEvent _ = False
 
 -- | Configuration options for converting from an SDL event to a 'SystemEvent'.
@@ -47,22 +56,30 @@ data ConvertEventsCfg = ConvertEventsCfg {
   _cecInvertWheelY :: Bool  -- ^ Whether wheel/trackpad y direction should be inverted.
 } deriving (Eq, Show)
 
--- | Converts SDL events to Monomer's SystemEvent
+-- | Converts SDL events to Monomer's SystemEvent. 
+--   IO necessary for marshalling (i.e. peekCString)
 convertEvents
   :: ConvertEventsCfg    -- ^ Settings for event conversion.
   -> Point               -- ^ Mouse position.
   -> [SDL.EventPayload]  -- ^ List of SDL events.
-  -> [SystemEvent]       -- ^ List of Monomer events.
-convertEvents cfg mousePos events = catMaybes convertedEvents where
-  ConvertEventsCfg os dpr epr invertX invertY = cfg
-  convertedEvents = fmap convertEvent events
-  convertEvent evt =
-    mouseMoveEvent mousePos evt
-    <|> mouseClick mousePos evt
-    <|> mouseWheelEvent cfg mousePos evt
-    <|> mouseMoveLeave mousePos evt
-    <|> keyboardEvent evt
-    <|> textEvent evt
+  -> IO [SystemEvent]    -- ^ List of Monomer events.
+convertEvents cfg mousePos events = 
+  fmap catMaybes $ forM events $ eventHandler [ mouseMove, mouseClk, mouseWheel, mouseLeave, keyboard, text, fileDrop ] 
+  where
+    ConvertEventsCfg os dpr epr invertX invertY = cfg
+    mouseMove  = \e -> return $ mouseMoveEvent mousePos e
+    mouseClk   = \e -> return $ mouseClick mousePos e
+    mouseWheel = \e -> return $ mouseWheelEvent cfg mousePos e
+    mouseLeave = \e -> return $ mouseMoveLeave mousePos e
+    keyboard   = \e -> return $ keyboardEvent e
+    text       = \e -> return $ textEvent e
+    fileDrop   = \e -> fileDropEvent mousePos e
+
+    eventHandler (f:fs) = \e -> f e >>= \maybeSE -> case maybeSE of
+      Just se  -> return $ Just se
+      Nothing  -> eventHandler fs e
+    eventHandler [] = \e -> return Nothing
+
 
 -- | Adds a given offset to mouse related SystemEvents.
 translateEvent
@@ -141,6 +158,19 @@ textEvent (SDL.TextInputEvent input) = Just textInput where
   textInput = TextInput (SDL.textInputEventText input)
 textEvent _ = Nothing
 
+-- TODO: 'OsPath' instead of 'FilePath' should be used, but is currently not part of the newest LTS snapshot
+--fileDropEvent :: Point -> SDL.EventPayload -> IO (Maybe SystemEvent)
+--fileDropEvent _ (SDL.DropEvent (SDL.DropEventData cstr)) = 
+--        peekCString cstr >>= \str -> case encodeWith utf8 utf16le str of
+--            Right osstr -> return $ Just (FileDrop osstr)
+--            _           -> return Nothing
+fileDropEvent :: Point -> SDL.EventPayload -> IO (Maybe SystemEvent)
+fileDropEvent _ (SDL.DropEvent (SDL.DropEventData cstr)) = do
+    str <- peekCString cstr -- the filepath 'cstr' must be an utf8 string when we compare to the SDL example https://wiki.libsdl.org/SDL2/SDL_DropEvent
+    putStrLn $ "FileDrop: " ++ str
+    return $ Just (FileDrop str)
+fileDropEvent _ _ = return Nothing
+
 convertKeyModifier :: SDL.KeyModifier -> KeyMod
 convertKeyModifier keyMod = KeyMod {
   _kmLeftShift = SDL.keyModifierLeftShift keyMod,

src/Monomer/Event/Types.hs

@@ -17,6 +17,8 @@ import Data.Default
 import Data.Text (Text)
 import Data.Typeable (Typeable, cast, typeOf)
 import Data.Map.Strict (Map)
+--import System.OsPath (OsPath)
+import System.FilePath (FilePath)
 
 import qualified Data.Map.Strict as M
 
@@ -117,6 +119,9 @@ data SystemEvent
   -- | A drag action was active and the main button was released inside the
   --   current viewport.
   | Drop Point Path WidgetDragMsg
+  -- | File dragged and dropped into window.
+  -- | FileDrop OsPath -- OsPath should be used but is currently not part of the newest LTS snapshot yet. for now, use old FilePath instead:
+  | FileDrop FilePath
   deriving (Eq, Show)
 
 -- | Status of input devices.

src/Monomer/Main/Core.hs

@@ -332,7 +332,7 @@ mainLoop window fontManager config loopArgs = do
   let invertX = fromMaybe False (_apcInvertWheelX config)
   let invertY = fromMaybe False (_apcInvertWheelY config)
   let convertCfg = ConvertEventsCfg _mlOS dpr epr invertX invertY
-  let baseSystemEvents = convertEvents convertCfg mousePos eventsPayload
+  baseSystemEvents <- liftIO $ convertEvents convertCfg mousePos eventsPayload
 
 --  when newSecond $
 --    liftIO . putStrLnErr $ "Frames: " ++ show _mlFrameCount

src/Monomer/Main/Handlers.hs

@@ -910,6 +910,8 @@ getTargetPath wenv root pressed overlay target event = case event of
     TextInput _                       -> pathEvent target
     -- Clipboard
     Clipboard _                       -> pathEvent target
+    -- FileDrop
+    FileDrop _                        -> pathEvent target
     -- Mouse/touch
     ButtonAction point _ BtnPressed _ -> pointEvent point
     ButtonAction _ _ BtnReleased _    -> pathEvent target