@@ -16,14 +16,16 @@ import GHCJS.DOM.EventM
16import GHCJS.DOM.File
16import GHCJS.DOM.File
17import qualified GHCJS.DOM.FileList as FileList
17import qualified GHCJS.DOM.FileList as FileList
18import Data.Monoid
18import Data.Monoid
19−import Data.Map as Map
19+import qualified Data.Map as Map
20−import Control.Lens
20+import Control.Lens hiding (ix)
21import Control.Monad hiding (forM_)
21import Control.Monad hiding (forM_)
22import Control.Monad.IO.Class
22import Control.Monad.IO.Class
23+import qualified Data.Bimap as B
23import Data.Default
24import Data.Default
26import Data.Dependent.Sum (DSum (..))
25import Data.Dependent.Sum (DSum (..))
28data TextInput t
30data TextInput t
29 = TextInput { _textInput_value :: Dynamic t String
31 = TextInput { _textInput_value :: Dynamic t String
@@ -191,26 +193,29 @@ instance (Reflex t, Ord k, Show k, Read k) => Default (DropdownConfig t k) where
193--TODO: We should allow the user to specify an ordering instead of relying on the ordering of the Map
195--TODO: We should allow the user to specify an ordering instead of relying on the ordering of the Map
194−--TODO: Get rid of Show k and Read k by indexing the possible values ourselves
195-- | Create a dropdown box
196-- | Create a dropdown box
196-- The first argument gives the initial value of the dropdown; if it is not present in the map of options provided, it will be added with an empty string as its text
197-- The first argument gives the initial value of the dropdown; if it is not present in the map of options provided, it will be added with an empty string as its text
197−dropdown :: forall k t m. (MonadWidget t m, Ord k, Show k, Read k) => k -> Dynamic t (Map k String) -> DropdownConfig t k -> m (Dropdown t k)
198+dropdown :: forall k t m. (MonadWidget t m, Ord k) => k -> Dynamic t (Map k String) -> DropdownConfig t k -> m (Dropdown t k)
198dropdown k0 options (DropdownConfig setK attrs) = do
199dropdown k0 options (DropdownConfig setK attrs) = do
200+ optionsWithAddedKeys <- combineDyn Map.union options <=< foldDyn Map.union (k0 =: "") $ fmap (=: "") setK
201+ defaultKey <- holdDyn k0 setK
202+ (indexedOptions, ixKeys) <- splitDyn <=< forDyn optionsWithAddedKeys $ \os ->
203+ let xs = map (\(ix, (k, v)) -> ((ix, k), ((ix, k), v))) $ zip [0::Int ..] $ Map.toList os
204+ ixVals = Map.fromList $ map snd xs
205+ ixKeys = B.fromList $ map fst xs
199− (eRaw, _) <- elDynAttr' "select" attrs $ do
207+ (eRaw, _) <- elDynAttr' "select" attrs $ listWithKey indexedOptions $ \(ix, k) v -> do
200− optionsWithDefault <- mapDyn (`Map.union` (k0 =: "")) options
201− listWithKey optionsWithDefault $ \k v -> do
202− elAttr "option" ("value" =: show k <> if k == k0 then "selected" =: "selected" else mempty) $ dynText v
208+ optionAttrs <- mapDyn (\dk -> "value" =: show ix <> if dk == k then "selected" =: "selected" else mempty) defaultKey
209+ elDynAttr "option" optionAttrs $ dynText v
203 let e = castToHTMLSelectElement $ _el_element eRaw
210 let e = castToHTMLSelectElement $ _el_element eRaw
204− performEvent_ $ fmap (Select.setValue e . Just . show) setK
211+ performEvent_ $ fmap (Select.setValue e . Just . show) $ attachDynWithMaybe (flip B.lookupR) ixKeys setK
205− eChange <- wrapDomEvent e (`on` change) $ do
212+ eChange <- attachDynWith (\ks s -> join $ B.lookup <$> join (readMaybe <$> s) <*> pure ks) ixKeys <$> (wrapDomEvent e (`on` change) $ Select.getValue e)
206− kStr <- fromMaybe "" <$> Select.getValue e
207− return $ readMay kStr
208− let readKey opts mk = fromMaybe k0 $ do
213+ let readKey keys mk = fromMaybe k0 $ do
210− guard $ Map.member k opts
215+ guard $ B.memberR k keys
212− dValue <- combineDyn readKey options =<< holdDyn (Just k0) (leftmost [eChange, fmap Just setK])
217+ dValue <- combineDyn readKey ixKeys <=< holdDyn (Just k0) $ leftmost [eChange, fmap Just setK]
213− return $ Dropdown dValue (attachDynWith readKey options eChange)
218+ return $ Dropdown dValue (attachDynWith readKey ixKeys eChange)
215liftM concat $ mapM makeLenses
220liftM concat $ mapM makeLenses
216 [ ''TextAreaConfig
221 [ ''TextAreaConfig