git.iko.soy/reflex-dom
on develop help sign in
Various adjustments to make the API cleaner
400dedcRyan Trinkle
src/Reflex/Dom/Widget/Input.hs+52−5
compare with develop
unifiedsplit
@@ -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 #-}
2module Reflex.Dom.Widget.Input where
2module Reflex.Dom.Widget.Input where
3
3
4import Prelude hiding (forM_)
4import Prelude hiding (forM_)
@@ -92,6 +92,10 @@ input' inputType eSetValue dAttrs = do
92 return $ TextInput dValue eKeypress eKeydown eKeyup dFocus dMyElement
92 return $ TextInput dValue eKeypress eKeydown eKeyup dFocus dMyElement
93-}
93-}
94
94
95+class HasValue a where
96+ type Value a :: *
97+ value :: a -> Value a
98+
95data TextInput t
99data TextInput t
96 = TextInput { _textInput_value :: Dynamic t String
100 = TextInput { _textInput_value :: Dynamic t String
97 , _textInput_keypress :: Event t Int
101 , _textInput_keypress :: Event t Int
@@ -101,20 +105,41 @@ data TextInput t
101 , _textInput_element :: HTMLInputElement
105 , _textInput_element :: HTMLInputElement
102 }
106 }
103
107
108+instance HasValue (TextInput t) where
109+ type Value (TextInput t) = Dynamic t String
110+ value = _textInput_value
111+
104textInput :: MonadWidget t m => m (TextInput t)
112textInput :: MonadWidget t m => m (TextInput t)
105textInput = input' "text" "" never (constDyn $ Map.empty)
113textInput = input' "text" "" never (constDyn $ Map.empty)
106
114
107textInputGetEnter :: Reflex t => TextInput t -> Event t ()
115textInputGetEnter :: Reflex t => TextInput t -> Event t ()
108textInputGetEnter i = fmapMaybe (\n -> if n == keycodeEnter then Just () else Nothing) $ _textInput_keypress i
116textInputGetEnter i = fmapMaybe (\n -> if n == keycodeEnter then Just () else Nothing) $ _textInput_keypress i
109
117
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+
110data TextArea t
130data TextArea t
111 = TextArea { _textArea_value :: Dynamic t String
131 = TextArea { _textArea_value :: Dynamic t String
112 , _textArea_element :: HTMLTextAreaElement
132 , _textArea_element :: HTMLTextAreaElement
113 , _textArea_hasFocus :: Dynamic t Bool
133 , _textArea_hasFocus :: Dynamic t Bool
134+ , _textArea_keypress :: Event t Int
114 }
135 }
115
136
137+instance HasValue (TextArea t) where
138+ type Value (TextArea t) = Dynamic t String
139+ value = _textArea_value
140+
116−textArea :: MonadWidget t m => String -> Event t String -> Dynamic t (Map String String) -> m (TextArea t)
141+textArea :: MonadWidget t m => TextAreaConfig t -> m (TextArea t)
117−textArea initial eSet attrs = do
142+textArea (TextAreaConfig initial eSet attrs) = do
118 e <- liftM castToHTMLTextAreaElement $ buildEmptyElement "textarea" attrs
143 e <- liftM castToHTMLTextAreaElement $ buildEmptyElement "textarea" attrs
119 postGui <- askPostGui
144 postGui <- askPostGui
120 runWithActions <- askRunWithActions
145 runWithActions <- askRunWithActions
@@ -127,8 +152,9 @@ textArea initial eSet attrs = do
127 performEvent_ $ fmap (liftIO . htmlTextAreaElementSetValue e) eSet
152 performEvent_ $ fmap (liftIO . htmlTextAreaElementSetValue e) eSet
128 f <- holdDyn False eChangeFocus
153 f <- holdDyn False eChangeFocus
129 ev <- wrapDomEvent e elementOninput $ liftIO $ htmlTextAreaElementGetValue e
154 ev <- wrapDomEvent e elementOninput $ liftIO $ htmlTextAreaElementGetValue e
130− v <- holdDyn "" ev
155+ v <- holdDyn "" $ leftmost [eSet, ev]
156+ eKeypress <- wrapDomEvent e elementOnkeypress $ liftIO . uiEventGetKeyCode =<< event
131− return $ TextArea v e f
157+ return $ TextArea v e f eKeypress
132
158
133{-
159{-
134type family Controller sm t a where
160type family Controller sm t a where
@@ -296,3 +322,24 @@ searchInputResultsList' results builder = do
296 resultsList <- elDynAttr "ul" attrs $ builder results
322 resultsList <- elDynAttr "ul" attrs $ builder results
297 liftM switch $ hold never $ fmap (leftmost . Map.elems) (updated resultsList)
323 liftM switch $ hold never $ fmap (leftmost . Map.elems) (updated resultsList)
298
324
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