module Graphics.UI.Threepenny.Widgets (
Tidings, rumors, facts, tidings,
TextEntry, entry, userText,
ListBox, listBox, userSelection,
) where
import Control.Monad (void, when)
import qualified Data.Map as Map
import qualified Graphics.UI.Threepenny.Attributes as UI
import qualified Graphics.UI.Threepenny.Events as UI
import qualified Graphics.UI.Threepenny.Elements as UI
import Graphics.UI.Threepenny.Core
import Reactive.Threepenny
data TextEntry = TextEntry
{ _elementTE :: Element
, _userTE :: Tidings String
}
instance Widget TextEntry where getElement = _elementTE
userText :: TextEntry -> Tidings String
userText = _userTE
entry
:: Behavior String
-> UI TextEntry
entry bValue = do
input <- UI.input
bEditing <- stepper False $ and <$>
unions [True <$ UI.focus input, False <$ UI.blur input]
window <- askWindow
liftIOLater $ onChange bValue $ \s -> runUI window $ do
editing <- liftIO $ currentValue bEditing
when (not editing) $ void $ element input # set value s
let _elementTE = input
_userTE = tidings bValue $ UI.valueChange input
return TextEntry {..}
data ListBox a = ListBox
{ _elementLB :: Element
, _selectionLB :: Tidings (Maybe a)
}
instance Widget (ListBox a) where getElement = _elementLB
userSelection :: ListBox a -> Tidings (Maybe a)
userSelection = _selectionLB
listBox :: forall a. Ord a
=> Behavior [a]
-> Behavior (Maybe a)
-> Behavior (a -> UI Element)
-> UI (ListBox a)
listBox bitems bsel bdisplay = do
list <- UI.select
element list # sink items (map <$> bdisplay <*> bitems)
let bindices :: Behavior (Map.Map a Int)
bindices = (Map.fromList . flip zip [0..]) <$> bitems
bindex = lookupIndex <$> bindices <*> bsel
lookupIndex indices Nothing = Nothing
lookupIndex indices (Just sel) = Map.lookup sel indices
element list # sink UI.selection bindex
let bindices2 :: Behavior (Map.Map Int a)
bindices2 = Map.fromList . zip [0..] <$> bitems
_selectionLB = tidings bsel $
lookupIndex <$> bindices2 <@> UI.selectionChange list
_elementLB = list
return ListBox {..}
items = mkWriteAttr $ \i x -> void $ do
return x # set children [] #+ map (\i -> UI.option #+ [i]) i