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

git.iko.soy/reflex-dom

on develop help sign in

Merge develop into jsaddle

385cc3aHamish Mackenzie10 years ago

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

compare with develop

unifiedsplit

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

101 Reflex.Dom.Xhr.Exception

102

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

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

104

105

105 if flag(expose-all-unfoldings)

106 if flag(expose-all-unfoldings)

106 ghc-options: -fexpose-all-unfoldings

107 ghc-options: -fexpose-all-unfoldings

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

115 template-haskell

116 template-haskell

116 other-extensions: TemplateHaskell

117 other-extensions: TemplateHaskell

117 cpp-options: -DUSE_TEMPLATE_HASKELL

118 cpp-options: -DUSE_TEMPLATE_HASKELL

119+ other-modules:

120+ Reflex.Dom.Builder.Class.TH

118 else

121 else

119 build-depends:

122 build-depends:

120 dependent-sum == 0.4.*

123 dependent-sum == 0.4.*

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

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

26import Reflex.Class as Reflex

27import Reflex.Dom.Builder.Class.Events

28+#ifdef USE_TEMPLATE_HASKELL

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

30+#endif

28import Reflex.DynamicWriter

31import Reflex.DynamicWriter

29import Reflex.EventWriter

32import Reflex.EventWriter

30import Reflex.PerformEvent.Class

33import Reflex.PerformEvent.Class

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

40import Data.Functor.Misc

43import Data.Functor.Misc

41import Data.Map (Map)

44import Data.Map (Map)

42import qualified Data.Map as Map

45import qualified Data.Map as Map

46+import Data.Maybe

43import Data.Proxy

47import Data.Proxy

44import Data.Semigroup

48import Data.Semigroup

45import Data.String

49import Data.String

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

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

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

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

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

