{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE DataKinds             #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE MultiParamTypeClasses #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Miso.Svg.Events
-- 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.Svg.Event
  ( -- * Animation event handlers
    onBegin
  , onEnd
  , onRepeat
    -- * Document event attributes
  , onAbort
  , onError
  , onResize
  , onScroll
  , onLoad
  , onUnload
  , onZoom
    -- * Graphical Event Attributes
  , onActivate
  , onClick
  , onFocusIn
  , onFocusOut
  , onMouseDown
  , onMouseMove
  , onMouseOut
  , onMouseOver
  , onMouseUp
  ) where

import Miso.Event 
import Miso.Html.Event (onClick)
import Miso.Html.Types

-- | onBegin event
onBegin :: action -> Attribute action
onBegin :: action -> Attribute action
onBegin action
action = MisoString -> Decoder () -> (() -> action) -> Attribute action
forall r action.
MisoString -> Decoder r -> (r -> action) -> Attribute action
on MisoString
"begin" Decoder ()
emptyDecoder ((() -> action) -> Attribute action)
-> (() -> action) -> Attribute action
forall a b. (a -> b) -> a -> b
$ \() -> action
action

-- | onEnd event
onEnd :: action -> Attribute action
onEnd :: action -> Attribute action
onEnd action
action = MisoString -> Decoder () -> (() -> action) -> Attribute action
forall r action.
MisoString -> Decoder r -> (r -> action) -> Attribute action
on MisoString
"end" Decoder ()
emptyDecoder ((() -> action) -> Attribute action)
-> (() -> action) -> Attribute action
forall a b. (a -> b) -> a -> b
$ \() -> action
action

-- | onRepeat event
onRepeat :: action -> Attribute action
onRepeat :: action -> Attribute action
onRepeat action
action = MisoString -> Decoder () -> (() -> action) -> Attribute action
forall r action.
MisoString -> Decoder r -> (r -> action) -> Attribute action
on MisoString
"repeat" Decoder ()
emptyDecoder ((() -> action) -> Attribute action)
-> (() -> action) -> Attribute action
forall a b. (a -> b) -> a -> b
$ \() -> action
action

-- | onAbort event
onAbort :: action -> Attribute action
onAbort :: action -> Attribute action
onAbort action
action = MisoString -> Decoder () -> (() -> action) -> Attribute action
forall r action.
MisoString -> Decoder r -> (r -> action) -> Attribute action
on MisoString
"abort" Decoder ()
emptyDecoder ((() -> action) -> Attribute action)
-> (() -> action) -> Attribute action
forall a b. (a -> b) -> a -> b
$ \() -> action
action

-- | onError event
onError :: action -> Attribute action
onError :: action -> Attribute action
onError action
action = MisoString -> Decoder () -> (() -> action) -> Attribute action
forall r action.
MisoString -> Decoder r -> (r -> action) -> Attribute action
on MisoString
"error" Decoder ()
emptyDecoder ((() -> action) -> Attribute action)
-> (() -> action) -> Attribute action
forall a b. (a -> b) -> a -> b
$ \() -> action
action

-- | onResize event
onResize :: action -> Attribute action
onResize :: action -> Attribute action
onResize action
action = MisoString -> Decoder () -> (() -> action) -> Attribute action
forall r action.
MisoString -> Decoder r -> (r -> action) -> Attribute action
on MisoString
"resize" Decoder ()
emptyDecoder ((() -> action) -> Attribute action)
-> (() -> action) -> Attribute action
forall a b. (a -> b) -> a -> b
$ \() -> action
action

-- | onScroll event
onScroll :: action -> Attribute action
onScroll :: action -> Attribute action
onScroll action
action = MisoString -> Decoder () -> (() -> action) -> Attribute action
forall r action.
MisoString -> Decoder r -> (r -> action) -> Attribute action
on MisoString
"scroll" Decoder ()
emptyDecoder ((() -> action) -> Attribute action)
-> (() -> action) -> Attribute action
forall a b. (a -> b) -> a -> b
$ \() -> action
action

-- | onLoad event
onLoad :: action -> Attribute action
onLoad :: action -> Attribute action
onLoad action
action = MisoString -> Decoder () -> (() -> action) -> Attribute action
forall r action.
MisoString -> Decoder r -> (r -> action) -> Attribute action
on MisoString
"load" Decoder ()
emptyDecoder ((() -> action) -> Attribute action)
-> (() -> action) -> Attribute action
forall a b. (a -> b) -> a -> b
$ \() -> action
action

-- | onUnload event
onUnload :: action -> Attribute action
onUnload :: action -> Attribute action
onUnload action
action = MisoString -> Decoder () -> (() -> action) -> Attribute action
forall r action.
MisoString -> Decoder r -> (r -> action) -> Attribute action
on MisoString
"unload" Decoder ()
emptyDecoder ((() -> action) -> Attribute action)
-> (() -> action) -> Attribute action
forall a b. (a -> b) -> a -> b
$ \() -> action
action

-- | onZoom event
onZoom :: action -> Attribute action
onZoom :: action -> Attribute action
onZoom action
action = MisoString -> Decoder () -> (() -> action) -> Attribute action
forall r action.
MisoString -> Decoder r -> (r -> action) -> Attribute action
on MisoString
"zoom" Decoder ()
emptyDecoder ((() -> action) -> Attribute action)
-> (() -> action) -> Attribute action
forall a b. (a -> b) -> a -> b
$ \() -> action
action

-- | onActivate event
onActivate :: action -> Attribute action
onActivate :: action -> Attribute action
onActivate action
action = MisoString -> Decoder () -> (() -> action) -> Attribute action
forall r action.
MisoString -> Decoder r -> (r -> action) -> Attribute action
on MisoString
"activate" Decoder ()
emptyDecoder ((() -> action) -> Attribute action)
-> (() -> action) -> Attribute action
forall a b. (a -> b) -> a -> b
$ \() -> action
action

-- | onFocusIn event
onFocusIn :: action -> Attribute action
onFocusIn :: action -> Attribute action
onFocusIn action
action = MisoString -> Decoder () -> (() -> action) -> Attribute action
forall r action.
MisoString -> Decoder r -> (r -> action) -> Attribute action
on MisoString
"focusin" Decoder ()
emptyDecoder ((() -> action) -> Attribute action)
-> (() -> action) -> Attribute action
forall a b. (a -> b) -> a -> b
$ \() -> action
action

-- | onFocusOut event
onFocusOut :: action -> Attribute action
onFocusOut :: action -> Attribute action
onFocusOut action
action = MisoString -> Decoder () -> (() -> action) -> Attribute action
forall r action.
MisoString -> Decoder r -> (r -> action) -> Attribute action
on MisoString
"focusout" Decoder ()
emptyDecoder ((() -> action) -> Attribute action)
-> (() -> action) -> Attribute action
forall a b. (a -> b) -> a -> b
$ \() -> action
action

-- | onMouseDown event
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
-- | onMouseMove event
onMouseMove :: action -> Attribute action
onMouseMove :: action -> Attribute action
onMouseMove action
action = MisoString -> Decoder () -> (() -> action) -> Attribute action
forall r action.
MisoString -> Decoder r -> (r -> action) -> Attribute action
on MisoString
"mousemove" Decoder ()
emptyDecoder ((() -> action) -> Attribute action)
-> (() -> action) -> Attribute action
forall a b. (a -> b) -> a -> b
$ \() -> action
action

-- | onMouseOut event
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

-- | onMouseOver event
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

-- | onMouseUp event
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