@@ -1,4 +1,4 @@
1−{-# LANGUAGE ConstraintKinds, TypeFamilies, FlexibleContexts, DataKinds, GADTs, ScopedTypeVariables, FlexibleInstances, RecursiveDo #-}
1+{-# LANGUAGE ConstraintKinds, TypeFamilies, FlexibleContexts, DataKinds, GADTs, ScopedTypeVariables, FlexibleInstances, RecursiveDo, TemplateHaskell #-}
22module Reflex.Dom.Widget.Input where
33
44import Prelude
@@ -88,6 +88,10 @@ input' inputType eSetValue dAttrs = do
8888 return $ TextInput dValue eKeypress eKeydown eKeyup dFocus dMyElement
8989-}
9090
91+class HasValue a where
92+ type Value a :: *
93+ value :: a -> Value a
94+
9195data TextInput t
9296 = TextInput { _textInput_value :: Dynamic t String
9397 , _textInput_keypress :: Event t Int
@@ -97,20 +101,41 @@ data TextInput t
97101 , _textInput_element :: HTMLInputElement
98102 }
99103
104+instance HasValue (TextInput t) where
105+ type Value (TextInput t) = Dynamic t String
106+ value = _textInput_value
107+
100108textInput :: MonadWidget t m => m (TextInput t)
101109textInput = input' "text" "" never (constDyn $ Map.empty)
102110
103111textInputGetEnter :: Reflex t => TextInput t -> Event t ()
104112textInputGetEnter i = fmapMaybe (\n -> if n == keycodeEnter then Just () else Nothing) $ _textInput_keypress i
105113
114+data TextAreaConfig t
115+ = TextAreaConfig { _textAreaConfig_initialValue :: String
116+ , _textAreaConfig_setValue :: Event t String
117+ , _textAreaConfig_attributes :: Dynamic t (Map String String)
118+ }
119+
120+instance Reflex t => Default (TextAreaConfig t) where
121+ def = TextAreaConfig { _textAreaConfig_initialValue = ""
122+ , _textAreaConfig_setValue = never
123+ , _textAreaConfig_attributes = constDyn mempty
124+ }
125+
106126data TextArea t
107127 = TextArea { _textArea_value :: Dynamic t String
108128 , _textArea_element :: HTMLTextAreaElement
109129 , _textArea_hasFocus :: Dynamic t Bool
130+ , _textArea_keypress :: Event t Int
110131 }
111132
112−textArea :: MonadWidget t m => String -> Event t String -> Dynamic t (Map String String) -> m (TextArea t)
113−textArea initial eSet attrs = do
133+instance HasValue (TextArea t) where
134+ type Value (TextArea t) = Dynamic t String
135+ value = _textArea_value
136+
137+textArea :: MonadWidget t m => TextAreaConfig t -> m (TextArea t)
138+textArea (TextAreaConfig initial eSet attrs) = do
114139 e <- liftM castToHTMLTextAreaElement $ buildEmptyElement "textarea" attrs
115140 liftIO $ htmlTextAreaElementSetValue e initial
116141 postGui <- askPostGui
@@ -124,8 +149,9 @@ textArea initial eSet attrs = do
124149 performEvent_ $ fmap (liftIO . htmlTextAreaElementSetValue e) eSet
125150 f <- holdDyn False eChangeFocus
126151 ev <- wrapDomEvent e elementOninput $ liftIO $ htmlTextAreaElementGetValue e
127− v <- holdDyn "" ev
128− return $ TextArea v e f
152+ v <- holdDyn "" $ leftmost [eSet, ev]
153+ eKeypress <- wrapDomEvent e elementOnkeypress $ liftIO . uiEventGetKeyCode =<< event
154+ return $ TextArea v e f eKeypress
129155
130156{-
131157type family Controller sm t a where
@@ -293,3 +319,24 @@ searchInputResultsList' results builder = do
293319 resultsList <- elDynAttr "ul" attrs $ builder results
294320 liftM switch $ hold never $ fmap (leftmost . Map.elems) (updated resultsList)
295321
322+liftM concat $ mapM makeLenses
323+ [ ''TextAreaConfig
324+ , ''TextArea
325+ , ''TextInput
326+ ]
327+
328+class HasAttributes a where
329+ type Attrs a :: *
330+ attributes :: Lens' a (Attrs a)
331+
332+instance HasAttributes (TextAreaConfig t) where
333+ type Attrs (TextAreaConfig t) = Dynamic t (Map String String)
334+ attributes = textAreaConfig_attributes
335+
336+class HasSetValue a where
337+ type SetValue a :: *
338+ setValue :: Lens' a (SetValue a)
339+
340+instance HasSetValue (TextAreaConfig t) where
341+ type SetValue (TextAreaConfig t) = Event t String
342+ setValue = textAreaConfig_setValue