88 {-# INLINABLE element #-}

92 {-# 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−-}

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

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

95 default inputElement :: ( MonadTransControl f

94 default inputElement :: ( MonadTransControl f

96 , m ~ f m'

95 , m ~ f m'

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

221data ElementConfig er t m

220data ElementConfig er t m

222 = ElementConfig { _elementConfig_namespace :: Maybe Namespace

221 = ElementConfig { _elementConfig_namespace :: Maybe Namespace

223 , _elementConfig_initialAttributes :: Map AttributeName Text

222 , _elementConfig_initialAttributes :: Map AttributeName Text

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

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

225 , _elementConfig_eventSpec :: EventSpec (DomBuilderSpace m) er

224 , _elementConfig_eventSpec :: EventSpec (DomBuilderSpace m) er

226 }

225 }

227

226

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

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

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

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

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

234{-# INLINE elementConfig_initialAttributes #-}

233{-# 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 #-}

242elementConfig_eventSpec :: Lens

234elementConfig_eventSpec :: Lens

243 (ElementConfig er1 t m1)

235 (ElementConfig er1 t m1)

244 (ElementConfig er2 t m2)

236 (ElementConfig er2 t m2)

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

253 , _element_raw :: RawElement d

245 , _element_raw :: RawElement d

254 }

246 }

255

247

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−

286data InputElementConfig er t m

248data InputElementConfig er t m

287 = InputElementConfig { _inputElementConfig_initialValue :: Text

249 = InputElementConfig { _inputElementConfig_initialValue :: Text

288− , _inputElementConfig_setValue :: Event t Text

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

289 , _inputElementConfig_initialChecked :: Bool

251 , _inputElementConfig_initialChecked :: Bool

290− , _inputElementConfig_setChecked :: Event t Bool

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

291 , _inputElementConfig_elementConfig :: ElementConfig er t m

253 , _inputElementConfig_elementConfig :: ElementConfig er t m

292 }

254 }

293

255

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

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

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

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

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

297{-# INLINE inputElementConfig_initialValue #-}

259{-# 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 #-}

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

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

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

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

303{-# INLINE inputElementConfig_initialChecked #-}

262{-# 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 #-}

307inputElementConfig_elementConfig :: Lens

263inputElementConfig_elementConfig :: Lens

308 (InputElementConfig er1 t m1)

264 (InputElementConfig er1 t m1)

309 (InputElementConfig er2 t m2)

265 (InputElementConfig er2 t m2)

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

317 {-# INLINABLE def #-}

273 {-# INLINABLE def #-}

318 def = InputElementConfig

274 def = InputElementConfig

319 { _inputElementConfig_initialValue = ""

275 { _inputElementConfig_initialValue = ""

320− , _inputElementConfig_setValue = never

276+ , _inputElementConfig_setValue = Nothing

321 , _inputElementConfig_initialChecked = False

277 , _inputElementConfig_initialChecked = False

322− , _inputElementConfig_setChecked = never

278+ , _inputElementConfig_setChecked = Nothing

323 , _inputElementConfig_elementConfig = def

279 , _inputElementConfig_elementConfig = def

324 }

280 }

325

281

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

336

292

337data TextAreaElementConfig er t m

293data TextAreaElementConfig er t m

338 = TextAreaElementConfig { _textAreaElementConfig_initialValue :: Text

294 = TextAreaElementConfig { _textAreaElementConfig_initialValue :: Text

339− , _textAreaElementConfig_setValue :: Event t Text

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

340 , _textAreaElementConfig_elementConfig :: ElementConfig er t m

296 , _textAreaElementConfig_elementConfig :: ElementConfig er t m

341 }

297 }

342

298

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

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

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

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

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

346{-# INLINE textAreaElementConfig_initialValue #-}

302{-# 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 #-}

350textAreaElementConfig_elementConfig :: Lens

303textAreaElementConfig_elementConfig :: Lens

351 (TextAreaElementConfig er1 t m1)

304 (TextAreaElementConfig er1 t m1)

352 (TextAreaElementConfig er2 t m2)

305 (TextAreaElementConfig er2 t m2)

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

360 {-# INLINABLE def #-}

313 {-# INLINABLE def #-}

361 def = TextAreaElementConfig

314 def = TextAreaElementConfig

362 { _textAreaElementConfig_initialValue = ""

315 { _textAreaElementConfig_initialValue = ""

363− , _textAreaElementConfig_setValue = never

316+ , _textAreaElementConfig_setValue = Nothing

364 , _textAreaElementConfig_elementConfig = def

317 , _textAreaElementConfig_elementConfig = def

365 }

318 }

366

319

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

379 }

332 }

380

333

381data RawElementConfig er t m = RawElementConfig

334data RawElementConfig er t m = RawElementConfig

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

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

383 , _rawElementConfig_eventSpec :: EventSpec (DomBuilderSpace m) er

336 , _rawElementConfig_eventSpec :: EventSpec (DomBuilderSpace m) er

384 }

337 }

385

338

386#ifndef USE_TEMPLATE_HASKELL

339#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 #-}

394rawElementConfig_eventSpec :: Lens

340rawElementConfig_eventSpec :: Lens

395 (RawElementConfig er1 t m1)

341 (RawElementConfig er1 t m1)

396 (RawElementConfig er2 t m2)

342 (RawElementConfig er2 t m2)

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

402

348

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

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

404 def = RawElementConfig

350 def = RawElementConfig

405− { _rawElementConfig_modifyAttributes = never

351+ { _rawElementConfig_modifyAttributes = Nothing

406 , _rawElementConfig_eventSpec = def

352 , _rawElementConfig_eventSpec = def

407 }

353 }

408

354

409data SelectElementConfig er t m = SelectElementConfig

355data SelectElementConfig er t m = SelectElementConfig

410 { _selectElementConfig_initialValue :: Text

356 { _selectElementConfig_initialValue :: Text

411− , _selectElementConfig_setValue :: Event t Text

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

412 , _selectElementConfig_elementConfig :: ElementConfig er t m

358 , _selectElementConfig_elementConfig :: ElementConfig er t m

413 }

359 }

414

360

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

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

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

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

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

418{-# INLINE selectElementConfig_initialValue #-}

364{-# 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 #-}

422selectElementConfig_elementConfig :: Lens

365selectElementConfig_elementConfig :: Lens

423 (SelectElementConfig er1 t m1)

366 (SelectElementConfig er1 t m1)

424 (SelectElementConfig er2 t m2)

367 (SelectElementConfig er2 t m2)

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

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

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

432 def = SelectElementConfig

375 def = SelectElementConfig

433 { _selectElementConfig_initialValue = ""

376 { _selectElementConfig_initialValue = ""

434− , _selectElementConfig_setValue = never

377+ , _selectElementConfig_setValue = Nothing

435 , _selectElementConfig_elementConfig = def

378 , _selectElementConfig_elementConfig = def

436 }

379 }

437

380

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

444 }

387 }

445

388

446#ifdef USE_TEMPLATE_HASKELL

389#ifdef USE_TEMPLATE_HASKELL

447−makeLensesFor

390+concat <$> mapM (uncurry makeLensesWithoutField)

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

449− ''TextNodeConfig

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+ ]

450#endif

399#endif

451

400

452-- | 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'.

401-- | 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'.

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

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

454textNodeConfig_setContents =

403textNodeConfig_setContents =

455− let getter t = case _textNodeConfig_setContents t of

404+ let getter = fromMaybe never . _textNodeConfig_setContents

456− Nothing -> never

457− Just e -> e

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

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

459 in lens getter setter

406 in lens getter setter

460

407

461−#ifdef USE_TEMPLATE_HASKELL

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'.

462−concat <$> mapM makeLenses

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

463− [ ''ElementConfig

410+inputElementConfig_setValue =

464− , ''PlaceholderConfig

411+ let getter = fromMaybe never . _inputElementConfig_setValue

465− , ''InputElementConfig

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

466− , ''TextAreaElementConfig

413+ in lens getter setter

467− , ''SelectElementConfig

414+

468− , ''RawElementConfig

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'.

469− ]

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

470−#endif

417+inputElementConfig_setChecked =

418+ let getter = fromMaybe never . _inputElementConfig_setChecked

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

420+ in lens getter setter

471

421

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

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'.

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

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

474

428

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

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'.

476− {-# INLINABLE deleteSelf #-}

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)))

477− deleteSelf = placeholderConfig_deleteSelf

431+elementConfig_modifyAttributes =

432+ let getter = fromMaybe never . _elementConfig_modifyAttributes

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

434+ in lens getter setter

478

435

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

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'.

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

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

481

442

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

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'.

483− insertAbove = placeholderConfig_insertAbove

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

484

449

485class InitialAttributes a where

450class InitialAttributes a where

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

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

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

502 initialAttributes = selectElementConfig_elementConfig . elementConfig_initialAttributes

467 initialAttributes = selectElementConfig_elementConfig . elementConfig_initialAttributes

503

468

504class ModifyAttributes t a | a -> t where

469class 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)))

506

471

507instance ModifyAttributes t (ElementConfig er t m) where

472instance ModifyAttributes t (ElementConfig er t m) where

508 {-# INLINABLE modifyAttributes #-}

473 {-# INLINABLE modifyAttributes #-}

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

536 def = ElementConfig

501 def = ElementConfig

537 { _elementConfig_namespace = Nothing

502 { _elementConfig_namespace = Nothing

538 , _elementConfig_initialAttributes = mempty

503 , _elementConfig_initialAttributes = mempty

539− , _elementConfig_modifyAttributes = never

504+ , _elementConfig_modifyAttributes = Nothing

540 , _elementConfig_eventSpec = def

505 , _elementConfig_eventSpec = def

541 }

506 }

542

507

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

623 { _elementConfig_eventSpec = _elementConfig_eventSpec cfg

588 { _elementConfig_eventSpec = _elementConfig_eventSpec cfg

624 }

589 }

625

590

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−

632instance Functor1 (InputElementConfig er t) where

591instance Functor1 (InputElementConfig er t) where

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

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

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

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

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

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

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

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

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

704

663

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−

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

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

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

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

712

666

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

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

157 EventResultType 'ResetTag = ()

158 EventResultType 'SearchTag = ()

159 EventResultType 'SelectstartTag = ()

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

160+ EventResultType 'TouchstartTag = TouchEventResult

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

161+ EventResultType 'TouchmoveTag = TouchEventResult

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

162+ EventResultType 'TouchendTag = TouchEventResult

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

163+ EventResultType 'TouchcancelTag = TouchEventResult

164 EventResultType 'WheelTag = ()

165

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+

166#ifdef USE_TEMPLATE_HASKELL

188#ifdef USE_TEMPLATE_HASKELL

167deriveGEq ''EventName

189deriveGEq ''EventName

168deriveGCompare ''EventName

190deriveGCompare ''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

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

208wrap e cfg = do

209 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

211 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)

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

214 triggerRef <- liftIO $ newIORef Nothing

215 _ <- elementOnEventName en e $ do

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

331 {-# INLINABLE textNode #-}

332 textNode (TextNodeConfig initialContents mSetContents) = do

333 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

337 return $ TextNode n

335 return $ TextNode n

338 {-# INLINABLE element #-}

336 {-# INLINABLE element #-}

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

337 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−-}

351 {-# INLINABLE inputElement #-}

338 {-# INLINABLE inputElement #-}

352 inputElement cfg = do

339 inputElement cfg = do

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

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

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

356 v0 <- Input.getValueUnchecked domInputElement

343 v0 <- Input.getValueUnchecked domInputElement

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

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

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

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

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

346+ valueChangedBySetValue <- case _inputElementConfig_setValue cfg of

347+ Nothing -> return never

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

360− Input.setValue domInputElement $ Just v'

349+ Input.setValue domInputElement $ Just v'

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

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

362 v <- holdDyn v0 $ leftmost

351 v <- holdDyn v0 $ leftmost

363 [ valueChangedBySetValue

352 [ valueChangedBySetValue

364 , valueChangedByUI

353 , valueChangedByUI

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

366 Input.setChecked domInputElement $ _inputElementConfig_initialChecked cfg

355 Input.setChecked domInputElement $ _inputElementConfig_initialChecked cfg

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

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

368 Input.getChecked domInputElement

357 Input.getChecked domInputElement

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

358+ checkedChangedBySetChecked <- case _inputElementConfig_setChecked cfg of

359+ Nothing -> return never

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

370− oldChecked <- Input.getChecked domInputElement

361+ oldChecked <- Input.getChecked domInputElement

371− Input.setChecked domInputElement newChecked

362+ Input.setChecked domInputElement newChecked

372− return $ if newChecked /= oldChecked

363+ return $ if newChecked /= oldChecked

373 then Just newChecked

364 then Just newChecked

374 else Nothing

365 else Nothing

375 c <- holdDyn (_inputElementConfig_initialChecked cfg) $ leftmost

366 c <- holdDyn (_inputElementConfig_initialChecked cfg) $ leftmost

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

403 v0 <- TextArea.getValueUnchecked domTextAreaElement

394 v0 <- TextArea.getValueUnchecked domTextAreaElement

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

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

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

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

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

397+ valueChangedBySetValue <- case _textAreaElementConfig_setValue cfg of

398+ Nothing -> return never

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

407− TextArea.setValue domTextAreaElement $ Just v'

400+ TextArea.setValue domTextAreaElement $ Just v'

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

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

409 v <- holdDyn v0 $ leftmost

402 v <- holdDyn v0 $ leftmost

410 [ valueChangedBySetValue

403 [ valueChangedBySetValue

411 , valueChangedByUI

404 , valueChangedByUI

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

426 Just v0 <- Select.getValue domSelectElement

419 Just v0 <- Select.getValue domSelectElement

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

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

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

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

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

422+ valueChangedBySetValue <- case _selectElementConfig_setValue cfg of

423+ Nothing -> return never

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

430− Select.setValue domSelectElement $ Just v'

425+ Select.setValue domSelectElement $ Just v'

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

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

432 v <- holdDyn v0 $ leftmost

427 v <- holdDyn v0 $ leftmost

433 [ valueChangedBySetValue

428 [ valueChangedBySetValue

434 , valueChangedByUI

429 , valueChangedByUI

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

670 Reset -> return ()

665 Reset -> return ()

671 Search -> return ()

666 Search -> return ()

672 Selectstart -> return ()

667 Selectstart -> return ()

673− Touchstart -> getTouchEventCoords

668+ Touchstart -> getTouchEvent

674− Touchmove -> getTouchEventCoords

669+ Touchmove -> getTouchEvent

675− Touchend -> getTouchEventCoords

670+ Touchend -> getTouchEvent

676− Touchcancel -> getTouchEventCoords

671+ Touchcancel -> getTouchEvent

677 Mousewheel -> return ()

672 Mousewheel -> return ()

678 Wheel -> return ()

673 Wheel -> return ()

679

674

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

720 Reset -> return ()

715 Reset -> return ()

721 Search -> return ()

716 Search -> return ()

722 Selectstart -> return ()

717 Selectstart -> return ()

723− Touchstart -> getTouchEventCoords

718+ Touchstart -> getTouchEvent

724− Touchmove -> getTouchEventCoords

719+ Touchmove -> getTouchEvent

725− Touchend -> getTouchEventCoords

720+ Touchend -> getTouchEvent

726− Touchcancel -> getTouchEventCoords

721+ Touchcancel -> getTouchEvent

727 Mousewheel -> return ()

722 Mousewheel -> return ()

728 Wheel -> return ()

723 Wheel -> return ()

729

724

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

984 e <- event

979 e <- event

985 bisequence (getClientX e, getClientY e)

980 bisequence (getClientX e, getClientY e)

986

981

987−{-# INLINABLE getTouchEventCoords #-}

982+{-# INLINABLE getTouchEvent #-}

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

983+getTouchEvent :: EventM e TouchEvent TouchEventResult

989−getTouchEventCoords = do

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+ }

990 e <- event

1008 e <- event

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

991− mTouchList <- TouchEvent.getTouches e

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

992− case mTouchList of

1016+ return $ TouchEventResult

993− Just touchList -> do

1017+ { _touchEventResult_altKey = altKey

994− touchListLength <- TouchList.getLength touchList

1018+ , _touchEventResult_changedTouches = changedTouches

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

1019+ , _touchEventResult_ctrlKey = ctrlKey

996− mTouch <- TouchList.item touchList i

1020+ , _touchEventResult_metaKey = metaKey

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

1021+ , _touchEventResult_shiftKey = shiftKey

998− sequence $ catMaybes mTouchCoords

1022+ , _touchEventResult_targetTouches = targetTouches

999− _ -> return []

1023+ , _touchEventResult_touches = touches

1024+ }

1000

1025

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

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

1002 {-# INLINABLE sample #-}

1027 {-# INLINABLE sample #-}

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

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

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

55disableElementConfig cfg = cfg

56 { _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

58 }

60instance 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

171 sample o

172 return (result0, result')

173

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.

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

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

175 type DomBuilderSpace (StaticDomBuilderT t m) = StaticDomSpace

176 type DomBuilderSpace (StaticDomBuilderT t m) = StaticDomSpace

176 {-# INLINABLE textNode #-}

177 {-# INLINABLE textNode #-}

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

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

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

293 elementConfig :: ElementConfig CheckboxViewEventResult t m

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

295− { _elementConfig_modifyAttributes = fmap mapKeysToAttributeName modifyAttrs

295+ { _elementConfig_modifyAttributes = Just $ fmap mapKeysToAttributeName modifyAttrs

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

297 , _elementConfig_eventSpec = GhcjsEventSpec

298 { _ghcjsEventSpec_filters = filters