----------------------------------------------------------------------------- {-# LANGUAGE LambdaCase #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} ----------------------------------------------------------------------------- -- | -- Module : Miso.Event.Types -- Copyright : (C) 2016-2025 David M. Johnson -- License : BSD3-style (see the file LICENSE) -- Maintainer : David M. Johnson <code@dmj.io> -- Stability : experimental -- Portability : non-portable ---------------------------------------------------------------------------- module Miso.Event.Types ( -- ** Types Events -- *** KeyboardEvent , KeyInfo (..) , KeyCode (..) -- *** CheckedEvent , Checked (..) -- *** PointerEvent , PointerEvent(..) , PointerType(..) -- *** DropEvent , AllowDrop(..) -- *** Options , Options(..) , defaultOptions -- *** Events , defaultEvents , keyboardEvents , mouseEvents , dragEvents , pointerEvents ) where ----------------------------------------------------------------------------- import Data.Aeson (FromJSON(..), withText) import qualified Data.Map.Strict as M import GHC.Generics (Generic) import GHCJS.Marshal (ToJSVal) import Miso.String (MisoString, ms) ----------------------------------------------------------------------------- -- | Type useful for both KeyCode and additional key press information. data KeyInfo = KeyInfo { keyCode :: !KeyCode , shiftKey, metaKey, ctrlKey, altKey :: !Bool } deriving (Show, Eq) ----------------------------------------------------------------------------- -- | Type used for Keyboard events. -- -- See <https://developer.mozilla.org/en-US/docs/Web/API/KeyboardEvent/keyCode#Browser_compatibility> newtype KeyCode = KeyCode Int deriving (Show, Eq, Ord, FromJSON) ----------------------------------------------------------------------------- -- | Type used for Checkbox events. newtype Checked = Checked Bool deriving (Show, Eq, Ord, FromJSON) ----------------------------------------------------------------------------- -- | Type used for Pointer events. -- <https://w3c.github.io/pointerevents> data PointerEvent = PointerEvent { pointerType :: PointerType , pointerId :: Int , isPrimary :: Bool , client :: (Double, Double) -- ^ clientX, clientY , screen :: (Double, Double) -- ^ screenX, screenY , page :: (Double,Double) -- ^ pageX, pageY , tilt :: (Double,Double) -- ^ tiltX, tiltY , pressure :: Double } deriving (Show, Eq) ----------------------------------------------------------------------------- -- | Pointer type -- <https://developer.mozilla.org/en-US/docs/Web/API/PointerEvent/pointerType> data PointerType = MousePointerType | PenPointerType | TouchPointerType | UnknownPointerType MisoString deriving (Show, Eq) ----------------------------------------------------------------------------- instance FromJSON PointerType where parseJSON = withText "PointerType" $ \case "mouse" -> pure MousePointerType "touch" -> pure TouchPointerType "pen" -> pure PenPointerType x -> pure (UnknownPointerType (ms x)) ----------------------------------------------------------------------------- -- | Options for handling event propagation. data Options = Options { preventDefault :: Bool , stopPropagation :: Bool } deriving (Show, Eq, Generic) ----------------------------------------------------------------------------- instance ToJSVal Options ----------------------------------------------------------------------------- -- | Default value for 'Options'. -- -- > defaultOptions = Options { preventDefault = False, stopPropagation = False } defaultOptions :: Options defaultOptions = Options { preventDefault = False , stopPropagation = False } ----------------------------------------------------------------------------- -- | Related to using drop-related events newtype AllowDrop = AllowDrop Bool deriving (Show, Eq, FromJSON) ----------------------------------------------------------------------------- -- | Convenience type for Events type Events = M.Map MisoString Bool ----------------------------------------------------------------------------- -- | Default delegated events defaultEvents :: M.Map MisoString Bool defaultEvents = M.fromList [ ("blur", True) , ("change", False) , ("click", False) , ("dblclick", False) , ("focus", False) , ("input", False) , ("select", False) , ("submit", False) ] ----------------------------------------------------------------------------- -- | Keyboard events keyboardEvents :: M.Map MisoString Bool keyboardEvents = M.fromList [ ("keydown", False) , ("keypress", False) , ("keyup", False) ] ----------------------------------------------------------------------------- -- | Mouse events mouseEvents :: M.Map MisoString Bool mouseEvents = M.fromList [ ("mouseup", False) , ("mousedown", False) , ("mouseenter", True) , ("mouseleave", False) , ("mouseover", False) , ("mouseout", False) ] ----------------------------------------------------------------------------- -- | Drag events dragEvents :: M.Map MisoString Bool dragEvents = M.fromList [ ("dragstart", False) , ("dragover", False) , ("dragend", False) , ("dragenter", False) , ("dragleave", False) , ("drag", False) , ("drop", False) ] ----------------------------------------------------------------------------- -- | Pointer events pointerEvents :: M.Map MisoString Bool pointerEvents = M.fromList [ ("pointerup", False) , ("pointerdown", False) , ("pointerenter", True) , ("pointercancel", False) , ("pointerleave", False) , ("pointerover", False) , ("pointerout", False) ] -----------------------------------------------------------------------------