{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Miso.Event.Types
(
Events
, Capture
, KeyInfo (..)
, KeyCode (..)
, Checked (..)
, PointerEvent(..)
, PointerType(..)
, AllowDrop(..)
, Options(..)
, defaultOptions
, defaultEvents
, keyboardEvents
, mouseEvents
, dragEvents
, pointerEvents
, audioVideoEvents
) 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)
data KeyInfo
= KeyInfo
{ KeyInfo -> KeyCode
keyCode :: !KeyCode
, KeyInfo -> Bool
shiftKey, KeyInfo -> Bool
metaKey, KeyInfo -> Bool
ctrlKey, KeyInfo -> Bool
altKey :: !Bool
} deriving (Int -> KeyInfo -> ShowS
[KeyInfo] -> ShowS
KeyInfo -> String
(Int -> KeyInfo -> ShowS)
-> (KeyInfo -> String) -> ([KeyInfo] -> ShowS) -> Show KeyInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> KeyInfo -> ShowS
showsPrec :: Int -> KeyInfo -> ShowS
$cshow :: KeyInfo -> String
show :: KeyInfo -> String
$cshowList :: [KeyInfo] -> ShowS
showList :: [KeyInfo] -> ShowS
Show, KeyInfo -> KeyInfo -> Bool
(KeyInfo -> KeyInfo -> Bool)
-> (KeyInfo -> KeyInfo -> Bool) -> Eq KeyInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: KeyInfo -> KeyInfo -> Bool
== :: KeyInfo -> KeyInfo -> Bool
$c/= :: KeyInfo -> KeyInfo -> Bool
/= :: KeyInfo -> KeyInfo -> Bool
Eq)
newtype KeyCode = KeyCode Int
deriving (Int -> KeyCode -> ShowS
[KeyCode] -> ShowS
KeyCode -> String
(Int -> KeyCode -> ShowS)
-> (KeyCode -> String) -> ([KeyCode] -> ShowS) -> Show KeyCode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> KeyCode -> ShowS
showsPrec :: Int -> KeyCode -> ShowS
$cshow :: KeyCode -> String
show :: KeyCode -> String
$cshowList :: [KeyCode] -> ShowS
showList :: [KeyCode] -> ShowS
Show, KeyCode -> KeyCode -> Bool
(KeyCode -> KeyCode -> Bool)
-> (KeyCode -> KeyCode -> Bool) -> Eq KeyCode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: KeyCode -> KeyCode -> Bool
== :: KeyCode -> KeyCode -> Bool
$c/= :: KeyCode -> KeyCode -> Bool
/= :: KeyCode -> KeyCode -> Bool
Eq, Eq KeyCode
Eq KeyCode =>
(KeyCode -> KeyCode -> Ordering)
-> (KeyCode -> KeyCode -> Bool)
-> (KeyCode -> KeyCode -> Bool)
-> (KeyCode -> KeyCode -> Bool)
-> (KeyCode -> KeyCode -> Bool)
-> (KeyCode -> KeyCode -> KeyCode)
-> (KeyCode -> KeyCode -> KeyCode)
-> Ord KeyCode
KeyCode -> KeyCode -> Bool
KeyCode -> KeyCode -> Ordering
KeyCode -> KeyCode -> KeyCode
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: KeyCode -> KeyCode -> Ordering
compare :: KeyCode -> KeyCode -> Ordering
$c< :: KeyCode -> KeyCode -> Bool
< :: KeyCode -> KeyCode -> Bool
$c<= :: KeyCode -> KeyCode -> Bool
<= :: KeyCode -> KeyCode -> Bool
$c> :: KeyCode -> KeyCode -> Bool
> :: KeyCode -> KeyCode -> Bool
$c>= :: KeyCode -> KeyCode -> Bool
>= :: KeyCode -> KeyCode -> Bool
$cmax :: KeyCode -> KeyCode -> KeyCode
max :: KeyCode -> KeyCode -> KeyCode
$cmin :: KeyCode -> KeyCode -> KeyCode
min :: KeyCode -> KeyCode -> KeyCode
Ord, Maybe KeyCode
Value -> Parser [KeyCode]
Value -> Parser KeyCode
(Value -> Parser KeyCode)
-> (Value -> Parser [KeyCode]) -> Maybe KeyCode -> FromJSON KeyCode
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser KeyCode
parseJSON :: Value -> Parser KeyCode
$cparseJSONList :: Value -> Parser [KeyCode]
parseJSONList :: Value -> Parser [KeyCode]
$comittedField :: Maybe KeyCode
omittedField :: Maybe KeyCode
FromJSON)
newtype Checked = Checked Bool
deriving (Int -> Checked -> ShowS
[Checked] -> ShowS
Checked -> String
(Int -> Checked -> ShowS)
-> (Checked -> String) -> ([Checked] -> ShowS) -> Show Checked
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Checked -> ShowS
showsPrec :: Int -> Checked -> ShowS
$cshow :: Checked -> String
show :: Checked -> String
$cshowList :: [Checked] -> ShowS
showList :: [Checked] -> ShowS
Show, Checked -> Checked -> Bool
(Checked -> Checked -> Bool)
-> (Checked -> Checked -> Bool) -> Eq Checked
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Checked -> Checked -> Bool
== :: Checked -> Checked -> Bool
$c/= :: Checked -> Checked -> Bool
/= :: Checked -> Checked -> Bool
Eq, Eq Checked
Eq Checked =>
(Checked -> Checked -> Ordering)
-> (Checked -> Checked -> Bool)
-> (Checked -> Checked -> Bool)
-> (Checked -> Checked -> Bool)
-> (Checked -> Checked -> Bool)
-> (Checked -> Checked -> Checked)
-> (Checked -> Checked -> Checked)
-> Ord Checked
Checked -> Checked -> Bool
Checked -> Checked -> Ordering
Checked -> Checked -> Checked
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Checked -> Checked -> Ordering
compare :: Checked -> Checked -> Ordering
$c< :: Checked -> Checked -> Bool
< :: Checked -> Checked -> Bool
$c<= :: Checked -> Checked -> Bool
<= :: Checked -> Checked -> Bool
$c> :: Checked -> Checked -> Bool
> :: Checked -> Checked -> Bool
$c>= :: Checked -> Checked -> Bool
>= :: Checked -> Checked -> Bool
$cmax :: Checked -> Checked -> Checked
max :: Checked -> Checked -> Checked
$cmin :: Checked -> Checked -> Checked
min :: Checked -> Checked -> Checked
Ord, Maybe Checked
Value -> Parser [Checked]
Value -> Parser Checked
(Value -> Parser Checked)
-> (Value -> Parser [Checked]) -> Maybe Checked -> FromJSON Checked
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser Checked
parseJSON :: Value -> Parser Checked
$cparseJSONList :: Value -> Parser [Checked]
parseJSONList :: Value -> Parser [Checked]
$comittedField :: Maybe Checked
omittedField :: Maybe Checked
FromJSON)
data PointerEvent
= PointerEvent
{ PointerEvent -> PointerType
pointerType :: PointerType
, PointerEvent -> Int
pointerId :: Int
, PointerEvent -> Bool
isPrimary :: Bool
, PointerEvent -> (Double, Double)
client :: (Double, Double)
, PointerEvent -> (Double, Double)
screen :: (Double, Double)
, PointerEvent -> (Double, Double)
page :: (Double,Double)
, PointerEvent -> (Double, Double)
tilt :: (Double,Double)
, PointerEvent -> Double
pressure :: Double
} deriving (Int -> PointerEvent -> ShowS
[PointerEvent] -> ShowS
PointerEvent -> String
(Int -> PointerEvent -> ShowS)
-> (PointerEvent -> String)
-> ([PointerEvent] -> ShowS)
-> Show PointerEvent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PointerEvent -> ShowS
showsPrec :: Int -> PointerEvent -> ShowS
$cshow :: PointerEvent -> String
show :: PointerEvent -> String
$cshowList :: [PointerEvent] -> ShowS
showList :: [PointerEvent] -> ShowS
Show, PointerEvent -> PointerEvent -> Bool
(PointerEvent -> PointerEvent -> Bool)
-> (PointerEvent -> PointerEvent -> Bool) -> Eq PointerEvent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PointerEvent -> PointerEvent -> Bool
== :: PointerEvent -> PointerEvent -> Bool
$c/= :: PointerEvent -> PointerEvent -> Bool
/= :: PointerEvent -> PointerEvent -> Bool
Eq)
data PointerType
= MousePointerType
| PenPointerType
| TouchPointerType
| UnknownPointerType MisoString
deriving (Int -> PointerType -> ShowS
[PointerType] -> ShowS
PointerType -> String
(Int -> PointerType -> ShowS)
-> (PointerType -> String)
-> ([PointerType] -> ShowS)
-> Show PointerType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PointerType -> ShowS
showsPrec :: Int -> PointerType -> ShowS
$cshow :: PointerType -> String
show :: PointerType -> String
$cshowList :: [PointerType] -> ShowS
showList :: [PointerType] -> ShowS
Show, PointerType -> PointerType -> Bool
(PointerType -> PointerType -> Bool)
-> (PointerType -> PointerType -> Bool) -> Eq PointerType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PointerType -> PointerType -> Bool
== :: PointerType -> PointerType -> Bool
$c/= :: PointerType -> PointerType -> Bool
/= :: PointerType -> PointerType -> Bool
Eq)
instance FromJSON PointerType where
parseJSON :: Value -> Parser PointerType
parseJSON = String
-> (MisoString -> Parser PointerType)
-> Value
-> Parser PointerType
forall a. String -> (MisoString -> Parser a) -> Value -> Parser a
withText String
"PointerType" ((MisoString -> Parser PointerType) -> Value -> Parser PointerType)
-> (MisoString -> Parser PointerType)
-> Value
-> Parser PointerType
forall a b. (a -> b) -> a -> b
$ \case
MisoString
"mouse" -> PointerType -> Parser PointerType
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PointerType
MousePointerType
MisoString
"touch" -> PointerType -> Parser PointerType
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PointerType
TouchPointerType
MisoString
"pen" -> PointerType -> Parser PointerType
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PointerType
PenPointerType
MisoString
x -> PointerType -> Parser PointerType
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MisoString -> PointerType
UnknownPointerType (MisoString -> MisoString
forall str. ToMisoString str => str -> MisoString
ms MisoString
x))
data Options
= Options
{ Options -> Bool
preventDefault :: Bool
, Options -> Bool
stopPropagation :: Bool
} deriving (Int -> Options -> ShowS
[Options] -> ShowS
Options -> String
(Int -> Options -> ShowS)
-> (Options -> String) -> ([Options] -> ShowS) -> Show Options
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Options -> ShowS
showsPrec :: Int -> Options -> ShowS
$cshow :: Options -> String
show :: Options -> String
$cshowList :: [Options] -> ShowS
showList :: [Options] -> ShowS
Show, Options -> Options -> Bool
(Options -> Options -> Bool)
-> (Options -> Options -> Bool) -> Eq Options
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Options -> Options -> Bool
== :: Options -> Options -> Bool
$c/= :: Options -> Options -> Bool
/= :: Options -> Options -> Bool
Eq, (forall x. Options -> Rep Options x)
-> (forall x. Rep Options x -> Options) -> Generic Options
forall x. Rep Options x -> Options
forall x. Options -> Rep Options x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Options -> Rep Options x
from :: forall x. Options -> Rep Options x
$cto :: forall x. Rep Options x -> Options
to :: forall x. Rep Options x -> Options
Generic)
instance ToJSVal Options
defaultOptions :: Options
defaultOptions :: Options
defaultOptions
= Options
{ preventDefault :: Bool
preventDefault = Bool
False
, stopPropagation :: Bool
stopPropagation = Bool
False
}
newtype AllowDrop = AllowDrop Bool
deriving (Int -> AllowDrop -> ShowS
[AllowDrop] -> ShowS
AllowDrop -> String
(Int -> AllowDrop -> ShowS)
-> (AllowDrop -> String)
-> ([AllowDrop] -> ShowS)
-> Show AllowDrop
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AllowDrop -> ShowS
showsPrec :: Int -> AllowDrop -> ShowS
$cshow :: AllowDrop -> String
show :: AllowDrop -> String
$cshowList :: [AllowDrop] -> ShowS
showList :: [AllowDrop] -> ShowS
Show, AllowDrop -> AllowDrop -> Bool
(AllowDrop -> AllowDrop -> Bool)
-> (AllowDrop -> AllowDrop -> Bool) -> Eq AllowDrop
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AllowDrop -> AllowDrop -> Bool
== :: AllowDrop -> AllowDrop -> Bool
$c/= :: AllowDrop -> AllowDrop -> Bool
/= :: AllowDrop -> AllowDrop -> Bool
Eq, Maybe AllowDrop
Value -> Parser [AllowDrop]
Value -> Parser AllowDrop
(Value -> Parser AllowDrop)
-> (Value -> Parser [AllowDrop])
-> Maybe AllowDrop
-> FromJSON AllowDrop
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser AllowDrop
parseJSON :: Value -> Parser AllowDrop
$cparseJSONList :: Value -> Parser [AllowDrop]
parseJSONList :: Value -> Parser [AllowDrop]
$comittedField :: Maybe AllowDrop
omittedField :: Maybe AllowDrop
FromJSON)
type Events = M.Map MisoString Capture
type Capture = Bool
defaultEvents :: Events
defaultEvents :: Events
defaultEvents = [(MisoString, Bool)] -> Events
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
[ (MisoString
"blur", Bool
True)
, (MisoString
"change", Bool
False)
, (MisoString
"click", Bool
False)
, (MisoString
"dblclick", Bool
False)
, (MisoString
"focus", Bool
False)
, (MisoString
"input", Bool
False)
, (MisoString
"select", Bool
False)
, (MisoString
"submit", Bool
False)
]
keyboardEvents :: Events
keyboardEvents :: Events
keyboardEvents = [(MisoString, Bool)] -> Events
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
[ (MisoString
"keydown", Bool
False)
, (MisoString
"keypress", Bool
False)
, (MisoString
"keyup", Bool
False)
]
mouseEvents :: Events
mouseEvents :: Events
mouseEvents = [(MisoString, Bool)] -> Events
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
[ (MisoString
"mouseup", Bool
False)
, (MisoString
"mousedown", Bool
False)
, (MisoString
"mouseenter", Bool
True)
, (MisoString
"mouseleave", Bool
False)
, (MisoString
"mouseover", Bool
False)
, (MisoString
"mouseout", Bool
False)
]
dragEvents :: Events
dragEvents :: Events
dragEvents = [(MisoString, Bool)] -> Events
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
[ (MisoString
"dragstart", Bool
False)
, (MisoString
"dragover", Bool
False)
, (MisoString
"dragend", Bool
False)
, (MisoString
"dragenter", Bool
False)
, (MisoString
"dragleave", Bool
False)
, (MisoString
"drag", Bool
False)
, (MisoString
"drop", Bool
False)
]
pointerEvents :: Events
pointerEvents :: Events
pointerEvents = [(MisoString, Bool)] -> Events
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
[ (MisoString
"pointerup", Bool
False)
, (MisoString
"pointerdown", Bool
False)
, (MisoString
"pointerenter", Bool
True)
, (MisoString
"pointercancel", Bool
False)
, (MisoString
"pointerleave", Bool
False)
, (MisoString
"pointerover", Bool
False)
, (MisoString
"pointerout", Bool
False)
]
audioVideoEvents :: Events
audioVideoEvents :: Events
audioVideoEvents = [(MisoString, Bool)] -> Events
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
[ (MisoString
"abort", Bool
True)
, (MisoString
"canplay", Bool
True)
, (MisoString
"canplaythrough", Bool
True)
, (MisoString
"durationchange", Bool
False)
, (MisoString
"emptied", Bool
True)
, (MisoString
"ended", Bool
True)
, (MisoString
"error", Bool
True)
, (MisoString
"loadeddata", Bool
False)
, (MisoString
"loadedmetadata", Bool
False)
, (MisoString
"loadstart", Bool
False)
, (MisoString
"pause", Bool
True)
, (MisoString
"play", Bool
True)
, (MisoString
"playing", Bool
True)
, (MisoString
"progress", Bool
True)
, (MisoString
"ratechange", Bool
True)
, (MisoString
"seeked", Bool
True)
, (MisoString
"seeking", Bool
True)
, (MisoString
"stalled", Bool
True)
, (MisoString
"suspend", Bool
True)
, (MisoString
"timeupdate", Bool
True)
, (MisoString
"volumechange", Bool
True)
, (MisoString
"waiting", Bool
True)
]