{-# LANGUAGE CPP #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RecursiveDo #-}
{-# LANGUAGE ScopedTypeVariables #-}
#ifdef USE_TEMPLATE_HASKELL
{-# LANGUAGE TemplateHaskell #-}
#endif
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
module Reflex.Dom.Widget.Input (module Reflex.Dom.Widget.Input, def, (&), (.~)) where
import Prelude
import Control.Lens hiding (element, ix)
import Control.Monad
import Control.Monad.Fix
import Control.Monad.IO.Class
import Control.Monad.Reader
import qualified Data.Bimap as Bimap
import Data.Default
import Data.Dependent.Map (DMap)
import qualified Data.Dependent.Map as DMap
import Data.Functor.Misc
import Data.Kind (Type)
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Maybe
import Data.Text (Text)
import qualified Data.Text as T
import GHCJS.DOM.HTMLInputElement (HTMLInputElement)
import GHCJS.DOM.HTMLTextAreaElement (HTMLTextAreaElement)
import GHCJS.DOM.Types (MonadJSM, File, uncheckedCastTo)
import qualified GHCJS.DOM.Types as DOM (HTMLElement(..), EventTarget(..))
import Reflex.Class
import Reflex.Collection
import Reflex.Dom.Builder.Class
import Reflex.Dom.Builder.Immediate
import Reflex.Dom.Class
import Reflex.Dom.Widget.Basic
import Reflex.Dynamic
import Reflex.PostBuild.Class
import Reflex.TriggerEvent.Class
import qualified Text.Read as T
import qualified GHCJS.DOM.Event as Event
import qualified GHCJS.DOM.HTMLInputElement as Input
{-# DEPRECATED TextInput, _textInput_element, TextInputConfig, textInput "Use 'inputElement' directly" #-}
data TextInput t
= TextInput { forall {k1} (t :: k1). TextInput t -> Dynamic t Text
_textInput_value :: Dynamic t Text
, forall {k1} (t :: k1). TextInput t -> Event t Text
_textInput_input :: Event t Text
, forall {k1} (t :: k1). TextInput t -> Event t Word
_textInput_keypress :: Event t Word
, forall {k1} (t :: k1). TextInput t -> Event t Word
_textInput_keydown :: Event t Word
, forall {k1} (t :: k1). TextInput t -> Event t Word
_textInput_keyup :: Event t Word
, forall {k1} (t :: k1). TextInput t -> Dynamic t Bool
_textInput_hasFocus :: Dynamic t Bool
, forall {k1} (t :: k1).
TextInput t -> InputElement EventResult GhcjsDomSpace t
_textInput_builderElement :: InputElement EventResult GhcjsDomSpace t
}
_textInput_element :: TextInput t -> HTMLInputElement
_textInput_element :: forall {k1} (t :: k1). TextInput t -> HTMLInputElement
_textInput_element = InputElement EventResult GhcjsDomSpace t -> HTMLInputElement
InputElement EventResult GhcjsDomSpace t
-> RawInputElement GhcjsDomSpace
forall {k1} {k2} (er :: EventTag -> *) (d :: k1) (t :: k2).
InputElement er d t -> RawInputElement d
_inputElement_raw (InputElement EventResult GhcjsDomSpace t -> HTMLInputElement)
-> (TextInput t -> InputElement EventResult GhcjsDomSpace t)
-> TextInput t
-> HTMLInputElement
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextInput t -> InputElement EventResult GhcjsDomSpace t
forall {k1} (t :: k1).
TextInput t -> InputElement EventResult GhcjsDomSpace t
_textInput_builderElement
instance Reflex t => HasDomEvent t (TextInput t) en where
type DomEventType (TextInput t) en = DomEventType (InputElement EventResult GhcjsDomSpace t) en
domEvent :: EventName en
-> TextInput t -> Event t (DomEventType (TextInput t) en)
domEvent EventName en
en = EventName en
-> InputElement EventResult GhcjsDomSpace t
-> Event
t (DomEventType (InputElement EventResult GhcjsDomSpace t) en)
forall {k} (t :: k) target (eventName :: EventTag).
HasDomEvent t target eventName =>
EventName eventName
-> target -> Event t (DomEventType target eventName)
domEvent EventName en
en (InputElement EventResult GhcjsDomSpace t
-> Event t (EventResultType en))
-> (TextInput t -> InputElement EventResult GhcjsDomSpace t)
-> TextInput t
-> Event t (EventResultType en)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextInput t -> InputElement EventResult GhcjsDomSpace t
forall {k1} (t :: k1).
TextInput t -> InputElement EventResult GhcjsDomSpace t
_textInput_builderElement
data TextInputConfig t
= TextInputConfig { forall {k} (t :: k). TextInputConfig t -> Text
_textInputConfig_inputType :: Text
, forall {k} (t :: k). TextInputConfig t -> Text
_textInputConfig_initialValue :: Text
, forall {k} (t :: k). TextInputConfig t -> Event t Text
_textInputConfig_setValue :: Event t Text
, forall {k} (t :: k). TextInputConfig t -> Dynamic t (Map Text Text)
_textInputConfig_attributes :: Dynamic t (Map Text Text)
}
instance Reflex t => Default (TextInputConfig t) where
{-# INLINABLE def #-}
def :: TextInputConfig t
def = TextInputConfig { _textInputConfig_inputType :: Text
_textInputConfig_inputType = Text
"text"
, _textInputConfig_initialValue :: Text
_textInputConfig_initialValue = Text
""
, _textInputConfig_setValue :: Event t Text
_textInputConfig_setValue = Event t Text
forall a. Event t a
forall {k} (t :: k) a. Reflex t => Event t a
never
, _textInputConfig_attributes :: Dynamic t (Map Text Text)
_textInputConfig_attributes = Map Text Text -> Dynamic t (Map Text Text)
forall {k} (t :: k) a. Reflex t => a -> Dynamic t a
constDyn Map Text Text
forall a. Monoid a => a
mempty
}
{-# INLINABLE textInput #-}
textInput :: (DomBuilder t m, PostBuild t m, DomBuilderSpace m ~ GhcjsDomSpace) => TextInputConfig t -> m (TextInput t)
textInput :: forall t (m :: * -> *).
(DomBuilder t m, PostBuild t m,
DomBuilderSpace m ~ GhcjsDomSpace) =>
TextInputConfig t -> m (TextInput t)
textInput (TextInputConfig Text
inputType Text
initial Event t Text
eSetValue Dynamic t (Map Text Text)
dAttrs) = do
modifyAttrs <- Dynamic t (Map Text Text) -> m (Event t (Map Text (Maybe Text)))
forall k t (m :: * -> *).
(Ord k, PostBuild t m) =>
Dynamic t (Map k Text) -> m (Event t (Map k (Maybe Text)))
dynamicAttributesToModifyAttributes (Dynamic t (Map Text Text) -> m (Event t (Map Text (Maybe Text))))
-> Dynamic t (Map Text Text) -> m (Event t (Map Text (Maybe Text)))
forall a b. (a -> b) -> a -> b
$ (Map Text Text -> Map Text Text)
-> Dynamic t (Map Text Text) -> Dynamic t (Map Text Text)
forall a b. (a -> b) -> Dynamic t a -> Dynamic t b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> Text -> Map Text Text -> Map Text Text
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Text
"type" Text
inputType) Dynamic t (Map Text Text)
dAttrs
i <- inputElement $ def
& inputElementConfig_initialValue .~ initial
& inputElementConfig_setValue .~ eSetValue
& inputElementConfig_elementConfig . elementConfig_modifyAttributes .~ fmap mapKeysToAttributeName modifyAttrs
return $ TextInput
{ _textInput_value = _inputElement_value i
, _textInput_input = _inputElement_input i
, _textInput_keypress = domEvent Keypress i
, _textInput_keydown = domEvent Keydown i
, _textInput_keyup = domEvent Keyup i
, _textInput_hasFocus = _inputElement_hasFocus i
, _textInput_builderElement = i
}
{-# INLINE textInputGetEnter #-}
{-# DEPRECATED textInputGetEnter "Use 'keypress Enter' instead" #-}
textInputGetEnter :: Reflex t => TextInput t -> Event t ()
textInputGetEnter :: forall {k} (t :: k). Reflex t => TextInput t -> Event t ()
textInputGetEnter = Key -> TextInput t -> Event t ()
forall {k} (t :: k) e.
(Reflex t, HasDomEvent t e 'KeypressTag,
DomEventType e 'KeypressTag ~ Word) =>
Key -> e -> Event t ()
keypress Key
Enter
{-# INLINABLE keypress #-}
keypress :: (Reflex t, HasDomEvent t e 'KeypressTag, DomEventType e 'KeypressTag ~ Word) => Key -> e -> Event t ()
keypress :: forall {k} (t :: k) e.
(Reflex t, HasDomEvent t e 'KeypressTag,
DomEventType e 'KeypressTag ~ Word) =>
Key -> e -> Event t ()
keypress Key
key = (Word -> Maybe ()) -> Event t Word -> Event t ()
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
fmapMaybe (\Word
n -> Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ KeyCode -> Key
keyCodeLookup (Word -> KeyCode
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
n) Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
== Key
key) (Event t Word -> Event t ())
-> (e -> Event t Word) -> e -> Event t ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EventName 'KeypressTag
-> e -> Event t (DomEventType e 'KeypressTag)
forall {k} (t :: k) target (eventName :: EventTag).
HasDomEvent t target eventName =>
EventName eventName
-> target -> Event t (DomEventType target eventName)
domEvent EventName 'KeypressTag
Keypress
{-# INLINABLE keydown #-}
keydown :: (Reflex t, HasDomEvent t e 'KeydownTag, DomEventType e 'KeydownTag ~ Word) => Key -> e -> Event t ()
keydown :: forall {k} (t :: k) e.
(Reflex t, HasDomEvent t e 'KeydownTag,
DomEventType e 'KeydownTag ~ Word) =>
Key -> e -> Event t ()
keydown Key
key = (Word -> Maybe ()) -> Event t Word -> Event t ()
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
fmapMaybe (\Word
n -> Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ KeyCode -> Key
keyCodeLookup (Word -> KeyCode
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
n) Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
== Key
key) (Event t Word -> Event t ())
-> (e -> Event t Word) -> e -> Event t ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EventName 'KeydownTag -> e -> Event t (DomEventType e 'KeydownTag)
forall {k} (t :: k) target (eventName :: EventTag).
HasDomEvent t target eventName =>
EventName eventName
-> target -> Event t (DomEventType target eventName)
domEvent EventName 'KeydownTag
Keydown
{-# INLINABLE keyup #-}
keyup :: (Reflex t, HasDomEvent t e 'KeyupTag, DomEventType e 'KeyupTag ~ Word) => Key -> e -> Event t ()
keyup :: forall {k} (t :: k) e.
(Reflex t, HasDomEvent t e 'KeyupTag,
DomEventType e 'KeyupTag ~ Word) =>
Key -> e -> Event t ()
keyup Key
key = (Word -> Maybe ()) -> Event t Word -> Event t ()
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
fmapMaybe (\Word
n -> Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ KeyCode -> Key
keyCodeLookup (Word -> KeyCode
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
n) Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
== Key
key) (Event t Word -> Event t ())
-> (e -> Event t Word) -> e -> Event t ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EventName 'KeyupTag -> e -> Event t (DomEventType e 'KeyupTag)
forall {k} (t :: k) target (eventName :: EventTag).
HasDomEvent t target eventName =>
EventName eventName
-> target -> Event t (DomEventType target eventName)
domEvent EventName 'KeyupTag
Keyup
data RangeInputConfig t
= RangeInputConfig { forall {k} (t :: k). RangeInputConfig t -> Float
_rangeInputConfig_initialValue :: Float
, forall {k} (t :: k). RangeInputConfig t -> Event t Float
_rangeInputConfig_setValue :: Event t Float
, forall {k} (t :: k).
RangeInputConfig t -> Dynamic t (Map Text Text)
_rangeInputConfig_attributes :: Dynamic t (Map Text Text)
}
instance Reflex t => Default (RangeInputConfig t) where
{-# INLINABLE def #-}
def :: RangeInputConfig t
def = RangeInputConfig { _rangeInputConfig_initialValue :: Float
_rangeInputConfig_initialValue = Float
0
, _rangeInputConfig_setValue :: Event t Float
_rangeInputConfig_setValue = Event t Float
forall a. Event t a
forall {k} (t :: k) a. Reflex t => Event t a
never
, _rangeInputConfig_attributes :: Dynamic t (Map Text Text)
_rangeInputConfig_attributes = Map Text Text -> Dynamic t (Map Text Text)
forall {k} (t :: k) a. Reflex t => a -> Dynamic t a
constDyn Map Text Text
forall a. Monoid a => a
mempty
}
data RangeInput t
= RangeInput { forall {k} (t :: k). RangeInput t -> Dynamic t Float
_rangeInput_value :: Dynamic t Float
, forall {k} (t :: k). RangeInput t -> Event t Float
_rangeInput_input :: Event t Float
, forall {k} (t :: k). RangeInput t -> Event t (KeyCode, KeyCode)
_rangeInput_mouseup :: Event t (Int, Int)
, forall {k} (t :: k). RangeInput t -> Dynamic t Bool
_rangeInput_hasFocus :: Dynamic t Bool
, forall {k} (t :: k). RangeInput t -> HTMLInputElement
_rangeInput_element :: HTMLInputElement
}
{-# INLINABLE rangeInput #-}
rangeInput :: (DomBuilder t m, PostBuild t m, DomBuilderSpace m ~ GhcjsDomSpace) => RangeInputConfig t -> m (RangeInput t)
rangeInput :: forall t (m :: * -> *).
(DomBuilder t m, PostBuild t m,
DomBuilderSpace m ~ GhcjsDomSpace) =>
RangeInputConfig t -> m (RangeInput t)
rangeInput (RangeInputConfig Float
initial Event t Float
eSetValue Dynamic t (Map Text Text)
dAttrs) = do
modifyAttrs <- Dynamic t (Map Text Text) -> m (Event t (Map Text (Maybe Text)))
forall k t (m :: * -> *).
(Ord k, PostBuild t m) =>
Dynamic t (Map k Text) -> m (Event t (Map k (Maybe Text)))
dynamicAttributesToModifyAttributes (Dynamic t (Map Text Text) -> m (Event t (Map Text (Maybe Text))))
-> Dynamic t (Map Text Text) -> m (Event t (Map Text (Maybe Text)))
forall a b. (a -> b) -> a -> b
$ (Map Text Text -> Map Text Text)
-> Dynamic t (Map Text Text) -> Dynamic t (Map Text Text)
forall a b. (a -> b) -> Dynamic t a -> Dynamic t b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> Text -> Map Text Text -> Map Text Text
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Text
"type" Text
"range") Dynamic t (Map Text Text)
dAttrs
i <- inputElement $ def
& inputElementConfig_initialValue .~ (T.pack . show $ initial)
& inputElementConfig_setValue .~ (T.pack . show <$> eSetValue)
& inputElementConfig_elementConfig . elementConfig_modifyAttributes .~ fmap mapKeysToAttributeName modifyAttrs
return $ RangeInput
{ _rangeInput_value = read . T.unpack <$> _inputElement_value i
, _rangeInput_input = read . T.unpack <$> _inputElement_input i
, _rangeInput_mouseup = domEvent Mouseup i
, _rangeInput_hasFocus = _inputElement_hasFocus i
, _rangeInput_element = _inputElement_raw i
}
{-# DEPRECATED TextAreaConfig, TextArea, textArea "Use 'textAreaElement' directly" #-}
data TextAreaConfig t
= TextAreaConfig { forall {k} (t :: k). TextAreaConfig t -> Text
_textAreaConfig_initialValue :: Text
, forall {k} (t :: k). TextAreaConfig t -> Event t Text
_textAreaConfig_setValue :: Event t Text
, forall {k} (t :: k). TextAreaConfig t -> Dynamic t (Map Text Text)
_textAreaConfig_attributes :: Dynamic t (Map Text Text)
}
instance Reflex t => Default (TextAreaConfig t) where
{-# INLINABLE def #-}
def :: TextAreaConfig t
def = TextAreaConfig { _textAreaConfig_initialValue :: Text
_textAreaConfig_initialValue = Text
""
, _textAreaConfig_setValue :: Event t Text
_textAreaConfig_setValue = Event t Text
forall a. Event t a
forall {k} (t :: k) a. Reflex t => Event t a
never
, _textAreaConfig_attributes :: Dynamic t (Map Text Text)
_textAreaConfig_attributes = Map Text Text -> Dynamic t (Map Text Text)
forall {k} (t :: k) a. Reflex t => a -> Dynamic t a
constDyn Map Text Text
forall a. Monoid a => a
mempty
}
data TextArea t
= TextArea { forall {k} (t :: k). TextArea t -> Dynamic t Text
_textArea_value :: Dynamic t Text
, forall {k} (t :: k). TextArea t -> Event t Text
_textArea_input :: Event t Text
, forall {k} (t :: k). TextArea t -> Dynamic t Bool
_textArea_hasFocus :: Dynamic t Bool
, forall {k} (t :: k). TextArea t -> Event t Word
_textArea_keypress :: Event t Word
, forall {k} (t :: k). TextArea t -> HTMLTextAreaElement
_textArea_element :: HTMLTextAreaElement
}
{-# INLINABLE textArea #-}
textArea :: (DomBuilder t m, PostBuild t m, DomBuilderSpace m ~ GhcjsDomSpace) => TextAreaConfig t -> m (TextArea t)
textArea :: forall t (m :: * -> *).
(DomBuilder t m, PostBuild t m,
DomBuilderSpace m ~ GhcjsDomSpace) =>
TextAreaConfig t -> m (TextArea t)
textArea (TextAreaConfig Text
initial Event t Text
eSet Dynamic t (Map Text Text)
attrs) = do
modifyAttrs <- Dynamic t (Map Text Text) -> m (Event t (Map Text (Maybe Text)))
forall k t (m :: * -> *).
(Ord k, PostBuild t m) =>
Dynamic t (Map k Text) -> m (Event t (Map k (Maybe Text)))
dynamicAttributesToModifyAttributes Dynamic t (Map Text Text)
attrs
i <- textAreaElement $ def
& textAreaElementConfig_initialValue .~ initial
& textAreaElementConfig_setValue .~ eSet
& textAreaElementConfig_elementConfig . elementConfig_modifyAttributes .~ fmap mapKeysToAttributeName modifyAttrs
return $ TextArea
{ _textArea_value = _textAreaElement_value i
, _textArea_input = _textAreaElement_input i
, _textArea_keypress = domEvent Keypress i
, _textArea_hasFocus = _textAreaElement_hasFocus i
, _textArea_element = _textAreaElement_raw i
}
{-# DEPRECATED CheckboxConfig, Checkbox, checkbox, checkboxView, CheckboxViewEventResultType, regularToCheckboxViewEventType, CheckboxViewEventResult "Use 'inputElement' directly" #-}
data CheckboxConfig t
= CheckboxConfig { forall {k} (t :: k). CheckboxConfig t -> Event t Bool
_checkboxConfig_setValue :: Event t Bool
, forall {k} (t :: k). CheckboxConfig t -> Dynamic t (Map Text Text)
_checkboxConfig_attributes :: Dynamic t (Map Text Text)
}
instance Reflex t => Default (CheckboxConfig t) where
{-# INLINABLE def #-}
def :: CheckboxConfig t
def = CheckboxConfig { _checkboxConfig_setValue :: Event t Bool
_checkboxConfig_setValue = Event t Bool
forall a. Event t a
forall {k} (t :: k) a. Reflex t => Event t a
never
, _checkboxConfig_attributes :: Dynamic t (Map Text Text)
_checkboxConfig_attributes = Map Text Text -> Dynamic t (Map Text Text)
forall {k} (t :: k) a. Reflex t => a -> Dynamic t a
constDyn Map Text Text
forall a. Monoid a => a
mempty
}
data Checkbox t
= Checkbox { forall {k} (t :: k). Checkbox t -> Dynamic t Bool
_checkbox_value :: Dynamic t Bool
, forall {k} (t :: k). Checkbox t -> Event t Bool
_checkbox_change :: Event t Bool
}
{-# INLINABLE checkbox #-}
checkbox :: (DomBuilder t m, PostBuild t m) => Bool -> CheckboxConfig t -> m (Checkbox t)
checkbox :: forall t (m :: * -> *).
(DomBuilder t m, PostBuild t m) =>
Bool -> CheckboxConfig t -> m (Checkbox t)
checkbox Bool
checked CheckboxConfig t
config = do
let permanentAttrs :: Map Text Text
permanentAttrs = Index (Map Text Text)
"type" Index (Map Text Text) -> IxValue (Map Text Text) -> Map Text Text
forall m. (At m, Monoid m) => Index m -> IxValue m -> m
=: IxValue (Map Text Text)
"checkbox"
dAttrs :: Dynamic t (Map Text Text)
dAttrs = Text -> Map Text Text -> Map Text Text
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete Text
"checked" (Map Text Text -> Map Text Text)
-> (Map Text Text -> Map Text Text)
-> Map Text Text
-> Map Text Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Text Text -> Map Text Text -> Map Text Text
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union Map Text Text
permanentAttrs (Map Text Text -> Map Text Text)
-> Dynamic t (Map Text Text) -> Dynamic t (Map Text Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CheckboxConfig t -> Dynamic t (Map Text Text)
forall {k} (t :: k). CheckboxConfig t -> Dynamic t (Map Text Text)
_checkboxConfig_attributes CheckboxConfig t
config
modifyAttrs <- Dynamic t (Map Text Text) -> m (Event t (Map Text (Maybe Text)))
forall k t (m :: * -> *).
(Ord k, PostBuild t m) =>
Dynamic t (Map k Text) -> m (Event t (Map k (Maybe Text)))
dynamicAttributesToModifyAttributes Dynamic t (Map Text Text)
dAttrs
i <- inputElement $ def
& inputElementConfig_initialChecked .~ checked
& inputElementConfig_setChecked .~ _checkboxConfig_setValue config
& inputElementConfig_elementConfig . elementConfig_initialAttributes .~ Map.mapKeys (AttributeName Nothing) permanentAttrs
& inputElementConfig_elementConfig . elementConfig_modifyAttributes .~ fmap mapKeysToAttributeName modifyAttrs
return $ Checkbox
{ _checkbox_value = _inputElement_checked i
, _checkbox_change = _inputElement_checkedChange i
}
type family CheckboxViewEventResultType (en :: EventTag) :: Type where
CheckboxViewEventResultType 'ClickTag = Bool
CheckboxViewEventResultType t = EventResultType t
regularToCheckboxViewEventType :: EventName t -> EventResultType t -> CheckboxViewEventResultType t
regularToCheckboxViewEventType :: forall (t :: EventTag).
EventName t -> EventResultType t -> CheckboxViewEventResultType t
regularToCheckboxViewEventType EventName t
en EventResultType t
r = case EventName t
en of
EventName t
Click -> String -> Bool
forall a. HasCallStack => String -> a
error String
"regularToCheckboxViewEventType: EventName Click should never be encountered"
EventName t
Abort -> EventResultType t
CheckboxViewEventResultType t
r
EventName t
Blur -> EventResultType t
CheckboxViewEventResultType t
r
EventName t
Change -> EventResultType t
CheckboxViewEventResultType t
r
EventName t
Contextmenu -> EventResultType t
CheckboxViewEventResultType t
r
EventName t
Dblclick -> EventResultType t
CheckboxViewEventResultType t
r
EventName t
Drag -> EventResultType t
CheckboxViewEventResultType t
r
EventName t
Dragend -> EventResultType t
CheckboxViewEventResultType t
r
EventName t
Dragenter -> EventResultType t
CheckboxViewEventResultType t
r
EventName t
Dragleave -> EventResultType t
CheckboxViewEventResultType t
r
EventName t
Dragover -> EventResultType t
CheckboxViewEventResultType t
r
EventName t
Dragstart -> EventResultType t
CheckboxViewEventResultType t
r
EventName t
Drop -> EventResultType t
CheckboxViewEventResultType t
r
EventName t
Error -> EventResultType t
CheckboxViewEventResultType t
r
EventName t
Focus -> EventResultType t
CheckboxViewEventResultType t
r
EventName t
Input -> EventResultType t
CheckboxViewEventResultType t
r
EventName t
Invalid -> EventResultType t
CheckboxViewEventResultType t
r
EventName t
Keydown -> EventResultType t
CheckboxViewEventResultType t
r
EventName t
Keypress -> EventResultType t
CheckboxViewEventResultType t
r
EventName t
Keyup -> EventResultType t
CheckboxViewEventResultType t
r
EventName t
Load -> EventResultType t
CheckboxViewEventResultType t
r
EventName t
Mousedown -> EventResultType t
CheckboxViewEventResultType t
r
EventName t
Mouseenter -> EventResultType t
CheckboxViewEventResultType t
r
EventName t
Mouseleave -> EventResultType t
CheckboxViewEventResultType t
r
EventName t
Mousemove -> EventResultType t
CheckboxViewEventResultType t
r
EventName t
Mouseout -> EventResultType t
CheckboxViewEventResultType t
r
EventName t
Mouseover -> EventResultType t
CheckboxViewEventResultType t
r
EventName t
Mouseup -> EventResultType t
CheckboxViewEventResultType t
r
EventName t
Mousewheel -> EventResultType t
CheckboxViewEventResultType t
r
EventName t
Scroll -> EventResultType t
CheckboxViewEventResultType t
r
EventName t
Select -> EventResultType t
CheckboxViewEventResultType t
r
EventName t
Submit -> EventResultType t
CheckboxViewEventResultType t
r
EventName t
Wheel -> EventResultType t
CheckboxViewEventResultType t
r
EventName t
Beforecut -> EventResultType t
CheckboxViewEventResultType t
r
EventName t
Cut -> EventResultType t
CheckboxViewEventResultType t
r
EventName t
Beforecopy -> EventResultType t
CheckboxViewEventResultType t
r
EventName t
Copy -> EventResultType t
CheckboxViewEventResultType t
r
EventName t
Beforepaste -> EventResultType t
CheckboxViewEventResultType t
r
EventName t
Paste -> EventResultType t
CheckboxViewEventResultType t
r
EventName t
Reset -> EventResultType t
CheckboxViewEventResultType t
r
EventName t
Search -> EventResultType t
CheckboxViewEventResultType t
r
EventName t
Selectstart -> EventResultType t
CheckboxViewEventResultType t
r
EventName t
Touchstart -> EventResultType t
CheckboxViewEventResultType t
r
EventName t
Touchmove -> EventResultType t
CheckboxViewEventResultType t
r
EventName t
Touchend -> EventResultType t
CheckboxViewEventResultType t
r
EventName t
Touchcancel -> EventResultType t
CheckboxViewEventResultType t
r
newtype CheckboxViewEventResult en = CheckboxViewEventResult { forall (en :: EventTag).
CheckboxViewEventResult en -> CheckboxViewEventResultType en
unCheckboxViewEventResult :: CheckboxViewEventResultType en }
{-# INLINABLE checkboxView #-}
checkboxView :: forall t m. (DomBuilder t m, DomBuilderSpace m ~ GhcjsDomSpace, PostBuild t m, MonadHold t m) => Dynamic t (Map Text Text) -> Dynamic t Bool -> m (Event t Bool)
checkboxView :: forall t (m :: * -> *).
(DomBuilder t m, DomBuilderSpace m ~ GhcjsDomSpace, PostBuild t m,
MonadHold t m) =>
Dynamic t (Map Text Text) -> Dynamic t Bool -> m (Event t Bool)
checkboxView Dynamic t (Map Text Text)
dAttrs Dynamic t Bool
dValue = do
let permanentAttrs :: Map Text Text
permanentAttrs = Index (Map Text Text)
"type" Index (Map Text Text) -> IxValue (Map Text Text) -> Map Text Text
forall m. (At m, Monoid m) => Index m -> IxValue m -> m
=: IxValue (Map Text Text)
"checkbox"
modifyAttrs <- Dynamic t (Map Text Text) -> m (Event t (Map Text (Maybe Text)))
forall k t (m :: * -> *).
(Ord k, PostBuild t m) =>
Dynamic t (Map k Text) -> m (Event t (Map k (Maybe Text)))
dynamicAttributesToModifyAttributes (Dynamic t (Map Text Text) -> m (Event t (Map Text (Maybe Text))))
-> Dynamic t (Map Text Text) -> m (Event t (Map Text (Maybe Text)))
forall a b. (a -> b) -> a -> b
$ (Map Text Text -> Map Text Text)
-> Dynamic t (Map Text Text) -> Dynamic t (Map Text Text)
forall a b. (a -> b) -> Dynamic t a -> Dynamic t b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Map Text Text -> Map Text Text -> Map Text Text
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union Map Text Text
permanentAttrs) Dynamic t (Map Text Text)
dAttrs
postBuild <- getPostBuild
let filters :: DMap EventName (GhcjsEventFilter CheckboxViewEventResult)
filters = EventName 'ClickTag
-> GhcjsEventFilter CheckboxViewEventResult 'ClickTag
-> DMap EventName (GhcjsEventFilter CheckboxViewEventResult)
forall {k1} (k2 :: k1 -> *) (v :: k1) (f :: k1 -> *).
k2 v -> f v -> DMap k2 f
DMap.singleton EventName 'ClickTag
Click (GhcjsEventFilter CheckboxViewEventResult 'ClickTag
-> DMap EventName (GhcjsEventFilter CheckboxViewEventResult))
-> GhcjsEventFilter CheckboxViewEventResult 'ClickTag
-> DMap EventName (GhcjsEventFilter CheckboxViewEventResult)
forall a b. (a -> b) -> a -> b
$ (GhcjsDomEvent 'ClickTag
-> JSM
(EventFlags, JSM (Maybe (CheckboxViewEventResult 'ClickTag))))
-> GhcjsEventFilter CheckboxViewEventResult 'ClickTag
forall (er :: EventTag -> *) (en :: EventTag).
(GhcjsDomEvent en -> JSM (EventFlags, JSM (Maybe (er en))))
-> GhcjsEventFilter er en
GhcjsEventFilter ((GhcjsDomEvent 'ClickTag
-> JSM
(EventFlags, JSM (Maybe (CheckboxViewEventResult 'ClickTag))))
-> GhcjsEventFilter CheckboxViewEventResult 'ClickTag)
-> (GhcjsDomEvent 'ClickTag
-> JSM
(EventFlags, JSM (Maybe (CheckboxViewEventResult 'ClickTag))))
-> GhcjsEventFilter CheckboxViewEventResult 'ClickTag
forall a b. (a -> b) -> a -> b
$ \(GhcjsDomEvent EventType 'ClickTag
evt) -> do
t <- MouseEvent -> JSM EventTarget
forall (m :: * -> *) self.
(MonadDOM m, IsEvent self) =>
self -> m EventTarget
Event.getTargetUnchecked MouseEvent
EventType 'ClickTag
evt
b <- Input.getChecked $ uncheckedCastTo Input.HTMLInputElement t
return $ (,) preventDefault $ return $ Just $ CheckboxViewEventResult b
elementConfig :: ElementConfig CheckboxViewEventResult t (DomBuilderSpace m)
elementConfig = (ElementConfig EventResult t (DomBuilderSpace m)
ElementConfig EventResult t GhcjsDomSpace
forall a. Default a => a
def :: ElementConfig EventResult t (DomBuilderSpace m))
{ _elementConfig_modifyAttributes = Just $ fmap mapKeysToAttributeName modifyAttrs
, _elementConfig_initialAttributes = Map.mapKeys (AttributeName Nothing) permanentAttrs
, _elementConfig_eventSpec = GhcjsEventSpec
{ _ghcjsEventSpec_filters = filters
, _ghcjsEventSpec_handler = GhcjsEventHandler $ \(EventName en
en, GhcjsDomEvent EventType en
evt) -> case EventName en
en of
EventName en
Click -> String -> JSM (Maybe (CheckboxViewEventResult en))
forall a. HasCallStack => String -> a
error String
"impossible"
EventName en
_ -> do
e :: DOM.EventTarget <- EventName en
-> (IsEvent (EventType en) => JSM EventTarget) -> JSM EventTarget
forall (en :: EventTag) r.
EventName en -> (IsEvent (EventType en) => r) -> r
withIsEvent EventName en
en ((IsEvent (EventType en) => JSM EventTarget) -> JSM EventTarget)
-> (IsEvent (EventType en) => JSM EventTarget) -> JSM EventTarget
forall a b. (a -> b) -> a -> b
$ EventType en -> JSM EventTarget
forall (m :: * -> *) self.
(MonadDOM m, IsEvent self) =>
self -> m EventTarget
Event.getTargetUnchecked EventType en
evt
let myElement = (JSVal -> HTMLElement) -> EventTarget -> HTMLElement
forall obj obj'.
(Coercible obj JSVal, IsGObject obj') =>
(JSVal -> obj') -> obj -> obj'
uncheckedCastTo JSVal -> HTMLElement
DOM.HTMLElement EventTarget
e
mr <- runReaderT (defaultDomEventHandler myElement en) evt
return $ ffor mr $ \(EventResult EventResultType en
r) -> CheckboxViewEventResultType en -> CheckboxViewEventResult en
forall (en :: EventTag).
CheckboxViewEventResultType en -> CheckboxViewEventResult en
CheckboxViewEventResult (CheckboxViewEventResultType en -> CheckboxViewEventResult en)
-> CheckboxViewEventResultType en -> CheckboxViewEventResult en
forall a b. (a -> b) -> a -> b
$ EventName en
-> EventResultType en -> CheckboxViewEventResultType en
forall (t :: EventTag).
EventName t -> EventResultType t -> CheckboxViewEventResultType t
regularToCheckboxViewEventType EventName en
en EventResultType en
r
}
}
inputElementConfig :: InputElementConfig CheckboxViewEventResult t (DomBuilderSpace m)
inputElementConfig = (InputElementConfig EventResult t (DomBuilderSpace m)
InputElementConfig EventResult t GhcjsDomSpace
forall a. Default a => a
def :: InputElementConfig EventResult t (DomBuilderSpace m))
InputElementConfig EventResult t GhcjsDomSpace
-> (InputElementConfig EventResult t GhcjsDomSpace
-> InputElementConfig EventResult t GhcjsDomSpace)
-> InputElementConfig EventResult t GhcjsDomSpace
forall a b. a -> (a -> b) -> b
& (Event t Bool -> Identity (Event t Bool))
-> InputElementConfig EventResult t GhcjsDomSpace
-> Identity (InputElementConfig EventResult t GhcjsDomSpace)
forall {k1} {k2} (t :: k1) (er :: EventTag -> *) (m :: k2).
Reflex t =>
Lens' (InputElementConfig er t m) (Event t Bool)
Lens'
(InputElementConfig EventResult t GhcjsDomSpace) (Event t Bool)
inputElementConfig_setChecked ((Event t Bool -> Identity (Event t Bool))
-> InputElementConfig EventResult t GhcjsDomSpace
-> Identity (InputElementConfig EventResult t GhcjsDomSpace))
-> Event t Bool
-> InputElementConfig EventResult t GhcjsDomSpace
-> InputElementConfig EventResult t GhcjsDomSpace
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Event t Bool] -> Event t Bool
forall {k} (t :: k) a. Reflex t => [Event t a] -> Event t a
leftmost [Dynamic t Bool -> Event t Bool
forall a. Dynamic t a -> Event t a
forall {k} (t :: k) a. Reflex t => Dynamic t a -> Event t a
updated Dynamic t Bool
dValue, Behavior t Bool -> Event t () -> Event t Bool
forall {k} (t :: k) b a.
Reflex t =>
Behavior t b -> Event t a -> Event t b
tag (Dynamic t Bool -> Behavior t Bool
forall a. Dynamic t a -> Behavior t a
forall {k} (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
current Dynamic t Bool
dValue) Event t ()
postBuild]
InputElementConfig EventResult t GhcjsDomSpace
-> (InputElementConfig EventResult t GhcjsDomSpace
-> InputElementConfig CheckboxViewEventResult t GhcjsDomSpace)
-> InputElementConfig CheckboxViewEventResult t GhcjsDomSpace
forall a b. a -> (a -> b) -> b
& (ElementConfig EventResult t GhcjsDomSpace
-> Identity
(ElementConfig CheckboxViewEventResult t GhcjsDomSpace))
-> InputElementConfig EventResult t GhcjsDomSpace
-> Identity
(InputElementConfig CheckboxViewEventResult t GhcjsDomSpace)
forall (er1 :: EventTag -> *) k1 (t :: k1) k2 (s1 :: k2)
(er2 :: EventTag -> *) k3 (s2 :: k3) (f :: * -> *).
Functor f =>
(ElementConfig er1 t s1 -> f (ElementConfig er2 t s2))
-> InputElementConfig er1 t s1 -> f (InputElementConfig er2 t s2)
inputElementConfig_elementConfig ((ElementConfig EventResult t GhcjsDomSpace
-> Identity
(ElementConfig CheckboxViewEventResult t GhcjsDomSpace))
-> InputElementConfig EventResult t GhcjsDomSpace
-> Identity
(InputElementConfig CheckboxViewEventResult t GhcjsDomSpace))
-> ElementConfig CheckboxViewEventResult t GhcjsDomSpace
-> InputElementConfig EventResult t GhcjsDomSpace
-> InputElementConfig CheckboxViewEventResult t GhcjsDomSpace
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ElementConfig CheckboxViewEventResult t (DomBuilderSpace m)
ElementConfig CheckboxViewEventResult t GhcjsDomSpace
elementConfig
i <- inputElement inputElementConfig
return $ unCheckboxViewEventResult <$> select (_element_events $ _inputElement_element i) (WrapArg Click)
{-# DEPRECATED FileInput, FileInputConfig, fileInput "Use 'inputElement' directly" #-}
data FileInput d t
= FileInput { forall {k} {k} (d :: k) (t :: k). FileInput d t -> Dynamic t [File]
_fileInput_value :: Dynamic t [File]
, forall {k} {k} (d :: k) (t :: k).
FileInput d t -> RawInputElement d
_fileInput_element :: RawInputElement d
}
newtype FileInputConfig t
= FileInputConfig { forall {k} (t :: k). FileInputConfig t -> Dynamic t (Map Text Text)
_fileInputConfig_attributes :: Dynamic t (Map Text Text)
}
instance Reflex t => Default (FileInputConfig t) where
def :: FileInputConfig t
def = FileInputConfig { _fileInputConfig_attributes :: Dynamic t (Map Text Text)
_fileInputConfig_attributes = Map Text Text -> Dynamic t (Map Text Text)
forall {k} (t :: k) a. Reflex t => a -> Dynamic t a
constDyn Map Text Text
forall a. Monoid a => a
mempty
}
fileInput :: forall t m. (MonadIO m, MonadJSM m, MonadFix m, MonadHold t m, TriggerEvent t m, DomBuilder t m, PostBuild t m, DomBuilderSpace m ~ GhcjsDomSpace)
=> FileInputConfig t -> m (FileInput (DomBuilderSpace m) t)
fileInput :: forall t (m :: * -> *).
(MonadIO m, MonadJSM m, MonadFix m, MonadHold t m,
TriggerEvent t m, DomBuilder t m, PostBuild t m,
DomBuilderSpace m ~ GhcjsDomSpace) =>
FileInputConfig t -> m (FileInput (DomBuilderSpace m) t)
fileInput FileInputConfig t
config = do
let insertType :: Map Text Text -> Map Text Text
insertType = Text -> Text -> Map Text Text -> Map Text Text
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Text
"type" Text
"file"
dAttrs :: Dynamic t (Map Text Text)
dAttrs = Map Text Text -> Map Text Text
insertType (Map Text Text -> Map Text Text)
-> Dynamic t (Map Text Text) -> Dynamic t (Map Text Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FileInputConfig t -> Dynamic t (Map Text Text)
forall {k} (t :: k). FileInputConfig t -> Dynamic t (Map Text Text)
_fileInputConfig_attributes FileInputConfig t
config
modifyAttrs <- Dynamic t (Map Text Text) -> m (Event t (Map Text (Maybe Text)))
forall k t (m :: * -> *).
(Ord k, PostBuild t m) =>
Dynamic t (Map k Text) -> m (Event t (Map k (Maybe Text)))
dynamicAttributesToModifyAttributes Dynamic t (Map Text Text)
dAttrs
let filters = EventName 'ChangeTag
-> GhcjsEventFilter EventResult 'ChangeTag
-> DMap EventName (GhcjsEventFilter EventResult)
forall {k1} (k2 :: k1 -> *) (v :: k1) (f :: k1 -> *).
k2 v -> f v -> DMap k2 f
DMap.singleton EventName 'ChangeTag
Change (GhcjsEventFilter EventResult 'ChangeTag
-> DMap EventName (GhcjsEventFilter EventResult))
-> ((GhcjsDomEvent 'ChangeTag
-> JSM (EventFlags, JSM (Maybe (EventResult 'ChangeTag))))
-> GhcjsEventFilter EventResult 'ChangeTag)
-> (GhcjsDomEvent 'ChangeTag
-> JSM (EventFlags, JSM (Maybe (EventResult 'ChangeTag))))
-> DMap EventName (GhcjsEventFilter EventResult)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GhcjsDomEvent 'ChangeTag
-> JSM (EventFlags, JSM (Maybe (EventResult 'ChangeTag))))
-> GhcjsEventFilter EventResult 'ChangeTag
forall (er :: EventTag -> *) (en :: EventTag).
(GhcjsDomEvent en -> JSM (EventFlags, JSM (Maybe (er en))))
-> GhcjsEventFilter er en
GhcjsEventFilter ((GhcjsDomEvent 'ChangeTag
-> JSM (EventFlags, JSM (Maybe (EventResult 'ChangeTag))))
-> DMap EventName (GhcjsEventFilter EventResult))
-> (GhcjsDomEvent 'ChangeTag
-> JSM (EventFlags, JSM (Maybe (EventResult 'ChangeTag))))
-> DMap EventName (GhcjsEventFilter EventResult)
forall a b. (a -> b) -> a -> b
$ \GhcjsDomEvent 'ChangeTag
_ -> do
(EventFlags, JSM (Maybe (EventResult 'ChangeTag)))
-> JSM (EventFlags, JSM (Maybe (EventResult 'ChangeTag)))
forall a. a -> JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return ((EventFlags, JSM (Maybe (EventResult 'ChangeTag)))
-> JSM (EventFlags, JSM (Maybe (EventResult 'ChangeTag))))
-> (JSM (Maybe (EventResult 'ChangeTag))
-> (EventFlags, JSM (Maybe (EventResult 'ChangeTag))))
-> JSM (Maybe (EventResult 'ChangeTag))
-> JSM (EventFlags, JSM (Maybe (EventResult 'ChangeTag)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,) EventFlags
forall a. Monoid a => a
mempty (JSM (Maybe (EventResult 'ChangeTag))
-> JSM (EventFlags, JSM (Maybe (EventResult 'ChangeTag))))
-> JSM (Maybe (EventResult 'ChangeTag))
-> JSM (EventFlags, JSM (Maybe (EventResult 'ChangeTag)))
forall a b. (a -> b) -> a -> b
$ Maybe (EventResult 'ChangeTag)
-> JSM (Maybe (EventResult 'ChangeTag))
forall a. a -> JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (EventResult 'ChangeTag)
-> JSM (Maybe (EventResult 'ChangeTag)))
-> (EventResult 'ChangeTag -> Maybe (EventResult 'ChangeTag))
-> EventResult 'ChangeTag
-> JSM (Maybe (EventResult 'ChangeTag))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EventResult 'ChangeTag -> Maybe (EventResult 'ChangeTag)
forall a. a -> Maybe a
Just (EventResult 'ChangeTag -> JSM (Maybe (EventResult 'ChangeTag)))
-> EventResult 'ChangeTag -> JSM (Maybe (EventResult 'ChangeTag))
forall a b. (a -> b) -> a -> b
$ EventResultType 'ChangeTag -> EventResult 'ChangeTag
forall (en :: EventTag). EventResultType en -> EventResult en
EventResult ()
elCfg = (ElementConfig EventResult t (DomBuilderSpace m)
ElementConfig EventResult t GhcjsDomSpace
forall a. Default a => a
def :: ElementConfig EventResult t (DomBuilderSpace m))
ElementConfig EventResult t GhcjsDomSpace
-> (ElementConfig EventResult t GhcjsDomSpace
-> ElementConfig EventResult t GhcjsDomSpace)
-> ElementConfig EventResult t GhcjsDomSpace
forall a b. a -> (a -> b) -> b
& (Event t (Map AttributeName (Maybe Text))
-> Identity (Event t (Map AttributeName (Maybe Text))))
-> ElementConfig EventResult t GhcjsDomSpace
-> Identity (ElementConfig EventResult t GhcjsDomSpace)
forall {k} (t :: k) a.
(ModifyAttributes t a, Reflex t) =>
Lens' a (Event t (Map AttributeName (Maybe Text)))
Lens'
(ElementConfig EventResult t GhcjsDomSpace)
(Event t (Map AttributeName (Maybe Text)))
modifyAttributes ((Event t (Map AttributeName (Maybe Text))
-> Identity (Event t (Map AttributeName (Maybe Text))))
-> ElementConfig EventResult t GhcjsDomSpace
-> Identity (ElementConfig EventResult t GhcjsDomSpace))
-> Event t (Map AttributeName (Maybe Text))
-> ElementConfig EventResult t GhcjsDomSpace
-> ElementConfig EventResult t GhcjsDomSpace
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (Map Text (Maybe Text) -> Map AttributeName (Maybe Text))
-> Event t (Map Text (Maybe Text))
-> Event t (Map AttributeName (Maybe Text))
forall a b. (a -> b) -> Event t a -> Event t b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Map Text (Maybe Text) -> Map AttributeName (Maybe Text)
forall v. Map Text v -> Map AttributeName v
mapKeysToAttributeName Event t (Map Text (Maybe Text))
modifyAttrs
ElementConfig EventResult t GhcjsDomSpace
-> (ElementConfig EventResult t GhcjsDomSpace
-> ElementConfig EventResult t GhcjsDomSpace)
-> ElementConfig EventResult t GhcjsDomSpace
forall a b. a -> (a -> b) -> b
& (EventSpec GhcjsDomSpace EventResult
-> Identity (EventSpec GhcjsDomSpace EventResult))
-> ElementConfig EventResult t GhcjsDomSpace
-> Identity (ElementConfig EventResult t GhcjsDomSpace)
(GhcjsEventSpec EventResult
-> Identity (GhcjsEventSpec EventResult))
-> ElementConfig EventResult t GhcjsDomSpace
-> Identity (ElementConfig EventResult t GhcjsDomSpace)
forall (er1 :: EventTag -> *) k1 (t :: k1) k2 (s1 :: k2)
(er2 :: EventTag -> *) k3 (s2 :: k3) (f :: * -> *).
Functor f =>
(EventSpec s1 er1 -> f (EventSpec s2 er2))
-> ElementConfig er1 t s1 -> f (ElementConfig er2 t s2)
elementConfig_eventSpec ((GhcjsEventSpec EventResult
-> Identity (GhcjsEventSpec EventResult))
-> ElementConfig EventResult t GhcjsDomSpace
-> Identity (ElementConfig EventResult t GhcjsDomSpace))
-> ((DMap EventName (GhcjsEventFilter EventResult)
-> Identity (DMap EventName (GhcjsEventFilter EventResult)))
-> GhcjsEventSpec EventResult
-> Identity (GhcjsEventSpec EventResult))
-> (DMap EventName (GhcjsEventFilter EventResult)
-> Identity (DMap EventName (GhcjsEventFilter EventResult)))
-> ElementConfig EventResult t GhcjsDomSpace
-> Identity (ElementConfig EventResult t GhcjsDomSpace)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DMap EventName (GhcjsEventFilter EventResult)
-> Identity (DMap EventName (GhcjsEventFilter EventResult)))
-> GhcjsEventSpec EventResult
-> Identity (GhcjsEventSpec EventResult)
forall (er :: EventTag -> *) (f :: * -> *).
Functor f =>
(DMap EventName (GhcjsEventFilter er)
-> f (DMap EventName (GhcjsEventFilter er)))
-> GhcjsEventSpec er -> f (GhcjsEventSpec er)
ghcjsEventSpec_filters ((DMap EventName (GhcjsEventFilter EventResult)
-> Identity (DMap EventName (GhcjsEventFilter EventResult)))
-> ElementConfig EventResult t GhcjsDomSpace
-> Identity (ElementConfig EventResult t GhcjsDomSpace))
-> DMap EventName (GhcjsEventFilter EventResult)
-> ElementConfig EventResult t GhcjsDomSpace
-> ElementConfig EventResult t GhcjsDomSpace
forall s t a b. ASetter s t a b -> b -> s -> t
.~ DMap EventName (GhcjsEventFilter EventResult)
filters
cfg = (InputElementConfig EventResult t (DomBuilderSpace m)
InputElementConfig EventResult t GhcjsDomSpace
forall a. Default a => a
def :: InputElementConfig EventResult t (DomBuilderSpace m)) InputElementConfig EventResult t GhcjsDomSpace
-> (InputElementConfig EventResult t GhcjsDomSpace
-> InputElementConfig EventResult t GhcjsDomSpace)
-> InputElementConfig EventResult t GhcjsDomSpace
forall a b. a -> (a -> b) -> b
& (ElementConfig EventResult t GhcjsDomSpace
-> Identity (ElementConfig EventResult t GhcjsDomSpace))
-> InputElementConfig EventResult t GhcjsDomSpace
-> Identity (InputElementConfig EventResult t GhcjsDomSpace)
forall (er1 :: EventTag -> *) k1 (t :: k1) k2 (s1 :: k2)
(er2 :: EventTag -> *) k3 (s2 :: k3) (f :: * -> *).
Functor f =>
(ElementConfig er1 t s1 -> f (ElementConfig er2 t s2))
-> InputElementConfig er1 t s1 -> f (InputElementConfig er2 t s2)
inputElementConfig_elementConfig ((ElementConfig EventResult t GhcjsDomSpace
-> Identity (ElementConfig EventResult t GhcjsDomSpace))
-> InputElementConfig EventResult t GhcjsDomSpace
-> Identity (InputElementConfig EventResult t GhcjsDomSpace))
-> ElementConfig EventResult t GhcjsDomSpace
-> InputElementConfig EventResult t GhcjsDomSpace
-> InputElementConfig EventResult t GhcjsDomSpace
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ElementConfig EventResult t GhcjsDomSpace
elCfg
input <- inputElement cfg
return $ FileInput
{ _fileInput_value = _inputElement_files input
, _fileInput_element = _inputElement_raw input
}
data Dropdown t k
= Dropdown { forall {k} (t :: k) k. Dropdown t k -> Dynamic t k
_dropdown_value :: Dynamic t k
, forall {k} (t :: k) k. Dropdown t k -> Event t k
_dropdown_change :: Event t k
}
data DropdownConfig t k
= DropdownConfig { forall {k} (t :: k) k. DropdownConfig t k -> Event t k
_dropdownConfig_setValue :: Event t k
, forall {k} (t :: k) k.
DropdownConfig t k -> Dynamic t (Map Text Text)
_dropdownConfig_attributes :: Dynamic t (Map Text Text)
}
instance Reflex t => Default (DropdownConfig t k) where
def :: DropdownConfig t k
def = DropdownConfig { _dropdownConfig_setValue :: Event t k
_dropdownConfig_setValue = Event t k
forall a. Event t a
forall {k} (t :: k) a. Reflex t => Event t a
never
, _dropdownConfig_attributes :: Dynamic t (Map Text Text)
_dropdownConfig_attributes = Map Text Text -> Dynamic t (Map Text Text)
forall {k} (t :: k) a. Reflex t => a -> Dynamic t a
constDyn Map Text Text
forall a. Monoid a => a
mempty
}
type family DropdownViewEventResultType (en :: EventTag) :: Type where
DropdownViewEventResultType 'ChangeTag = Text
DropdownViewEventResultType t = EventResultType t
newtype DropdownViewEventResult en = DropdownViewEventResult { forall (en :: EventTag).
DropdownViewEventResult en -> DropdownViewEventResultType en
unDropdownViewEventResult :: DropdownViewEventResultType en }
regularToDropdownViewEventType :: EventName t -> EventResultType t -> DropdownViewEventResultType t
regularToDropdownViewEventType :: forall (t :: EventTag).
EventName t -> EventResultType t -> DropdownViewEventResultType t
regularToDropdownViewEventType EventName t
en EventResultType t
r = case EventName t
en of
EventName t
Change -> String -> Text
forall a. HasCallStack => String -> a
error String
"regularToDropdownViewEventType: EventName Change should never be encountered"
EventName t
Abort -> EventResultType t
DropdownViewEventResultType t
r
EventName t
Blur -> EventResultType t
DropdownViewEventResultType t
r
EventName t
Click -> EventResultType t
DropdownViewEventResultType t
r
EventName t
Contextmenu -> EventResultType t
DropdownViewEventResultType t
r
EventName t
Dblclick -> EventResultType t
DropdownViewEventResultType t
r
EventName t
Drag -> EventResultType t
DropdownViewEventResultType t
r
EventName t
Dragend -> EventResultType t
DropdownViewEventResultType t
r
EventName t
Dragenter -> EventResultType t
DropdownViewEventResultType t
r
EventName t
Dragleave -> EventResultType t
DropdownViewEventResultType t
r
EventName t
Dragover -> EventResultType t
DropdownViewEventResultType t
r
EventName t
Dragstart -> EventResultType t
DropdownViewEventResultType t
r
EventName t
Drop -> EventResultType t
DropdownViewEventResultType t
r
EventName t
Error -> EventResultType t
DropdownViewEventResultType t
r
EventName t
Focus -> EventResultType t
DropdownViewEventResultType t
r
EventName t
Input -> EventResultType t
DropdownViewEventResultType t
r
EventName t
Invalid -> EventResultType t
DropdownViewEventResultType t
r
EventName t
Keydown -> EventResultType t
DropdownViewEventResultType t
r
EventName t
Keypress -> EventResultType t
DropdownViewEventResultType t
r
EventName t
Keyup -> EventResultType t
DropdownViewEventResultType t
r
EventName t
Load -> EventResultType t
DropdownViewEventResultType t
r
EventName t
Mousedown -> EventResultType t
DropdownViewEventResultType t
r
EventName t
Mouseenter -> EventResultType t
DropdownViewEventResultType t
r
EventName t
Mouseleave -> EventResultType t
DropdownViewEventResultType t
r
EventName t
Mousemove -> EventResultType t
DropdownViewEventResultType t
r
EventName t
Mouseout -> EventResultType t
DropdownViewEventResultType t
r
EventName t
Mouseover -> EventResultType t
DropdownViewEventResultType t
r
EventName t
Mouseup -> EventResultType t
DropdownViewEventResultType t
r
EventName t
Mousewheel -> EventResultType t
DropdownViewEventResultType t
r
EventName t
Scroll -> EventResultType t
DropdownViewEventResultType t
r
EventName t
Select -> EventResultType t
DropdownViewEventResultType t
r
EventName t
Submit -> EventResultType t
DropdownViewEventResultType t
r
EventName t
Wheel -> EventResultType t
DropdownViewEventResultType t
r
EventName t
Beforecut -> EventResultType t
DropdownViewEventResultType t
r
EventName t
Cut -> EventResultType t
DropdownViewEventResultType t
r
EventName t
Beforecopy -> EventResultType t
DropdownViewEventResultType t
r
EventName t
Copy -> EventResultType t
DropdownViewEventResultType t
r
EventName t
Beforepaste -> EventResultType t
DropdownViewEventResultType t
r
EventName t
Paste -> EventResultType t
DropdownViewEventResultType t
r
EventName t
Reset -> EventResultType t
DropdownViewEventResultType t
r
EventName t
Search -> EventResultType t
DropdownViewEventResultType t
r
EventName t
Selectstart -> EventResultType t
DropdownViewEventResultType t
r
EventName t
Touchstart -> EventResultType t
DropdownViewEventResultType t
r
EventName t
Touchmove -> EventResultType t
DropdownViewEventResultType t
r
EventName t
Touchend -> EventResultType t
DropdownViewEventResultType t
r
EventName t
Touchcancel -> EventResultType t
DropdownViewEventResultType t
r
dropdown :: forall k t m. (DomBuilder t m, MonadFix m, MonadHold t m, PostBuild t m, Ord k) => k -> Dynamic t (Map k Text) -> DropdownConfig t k -> m (Dropdown t k)
dropdown :: forall k t (m :: * -> *).
(DomBuilder t m, MonadFix m, MonadHold t m, PostBuild t m,
Ord k) =>
k
-> Dynamic t (Map k Text) -> DropdownConfig t k -> m (Dropdown t k)
dropdown k
k0 Dynamic t (Map k Text)
options (DropdownConfig Event t k
setK Dynamic t (Map Text Text)
attrs) = do
optionsWithAddedKeys <- (Dynamic t (Map k Text) -> Dynamic t (Map k Text))
-> m (Dynamic t (Map k Text)) -> m (Dynamic t (Map k Text))
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Map k Text -> Map k Text -> Map k Text)
-> Dynamic t (Map k Text)
-> Dynamic t (Map k Text)
-> Dynamic t (Map k Text)
forall {k} (t :: k) a b c.
Reflex t =>
(a -> b -> c) -> Dynamic t a -> Dynamic t b -> Dynamic t c
zipDynWith Map k Text -> Map k Text -> Map k Text
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union Dynamic t (Map k Text)
options) (m (Dynamic t (Map k Text)) -> m (Dynamic t (Map k Text)))
-> m (Dynamic t (Map k Text)) -> m (Dynamic t (Map k Text))
forall a b. (a -> b) -> a -> b
$ (Map k Text -> Map k Text -> Map k Text)
-> Map k Text -> Event t (Map k Text) -> m (Dynamic t (Map k Text))
forall {k} (t :: k) (m :: * -> *) a b.
(Reflex t, MonadHold t m, MonadFix m) =>
(a -> b -> b) -> b -> Event t a -> m (Dynamic t b)
foldDyn Map k Text -> Map k Text -> Map k Text
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union (k
Index (Map k Text)
k0 Index (Map k Text) -> IxValue (Map k Text) -> Map k Text
forall m. (At m, Monoid m) => Index m -> IxValue m -> m
=: Text
IxValue (Map k Text)
"") (Event t (Map k Text) -> m (Dynamic t (Map k Text)))
-> Event t (Map k Text) -> m (Dynamic t (Map k Text))
forall a b. (a -> b) -> a -> b
$ (k -> Map k Text) -> Event t k -> Event t (Map k Text)
forall a b. (a -> b) -> Event t a -> Event t b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Index (Map k Text) -> IxValue (Map k Text) -> Map k Text
forall m. (At m, Monoid m) => Index m -> IxValue m -> m
=: IxValue (Map k Text)
"") Event t k
setK
defaultKey <- holdDyn k0 setK
let (indexedOptions, ixKeys) = splitDynPure $ ffor optionsWithAddedKeys $ \Map k Text
os ->
let xs :: [((KeyCode, k), ((KeyCode, k), Text))]
xs = ((KeyCode, (k, Text)) -> ((KeyCode, k), ((KeyCode, k), Text)))
-> [(KeyCode, (k, Text))] -> [((KeyCode, k), ((KeyCode, k), Text))]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(KeyCode
ix, (k
k, Text
v)) -> ((KeyCode
ix, k
k), ((KeyCode
ix, k
k), Text
v))) ([(KeyCode, (k, Text))] -> [((KeyCode, k), ((KeyCode, k), Text))])
-> [(KeyCode, (k, Text))] -> [((KeyCode, k), ((KeyCode, k), Text))]
forall a b. (a -> b) -> a -> b
$ [KeyCode] -> [(k, Text)] -> [(KeyCode, (k, Text))]
forall a b. [a] -> [b] -> [(a, b)]
zip [KeyCode
0::Int ..] ([(k, Text)] -> [(KeyCode, (k, Text))])
-> [(k, Text)] -> [(KeyCode, (k, Text))]
forall a b. (a -> b) -> a -> b
$ Map k Text -> [(k, Text)]
forall k a. Map k a -> [(k, a)]
Map.toList Map k Text
os
in ([((KeyCode, k), Text)] -> Map (KeyCode, k) Text
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([((KeyCode, k), Text)] -> Map (KeyCode, k) Text)
-> [((KeyCode, k), Text)] -> Map (KeyCode, k) Text
forall a b. (a -> b) -> a -> b
$ (((KeyCode, k), ((KeyCode, k), Text)) -> ((KeyCode, k), Text))
-> [((KeyCode, k), ((KeyCode, k), Text))] -> [((KeyCode, k), Text)]
forall a b. (a -> b) -> [a] -> [b]
map ((KeyCode, k), ((KeyCode, k), Text)) -> ((KeyCode, k), Text)
forall a b. (a, b) -> b
snd [((KeyCode, k), ((KeyCode, k), Text))]
xs, [(KeyCode, k)] -> Bimap KeyCode k
forall a b. (Ord a, Ord b) => [(a, b)] -> Bimap a b
Bimap.fromList ([(KeyCode, k)] -> Bimap KeyCode k)
-> [(KeyCode, k)] -> Bimap KeyCode k
forall a b. (a -> b) -> a -> b
$ (((KeyCode, k), ((KeyCode, k), Text)) -> (KeyCode, k))
-> [((KeyCode, k), ((KeyCode, k), Text))] -> [(KeyCode, k)]
forall a b. (a -> b) -> [a] -> [b]
map ((KeyCode, k), ((KeyCode, k), Text)) -> (KeyCode, k)
forall a b. (a, b) -> a
fst [((KeyCode, k), ((KeyCode, k), Text))]
xs)
modifyAttrs <- dynamicAttributesToModifyAttributes attrs
postBuild <- getPostBuild
let setSelection = (Bimap KeyCode k -> k -> Maybe KeyCode)
-> Dynamic t (Bimap KeyCode k) -> Event t k -> Event t KeyCode
forall {k} (t :: k) a b c.
Reflex t =>
(a -> b -> Maybe c) -> Dynamic t a -> Event t b -> Event t c
attachPromptlyDynWithMaybe ((k -> Bimap KeyCode k -> Maybe KeyCode)
-> Bimap KeyCode k -> k -> Maybe KeyCode
forall a b c. (a -> b -> c) -> b -> a -> c
flip k -> Bimap KeyCode k -> Maybe KeyCode
forall a b (m :: * -> *).
(Ord a, Ord b, MonadThrow m) =>
b -> Bimap a b -> m a
Bimap.lookupR) Dynamic t (Bimap KeyCode k)
ixKeys (Event t k -> Event t KeyCode) -> Event t k -> Event t KeyCode
forall a b. (a -> b) -> a -> b
$
[Event t k] -> Event t k
forall {k} (t :: k) a. Reflex t => [Event t a] -> Event t a
leftmost [Event t k
setK, k
k0 k -> Event t () -> Event t k
forall a b. a -> Event t b -> Event t a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Event t ()
postBuild]
let cfg = SelectElementConfig EventResult t (DomBuilderSpace m)
forall a. Default a => a
def
SelectElementConfig EventResult t (DomBuilderSpace m)
-> (SelectElementConfig EventResult t (DomBuilderSpace m)
-> SelectElementConfig EventResult t (DomBuilderSpace m))
-> SelectElementConfig EventResult t (DomBuilderSpace m)
forall a b. a -> (a -> b) -> b
& (ElementConfig EventResult t (DomBuilderSpace m)
-> Identity (ElementConfig EventResult t (DomBuilderSpace m)))
-> SelectElementConfig EventResult t (DomBuilderSpace m)
-> Identity (SelectElementConfig EventResult t (DomBuilderSpace m))
forall (er1 :: EventTag -> *) k1 (t :: k1) k2 (m1 :: k2)
(er2 :: EventTag -> *) k3 (m2 :: k3) (f :: * -> *).
Functor f =>
(ElementConfig er1 t m1 -> f (ElementConfig er2 t m2))
-> SelectElementConfig er1 t m1 -> f (SelectElementConfig er2 t m2)
selectElementConfig_elementConfig ((ElementConfig EventResult t (DomBuilderSpace m)
-> Identity (ElementConfig EventResult t (DomBuilderSpace m)))
-> SelectElementConfig EventResult t (DomBuilderSpace m)
-> Identity
(SelectElementConfig EventResult t (DomBuilderSpace m)))
-> ((Event t (Map AttributeName (Maybe Text))
-> Identity (Event t (Map AttributeName (Maybe Text))))
-> ElementConfig EventResult t (DomBuilderSpace m)
-> Identity (ElementConfig EventResult t (DomBuilderSpace m)))
-> (Event t (Map AttributeName (Maybe Text))
-> Identity (Event t (Map AttributeName (Maybe Text))))
-> SelectElementConfig EventResult t (DomBuilderSpace m)
-> Identity (SelectElementConfig EventResult t (DomBuilderSpace m))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Event t (Map AttributeName (Maybe Text))
-> Identity (Event t (Map AttributeName (Maybe Text))))
-> ElementConfig EventResult t (DomBuilderSpace m)
-> Identity (ElementConfig EventResult t (DomBuilderSpace m))
forall {k1} {k2} (t :: k1) (er :: EventTag -> *) (m :: k2).
Reflex t =>
Lens'
(ElementConfig er t m) (Event t (Map AttributeName (Maybe Text)))
Lens'
(ElementConfig EventResult t (DomBuilderSpace m))
(Event t (Map AttributeName (Maybe Text)))
elementConfig_modifyAttributes ((Event t (Map AttributeName (Maybe Text))
-> Identity (Event t (Map AttributeName (Maybe Text))))
-> SelectElementConfig EventResult t (DomBuilderSpace m)
-> Identity
(SelectElementConfig EventResult t (DomBuilderSpace m)))
-> Event t (Map AttributeName (Maybe Text))
-> SelectElementConfig EventResult t (DomBuilderSpace m)
-> SelectElementConfig EventResult t (DomBuilderSpace m)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (Map Text (Maybe Text) -> Map AttributeName (Maybe Text))
-> Event t (Map Text (Maybe Text))
-> Event t (Map AttributeName (Maybe Text))
forall a b. (a -> b) -> Event t a -> Event t b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Map Text (Maybe Text) -> Map AttributeName (Maybe Text)
forall v. Map Text v -> Map AttributeName v
mapKeysToAttributeName Event t (Map Text (Maybe Text))
modifyAttrs
SelectElementConfig EventResult t (DomBuilderSpace m)
-> (SelectElementConfig EventResult t (DomBuilderSpace m)
-> SelectElementConfig EventResult t (DomBuilderSpace m))
-> SelectElementConfig EventResult t (DomBuilderSpace m)
forall a b. a -> (a -> b) -> b
& (Event t Text -> Identity (Event t Text))
-> SelectElementConfig EventResult t (DomBuilderSpace m)
-> Identity (SelectElementConfig EventResult t (DomBuilderSpace m))
forall {k1} {k2} (t :: k1) (er :: EventTag -> *) (m :: k2).
Reflex t =>
Lens' (SelectElementConfig er t m) (Event t Text)
Lens'
(SelectElementConfig EventResult t (DomBuilderSpace m))
(Event t Text)
selectElementConfig_setValue ((Event t Text -> Identity (Event t Text))
-> SelectElementConfig EventResult t (DomBuilderSpace m)
-> Identity
(SelectElementConfig EventResult t (DomBuilderSpace m)))
-> Event t Text
-> SelectElementConfig EventResult t (DomBuilderSpace m)
-> SelectElementConfig EventResult t (DomBuilderSpace m)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (KeyCode -> Text) -> Event t KeyCode -> Event t Text
forall a b. (a -> b) -> Event t a -> Event t b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> Text
T.pack (String -> Text) -> (KeyCode -> String) -> KeyCode -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyCode -> String
forall a. Show a => a -> String
show) Event t KeyCode
setSelection
(eRaw, _) <- selectElement cfg $ listWithKey indexedOptions $ \(KeyCode
ix, k
k) Dynamic t Text
v -> do
let optionAttrs :: Dynamic t (Map Text Text)
optionAttrs = (k -> Map Text Text) -> Dynamic t k -> Dynamic t (Map Text Text)
forall a b. (a -> b) -> Dynamic t a -> Dynamic t b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\k
dk -> Text
Index (Map Text Text)
"value" Index (Map Text Text) -> IxValue (Map Text Text) -> Map Text Text
forall m. (At m, Monoid m) => Index m -> IxValue m -> m
=: String -> Text
T.pack (KeyCode -> String
forall a. Show a => a -> String
show KeyCode
ix) Map Text Text -> Map Text Text -> Map Text Text
forall a. Semigroup a => a -> a -> a
<> if k
dk k -> k -> Bool
forall a. Eq a => a -> a -> Bool
== k
k then Text
Index (Map Text Text)
"selected" Index (Map Text Text) -> IxValue (Map Text Text) -> Map Text Text
forall m. (At m, Monoid m) => Index m -> IxValue m -> m
=: Text
IxValue (Map Text Text)
"selected" else Map Text Text
forall a. Monoid a => a
mempty) Dynamic t k
defaultKey
Text -> Dynamic t (Map Text Text) -> m () -> m ()
forall t (m :: * -> *) a.
(DomBuilder t m, PostBuild t m) =>
Text -> Dynamic t (Map Text Text) -> m a -> m a
elDynAttr Text
"option" Dynamic t (Map Text Text)
optionAttrs (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Dynamic t Text -> m ()
forall t (m :: * -> *).
(PostBuild t m, DomBuilder t m) =>
Dynamic t Text -> m ()
dynText Dynamic t Text
v
let lookupSelected Bimap a b
ks Text
v = do
key <- String -> Maybe a
forall a. Read a => String -> Maybe a
T.readMaybe (String -> Maybe a) -> String -> Maybe a
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
v
Bimap.lookup key ks
let eChange = (Bimap KeyCode k -> Text -> Maybe k)
-> Dynamic t (Bimap KeyCode k) -> Event t Text -> Event t (Maybe k)
forall {k} (t :: k) a b c.
Reflex t =>
(a -> b -> c) -> Dynamic t a -> Event t b -> Event t c
attachPromptlyDynWith Bimap KeyCode k -> Text -> Maybe k
forall {a} {b}.
(Read a, Ord a, Ord b) =>
Bimap a b -> Text -> Maybe b
lookupSelected Dynamic t (Bimap KeyCode k)
ixKeys (Event t Text -> Event t (Maybe k))
-> Event t Text -> Event t (Maybe k)
forall a b. (a -> b) -> a -> b
$ SelectElement EventResult (DomBuilderSpace m) t -> Event t Text
forall {k1} {k2} (er :: EventTag -> *) (d :: k1) (t :: k2).
SelectElement er d t -> Event t Text
_selectElement_change SelectElement EventResult (DomBuilderSpace m) t
eRaw
let readKey Bimap KeyCode k
keys Maybe k
mk = k -> Maybe k -> k
forall a. a -> Maybe a -> a
fromMaybe k
k0 (Maybe k -> k) -> Maybe k -> k
forall a b. (a -> b) -> a -> b
$ do
k <- Maybe k
mk
guard $ Bimap.memberR k keys
return k
dValue <- fmap (zipDynWith readKey ixKeys) $ holdDyn (Just k0) $ leftmost [eChange, fmap Just setK]
return $ Dropdown dValue (attachPromptlyDynWith readKey ixKeys eChange)
#ifdef USE_TEMPLATE_HASKELL
concat <$> mapM makeLenses
[ ''TextAreaConfig
, ''TextArea
, ''TextInputConfig
, ''TextInput
, ''RangeInputConfig
, ''RangeInput
, ''FileInputConfig
, ''FileInput
, ''DropdownConfig
, ''Dropdown
, ''CheckboxConfig
, ''Checkbox
]
#else
textAreaConfig_attributes :: Lens' (TextAreaConfig t) (Dynamic t (Map Text Text))
textAreaConfig_attributes f (TextAreaConfig x1 x2 x3) = (\y -> TextAreaConfig x1 x2 y) <$> f x3
{-# INLINE textAreaConfig_attributes #-}
textAreaConfig_initialValue :: Lens' (TextAreaConfig t) Text
textAreaConfig_initialValue f (TextAreaConfig x1 x2 x3) = (\y -> TextAreaConfig y x2 x3) <$> f x1
{-# INLINE textAreaConfig_initialValue #-}
textAreaConfig_setValue :: Lens' (TextAreaConfig t) (Event t Text)
textAreaConfig_setValue f (TextAreaConfig x1 x2 x3) = (\y -> TextAreaConfig x1 y x3) <$> f x2
{-# INLINE textAreaConfig_setValue #-}
textArea_element :: Lens' (TextArea t) HTMLTextAreaElement
textArea_element f (TextArea x1 x2 x3 x4 x5) = (\y -> TextArea x1 x2 x3 x4 y) <$> f x5
{-# INLINE textArea_element #-}
textArea_hasFocus :: Lens' (TextArea t) (Dynamic t Bool)
textArea_hasFocus f (TextArea x1 x2 x3 x4 x5) = (\y -> TextArea x1 x2 y x4 x5) <$> f x3
{-# INLINE textArea_hasFocus #-}
textArea_input :: Lens' (TextArea t) (Event t Text)
textArea_input f (TextArea x1 x2 x3 x4 x5) = (\y -> TextArea x1 y x3 x4 x5) <$> f x2
{-# INLINE textArea_input #-}
textArea_keypress :: Lens' (TextArea t) (Event t Word)
textArea_keypress f (TextArea x1 x2 x3 x4 x5) = (\y -> TextArea x1 x2 x3 y x5) <$> f x4
{-# INLINE textArea_keypress #-}
textArea_value :: Lens' (TextArea t) (Dynamic t Text)
textArea_value f (TextArea x1 x2 x3 x4 x5) = (\y -> TextArea y x2 x3 x4 x5) <$> f x1
{-# INLINE textArea_value #-}
textInputConfig_attributes :: Lens' (TextInputConfig t) (Dynamic t (Map Text Text))
textInputConfig_attributes f (TextInputConfig x1 x2 x3 x4) = (\y -> TextInputConfig x1 x2 x3 y) <$> f x4
{-# INLINE textInputConfig_attributes #-}
textInputConfig_initialValue :: Lens' (TextInputConfig t) Text
textInputConfig_initialValue f (TextInputConfig x1 x2 x3 x4) = (\y -> TextInputConfig x1 y x3 x4) <$> f x2
{-# INLINE textInputConfig_initialValue #-}
textInputConfig_inputType :: Lens' (TextInputConfig t) Text
textInputConfig_inputType f (TextInputConfig x1 x2 x3 x4) = (\y -> TextInputConfig y x2 x3 x4) <$> f x1
{-# INLINE textInputConfig_inputType #-}
textInputConfig_setValue :: Lens' (TextInputConfig t) (Event t Text)
textInputConfig_setValue f (TextInputConfig x1 x2 x3 x4) = (\y -> TextInputConfig x1 x2 y x4) <$> f x3
{-# INLINE textInputConfig_setValue #-}
textInput_builderElement :: Lens' (TextInput t) (InputElement EventResult GhcjsDomSpace t)
textInput_builderElement f (TextInput x1 x2 x3 x4 x5 x6 x7) = (\y -> TextInput x1 x2 x3 x4 x5 x6 y) <$> f x7
{-# INLINE textInput_builderElement #-}
textInput_hasFocus :: Lens' (TextInput t) (Dynamic t Bool)
textInput_hasFocus f (TextInput x1 x2 x3 x4 x5 x6 x7) = (\y -> TextInput x1 x2 x3 x4 x5 y x7) <$> f x6
{-# INLINE textInput_hasFocus #-}
textInput_input :: Lens' (TextInput t) (Event t Text)
textInput_input f (TextInput x1 x2 x3 x4 x5 x6 x7) = (\y -> TextInput x1 y x3 x4 x5 x6 x7) <$> f x2
{-# INLINE textInput_input #-}
textInput_keydown :: Lens' (TextInput t) (Event t Word)
textInput_keydown f (TextInput x1 x2 x3 x4 x5 x6 x7) = (\y -> TextInput x1 x2 x3 y x5 x6 x7) <$> f x4
{-# INLINE textInput_keydown #-}
textInput_keypress :: Lens' (TextInput t) (Event t Word)
textInput_keypress f (TextInput x1 x2 x3 x4 x5 x6 x7) = (\y -> TextInput x1 x2 y x4 x5 x6 x7) <$> f x3
{-# INLINE textInput_keypress #-}
textInput_keyup :: Lens' (TextInput t) (Event t Word)
textInput_keyup f (TextInput x1 x2 x3 x4 x5 x6 x7) = (\y -> TextInput x1 x2 x3 x4 y x6 x7) <$> f x5
{-# INLINE textInput_keyup #-}
textInput_value :: Lens' (TextInput t) (Dynamic t Text)
textInput_value f (TextInput x1 x2 x3 x4 x5 x6 x7) = (\y -> TextInput y x2 x3 x4 x5 x6 x7) <$> f x1
{-# INLINE textInput_value #-}
rangeInputConfig_attributes :: Lens' (RangeInputConfig t) (Dynamic t (Map Text Text))
rangeInputConfig_attributes f (RangeInputConfig x1 x2 x3) = (\y -> RangeInputConfig x1 x2 y) <$> f x3
{-# INLINE rangeInputConfig_attributes #-}
rangeInputConfig_initialValue :: Lens' (RangeInputConfig t) Float
rangeInputConfig_initialValue f (RangeInputConfig x1 x2 x3) = (\y -> RangeInputConfig y x2 x3) <$> f x1
{-# INLINE rangeInputConfig_initialValue #-}
rangeInputConfig_setValue :: Lens' (RangeInputConfig t) (Event t Float)
rangeInputConfig_setValue f (RangeInputConfig x1 x2 x3) = (\y -> RangeInputConfig x1 y x3) <$> f x2
{-# INLINE rangeInputConfig_setValue #-}
rangeInput_element :: Lens' (RangeInput t) HTMLInputElement
rangeInput_element f (RangeInput x1 x2 x3 x4 x5) = (\y -> RangeInput x1 x2 x3 x4 y) <$> f x5
{-# INLINE rangeInput_element #-}
rangeInput_hasFocus :: Lens' (RangeInput t) (Dynamic t Bool)
rangeInput_hasFocus f (RangeInput x1 x2 x3 x4 x5) = (\y -> RangeInput x1 x2 x3 y x5) <$> f x4
{-# INLINE rangeInput_hasFocus #-}
rangeInput_input :: Lens' (RangeInput t) (Event t Float)
rangeInput_input f (RangeInput x1 x2 x3 x4 x5) = (\y -> RangeInput x1 y x3 x4 x5) <$> f x2
{-# INLINE rangeInput_input #-}
rangeInput_mouseup :: Lens' (RangeInput t) (Event t (Int, Int))
rangeInput_mouseup f (RangeInput x1 x2 x3 x4 x5) = (\y -> RangeInput x1 x2 y x4 x5) <$> f x3
{-# INLINE rangeInput_mouseup #-}
rangeInput_value :: Lens' (RangeInput t) (Dynamic t Float)
rangeInput_value f (RangeInput x1 x2 x3 x4 x5) = (\y -> RangeInput y x2 x3 x4 x5) <$> f x1
{-# INLINE rangeInput_value #-}
fileInputConfig_attributes :: Iso
(FileInputConfig t1)
(FileInputConfig t2)
(Dynamic t1 (Map Text Text))
(Dynamic t2 (Map Text Text))
fileInputConfig_attributes = iso (\(FileInputConfig x) -> x) FileInputConfig
{-# INLINE fileInputConfig_attributes #-}
fileInput_element :: Lens
(FileInput d1 t)
(FileInput d2 t)
(RawInputElement d1)
(RawInputElement d2)
fileInput_element f (FileInput x1 x2) = (\y -> FileInput x1 y) <$> f x2
{-# INLINE fileInput_element #-}
fileInput_value :: Lens
(FileInput d t1)
(FileInput d t2)
(Dynamic t1 [File])
(Dynamic t2 [File])
fileInput_value f (FileInput x1 x2) = (\y -> FileInput y x2) <$> f x1
{-# INLINE fileInput_value #-}
dropdownConfig_attributes :: Lens' (DropdownConfig t k) (Dynamic t (Map Text Text))
dropdownConfig_attributes f (DropdownConfig x1 x2) = (\y -> DropdownConfig x1 y) <$> f x2
{-# INLINE dropdownConfig_attributes #-}
dropdownConfig_setValue :: Lens
(DropdownConfig t k1)
(DropdownConfig t k2)
(Event t k1)
(Event t k2)
dropdownConfig_setValue f (DropdownConfig x1 x2) = (\y -> DropdownConfig y x2) <$> f x1
{-# INLINE dropdownConfig_setValue #-}
dropdown_change :: Lens' (Dropdown t k) (Event t k)
dropdown_change f (Dropdown x1 x2) = (\y -> Dropdown x1 y) <$> f x2
{-# INLINE dropdown_change #-}
dropdown_value :: Lens' (Dropdown t k) (Dynamic t k)
dropdown_value f (Dropdown x1 x2) = (\y -> Dropdown y x2) <$> f x1
{-# INLINE dropdown_value #-}
checkboxConfig_attributes :: Lens' (CheckboxConfig t) (Dynamic t (Map Text Text))
checkboxConfig_attributes f (CheckboxConfig x1 x2) = (\y -> CheckboxConfig x1 y) <$> f x2
{-# INLINE checkboxConfig_attributes #-}
checkboxConfig_setValue :: Lens' (CheckboxConfig t) (Event t Bool)
checkboxConfig_setValue f (CheckboxConfig x1 x2) = (\y -> CheckboxConfig y x2) <$> f x1
{-# INLINE checkboxConfig_setValue #-}
checkbox_change :: Lens' (Checkbox t) (Event t Bool)
checkbox_change f (Checkbox x1 x2) = (\y -> Checkbox x1 y) <$> f x2
{-# INLINE checkbox_change #-}
checkbox_value :: Lens' (Checkbox t) (Dynamic t Bool)
checkbox_value f (Checkbox x1 x2) = (\y -> Checkbox y x2) <$> f x1
{-# INLINE checkbox_value #-}
#endif
instance HasAttributes (TextAreaConfig t) where
type Attrs (TextAreaConfig t) = Dynamic t (Map Text Text)
attributes :: Lens' (TextAreaConfig t) (Attrs (TextAreaConfig t))
attributes = (Dynamic t (Map Text Text) -> f (Dynamic t (Map Text Text)))
-> TextAreaConfig t -> f (TextAreaConfig t)
(Attrs (TextAreaConfig t) -> f (Attrs (TextAreaConfig t)))
-> TextAreaConfig t -> f (TextAreaConfig t)
forall k (t :: k) (f :: * -> *).
Functor f =>
(Dynamic t (Map Text Text) -> f (Dynamic t (Map Text Text)))
-> TextAreaConfig t -> f (TextAreaConfig t)
textAreaConfig_attributes
instance HasAttributes (TextInputConfig t) where
type Attrs (TextInputConfig t) = Dynamic t (Map Text Text)
attributes :: Lens' (TextInputConfig t) (Attrs (TextInputConfig t))
attributes = (Dynamic t (Map Text Text) -> f (Dynamic t (Map Text Text)))
-> TextInputConfig t -> f (TextInputConfig t)
(Attrs (TextInputConfig t) -> f (Attrs (TextInputConfig t)))
-> TextInputConfig t -> f (TextInputConfig t)
forall k (t :: k) (f :: * -> *).
Functor f =>
(Dynamic t (Map Text Text) -> f (Dynamic t (Map Text Text)))
-> TextInputConfig t -> f (TextInputConfig t)
textInputConfig_attributes
instance HasAttributes (RangeInputConfig t) where
type Attrs (RangeInputConfig t) = Dynamic t (Map Text Text)
attributes :: Lens' (RangeInputConfig t) (Attrs (RangeInputConfig t))
attributes = (Dynamic t (Map Text Text) -> f (Dynamic t (Map Text Text)))
-> RangeInputConfig t -> f (RangeInputConfig t)
(Attrs (RangeInputConfig t) -> f (Attrs (RangeInputConfig t)))
-> RangeInputConfig t -> f (RangeInputConfig t)
forall k (t :: k) (f :: * -> *).
Functor f =>
(Dynamic t (Map Text Text) -> f (Dynamic t (Map Text Text)))
-> RangeInputConfig t -> f (RangeInputConfig t)
rangeInputConfig_attributes
instance HasAttributes (DropdownConfig t k) where
type Attrs (DropdownConfig t k) = Dynamic t (Map Text Text)
attributes :: Lens' (DropdownConfig t k) (Attrs (DropdownConfig t k))
attributes = (Dynamic t (Map Text Text) -> f (Dynamic t (Map Text Text)))
-> DropdownConfig t k -> f (DropdownConfig t k)
(Attrs (DropdownConfig t k) -> f (Attrs (DropdownConfig t k)))
-> DropdownConfig t k -> f (DropdownConfig t k)
forall k (t :: k) k (f :: * -> *).
Functor f =>
(Dynamic t (Map Text Text) -> f (Dynamic t (Map Text Text)))
-> DropdownConfig t k -> f (DropdownConfig t k)
dropdownConfig_attributes
instance HasAttributes (CheckboxConfig t) where
type Attrs (CheckboxConfig t) = Dynamic t (Map Text Text)
attributes :: Lens' (CheckboxConfig t) (Attrs (CheckboxConfig t))
attributes = (Dynamic t (Map Text Text) -> f (Dynamic t (Map Text Text)))
-> CheckboxConfig t -> f (CheckboxConfig t)
(Attrs (CheckboxConfig t) -> f (Attrs (CheckboxConfig t)))
-> CheckboxConfig t -> f (CheckboxConfig t)
forall k (t :: k) (f :: * -> *).
Functor f =>
(Dynamic t (Map Text Text) -> f (Dynamic t (Map Text Text)))
-> CheckboxConfig t -> f (CheckboxConfig t)
checkboxConfig_attributes
instance HasAttributes (FileInputConfig t) where
type Attrs (FileInputConfig t) = Dynamic t (Map Text Text)
attributes :: Lens' (FileInputConfig t) (Attrs (FileInputConfig t))
attributes = (Dynamic t (Map Text Text) -> f (Dynamic t (Map Text Text)))
-> FileInputConfig t -> f (FileInputConfig t)
(Attrs (FileInputConfig t) -> f (Attrs (FileInputConfig t)))
-> FileInputConfig t -> f (FileInputConfig t)
forall k (t :: k) k (t :: k) (p :: * -> * -> *) (f :: * -> *).
(Profunctor p, Functor f) =>
p (Dynamic t (Map Text Text)) (f (Dynamic t (Map Text Text)))
-> p (FileInputConfig t) (f (FileInputConfig t))
fileInputConfig_attributes
instance HasSetValue (TextAreaConfig t) where
type SetValue (TextAreaConfig t) = Event t Text
setValue :: Lens' (TextAreaConfig t) (SetValue (TextAreaConfig t))
setValue = (Event t Text -> f (Event t Text))
-> TextAreaConfig t -> f (TextAreaConfig t)
(SetValue (TextAreaConfig t) -> f (SetValue (TextAreaConfig t)))
-> TextAreaConfig t -> f (TextAreaConfig t)
forall k (t :: k) (f :: * -> *).
Functor f =>
(Event t Text -> f (Event t Text))
-> TextAreaConfig t -> f (TextAreaConfig t)
textAreaConfig_setValue
instance HasSetValue (TextInputConfig t) where
type SetValue (TextInputConfig t) = Event t Text
setValue :: Lens' (TextInputConfig t) (SetValue (TextInputConfig t))
setValue = (Event t Text -> f (Event t Text))
-> TextInputConfig t -> f (TextInputConfig t)
(SetValue (TextInputConfig t) -> f (SetValue (TextInputConfig t)))
-> TextInputConfig t -> f (TextInputConfig t)
forall k (t :: k) (f :: * -> *).
Functor f =>
(Event t Text -> f (Event t Text))
-> TextInputConfig t -> f (TextInputConfig t)
textInputConfig_setValue
instance HasSetValue (RangeInputConfig t) where
type SetValue (RangeInputConfig t) = Event t Float
setValue :: Lens' (RangeInputConfig t) (SetValue (RangeInputConfig t))
setValue = (Event t Float -> f (Event t Float))
-> RangeInputConfig t -> f (RangeInputConfig t)
(SetValue (RangeInputConfig t)
-> f (SetValue (RangeInputConfig t)))
-> RangeInputConfig t -> f (RangeInputConfig t)
forall k (t :: k) (f :: * -> *).
Functor f =>
(Event t Float -> f (Event t Float))
-> RangeInputConfig t -> f (RangeInputConfig t)
rangeInputConfig_setValue
instance HasSetValue (DropdownConfig t k) where
type SetValue (DropdownConfig t k) = Event t k
setValue :: Lens' (DropdownConfig t k) (SetValue (DropdownConfig t k))
setValue = (Event t k -> f (Event t k))
-> DropdownConfig t k -> f (DropdownConfig t k)
(SetValue (DropdownConfig t k)
-> f (SetValue (DropdownConfig t k)))
-> DropdownConfig t k -> f (DropdownConfig t k)
forall k (t :: k) k k (f :: * -> *).
Functor f =>
(Event t k -> f (Event t k))
-> DropdownConfig t k -> f (DropdownConfig t k)
dropdownConfig_setValue
instance HasSetValue (CheckboxConfig t) where
type SetValue (CheckboxConfig t) = Event t Bool
setValue :: Lens' (CheckboxConfig t) (SetValue (CheckboxConfig t))
setValue = (Event t Bool -> f (Event t Bool))
-> CheckboxConfig t -> f (CheckboxConfig t)
(SetValue (CheckboxConfig t) -> f (SetValue (CheckboxConfig t)))
-> CheckboxConfig t -> f (CheckboxConfig t)
forall k (t :: k) (f :: * -> *).
Functor f =>
(Event t Bool -> f (Event t Bool))
-> CheckboxConfig t -> f (CheckboxConfig t)
checkboxConfig_setValue
class HasValue a where
type Value a :: Type
value :: a -> Value a
instance HasValue (InputElement er d t) where
type Value (InputElement er d t) = Dynamic t Text
value :: InputElement er d t -> Value (InputElement er d t)
value = InputElement er d t -> Dynamic t Text
InputElement er d t -> Value (InputElement er d t)
forall {k1} {k2} (er :: EventTag -> *) (d :: k1) (t :: k2).
InputElement er d t -> Dynamic t Text
_inputElement_value
instance HasValue (TextAreaElement er d t) where
type Value (TextAreaElement er d t) = Dynamic t Text
value :: TextAreaElement er d t -> Value (TextAreaElement er d t)
value = TextAreaElement er d t -> Dynamic t Text
TextAreaElement er d t -> Value (TextAreaElement er d t)
forall {k1} {k2} (er :: EventTag -> *) (d :: k1) (t :: k2).
TextAreaElement er d t -> Dynamic t Text
_textAreaElement_value
instance HasValue (TextArea t) where
type Value (TextArea t) = Dynamic t Text
value :: TextArea t -> Value (TextArea t)
value = TextArea t -> Dynamic t Text
TextArea t -> Value (TextArea t)
forall {k} (t :: k). TextArea t -> Dynamic t Text
_textArea_value
instance HasValue (TextInput t) where
type Value (TextInput t) = Dynamic t Text
value :: TextInput t -> Value (TextInput t)
value = TextInput t -> Dynamic t Text
TextInput t -> Value (TextInput t)
forall {k1} (t :: k1). TextInput t -> Dynamic t Text
_textInput_value
instance HasValue (RangeInput t) where
type Value (RangeInput t) = Dynamic t Float
value :: RangeInput t -> Value (RangeInput t)
value = RangeInput t -> Dynamic t Float
RangeInput t -> Value (RangeInput t)
forall {k} (t :: k). RangeInput t -> Dynamic t Float
_rangeInput_value
instance HasValue (FileInput d t) where
type Value (FileInput d t) = Dynamic t [File]
value :: FileInput d t -> Value (FileInput d t)
value = FileInput d t -> Dynamic t [File]
FileInput d t -> Value (FileInput d t)
forall {k} {k} (d :: k) (t :: k). FileInput d t -> Dynamic t [File]
_fileInput_value
instance HasValue (Dropdown t k) where
type Value (Dropdown t k) = Dynamic t k
value :: Dropdown t k -> Value (Dropdown t k)
value = Dropdown t k -> Dynamic t k
Dropdown t k -> Value (Dropdown t k)
forall {k} (t :: k) k. Dropdown t k -> Dynamic t k
_dropdown_value
instance HasValue (Checkbox t) where
type Value (Checkbox t) = Dynamic t Bool
value :: Checkbox t -> Value (Checkbox t)
value = Checkbox t -> Dynamic t Bool
Checkbox t -> Value (Checkbox t)
forall {k} (t :: k). Checkbox t -> Dynamic t Bool
_checkbox_value