385cc3a · reflex-dom · git.iko.soy

git.iko.soy/reflex-dom

Merge develop into jsaddle

commit385cc3a91253a12b135807048a6dab40ddf5e5c7 authorHamish Mackenzie <Hamish.K.Mackenzie@googlemail.com> dateSat 4 Feb 2017, 17:13 (10 years ago) parenta941721 2737fa4

8 files changed+182−165

compare with develop

unifiedsplit

reflex-dom-core/reflex-dom-core.cabal+3 reflex-dom-core/src/Reflex/Dom/Builder/Class.hs+64−110 reflex-dom-core/src/Reflex/Dom/Builder/Class/Events.hs+26−4 reflex-dom-core/src/Reflex/Dom/Builder/Class/TH.hs+12 reflex-dom-core/src/Reflex/Dom/Builder/Immediate.hs+74−49 reflex-dom-core/src/Reflex/Dom/Builder/InputDisabled.hs+1−1 reflex-dom-core/src/Reflex/Dom/Builder/Static.hs+1 reflex-dom-core/src/Reflex/Dom/Widget/Input.hs+1−1

reflex-dom-core/reflex-dom-core.cabal+3

@@ -101,6 +101,7 @@ library

101101 Reflex.Dom.Xhr.Exception

102102

103103 ghc-options: -Wall -fwarn-tabs -funbox-strict-fields -O2 -ferror-spans

104+ ghc-prof-options: -fprof-auto

104105

105106 if flag(expose-all-unfoldings)

106107 ghc-options: -fexpose-all-unfoldings

@@ -115,6 +116,8 @@ library

115116 template-haskell

116117 other-extensions: TemplateHaskell

117118 cpp-options: -DUSE_TEMPLATE_HASKELL

119+ other-modules:

120+ Reflex.Dom.Builder.Class.TH

118121 else

119122 build-depends:

120123 dependent-sum == 0.4.*

reflex-dom-core/src/Reflex/Dom/Builder/Class.hs+64−110

@@ -25,6 +25,9 @@ module Reflex.Dom.Builder.Class

2525

2626import Reflex.Class as Reflex

2727import Reflex.Dom.Builder.Class.Events

28+#ifdef USE_TEMPLATE_HASKELL

29+import Reflex.Dom.Builder.Class.TH

30+#endif

2831import Reflex.DynamicWriter

2932import Reflex.EventWriter

3033import Reflex.PerformEvent.Class

@@ -40,6 +43,7 @@ import Data.Default

4043import Data.Functor.Misc

4144import Data.Map (Map)

4245import qualified Data.Map as Map

46+import Data.Maybe

4347import Data.Proxy

4448import Data.Semigroup

4549import Data.String

@@ -86,11 +90,6 @@ class (Monad m, Reflex t, DomSpace (DomBuilderSpace m), MonadAdjust t m) => DomB

8690 => Text -> ElementConfig er t m -> m a -> m (Element er (DomBuilderSpace m) t, a)

8791 element t cfg child = liftWith $ \run -> element t (liftElementConfig cfg) $ run child

