@@ -16,14 +16,16 @@ import GHCJS.DOM.EventM
1616import GHCJS.DOM.File
1717import qualified GHCJS.DOM.FileList as FileList
1818import Data.Monoid
19−import Data.Map as Map
20−import Control.Lens
19+import qualified Data.Map as Map
20+import Control.Lens hiding (ix)
2121import Control.Monad hiding (forM_)
2222import Control.Monad.IO.Class
23+import qualified Data.Bimap as B
2324import Data.Default
24−import Data.Maybe
25−import Safe
2625import Data.Dependent.Sum (DSum (..))
26+import Data.Map (Map)
27+import Data.Maybe
28+import Text.Read
2729
2830data TextInput t
2931 = TextInput { _textInput_value :: Dynamic t String
@@ -191,26 +193,29 @@ instance (Reflex t, Ord k, Show k, Read k) => Default (DropdownConfig t k) where
191193 }
192194
193195--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
195196-- | Create a dropdown box
196197-- 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)
198199dropdown k0 options (DropdownConfig setK attrs) = do
199− (eRaw, _) <- elDynAttr' "select" attrs $ 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
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
206+ in (ixVals, ixKeys)
207+ (eRaw, _) <- elDynAttr' "select" attrs $ listWithKey indexedOptions $ \(ix, k) v -> do
208+ optionAttrs <- mapDyn (\dk -> "value" =: show ix <> if dk == k then "selected" =: "selected" else mempty) defaultKey
209+ elDynAttr "option" optionAttrs $ dynText v
203210 let e = castToHTMLSelectElement $ _el_element eRaw
204− performEvent_ $ fmap (Select.setValue e . Just . show) setK
205− eChange <- wrapDomEvent e (`on` change) $ do
206− kStr <- fromMaybe "" <$> Select.getValue e
207− return $ readMay kStr
208− let readKey opts mk = fromMaybe k0 $ do
211+ performEvent_ $ fmap (Select.setValue e . Just . show) $ attachDynWithMaybe (flip B.lookupR) ixKeys setK
212+ eChange <- attachDynWith (\ks s -> join $ B.lookup <$> join (readMaybe <$> s) <*> pure ks) ixKeys <$> (wrapDomEvent e (`on` change) $ Select.getValue e)
213+ let readKey keys mk = fromMaybe k0 $ do
209214 k <- mk
210− guard $ Map.member k opts
215+ guard $ B.memberR k keys
211216 return k
212− dValue <- combineDyn readKey options =<< holdDyn (Just k0) (leftmost [eChange, fmap Just setK])
213− return $ Dropdown dValue (attachDynWith readKey options eChange)
217+ dValue <- combineDyn readKey ixKeys <=< holdDyn (Just k0) $ leftmost [eChange, fmap Just setK]
218+ return $ Dropdown dValue (attachDynWith readKey ixKeys eChange)
214219
215220liftM concat $ mapM makeLenses
216221 [ ''TextAreaConfig