{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module Miso.Event.Decoder
(
Decoder (..)
, DecodeTarget (..)
, at
, emptyDecoder
, keycodeDecoder
, keyInfoDecoder
, checkedDecoder
, valueDecoder
)
where
import Data.Aeson.Types
import Control.Applicative
import GHCJS.Marshal (ToJSVal, toJSVal)
import Miso.Event.Types
import Miso.String
data DecodeTarget
= DecodeTarget [MisoString]
| DecodeTargets [[MisoString]]
instance ToJSVal DecodeTarget where
toJSVal :: DecodeTarget -> JSM JSVal
toJSVal (DecodeTarget [MisoString]
xs) = [MisoString] -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal [MisoString]
xs
toJSVal (DecodeTargets [[MisoString]]
xs) = [[MisoString]] -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal [[MisoString]]
xs
data Decoder a = Decoder {
Decoder a -> Value -> Parser a
decoder :: Value -> Parser a
, Decoder a -> DecodeTarget
decodeAt :: DecodeTarget
}
at :: [MisoString] -> (Value -> Parser a) -> Decoder a
at :: [MisoString] -> (Value -> Parser a) -> Decoder a
at [MisoString]
decodeAt Value -> Parser a
decoder = Decoder :: forall a. (Value -> Parser a) -> DecodeTarget -> Decoder a
Decoder {decodeAt :: DecodeTarget
decodeAt = [MisoString] -> DecodeTarget
DecodeTarget [MisoString]
decodeAt, Value -> Parser a
decoder :: Value -> Parser a
decoder :: Value -> Parser a
..}
emptyDecoder :: Decoder ()
emptyDecoder :: Decoder ()
emptyDecoder = [MisoString]
forall a. Monoid a => a
mempty [MisoString] -> (Value -> Parser ()) -> Decoder ()
forall a. [MisoString] -> (Value -> Parser a) -> Decoder a
`at` Value -> Parser ()
go
where
go :: Value -> Parser ()
go = String -> (Object -> Parser ()) -> Value -> Parser ()
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"emptyDecoder" ((Object -> Parser ()) -> Value -> Parser ())
-> (Object -> Parser ()) -> Value -> Parser ()
forall a b. (a -> b) -> a -> b
$ \Object
_ -> () -> Parser ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
keycodeDecoder :: Decoder KeyCode
keycodeDecoder :: Decoder KeyCode
keycodeDecoder = Decoder :: forall a. (Value -> Parser a) -> DecodeTarget -> Decoder a
Decoder {DecodeTarget
Value -> Parser KeyCode
decoder :: Value -> Parser KeyCode
decodeAt :: DecodeTarget
decodeAt :: DecodeTarget
decoder :: Value -> Parser KeyCode
..}
where
decodeAt :: DecodeTarget
decodeAt = [MisoString] -> DecodeTarget
DecodeTarget [MisoString]
forall a. Monoid a => a
mempty
decoder :: Value -> Parser KeyCode
decoder = String -> (Object -> Parser KeyCode) -> Value -> Parser KeyCode
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"event" ((Object -> Parser KeyCode) -> Value -> Parser KeyCode)
-> (Object -> Parser KeyCode) -> Value -> Parser KeyCode
forall a b. (a -> b) -> a -> b
$ \Object
o ->
Int -> KeyCode
KeyCode (Int -> KeyCode) -> Parser Int -> Parser KeyCode
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> MisoString -> Parser Int
forall a. FromJSON a => Object -> MisoString -> Parser a
.: MisoString
"keyCode" Parser Int -> Parser Int -> Parser Int
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Object
o Object -> MisoString -> Parser Int
forall a. FromJSON a => Object -> MisoString -> Parser a
.: MisoString
"which" Parser Int -> Parser Int -> Parser Int
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Object
o Object -> MisoString -> Parser Int
forall a. FromJSON a => Object -> MisoString -> Parser a
.: MisoString
"charCode")
keyInfoDecoder :: Decoder KeyInfo
keyInfoDecoder :: Decoder KeyInfo
keyInfoDecoder = Decoder :: forall a. (Value -> Parser a) -> DecodeTarget -> Decoder a
Decoder {DecodeTarget
Value -> Parser KeyInfo
decoder :: Value -> Parser KeyInfo
decodeAt :: DecodeTarget
decodeAt :: DecodeTarget
decoder :: Value -> Parser KeyInfo
..}
where
decodeAt :: DecodeTarget
decodeAt = [MisoString] -> DecodeTarget
DecodeTarget [MisoString]
forall a. Monoid a => a
mempty
decoder :: Value -> Parser KeyInfo
decoder =
String -> (Object -> Parser KeyInfo) -> Value -> Parser KeyInfo
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"event" ((Object -> Parser KeyInfo) -> Value -> Parser KeyInfo)
-> (Object -> Parser KeyInfo) -> Value -> Parser KeyInfo
forall a b. (a -> b) -> a -> b
$ \Object
o ->
KeyCode -> Bool -> Bool -> Bool -> Bool -> KeyInfo
KeyInfo (KeyCode -> Bool -> Bool -> Bool -> Bool -> KeyInfo)
-> Parser KeyCode
-> Parser (Bool -> Bool -> Bool -> Bool -> KeyInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> MisoString -> Parser KeyCode
forall a. FromJSON a => Object -> MisoString -> Parser a
.: MisoString
"keyCode" Parser KeyCode -> Parser KeyCode -> Parser KeyCode
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Object
o Object -> MisoString -> Parser KeyCode
forall a. FromJSON a => Object -> MisoString -> Parser a
.: MisoString
"which" Parser KeyCode -> Parser KeyCode -> Parser KeyCode
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Object
o Object -> MisoString -> Parser KeyCode
forall a. FromJSON a => Object -> MisoString -> Parser a
.: MisoString
"charCode")
Parser (Bool -> Bool -> Bool -> Bool -> KeyInfo)
-> Parser Bool -> Parser (Bool -> Bool -> Bool -> KeyInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> MisoString -> Parser Bool
forall a. FromJSON a => Object -> MisoString -> Parser a
.: MisoString
"shiftKey"
Parser (Bool -> Bool -> Bool -> KeyInfo)
-> Parser Bool -> Parser (Bool -> Bool -> KeyInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> MisoString -> Parser Bool
forall a. FromJSON a => Object -> MisoString -> Parser a
.: MisoString
"metaKey"
Parser (Bool -> Bool -> KeyInfo)
-> Parser Bool -> Parser (Bool -> KeyInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> MisoString -> Parser Bool
forall a. FromJSON a => Object -> MisoString -> Parser a
.: MisoString
"ctrlKey"
Parser (Bool -> KeyInfo) -> Parser Bool -> Parser KeyInfo
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> MisoString -> Parser Bool
forall a. FromJSON a => Object -> MisoString -> Parser a
.: MisoString
"altKey"
valueDecoder :: Decoder MisoString
valueDecoder :: Decoder MisoString
valueDecoder = Decoder :: forall a. (Value -> Parser a) -> DecodeTarget -> Decoder a
Decoder {DecodeTarget
Value -> Parser MisoString
decoder :: Value -> Parser MisoString
decodeAt :: DecodeTarget
decodeAt :: DecodeTarget
decoder :: Value -> Parser MisoString
..}
where
decodeAt :: DecodeTarget
decodeAt = [MisoString] -> DecodeTarget
DecodeTarget [MisoString
"target"]
decoder :: Value -> Parser MisoString
decoder = String
-> (Object -> Parser MisoString) -> Value -> Parser MisoString
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"target" ((Object -> Parser MisoString) -> Value -> Parser MisoString)
-> (Object -> Parser MisoString) -> Value -> Parser MisoString
forall a b. (a -> b) -> a -> b
$ \Object
o -> Object
o Object -> MisoString -> Parser MisoString
forall a. FromJSON a => Object -> MisoString -> Parser a
.: MisoString
"value"
checkedDecoder :: Decoder Checked
checkedDecoder :: Decoder Checked
checkedDecoder = Decoder :: forall a. (Value -> Parser a) -> DecodeTarget -> Decoder a
Decoder {DecodeTarget
Value -> Parser Checked
decoder :: Value -> Parser Checked
decodeAt :: DecodeTarget
decodeAt :: DecodeTarget
decoder :: Value -> Parser Checked
..}
where
decodeAt :: DecodeTarget
decodeAt = [MisoString] -> DecodeTarget
DecodeTarget [MisoString
"target"]
decoder :: Value -> Parser Checked
decoder = String -> (Object -> Parser Checked) -> Value -> Parser Checked
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"target" ((Object -> Parser Checked) -> Value -> Parser Checked)
-> (Object -> Parser Checked) -> Value -> Parser Checked
forall a b. (a -> b) -> a -> b
$ \Object
o ->
Bool -> Checked
Checked (Bool -> Checked) -> Parser Bool -> Parser Checked
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> MisoString -> Parser Bool
forall a. FromJSON a => Object -> MisoString -> Parser a
.: MisoString
"checked")