{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecursiveDo #-}
{-# LANGUAGE TypeFamilies #-}
module Reflex.Bulmex.Input.Polymorphic
( textInput
, TextInput(..)
, textArea
, TextArea(..)
, textArea_value
, textArea_keypress
, textInput_value
, textInput_keyup
, textInput_keypress
, textInput_keydown
, textInput_input
, textInput_hasFocus
) where
import Control.Lens
import qualified Data.Map.Strict as Map
import qualified Data.Text as Text
import Reflex
import Reflex.Dom.Builder.Class
import Reflex.Dom.Widget.Basic
import qualified Reflex.Dom.Widget.Input as Inp
textInput ::
(DomBuilder t m, PostBuild t m) => Inp.TextInputConfig t -> m (TextInput t)
textInput (Inp.TextInputConfig inputType initial eSetValue dAttrs) = do
modifyAttrs <-
dynamicAttributesToModifyAttributes $
fmap (Map.insert "type" inputType) dAttrs
i <-
inputElement $ Inp.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
}
data TextInput t = TextInput
{ _textInput_value :: Dynamic t Text.Text
, _textInput_input :: Event t Text.Text
, _textInput_keypress :: Event t Word
, _textInput_keydown :: Event t Word
, _textInput_keyup :: Event t Word
, _textInput_hasFocus :: Dynamic t Bool
}
instance Inp.HasValue (TextInput t) where
type Value (TextInput t) = Dynamic t Text.Text
value = _textInput_value
textArea ::
(DomBuilder t m, PostBuild t m) => Inp.TextAreaConfig t -> m (TextArea t)
textArea (Inp.TextAreaConfig initial eSet attrs) = do
modifyAttrs <- dynamicAttributesToModifyAttributes attrs
i <-
textAreaElement $ Inp.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
}
data TextArea t = TextArea
{ _textArea_value :: Dynamic t Text.Text
, _textArea_input :: Event t Text.Text
, _textArea_hasFocus :: Dynamic t Bool
, _textArea_keypress :: Event t Word
}
instance Inp.HasValue (TextArea t) where
type Value (TextArea t) = Dynamic t Text.Text
value = _textArea_value
textArea_keypress :: Lens' (TextArea t) (Event t Word)
textArea_keypress f (TextArea x1 x2 x3 x4) =
(\y -> TextArea x1 x2 x3 y) <$> f x4
textArea_value :: Lens' (TextArea t) (Dynamic t Text.Text)
textArea_value f (TextArea x1 x2 x3 x4) = (\y -> TextArea y x2 x3 x4) <$> f x1
textInput_hasFocus :: Lens' (TextInput t) (Dynamic t Bool)
textInput_hasFocus f (TextInput x1 x2 x3 x4 x5 x6) =
(\y -> TextInput x1 x2 x3 x4 x5 y) <$> f x6
textInput_input :: Lens' (TextInput t) (Event t Text.Text)
textInput_input f (TextInput x1 x2 x3 x4 x5 x6) =
(\y -> TextInput x1 y x3 x4 x5 x6) <$> f x2
textInput_keydown :: Lens' (TextInput t) (Event t Word)
textInput_keydown f (TextInput x1 x2 x3 x4 x5 x6) =
(\y -> TextInput x1 x2 x3 y x5 x6) <$> f x4
textInput_keypress :: Lens' (TextInput t) (Event t Word)
textInput_keypress f (TextInput x1 x2 x3 x4 x5 x6) =
(\y -> TextInput x1 x2 y x4 x5 x6) <$> f x3
textInput_keyup :: Lens' (TextInput t) (Event t Word)
textInput_keyup f (TextInput x1 x2 x3 x4 x5 x6) =
(\y -> TextInput x1 x2 x3 x4 y x6) <$> f x5
textInput_value :: Lens' (TextInput t) (Dynamic t Text.Text)
textInput_value f (TextInput x1 x2 x3 x4 x5 x6) =
(\y -> TextInput y x2 x3 x4 x5 x6) <$> f x1