8892 {-# INLINABLE element #-}

89− {-

90− -- | Create a placeholder in the DOM, with the ability to insert new DOM before it

91− -- The provided DOM will be executed after the current frame, so it will not be affected by any occurrences that are concurrent with the occurrence that created it

92− placeholder :: PlaceholderConfig above t m -> m (Placeholder above t)

93−-}

9493 inputElement :: InputElementConfig er t m -> m (InputElement er (DomBuilderSpace m) t)

9594 default inputElement :: ( MonadTransControl f

9695 , m ~ f m'

@@ -221,7 +220,7 @@ stopPropagation = mempty { _eventFlags_propagation = Propagation_Stop }

221220data ElementConfig er t m

222221 = ElementConfig { _elementConfig_namespace :: Maybe Namespace

223222 , _elementConfig_initialAttributes :: Map AttributeName Text

224− , _elementConfig_modifyAttributes :: Event t (Map AttributeName (Maybe Text))

223+ , _elementConfig_modifyAttributes :: Maybe (Event t (Map AttributeName (Maybe Text)))

225224 , _elementConfig_eventSpec :: EventSpec (DomBuilderSpace m) er

226225 }

227226

@@ -232,13 +231,6 @@ elementConfig_namespace f (ElementConfig a b c d) = (\a' -> ElementConfig a' b c

232231elementConfig_initialAttributes :: Lens' (ElementConfig er t m) (Map AttributeName Text)

233232elementConfig_initialAttributes f (ElementConfig a b c d) = (\b' -> ElementConfig a b' c d) <$> f b

234233{-# INLINE elementConfig_initialAttributes #-}

235−elementConfig_modifyAttributes :: Lens

236− (ElementConfig er t1 m)

237− (ElementConfig er t2 m)

238− (Event t1 (Map AttributeName (Maybe Text)))

239− (Event t2 (Map AttributeName (Maybe Text)))

240−elementConfig_modifyAttributes f (ElementConfig a b c d) = (\c' -> ElementConfig a b c' d) <$> f c

241−{-# INLINE elementConfig_modifyAttributes #-}

242234elementConfig_eventSpec :: Lens

243235 (ElementConfig er1 t m1)

244236 (ElementConfig er2 t m2)

@@ -253,41 +245,11 @@ data Element er d t

253245 , _element_raw :: RawElement d

254246 }

255247

256−data PlaceholderConfig above t m

257− = PlaceholderConfig { _placeholderConfig_insertAbove :: Event t (m above)

258− , _placeholderConfig_deleteSelf :: Event t ()

259− }

260−

261−#ifndef USE_TEMPLATE_HASKELL

262−placeholderConfig_insertAbove :: Lens

263− (PlaceholderConfig above1 t m1)

264− (PlaceholderConfig above2 t m2)

265− (Event t (m1 above1))

266− (Event t (m2 above2))

267−placeholderConfig_insertAbove f (PlaceholderConfig a b) = (\a' -> PlaceholderConfig a' b) <$> f a

268−{-# INLINE placeholderConfig_insertAbove #-}

269−placeholderConfig_deleteSelf :: Lens' (PlaceholderConfig above t m) (Event t ())

270−placeholderConfig_deleteSelf f (PlaceholderConfig a b) = (\b' -> PlaceholderConfig a b') <$> f b

271−{-# INLINE placeholderConfig_deleteSelf #-}

272−#endif

273−

274−instance Reflex t => Default (PlaceholderConfig above t m) where

275− {-# INLINABLE def #-}

276− def = PlaceholderConfig

277− { _placeholderConfig_insertAbove = never

278− , _placeholderConfig_deleteSelf = never

279− }

280−

281−data Placeholder above t

282− = Placeholder { _placeholder_insertedAbove :: Event t above

283− , _placeholder_deletedSelf :: Event t ()

284− }

285−

286248data InputElementConfig er t m

287249 = InputElementConfig { _inputElementConfig_initialValue :: Text

288− , _inputElementConfig_setValue :: Event t Text

250+ , _inputElementConfig_setValue :: Maybe (Event t Text)

289251 , _inputElementConfig_initialChecked :: Bool

290− , _inputElementConfig_setChecked :: Event t Bool

252+ , _inputElementConfig_setChecked :: Maybe (Event t Bool)

291253 , _inputElementConfig_elementConfig :: ElementConfig er t m

292254 }

293255

@@ -295,15 +257,9 @@ data InputElementConfig er t m

295257inputElementConfig_initialValue :: Lens' (InputElementConfig er t m) Text

296258inputElementConfig_initialValue f (InputElementConfig a b c d e) = (\a' -> InputElementConfig a' b c d e) <$> f a

297259{-# INLINE inputElementConfig_initialValue #-}

298−inputElementConfig_setValue :: Lens' (InputElementConfig er t m) (Event t Text)

299−inputElementConfig_setValue f (InputElementConfig a b c d e) = (\b' -> InputElementConfig a b' c d e) <$> f b

300−{-# INLINE inputElementConfig_setValue #-}

301260inputElementConfig_initialChecked :: Lens' (InputElementConfig er t m) Bool

302261inputElementConfig_initialChecked f (InputElementConfig a b c d e) = (\c' -> InputElementConfig a b c' d e) <$> f c

303262{-# INLINE inputElementConfig_initialChecked #-}

304−inputElementConfig_setChecked :: Lens' (InputElementConfig er t m) (Event t Bool)

305−inputElementConfig_setChecked f (InputElementConfig a b c d e) = (\d' -> InputElementConfig a b c d' e) <$> f d

306−{-# INLINE inputElementConfig_setChecked #-}

307263inputElementConfig_elementConfig :: Lens

308264 (InputElementConfig er1 t m1)

309265 (InputElementConfig er2 t m2)

@@ -317,9 +273,9 @@ instance (Reflex t, er ~ EventResult, DomBuilder t m) => Default (InputElementCo

317273 {-# INLINABLE def #-}

318274 def = InputElementConfig

319275 { _inputElementConfig_initialValue = ""

320− , _inputElementConfig_setValue = never

276+ , _inputElementConfig_setValue = Nothing

321277 , _inputElementConfig_initialChecked = False

322− , _inputElementConfig_setChecked = never

278+ , _inputElementConfig_setChecked = Nothing

323279 , _inputElementConfig_elementConfig = def

324280 }

325281

@@ -336,7 +292,7 @@ data InputElement er d t

336292

337293data TextAreaElementConfig er t m

338294 = TextAreaElementConfig { _textAreaElementConfig_initialValue :: Text

339− , _textAreaElementConfig_setValue :: Event t Text

295+ , _textAreaElementConfig_setValue :: Maybe (Event t Text)

340296 , _textAreaElementConfig_elementConfig :: ElementConfig er t m

341297 }

342298

@@ -344,9 +300,6 @@ data TextAreaElementConfig er t m

344300textAreaElementConfig_initialValue :: Lens' (TextAreaElementConfig er t m) Text

345301textAreaElementConfig_initialValue f (TextAreaElementConfig a b c) = (\a' -> TextAreaElementConfig a' b c) <$> f a

346302{-# INLINE textAreaElementConfig_initialValue #-}

347−textAreaElementConfig_setValue :: Lens' (TextAreaElementConfig er t m) (Event t Text)

348−textAreaElementConfig_setValue f (TextAreaElementConfig a b c) = (\b' -> TextAreaElementConfig a b' c) <$> f b

349−{-# INLINE textAreaElementConfig_setValue #-}

350303textAreaElementConfig_elementConfig :: Lens

351304 (TextAreaElementConfig er1 t m1)

352305 (TextAreaElementConfig er2 t m2)

@@ -360,7 +313,7 @@ instance (Reflex t, er ~ EventResult, DomBuilder t m) => Default (TextAreaElemen

360313 {-# INLINABLE def #-}

361314 def = TextAreaElementConfig

362315 { _textAreaElementConfig_initialValue = ""

363− , _textAreaElementConfig_setValue = never

316+ , _textAreaElementConfig_setValue = Nothing

364317 , _textAreaElementConfig_elementConfig = def

365318 }

366319

@@ -379,18 +332,11 @@ extractRawElementConfig cfg = RawElementConfig

379332 }

380333

381334data RawElementConfig er t m = RawElementConfig

382− { _rawElementConfig_modifyAttributes :: Event t (Map AttributeName (Maybe Text))

335+ { _rawElementConfig_modifyAttributes :: Maybe (Event t (Map AttributeName (Maybe Text)))

383336 , _rawElementConfig_eventSpec :: EventSpec (DomBuilderSpace m) er

384337 }

385338

386339#ifndef USE_TEMPLATE_HASKELL

387−rawElementConfig_modifyAttributes :: Lens

388− (RawElementConfig er t1 m)

389− (RawElementConfig er t2 m)

390− (Event t1 (Map AttributeName (Maybe Text)))

391− (Event t2 (Map AttributeName (Maybe Text)))

392−rawElementConfig_modifyAttributes f (RawElementConfig a b) = (\a' -> RawElementConfig a' b) <$> f a

393−{-# INLINE rawElementConfig_modifyAttributes #-}

394340rawElementConfig_eventSpec :: Lens

395341 (RawElementConfig er1 t m1)

396342 (RawElementConfig er2 t m2)

@@ -402,13 +348,13 @@ rawElementConfig_eventSpec f (RawElementConfig a b) = (\b' -> RawElementConfig a

402348

403349instance (Reflex t, DomSpace (DomBuilderSpace m)) => Default (RawElementConfig EventResult t m) where

404350 def = RawElementConfig

405− { _rawElementConfig_modifyAttributes = never

351+ { _rawElementConfig_modifyAttributes = Nothing

406352 , _rawElementConfig_eventSpec = def

407353 }

408354

409355data SelectElementConfig er t m = SelectElementConfig

410356 { _selectElementConfig_initialValue :: Text

411− , _selectElementConfig_setValue :: Event t Text

357+ , _selectElementConfig_setValue :: Maybe (Event t Text)

412358 , _selectElementConfig_elementConfig :: ElementConfig er t m

413359 }

414360

@@ -416,9 +362,6 @@ data SelectElementConfig er t m = SelectElementConfig

416362selectElementConfig_initialValue :: Lens' (SelectElementConfig er t m) Text

417363selectElementConfig_initialValue f (SelectElementConfig a b c) = (\a' -> SelectElementConfig a' b c) <$> f a

418364{-# INLINE selectElementConfig_initialValue #-}

419−selectElementConfig_setValue :: Lens' (SelectElementConfig er t m) (Event t Text)

420−selectElementConfig_setValue f (SelectElementConfig a b c) = (\b' -> SelectElementConfig a b' c) <$> f b

421−{-# INLINE selectElementConfig_setValue #-}

422365selectElementConfig_elementConfig :: Lens

423366 (SelectElementConfig er1 t m1)

424367 (SelectElementConfig er2 t m2)

@@ -431,7 +374,7 @@ selectElementConfig_elementConfig f (SelectElementConfig a b c) = (\c' -> Select

431374instance (Reflex t, er ~ EventResult, DomBuilder t m) => Default (SelectElementConfig er t m) where

432375 def = SelectElementConfig

433376 { _selectElementConfig_initialValue = ""

434− , _selectElementConfig_setValue = never

377+ , _selectElementConfig_setValue = Nothing

435378 , _selectElementConfig_elementConfig = def

436379 }

437380

@@ -444,43 +387,65 @@ data SelectElement er d t = SelectElement

444387 }

445388

446389#ifdef USE_TEMPLATE_HASKELL

447−makeLensesFor

448− [("_textNodeConfig_initialContents", "textNodeConfig_initialContents")]

449− ''TextNodeConfig

390+concat <$> mapM (uncurry makeLensesWithoutField)

391+ [ (["_textNodeConfig_setContents"], ''TextNodeConfig)

392+ , ([ "_inputElementConfig_setValue"

393+ , "_inputElementConfig_setChecked" ], ''InputElementConfig)

394+ , (["_rawElementConfig_modifyAttributes"], ''RawElementConfig)

395+ , (["_elementConfig_modifyAttributes"], ''ElementConfig)

396+ , (["_textAreaElementConfig_setValue"], ''TextAreaElementConfig)

397+ , (["_selectElementConfig_setValue"], ''SelectElementConfig)

398+ ]

450399#endif

451400

452401-- | This lens is technically illegal. The implementation of 'TextNodeConfig' uses a 'Maybe' under the hood for efficiency reasons. However, always interacting with 'TextNodeConfig' via lenses will always behave correctly, and if you pattern match on it, you should always treat 'Nothing' as 'never'.

453402textNodeConfig_setContents :: Reflex t => Lens (TextNodeConfig t) (TextNodeConfig t) (Event t Text) (Event t Text)

454403textNodeConfig_setContents =

455− let getter t = case _textNodeConfig_setContents t of

456− Nothing -> never

457− Just e -> e

404+ let getter = fromMaybe never . _textNodeConfig_setContents

458405 setter t e = t { _textNodeConfig_setContents = Just e }

459406 in lens getter setter

460407

461−#ifdef USE_TEMPLATE_HASKELL

462−concat <$> mapM makeLenses

463− [ ''ElementConfig

464− , ''PlaceholderConfig

465− , ''InputElementConfig

466− , ''TextAreaElementConfig

467− , ''SelectElementConfig

468− , ''RawElementConfig

469− ]

470−#endif

408+-- | This lens is technically illegal. The implementation of 'InputElementConfig' uses a 'Maybe' under the hood for efficiency reasons. However, always interacting with 'InputElementConfig' via lenses will always behave correctly, and if you pattern match on it, you should always treat 'Nothing' as 'never'.

409+inputElementConfig_setValue :: Reflex t => Lens (InputElementConfig er t m) (InputElementConfig er t m) (Event t Text) (Event t Text)

410+inputElementConfig_setValue =

411+ let getter = fromMaybe never . _inputElementConfig_setValue

412+ setter t e = t { _inputElementConfig_setValue = Just e }

413+ in lens getter setter

414+

415+-- | This lens is technically illegal. The implementation of 'InputElementConfig' uses a 'Maybe' under the hood for efficiency reasons. However, always interacting with 'InputElementConfig' via lenses will always behave correctly, and if you pattern match on it, you should always treat 'Nothing' as 'never'.

416+inputElementConfig_setChecked :: Reflex t => Lens (InputElementConfig er t m) (InputElementConfig er t m) (Event t Bool) (Event t Bool)

417+inputElementConfig_setChecked =

418+ let getter = fromMaybe never . _inputElementConfig_setChecked

419+ setter t e = t { _inputElementConfig_setChecked = Just e }

420+ in lens getter setter

471421

472−class CanDeleteSelf t a | a -> t where

473− deleteSelf :: Lens' a (Event t ())

422+-- | This lens is technically illegal. The implementation of 'RawElementConfig' uses a 'Maybe' under the hood for efficiency reasons. However, always interacting with 'RawElementConfig' via lenses will always behave correctly, and if you pattern match on it, you should always treat 'Nothing' as 'never'.

423+rawElementConfig_modifyAttributes :: Reflex t => Lens (RawElementConfig er t m) (RawElementConfig er t m) (Event t (Map AttributeName (Maybe Text))) (Event t (Map AttributeName (Maybe Text)))

424+rawElementConfig_modifyAttributes =

425+ let getter = fromMaybe never . _rawElementConfig_modifyAttributes

426+ setter t e = t { _rawElementConfig_modifyAttributes = Just e }

427+ in lens getter setter

474428

475−instance CanDeleteSelf t (PlaceholderConfig above t m) where

476− {-# INLINABLE deleteSelf #-}

477− deleteSelf = placeholderConfig_deleteSelf

429+-- | This lens is technically illegal. The implementation of 'RawElementConfig' uses a 'Maybe' under the hood for efficiency reasons. However, always interacting with 'RawElementConfig' via lenses will always behave correctly, and if you pattern match on it, you should always treat 'Nothing' as 'never'.

430+elementConfig_modifyAttributes :: Reflex t => Lens (ElementConfig er t m) (ElementConfig er t m) (Event t (Map AttributeName (Maybe Text))) (Event t (Map AttributeName (Maybe Text)))

431+elementConfig_modifyAttributes =

432+ let getter = fromMaybe never . _elementConfig_modifyAttributes

433+ setter t e = t { _elementConfig_modifyAttributes = Just e }

434+ in lens getter setter

478435

479−class InsertAbove t m above above' a a' | a -> t m above, a' -> t m above', a above' -> a', a' above -> a where

480− insertAbove :: Lens a a' (Event t (m above)) (Event t (m above'))

436+-- | This lens is technically illegal. The implementation of 'TextAreaElementConfig' uses a 'Maybe' under the hood for efficiency reasons. However, always interacting with 'TextAreaElementConfig' via lenses will always behave correctly, and if you pattern match on it, you should always treat 'Nothing' as 'never'.

437+textAreaElementConfig_setValue :: Reflex t => Lens (TextAreaElementConfig er t m) (TextAreaElementConfig er t m) (Event t Text) (Event t Text)

438+textAreaElementConfig_setValue =

439+ let getter = fromMaybe never . _textAreaElementConfig_setValue

440+ setter t e = t { _textAreaElementConfig_setValue = Just e }

441+ in lens getter setter

481442

482−instance InsertAbove t m above above' (PlaceholderConfig above t m) (PlaceholderConfig above' t m) where

483− insertAbove = placeholderConfig_insertAbove

443+-- | This lens is technically illegal. The implementation of 'SelectElementConfig' uses a 'Maybe' under the hood for efficiency reasons. However, always interacting with 'SelectElementConfig' via lenses will always behave correctly, and if you pattern match on it, you should always treat 'Nothing' as 'never'.

444+selectElementConfig_setValue :: Reflex t => Lens (SelectElementConfig er t m) (SelectElementConfig er t m) (Event t Text) (Event t Text)

445+selectElementConfig_setValue =

446+ let getter = fromMaybe never . _selectElementConfig_setValue

447+ setter t e = t { _selectElementConfig_setValue = Just e }

448+ in lens getter setter

484449

485450class InitialAttributes a where

486451 initialAttributes :: Lens' a (Map AttributeName Text)

@@ -502,7 +467,7 @@ instance InitialAttributes (SelectElementConfig er t m) where

502467 initialAttributes = selectElementConfig_elementConfig . elementConfig_initialAttributes

503468

504469class ModifyAttributes t a | a -> t where

505− modifyAttributes :: Lens' a (Event t (Map AttributeName (Maybe Text)))

470+ modifyAttributes :: Reflex t => Lens' a (Event t (Map AttributeName (Maybe Text)))

506471

507472instance ModifyAttributes t (ElementConfig er t m) where

508473 {-# INLINABLE modifyAttributes #-}

@@ -536,7 +501,7 @@ instance (Reflex t, er ~ EventResult, DomBuilder t m) => Default (ElementConfig

536501 def = ElementConfig

537502 { _elementConfig_namespace = Nothing

538503 , _elementConfig_initialAttributes = mempty

539− , _elementConfig_modifyAttributes = never

504+ , _elementConfig_modifyAttributes = Nothing

540505 , _elementConfig_eventSpec = def

541506 }

542507

@@ -623,12 +588,6 @@ instance Functor1 (ElementConfig er t) where

623588 { _elementConfig_eventSpec = _elementConfig_eventSpec cfg

624589 }

625590

626−instance Reflex t => Functor1 (PlaceholderConfig above t) where

627− {-# INLINABLE fmap1 #-}

628− fmap1 f cfg = cfg

629− { _placeholderConfig_insertAbove = f <$> _placeholderConfig_insertAbove cfg

630− }

631−

632591instance Functor1 (InputElementConfig er t) where

633592 type Functor1Constraint (InputElementConfig er t) a b = Functor1Constraint (ElementConfig er t) a b

634593 fmap1 f cfg = cfg & inputElementConfig_elementConfig %~ fmap1 f

@@ -702,11 +661,6 @@ liftTextNode = lift . textNode

702661liftElement :: LiftDomBuilder t f m => Text -> ElementConfig er t (f m) -> f m a -> f m (Element er (DomBuilderSpace m) t, a)

703662liftElement elementTag cfg child = liftWithStateless $ \run -> element elementTag (fmap1 run cfg) $ run child

704663

705−{-

706−liftPlaceholder :: LiftDomBuilder t f m => PlaceholderConfig above t (f m) -> f m (Placeholder above t)

707−liftPlaceholder cfg = liftWithStateless $ \run -> placeholder $ fmap1 run cfg

708−-}

709−

710664liftInputElement :: LiftDomBuilder t f m => InputElementConfig er t (f m) -> f m (InputElement er (DomBuilderSpace m) t)

711665liftInputElement cfg = liftWithStateless $ \run -> inputElement $ fmap1 run cfg

712666

reflex-dom-core/src/Reflex/Dom/Builder/Class/Events.hs+26−4

@@ -157,12 +157,34 @@ type family EventResultType (en :: EventTag) :: * where

157157 EventResultType 'ResetTag = ()

158158 EventResultType 'SearchTag = ()

159159 EventResultType 'SelectstartTag = ()

160− EventResultType 'TouchstartTag = [(Int, Int)]

161− EventResultType 'TouchmoveTag = [(Int, Int)]

162− EventResultType 'TouchendTag = [(Int, Int)]

163− EventResultType 'TouchcancelTag = [(Int, Int)]

160+ EventResultType 'TouchstartTag = TouchEventResult

161+ EventResultType 'TouchmoveTag = TouchEventResult

162+ EventResultType 'TouchendTag = TouchEventResult

163+ EventResultType 'TouchcancelTag = TouchEventResult

164164 EventResultType 'WheelTag = ()

165165

166+data TouchEventResult = TouchEventResult

167+ { _touchEventResult_altKey :: Bool

168+ , _touchEventResult_changedTouches :: [TouchResult]

169+ , _touchEventResult_ctrlKey :: Bool

170+ , _touchEventResult_metaKey :: Bool

171+ , _touchEventResult_shiftKey :: Bool

172+ , _touchEventResult_targetTouches :: [TouchResult]

173+ , _touchEventResult_touches :: [TouchResult]

174+ }

175+ deriving (Show, Read, Eq, Ord)

176+

177+data TouchResult = TouchResult

178+ { _touchResult_identifier :: Word

179+ , _touchResult_screenX :: Int

180+ , _touchResult_screenY :: Int

181+ , _touchResult_clientX :: Int

182+ , _touchResult_clientY :: Int

183+ , _touchResult_pageX :: Int

184+ , _touchResult_pageY :: Int

185+ }

186+ deriving (Show, Read, Eq, Ord)

187+

166188#ifdef USE_TEMPLATE_HASKELL

167189deriveGEq ''EventName

168190deriveGCompare ''EventName

reflex-dom-core/src/Reflex/Dom/Builder/Class/TH.hsnew file+12

@@ -0,0 +1,12 @@

1+module Reflex.Dom.Builder.Class.TH where

3+import Control.Lens

4+import Language.Haskell.TH.Syntax (Name, nameBase)

5+import Language.Haskell.TH.Lib (DecsQ)

7+namer :: [String] -> Name -> [Name] -> Name -> [DefName]

8+namer s n ks t | nameBase t `elem` s = []

9+ | otherwise = underscoreNoPrefixNamer n ks t

10+

11+makeLensesWithoutField :: [String] -> Name -> DecsQ

12+makeLensesWithoutField s = makeLensesWith (lensRules & lensField .~ namer s)

reflex-dom-core/src/Reflex/Dom/Builder/Immediate.hs+74−49

@@ -207,9 +207,9 @@ newtype EventFilterTriggerRef t er (en :: EventTag) = EventFilterTriggerRef (IOR

207207wrap :: forall m er t. SupportsImmediateDomBuilder t m => RawElement GhcjsDomSpace -> RawElementConfig er t (ImmediateDomBuilderT t m) -> ImmediateDomBuilderT t m (Element er GhcjsDomSpace t)

208208wrap e cfg = do

209209 events <- askEvents

210− lift $ performEvent_ $ ffor (cfg ^. modifyAttributes) $ imapM_ $ \(AttributeName mAttrNamespace n) mv -> case mAttrNamespace of

210+ mapM_ (performEvent_ . fmap (imapM_ $ \(AttributeName mAttrNamespace n) mv -> case mAttrNamespace of

211211 Nothing -> maybe (removeAttribute e n) (setAttribute e n) mv

212− Just ns -> maybe (removeAttributeNS e (Just ns) n) (setAttributeNS e (Just ns) n) mv

212+ Just ns -> maybe (removeAttributeNS e (Just ns) n) (setAttributeNS e (Just ns) n) mv)) (_rawElementConfig_modifyAttributes cfg)

213213 eventTriggerRefs :: DMap EventName (EventFilterTriggerRef t er) <- liftJSM $ fmap DMap.fromList $ forM (DMap.toList $ _ghcjsEventSpec_filters $ _rawElementConfig_eventSpec cfg) $ \(en :=> GhcjsEventFilter f) -> do

214214 triggerRef <- liftIO $ newIORef Nothing

215215 _ <- elementOnEventName en e $ do

@@ -331,23 +331,10 @@ instance SupportsImmediateDomBuilder t m => DomBuilder t (ImmediateDomBuilderT t

331331 {-# INLINABLE textNode #-}

332332 textNode (TextNodeConfig initialContents mSetContents) = do

333333 n <- textNodeInternal initialContents

334− case mSetContents of

335− Nothing -> return ()

336− Just eSetContents -> lift $ performEvent_ $ ffor eSetContents $ \t -> setNodeValue n (Just t)

334+ mapM_ (lift . performEvent_ . fmap (setNodeValue n . Just)) mSetContents

337335 return $ TextNode n

338336 {-# INLINABLE element #-}

339337 element elementTag cfg child = fst <$> makeElement elementTag cfg child

340− {-

341− {-# INLINABLE placeholder #-}

342− placeholder (PlaceholderConfig toInsertAbove delete) = liftThrough (deletable delete) $ do

343− n <- textNodeInternal ("" :: Text)

344− insertedAbove <- insertImmediateAbove n toInsertAbove

345− --Note: "deleteSelf" must come after "insertAbove", because we need to be able to insert above in the same frame that we delete

346− deleted <- lift $ performEvent $ ffor delete $ \_ -> do

347− mp <- getParentNode n

348− forM_ mp $ \p -> removeChild p $ Just n

349− return $ Placeholder insertedAbove deleted

350−-}

351338 {-# INLINABLE inputElement #-}

352339 inputElement cfg = do

353340 ((e, _), domElement) <- makeElement "input" (cfg ^. inputElementConfig_elementConfig) $ return ()

@@ -356,9 +343,11 @@ instance SupportsImmediateDomBuilder t m => DomBuilder t (ImmediateDomBuilderT t

356343 v0 <- Input.getValueUnchecked domInputElement

357344 let getMyValue = fromMaybe "" <$> Input.getValue domInputElement

358345 valueChangedByUI <- performEvent $ getMyValue <$ Reflex.select (_element_events e) (WrapArg Input)

359− valueChangedBySetValue <- performEvent $ ffor (cfg ^. inputElementConfig_setValue) $ \v' -> do

360− Input.setValue domInputElement $ Just v'

361− getMyValue -- We get the value after setting it in case the browser has mucked with it somehow

346+ valueChangedBySetValue <- case _inputElementConfig_setValue cfg of

347+ Nothing -> return never

348+ Just eSetValue -> performEvent $ ffor eSetValue $ \v' -> do

349+ Input.setValue domInputElement $ Just v'

350+ getMyValue -- We get the value after setting it in case the browser has mucked with it somehow

362351 v <- holdDyn v0 $ leftmost

363352 [ valueChangedBySetValue

364353 , valueChangedByUI

@@ -366,10 +355,12 @@ instance SupportsImmediateDomBuilder t m => DomBuilder t (ImmediateDomBuilderT t

366355 Input.setChecked domInputElement $ _inputElementConfig_initialChecked cfg

367356 checkedChangedByUI <- wrapDomEvent domInputElement (`on` Element.click) $ do

368357 Input.getChecked domInputElement

369− checkedChangedBySetChecked <- performEvent $ ffor (_inputElementConfig_setChecked cfg) $ \newChecked -> do

370− oldChecked <- Input.getChecked domInputElement

371− Input.setChecked domInputElement newChecked

372− return $ if newChecked /= oldChecked

358+ checkedChangedBySetChecked <- case _inputElementConfig_setChecked cfg of

359+ Nothing -> return never

360+ Just eNewchecked -> performEvent $ ffor eNewchecked $ \newChecked -> do

361+ oldChecked <- Input.getChecked domInputElement

362+ Input.setChecked domInputElement newChecked

363+ return $ if newChecked /= oldChecked

373364 then Just newChecked

374365 else Nothing

375366 c <- holdDyn (_inputElementConfig_initialChecked cfg) $ leftmost

@@ -403,9 +394,11 @@ instance SupportsImmediateDomBuilder t m => DomBuilder t (ImmediateDomBuilderT t

403394 v0 <- TextArea.getValueUnchecked domTextAreaElement

404395 let getMyValue = fromMaybe "" <$> TextArea.getValue domTextAreaElement

405396 valueChangedByUI <- performEvent $ getMyValue <$ Reflex.select (_element_events e) (WrapArg Input)

406− valueChangedBySetValue <- performEvent $ ffor (cfg ^. textAreaElementConfig_setValue) $ \v' -> do

407− TextArea.setValue domTextAreaElement $ Just v'

408− getMyValue -- We get the value after setting it in case the browser has mucked with it somehow

397+ valueChangedBySetValue <- case _textAreaElementConfig_setValue cfg of

398+ Nothing -> return never

399+ Just eSetValue -> performEvent $ ffor eSetValue $ \v' -> do

400+ TextArea.setValue domTextAreaElement $ Just v'

401+ getMyValue -- We get the value after setting it in case the browser has mucked with it somehow

409402 v <- holdDyn v0 $ leftmost

410403 [ valueChangedBySetValue

411404 , valueChangedByUI

@@ -426,9 +419,11 @@ instance SupportsImmediateDomBuilder t m => DomBuilder t (ImmediateDomBuilderT t

426419 Just v0 <- Select.getValue domSelectElement

427420 let getMyValue = fromMaybe "" <$> Select.getValue domSelectElement

428421 valueChangedByUI <- performEvent $ getMyValue <$ Reflex.select (_element_events e) (WrapArg Change)

429− valueChangedBySetValue <- performEvent $ ffor (cfg ^. selectElementConfig_setValue) $ \v' -> do

430− Select.setValue domSelectElement $ Just v'

431− getMyValue -- We get the value after setting it in case the browser has mucked with it somehow

422+ valueChangedBySetValue <- case _selectElementConfig_setValue cfg of

423+ Nothing -> return never

424+ Just eSetValue -> performEvent $ ffor eSetValue $ \v' -> do

425+ Select.setValue domSelectElement $ Just v'

426+ getMyValue -- We get the value after setting it in case the browser has mucked with it somehow

432427 v <- holdDyn v0 $ leftmost

433428 [ valueChangedBySetValue

434429 , valueChangedByUI

@@ -670,10 +665,10 @@ defaultDomEventHandler e evt = fmap (Just . EventResult) $ case evt of

670665 Reset -> return ()

671666 Search -> return ()

672667 Selectstart -> return ()

673− Touchstart -> getTouchEventCoords

674− Touchmove -> getTouchEventCoords

675− Touchend -> getTouchEventCoords

676− Touchcancel -> getTouchEventCoords

668+ Touchstart -> getTouchEvent

669+ Touchmove -> getTouchEvent

670+ Touchend -> getTouchEvent

671+ Touchcancel -> getTouchEvent

677672 Mousewheel -> return ()

678673 Wheel -> return ()

679674

@@ -720,10 +715,10 @@ defaultDomWindowEventHandler w evt = fmap (Just . EventResult) $ case evt of

720715 Reset -> return ()

721716 Search -> return ()

722717 Selectstart -> return ()

723− Touchstart -> getTouchEventCoords

724− Touchmove -> getTouchEventCoords

725− Touchend -> getTouchEventCoords

726− Touchcancel -> getTouchEventCoords

718+ Touchstart -> getTouchEvent

719+ Touchmove -> getTouchEvent

720+ Touchend -> getTouchEvent

721+ Touchcancel -> getTouchEvent

727722 Mousewheel -> return ()

728723 Wheel -> return ()

729724

@@ -984,19 +979,49 @@ getMouseEventCoords = do

984979 e <- event

985980 bisequence (getClientX e, getClientY e)

986981

987−{-# INLINABLE getTouchEventCoords #-}

988−getTouchEventCoords :: EventM e TouchEvent [(Int, Int)]

989−getTouchEventCoords = do

982+{-# INLINABLE getTouchEvent #-}

983+getTouchEvent :: EventM e TouchEvent TouchEventResult

984+getTouchEvent = do

985+ let touchResults = \case

986+ Nothing -> return []

987+ Just ts -> do

988+ n <- TouchList.getLength ts

989+ fmap catMaybes . forM [0 .. n - 1] $ \ix -> do

990+ mt <- TouchList.item ts ix

991+ forM mt $ \t -> do

992+ identifier <- Touch.getIdentifier t

993+ screenX <- Touch.getScreenX t

994+ screenY <- Touch.getScreenY t

995+ clientX <- Touch.getClientX t

996+ clientY <- Touch.getClientY t

997+ pageX <- Touch.getPageX t

998+ pageY <- Touch.getPageY t

999+ return $ TouchResult

1000+ { _touchResult_identifier = identifier

1001+ , _touchResult_screenX = screenX

1002+ , _touchResult_screenY = screenY

1003+ , _touchResult_clientX = clientX

1004+ , _touchResult_clientY = clientY

1005+ , _touchResult_pageX = pageX

1006+ , _touchResult_pageY = pageY

1007+ }

9901008 e <- event

991− mTouchList <- TouchEvent.getTouches e

992− case mTouchList of

993− Just touchList -> do

994− touchListLength <- TouchList.getLength touchList

995− mTouchCoords <- forM [0..touchListLength - 1] $ \i -> do

996− mTouch <- TouchList.item touchList i

997− return $ fmap (\t -> bisequence (Touch.getClientX t, Touch.getClientY t)) mTouch

998− sequence $ catMaybes mTouchCoords

999− _ -> return []

1009+ altKey <- TouchEvent.getAltKey e

1010+ ctrlKey <- TouchEvent.getCtrlKey e

1011+ shiftKey <- TouchEvent.getShiftKey e

1012+ metaKey <- TouchEvent.getMetaKey e

1013+ changedTouches <- touchResults =<< TouchEvent.getChangedTouches e

1014+ targetTouches <- touchResults =<< TouchEvent.getTargetTouches e

1015+ touches <- touchResults =<< TouchEvent.getTouches e

1016+ return $ TouchEventResult

1017+ { _touchEventResult_altKey = altKey

1018+ , _touchEventResult_changedTouches = changedTouches

1019+ , _touchEventResult_ctrlKey = ctrlKey

1020+ , _touchEventResult_metaKey = metaKey

1021+ , _touchEventResult_shiftKey = shiftKey

1022+ , _touchEventResult_targetTouches = targetTouches

1023+ , _touchEventResult_touches = touches

1024+ }

10001025

10011026instance MonadSample t m => MonadSample t (ImmediateDomBuilderT t m) where

10021027 {-# INLINABLE sample #-}

reflex-dom-core/src/Reflex/Dom/Builder/InputDisabled.hs+1−1

@@ -54,7 +54,7 @@ instance PrimMonad m => PrimMonad (InputDisabledT m) where

5454disableElementConfig :: Reflex t => ElementConfig er t m -> ElementConfig er t m

5555disableElementConfig cfg = cfg

5656 { _elementConfig_initialAttributes = Map.insert "disabled" "disabled" $ _elementConfig_initialAttributes cfg

57− , _elementConfig_modifyAttributes = Map.delete "disabled" <$> _elementConfig_modifyAttributes cfg

57+ , _elementConfig_modifyAttributes = fmap (Map.delete "disabled") <$> _elementConfig_modifyAttributes cfg

5858 }

5959

6060instance PostBuild t m => PostBuild t (InputDisabledT m) where

reflex-dom-core/src/Reflex/Dom/Builder/Static.hs+1

@@ -171,6 +171,7 @@ instance (Reflex t, MonadAdjust t m, MonadHold t m) => MonadAdjust t (StaticDomB

171171 sample o

172172 return (result0, result')

173173

174+-- TODO: the uses of illegal lenses in this instance causes it to be somewhat less efficient than it can be. replacing them with explicit cases to get the underlying Maybe Event and working with those is ideal.

174175instance SupportsStaticDomBuilder t m => DomBuilder t (StaticDomBuilderT t m) where

175176 type DomBuilderSpace (StaticDomBuilderT t m) = StaticDomSpace

176177 {-# INLINABLE textNode #-}

reflex-dom-core/src/Reflex/Dom/Widget/Input.hs+1−1

@@ -292,7 +292,7 @@ checkboxView dAttrs dValue = do

292292 return $ (,) preventDefault $ return $ Just $ CheckboxViewEventResult b

293293 elementConfig :: ElementConfig CheckboxViewEventResult t m

294294 elementConfig = (def :: ElementConfig EventResult t m)

295− { _elementConfig_modifyAttributes = fmap mapKeysToAttributeName modifyAttrs

295+ { _elementConfig_modifyAttributes = Just $ fmap mapKeysToAttributeName modifyAttrs

296296 , _elementConfig_initialAttributes = Map.mapKeys (AttributeName Nothing) permanentAttrs

297297 , _elementConfig_eventSpec = GhcjsEventSpec

298298 { _ghcjsEventSpec_filters = filters