{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards   #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Miso.Event.Decoder
-- Copyright   :  (C) 2016-2018 David M. Johnson
-- License     :  BSD3-style (see the file LICENSE)
-- Maintainer  :  David M. Johnson <djohnson.m@gmail.com>
-- Stability   :  experimental
-- Portability :  non-portable
----------------------------------------------------------------------------
module Miso.Event.Decoder
  ( -- * Decoder
    Decoder (..)
  , DecodeTarget (..)
  , at
  -- * Decoders
  , 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 type representing path (consisting of field names) within event object, where a decoder should be applied.
data DecodeTarget
  = DecodeTarget [MisoString] -- ^ Specify single path within Event object, where a decoder should be applied.
  | DecodeTargets [[MisoString]] -- ^ Specify multiple paths withing Event object, where decoding should be attempted. The first path where decoding suceeds is the one taken.

-- | `ToJSVal` instance for `Decoder`
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

-- | Decoder data type for parsing events
data Decoder a = Decoder {
  Decoder a -> Value -> Parser a
decoder :: Value -> Parser a -- ^ FromJSON-based Event decoder
, Decoder a -> DecodeTarget
decodeAt :: DecodeTarget -- ^ Location in DOM of where to decode
}

-- | Smart constructor for building a `Decoder`.
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
..}

-- | Empty decoder for use with events like "click" that do not
-- return any meaningful values
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 ()

-- | Retrieves either "keyCode", "which" or "charCode" field in `Decoder`
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")

-- | Retrieves either "keyCode", "which" or "charCode" field in `Decoder`, along with shift, ctrl, meta and alt.
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"

-- | Retrieves "value" field in `Decoder`
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"

-- | Retrieves "checked" field in Decoder
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")