{-# LANGUAGE RankNTypes                #-}
{-# LANGUAGE OverloadedStrings         #-}
{-# LANGUAGE FlexibleContexts          #-}
{-# LANGUAGE FlexibleInstances         #-}
{-# LANGUAGE MultiParamTypeClasses     #-}
{-# LANGUAGE DataKinds                 #-}
{-# LANGUAGE KindSignatures            #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE CPP                       #-}
{-# LANGUAGE TypeFamilies              #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Miso.Html.Event
-- 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.Html.Event
  ( -- * Custom event handlers
    on
  , onWithOptions
  , Options (..)
  , defaultOptions
   -- * Mouse events
  , onClick
  , onDoubleClick
  , onMouseDown
  , onMouseUp
  , onMouseEnter
  , onMouseLeave
  , onMouseOver
  , onMouseOut
  -- * Keyboard events
  , onKeyDown
  , onKeyDownWithInfo
  , onKeyPress
  , onKeyUp
  -- * Form events
  , onInput
  , onChange
  , onChecked
  , onSubmit
  -- * Focus events
  , onBlur
  , onFocus
  -- * Drag events
  , onDrag
  , onDragLeave
  , onDragEnter
  , onDragEnd
  , onDragStart
  , onDragOver
  -- * Drop events
  , onDrop
  ) where

import Miso.Html.Types ( Attribute, on, onWithOptions )
import Miso.Event
import Miso.String (MisoString)

-- | `blur` event defined with custom options
--
-- <https://developer.mozilla.org/en-US/docs/Web/Events/blur>
--
onBlur :: action -> Attribute action
onBlur :: action -> Attribute action
onBlur action
action = MisoString -> Decoder () -> (() -> action) -> Attribute action
forall r action.
MisoString -> Decoder r -> (r -> action) -> Attribute action
on MisoString
"blur" Decoder ()
emptyDecoder ((() -> action) -> Attribute action)
-> (() -> action) -> Attribute action
forall a b. (a -> b) -> a -> b
$ \() -> action
action

-- | https://developer.mozilla.org/en-US/docs/Web/Events/change
onChecked :: (Checked -> action) -> Attribute action
onChecked :: (Checked -> action) -> Attribute action
onChecked = MisoString
-> Decoder Checked -> (Checked -> action) -> Attribute action
forall r action.
MisoString -> Decoder r -> (r -> action) -> Attribute action
on MisoString
"change" Decoder Checked
checkedDecoder

-- | https://developer.mozilla.org/en-US/docs/Web/Events/click
onClick :: action -> Attribute action
onClick :: action -> Attribute action
onClick action
action = MisoString -> Decoder () -> (() -> action) -> Attribute action
forall r action.
MisoString -> Decoder r -> (r -> action) -> Attribute action
on MisoString
"click" Decoder ()
emptyDecoder ((() -> action) -> Attribute action)
-> (() -> action) -> Attribute action
forall a b. (a -> b) -> a -> b
$ \() -> action
action

-- | https://developer.mozilla.org/en-US/docs/Web/Events/focus
onFocus :: action -> Attribute action
onFocus :: action -> Attribute action
onFocus action
action = MisoString -> Decoder () -> (() -> action) -> Attribute action
forall r action.
MisoString -> Decoder r -> (r -> action) -> Attribute action
on MisoString
"focus" Decoder ()
emptyDecoder ((() -> action) -> Attribute action)
-> (() -> action) -> Attribute action
forall a b. (a -> b) -> a -> b
$ \() -> action
action

-- | https://developer.mozilla.org/en-US/docs/Web/Events/dblclick
onDoubleClick :: action -> Attribute action
onDoubleClick :: action -> Attribute action
onDoubleClick action
action = MisoString -> Decoder () -> (() -> action) -> Attribute action
forall r action.
MisoString -> Decoder r -> (r -> action) -> Attribute action
on MisoString
"dblclick" Decoder ()
emptyDecoder ((() -> action) -> Attribute action)
-> (() -> action) -> Attribute action
forall a b. (a -> b) -> a -> b
$ \() -> action
action

-- | https://developer.mozilla.org/en-US/docs/Web/Events/input
onInput :: (MisoString -> action) -> Attribute action
onInput :: (MisoString -> action) -> Attribute action
onInput = MisoString
-> Decoder MisoString -> (MisoString -> action) -> Attribute action
forall r action.
MisoString -> Decoder r -> (r -> action) -> Attribute action
on MisoString
"input" Decoder MisoString
valueDecoder

-- | https://developer.mozilla.org/en-US/docs/Web/Events/change
onChange :: (MisoString -> action) -> Attribute action
onChange :: (MisoString -> action) -> Attribute action
onChange = MisoString
-> Decoder MisoString -> (MisoString -> action) -> Attribute action
forall r action.
MisoString -> Decoder r -> (r -> action) -> Attribute action
on MisoString
"change" Decoder MisoString
valueDecoder

-- | https://developer.mozilla.org/en-US/docs/Web/Events/keydown
onKeyDownWithInfo :: (KeyInfo -> action) -> Attribute action
onKeyDownWithInfo :: (KeyInfo -> action) -> Attribute action
onKeyDownWithInfo = MisoString
-> Decoder KeyInfo -> (KeyInfo -> action) -> Attribute action
forall r action.
MisoString -> Decoder r -> (r -> action) -> Attribute action
on MisoString
"keydown" Decoder KeyInfo
keyInfoDecoder

-- | https://developer.mozilla.org/en-US/docs/Web/Events/keydown
onKeyDown :: (KeyCode -> action) -> Attribute action
onKeyDown :: (KeyCode -> action) -> Attribute action
onKeyDown = MisoString
-> Decoder KeyCode -> (KeyCode -> action) -> Attribute action
forall r action.
MisoString -> Decoder r -> (r -> action) -> Attribute action
on MisoString
"keydown" Decoder KeyCode
keycodeDecoder

-- | https://developer.mozilla.org/en-US/docs/Web/Events/keypress
onKeyPress :: (KeyCode -> action) -> Attribute action
onKeyPress :: (KeyCode -> action) -> Attribute action
onKeyPress = MisoString
-> Decoder KeyCode -> (KeyCode -> action) -> Attribute action
forall r action.
MisoString -> Decoder r -> (r -> action) -> Attribute action
on MisoString
"keypress" Decoder KeyCode
keycodeDecoder

-- | https://developer.mozilla.org/en-US/docs/Web/Events/keyup
onKeyUp :: (KeyCode -> action) -> Attribute action
onKeyUp :: (KeyCode -> action) -> Attribute action
onKeyUp = MisoString
-> Decoder KeyCode -> (KeyCode -> action) -> Attribute action
forall r action.
MisoString -> Decoder r -> (r -> action) -> Attribute action
on MisoString
"keyup" Decoder KeyCode
keycodeDecoder

-- | https://developer.mozilla.org/en-US/docs/Web/Events/mouseup
onMouseUp :: action -> Attribute action
onMouseUp :: action -> Attribute action
onMouseUp action
action = MisoString -> Decoder () -> (() -> action) -> Attribute action
forall r action.
MisoString -> Decoder r -> (r -> action) -> Attribute action
on MisoString
"mouseup" Decoder ()
emptyDecoder ((() -> action) -> Attribute action)
-> (() -> action) -> Attribute action
forall a b. (a -> b) -> a -> b
$ \() -> action
action

-- | https://developer.mozilla.org/en-US/docs/Web/Events/mousedown
onMouseDown :: action -> Attribute action
onMouseDown :: action -> Attribute action
onMouseDown action
action = MisoString -> Decoder () -> (() -> action) -> Attribute action
forall r action.
MisoString -> Decoder r -> (r -> action) -> Attribute action
on MisoString
"mousedown" Decoder ()
emptyDecoder ((() -> action) -> Attribute action)
-> (() -> action) -> Attribute action
forall a b. (a -> b) -> a -> b
$ \() -> action
action

-- | https://developer.mozilla.org/en-US/docs/Web/Events/mouseenter
onMouseEnter :: action -> Attribute action
onMouseEnter :: action -> Attribute action
onMouseEnter action
action = MisoString -> Decoder () -> (() -> action) -> Attribute action
forall r action.
MisoString -> Decoder r -> (r -> action) -> Attribute action
on MisoString
"mouseenter" Decoder ()
emptyDecoder ((() -> action) -> Attribute action)
-> (() -> action) -> Attribute action
forall a b. (a -> b) -> a -> b
$ \() -> action
action

-- | https://developer.mozilla.org/en-US/docs/Web/Events/mouseleave
onMouseLeave :: action -> Attribute action
onMouseLeave :: action -> Attribute action
onMouseLeave action
action = MisoString -> Decoder () -> (() -> action) -> Attribute action
forall r action.
MisoString -> Decoder r -> (r -> action) -> Attribute action
on MisoString
"mouseleave" Decoder ()
emptyDecoder ((() -> action) -> Attribute action)
-> (() -> action) -> Attribute action
forall a b. (a -> b) -> a -> b
$ \() -> action
action

-- | https://developer.mozilla.org/en-US/docs/Web/Events/mouseover
onMouseOver :: action -> Attribute action
onMouseOver :: action -> Attribute action
onMouseOver action
action = MisoString -> Decoder () -> (() -> action) -> Attribute action
forall r action.
MisoString -> Decoder r -> (r -> action) -> Attribute action
on MisoString
"mouseover" Decoder ()
emptyDecoder ((() -> action) -> Attribute action)
-> (() -> action) -> Attribute action
forall a b. (a -> b) -> a -> b
$ \() -> action
action

-- | https://developer.mozilla.org/en-US/docs/Web/Events/mouseout
onMouseOut :: action -> Attribute action
onMouseOut :: action -> Attribute action
onMouseOut action
action = MisoString -> Decoder () -> (() -> action) -> Attribute action
forall r action.
MisoString -> Decoder r -> (r -> action) -> Attribute action
on MisoString
"mouseout" Decoder ()
emptyDecoder ((() -> action) -> Attribute action)
-> (() -> action) -> Attribute action
forall a b. (a -> b) -> a -> b
$ \() -> action
action

-- | https://developer.mozilla.org/en-US/docs/Web/Events/dragstart
onDragStart :: action -> Attribute action
onDragStart :: action -> Attribute action
onDragStart action
action = MisoString -> Decoder () -> (() -> action) -> Attribute action
forall r action.
MisoString -> Decoder r -> (r -> action) -> Attribute action
on MisoString
"dragstart" Decoder ()
emptyDecoder ((() -> action) -> Attribute action)
-> (() -> action) -> Attribute action
forall a b. (a -> b) -> a -> b
$ \() -> action
action

-- | https://developer.mozilla.org/en-US/docs/Web/Events/dragover
onDragOver :: action -> Attribute action
onDragOver :: action -> Attribute action
onDragOver action
action = MisoString -> Decoder () -> (() -> action) -> Attribute action
forall r action.
MisoString -> Decoder r -> (r -> action) -> Attribute action
on MisoString
"dragover" Decoder ()
emptyDecoder ((() -> action) -> Attribute action)
-> (() -> action) -> Attribute action
forall a b. (a -> b) -> a -> b
$ \() -> action
action

-- | https://developer.mozilla.org/en-US/docs/Web/Events/dragend
onDragEnd :: action -> Attribute action
onDragEnd :: action -> Attribute action
onDragEnd action
action = MisoString -> Decoder () -> (() -> action) -> Attribute action
forall r action.
MisoString -> Decoder r -> (r -> action) -> Attribute action
on MisoString
"dragend" Decoder ()
emptyDecoder ((() -> action) -> Attribute action)
-> (() -> action) -> Attribute action
forall a b. (a -> b) -> a -> b
$ \() -> action
action

-- | https://developer.mozilla.org/en-US/docs/Web/Events/dragenter
onDragEnter :: action -> Attribute action
onDragEnter :: action -> Attribute action
onDragEnter action
action = MisoString -> Decoder () -> (() -> action) -> Attribute action
forall r action.
MisoString -> Decoder r -> (r -> action) -> Attribute action
on MisoString
"dragenter" Decoder ()
emptyDecoder ((() -> action) -> Attribute action)
-> (() -> action) -> Attribute action
forall a b. (a -> b) -> a -> b
$ \() -> action
action

-- | https://developer.mozilla.org/en-US/docs/Web/Events/dragleave
onDragLeave :: action -> Attribute action
onDragLeave :: action -> Attribute action
onDragLeave action
action = MisoString -> Decoder () -> (() -> action) -> Attribute action
forall r action.
MisoString -> Decoder r -> (r -> action) -> Attribute action
on MisoString
"dragleave" Decoder ()
emptyDecoder ((() -> action) -> Attribute action)
-> (() -> action) -> Attribute action
forall a b. (a -> b) -> a -> b
$ \() -> action
action

-- | https://developer.mozilla.org/en-US/docs/Web/Events/drag
onDrag :: action -> Attribute action
onDrag :: action -> Attribute action
onDrag action
action = MisoString -> Decoder () -> (() -> action) -> Attribute action
forall r action.
MisoString -> Decoder r -> (r -> action) -> Attribute action
on MisoString
"drag" Decoder ()
emptyDecoder ((() -> action) -> Attribute action)
-> (() -> action) -> Attribute action
forall a b. (a -> b) -> a -> b
$ \() -> action
action

-- | https://developer.mozilla.org/en-US/docs/Web/Events/drop
onDrop :: AllowDrop -> action -> Attribute action
onDrop :: AllowDrop -> action -> Attribute action
onDrop (AllowDrop Bool
allowDrop) action
action =
  Options
-> MisoString -> Decoder () -> (() -> action) -> Attribute action
forall r action.
Options
-> MisoString -> Decoder r -> (r -> action) -> Attribute action
onWithOptions Options
defaultOptions { preventDefault :: Bool
preventDefault = Bool
allowDrop }
    MisoString
"drop" Decoder ()
emptyDecoder (\() -> action
action)

-- | https://developer.mozilla.org/en-US/docs/Web/Events/submit
onSubmit :: action -> Attribute action
onSubmit :: action -> Attribute action
onSubmit action
action =
  Options
-> MisoString -> Decoder () -> (() -> action) -> Attribute action
forall r action.
Options
-> MisoString -> Decoder r -> (r -> action) -> Attribute action
onWithOptions Options
defaultOptions { preventDefault :: Bool
preventDefault = Bool
True }
    MisoString
"submit" Decoder ()
emptyDecoder ((() -> action) -> Attribute action)
-> (() -> action) -> Attribute action
forall a b. (a -> b) -> a -> b
$ \() -> action
action