git.iko.soy/reflex-dom
on develop help sign in
Merge branch 'develop' of github.com:ryantrinkle/reflex-dom into develop
64c4303Ryan Trinkle
src/Reflex/Dom/Widget/Basic.hs+16−8
compare with develop
unifiedsplit
@@ -347,14 +347,17 @@ deleteBetweenExclusive s e = do
347-- | s and e must both be children of the same node and s must precede e
347-- | s and e must both be children of the same node and s must precede e
348deleteBetweenInclusive :: (IsNode start, IsNode end) => start -> end -> IO ()
348deleteBetweenInclusive :: (IsNode start, IsNode end) => start -> end -> IO ()
349deleteBetweenInclusive s e = do
349deleteBetweenInclusive s e = do
350− Just currentParent <- nodeGetParentNode e -- May be different than it was at initial construction, e.g., because the parent may have dumped us in from a DocumentFragment
350+ mCurrentParent <- nodeGetParentNode e -- May be different than it was at initial construction, e.g., because the parent may have dumped us in from a DocumentFragment
351+ case mCurrentParent of
352+ Nothing -> return () --TODO: Is this the right behavior?
353+ Just currentParent -> do
351− let go = do
354+ let go = do
352− Just x <- nodeGetPreviousSibling e -- This can't be Nothing because we should hit 's' first
355+ Just x <- nodeGetPreviousSibling e -- This can't be Nothing because we should hit 's' first
353− _ <- nodeRemoveChild currentParent $ Just x
356+ _ <- nodeRemoveChild currentParent $ Just x
354− when (unNode (toNode s) /= unNode (toNode x)) go
357+ when (unNode (toNode s) /= unNode (toNode x)) go
355− go
358+ go
356− _ <- nodeRemoveChild currentParent $ Just e
359+ _ <- nodeRemoveChild currentParent $ Just e
357− return ()
360+ return ()
358
361
359--------------------------------------------------------------------------------
362--------------------------------------------------------------------------------
360-- Adapters
363-- Adapters
@@ -467,6 +470,11 @@ linkClass s c = do
467link :: MonadWidget t m => String -> m (Link t)
470link :: MonadWidget t m => String -> m (Link t)
468link s = linkClass s ""
471link s = linkClass s ""
469
472
473+button :: MonadWidget t m => String -> m (Event t ())
474+button s = do
475+ (e, _) <- el' "button" $ text s
476+ return $ _el_clicked e
477+
470newtype Workflow t m a = Workflow { unWorkflow :: m (a, Event t (Workflow t m a)) }
478newtype Workflow t m a = Workflow { unWorkflow :: m (a, Event t (Workflow t m a)) }
471
479
472workflowView :: forall t m a. MonadWidget t m => Workflow t m a -> m (Event t a)
480workflowView :: forall t m a. MonadWidget t m => Workflow t m a -> m (Event t a)
src/Reflex/Dom/Widget/Input.hs+52−5
@@ -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
4import Prelude
@@ -88,6 +88,10 @@ input' inputType eSetValue dAttrs = do
88 return $ TextInput dValue eKeypress eKeydown eKeyup dFocus dMyElement
88 return $ TextInput dValue eKeypress eKeydown eKeyup dFocus dMyElement
89-}
89-}
90
90
91+class HasValue a where
92+ type Value a :: *
93+ value :: a -> Value a
94+
91data TextInput t
95data TextInput t
92 = TextInput { _textInput_value :: Dynamic t String
96 = TextInput { _textInput_value :: Dynamic t String
93 , _textInput_keypress :: Event t Int
97 , _textInput_keypress :: Event t Int
@@ -97,20 +101,41 @@ data TextInput t
97 , _textInput_element :: HTMLInputElement
101 , _textInput_element :: HTMLInputElement
98 }
102 }
99
103
104+instance HasValue (TextInput t) where
105+ type Value (TextInput t) = Dynamic t String
106+ value = _textInput_value
107+
100textInput :: MonadWidget t m => m (TextInput t)
108textInput :: MonadWidget t m => m (TextInput t)
101textInput = input' "text" "" never (constDyn $ Map.empty)
109textInput = input' "text" "" never (constDyn $ Map.empty)
102
110
103textInputGetEnter :: Reflex t => TextInput t -> Event t ()
111textInputGetEnter :: Reflex t => TextInput t -> Event t ()
104textInputGetEnter i = fmapMaybe (\n -> if n == keycodeEnter then Just () else Nothing) $ _textInput_keypress i
112textInputGetEnter i = fmapMaybe (\n -> if n == keycodeEnter then Just () else Nothing) $ _textInput_keypress i
105
113
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+
106data TextArea t
126data TextArea t
107 = TextArea { _textArea_value :: Dynamic t String
127 = TextArea { _textArea_value :: Dynamic t String
108 , _textArea_element :: HTMLTextAreaElement
128 , _textArea_element :: HTMLTextAreaElement
109 , _textArea_hasFocus :: Dynamic t Bool
129 , _textArea_hasFocus :: Dynamic t Bool
130+ , _textArea_keypress :: Event t Int
110 }
131 }
111
132
133+instance HasValue (TextArea t) where
134+ type Value (TextArea t) = Dynamic t String
135+ value = _textArea_value
136+
112−textArea :: MonadWidget t m => String -> Event t String -> Dynamic t (Map String String) -> m (TextArea t)
137+textArea :: MonadWidget t m => TextAreaConfig t -> m (TextArea t)
113−textArea initial eSet attrs = do
138+textArea (TextAreaConfig initial eSet attrs) = do
114 e <- liftM castToHTMLTextAreaElement $ buildEmptyElement "textarea" attrs
139 e <- liftM castToHTMLTextAreaElement $ buildEmptyElement "textarea" attrs
115 liftIO $ htmlTextAreaElementSetValue e initial
140 liftIO $ htmlTextAreaElementSetValue e initial
116 postGui <- askPostGui
141 postGui <- askPostGui
@@ -124,8 +149,9 @@ textArea initial eSet attrs = do
124 performEvent_ $ fmap (liftIO . htmlTextAreaElementSetValue e) eSet
149 performEvent_ $ fmap (liftIO . htmlTextAreaElementSetValue e) eSet
125 f <- holdDyn False eChangeFocus
150 f <- holdDyn False eChangeFocus
126 ev <- wrapDomEvent e elementOninput $ liftIO $ htmlTextAreaElementGetValue e
151 ev <- wrapDomEvent e elementOninput $ liftIO $ htmlTextAreaElementGetValue e
127− v <- holdDyn "" ev
152+ v <- holdDyn "" $ leftmost [eSet, ev]
153+ eKeypress <- wrapDomEvent e elementOnkeypress $ liftIO . uiEventGetKeyCode =<< event
128− return $ TextArea v e f
154+ return $ TextArea v e f eKeypress
129
155
130{-
156{-
131type family Controller sm t a where
157type family Controller sm t a where
@@ -293,3 +319,24 @@ searchInputResultsList' results builder = do
293 resultsList <- elDynAttr "ul" attrs $ builder results
319 resultsList <- elDynAttr "ul" attrs $ builder results
294 liftM switch $ hold never $ fmap (leftmost . Map.elems) (updated resultsList)
320 liftM switch $ hold never $ fmap (leftmost . Map.elems) (updated resultsList)
295
321
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