@@ -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 hiding (forM_)
@@ -92,6 +92,10 @@ input' inputType eSetValue dAttrs = do
9292 return $ TextInput dValue eKeypress eKeydown eKeyup dFocus dMyElement
9393-}
9494
95+class HasValue a where
96+ type Value a :: *
97+ value :: a -> Value a
98+
9599data TextInput t
96100 = TextInput { _textInput_value :: Dynamic t String
97101 , _textInput_keypress :: Event t Int
@@ -101,20 +105,41 @@ data TextInput t
101105 , _textInput_element :: HTMLInputElement
102106 }
103107
108+instance HasValue (TextInput t) where
109+ type Value (TextInput t) = Dynamic t String
110+ value = _textInput_value
111+
104112textInput :: MonadWidget t m => m (TextInput t)
105113textInput = input' "text" "" never (constDyn $ Map.empty)
106114
107115textInputGetEnter :: Reflex t => TextInput t -> Event t ()
108116textInputGetEnter i = fmapMaybe (\n -> if n == keycodeEnter then Just () else Nothing) $ _textInput_keypress i
109117
118+data TextAreaConfig t
119+ = TextAreaConfig { _textAreaConfig_initialValue :: String
120+ , _textAreaConfig_setValue :: Event t String
121+ , _textAreaConfig_attributes :: Dynamic t (Map String String)
122+ }
123+
124+instance Reflex t => Default (TextAreaConfig t) where
125+ def = TextAreaConfig { _textAreaConfig_initialValue = ""
126+ , _textAreaConfig_setValue = never
127+ , _textAreaConfig_attributes = constDyn mempty
128+ }
129+
110130data TextArea t
111131 = TextArea { _textArea_value :: Dynamic t String
112132 , _textArea_element :: HTMLTextAreaElement
113133 , _textArea_hasFocus :: Dynamic t Bool
134+ , _textArea_keypress :: Event t Int
114135 }
115136
116−textArea :: MonadWidget t m => String -> Event t String -> Dynamic t (Map String String) -> m (TextArea t)
117−textArea initial eSet attrs = do
137+instance HasValue (TextArea t) where
138+ type Value (TextArea t) = Dynamic t String
139+ value = _textArea_value
140+
141+textArea :: MonadWidget t m => TextAreaConfig t -> m (TextArea t)
142+textArea (TextAreaConfig initial eSet attrs) = do
118143 e <- liftM castToHTMLTextAreaElement $ buildEmptyElement "textarea" attrs
119144 postGui <- askPostGui
120145 runWithActions <- askRunWithActions
@@ -127,8 +152,9 @@ textArea initial eSet attrs = do
127152 performEvent_ $ fmap (liftIO . htmlTextAreaElementSetValue e) eSet
128153 f <- holdDyn False eChangeFocus
129154 ev <- wrapDomEvent e elementOninput $ liftIO $ htmlTextAreaElementGetValue e
130− v <- holdDyn "" ev
131− return $ TextArea v e f
155+ v <- holdDyn "" $ leftmost [eSet, ev]
156+ eKeypress <- wrapDomEvent e elementOnkeypress $ liftIO . uiEventGetKeyCode =<< event
157+ return $ TextArea v e f eKeypress
132158
133159{-
134160type family Controller sm t a where
@@ -296,3 +322,24 @@ searchInputResultsList' results builder = do
296322 resultsList <- elDynAttr "ul" attrs $ builder results
297323 liftM switch $ hold never $ fmap (leftmost . Map.elems) (updated resultsList)
298324
325+liftM concat $ mapM makeLenses
326+ [ ''TextAreaConfig
327+ , ''TextArea
328+ , ''TextInput
329+ ]
330+
331+class HasAttributes a where
332+ type Attrs a :: *
333+ attributes :: Lens' a (Attrs a)
334+
335+instance HasAttributes (TextAreaConfig t) where
336+ type Attrs (TextAreaConfig t) = Dynamic t (Map String String)
337+ attributes = textAreaConfig_attributes
338+
339+class HasSetValue a where
340+ type SetValue a :: *
341+ setValue :: Lens' a (SetValue a)
342+
343+instance HasSetValue (TextAreaConfig t) where
344+ type SetValue (TextAreaConfig t) = Event t String
345+ setValue = textAreaConfig_setValue