module Engine.Window.Drop ( Callback , callback , mkCallback ) where import RIO import Graphics.UI.GLFW qualified as GLFW import RIO.App (appEnv) import UnliftIO.Resource (ReleaseKey) import UnliftIO.Resource qualified as Resource import Engine.Events.Sink (MonadSink) import Engine.Types (GlobalHandles(..)) type Callback m = [FilePath] -> m () callback :: MonadSink rs m => Callback m -> m ReleaseKey callback :: forall rs (m :: * -> *). MonadSink rs m => Callback m -> m ReleaseKey callback Callback m handler = do Window window <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a asks forall a b. (a -> b) -> a -> b $ GlobalHandles -> Window ghWindow forall b c a. (b -> c) -> (a -> b) -> a -> c . forall env st. App env st -> env appEnv forall (m :: * -> *) a. MonadUnliftIO m => (UnliftIO m -> IO a) -> m a withUnliftIO \UnliftIO m ul -> Window -> Maybe DropCallback -> IO () GLFW.setDropCallback Window window forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a. a -> Maybe a Just forall a b. (a -> b) -> a -> b $ forall (m :: * -> *). UnliftIO m -> Callback m -> DropCallback mkCallback UnliftIO m ul Callback m handler forall (m :: * -> *). MonadResource m => IO () -> m ReleaseKey Resource.register forall a b. (a -> b) -> a -> b $ Window -> Maybe DropCallback -> IO () GLFW.setDropCallback Window window forall a. Maybe a Nothing mkCallback :: UnliftIO m -> Callback m -> GLFW.DropCallback mkCallback :: forall (m :: * -> *). UnliftIO m -> Callback m -> DropCallback mkCallback (UnliftIO forall a. m a -> IO a ul) Callback m action = \Window _window [String] files -> forall a. m a -> IO a ul forall a b. (a -> b) -> a -> b $ Callback m action [String] files