aa8659d · reflex-dom · git.iko.soy

git.iko.soy/reflex-dom

Add wrapElement

commitaa8659deff8ef63d1b8c49fc10f095d6e48e65fd authorRyan Trinkle <ryan.trinkle@gmail.com> dateTue 9 Aug 2016, 14:52 (10 years ago) parentaf60a0e

2 files changed+20−4

compare with develop

unifiedsplit

src/Reflex/Dom/Builder/Static.hs+6−4 src/Reflex/Dom/Old.hs+14

src/Reflex/Dom/Builder/Static.hs+6−4

@@ -1,5 +1,6 @@

11{-# LANGUAGE ConstraintKinds #-}

22{-# LANGUAGE DataKinds #-}

3+{-# LANGUAGE DeriveGeneric #-}

34{-# LANGUAGE EmptyDataDecls #-}

45{-# LANGUAGE FlexibleContexts #-}

56{-# LANGUAGE FlexibleInstances #-}

@@ -30,6 +31,7 @@ import Data.Dependent.Sum (DSum (..))

3031import qualified Data.Map as Map

3132import Data.Monoid

3233import Data.Text.Encoding

34+import GHC.Generics

3335import Reflex

3436import Reflex.Dom.Builder.Class

3537import Reflex.Dom.PerformEvent.Base

@@ -109,12 +111,12 @@ data StaticDomEvent (a :: k)

109111-- | Static documents don't process events, so all handlers are equivalent

110112data StaticDomHandler (a :: k) (b :: k) = StaticDomHandler

111113

112−--TODO: Move this upstream into the data-default package

113−instance Default a => Default (Const a b) where

114− def = Const def

114+data StaticEventSpec (er :: EventTag -> *) = StaticEventSpec deriving (Generic)

115+

116+instance Default (StaticEventSpec er)

115117

116118instance DomSpace StaticDomSpace where

117− type EventSpec StaticDomSpace = Const ()

119+ type EventSpec StaticDomSpace = StaticEventSpec

118120 type RawTextNode StaticDomSpace = ()

119121 type RawElement StaticDomSpace = ()

120122 type RawInputElement StaticDomSpace = ()

src/Reflex/Dom/Old.hs+14

@@ -3,6 +3,8 @@

33{-# LANGUAGE FlexibleContexts #-}

44{-# LANGUAGE FlexibleInstances #-}

55{-# LANGUAGE MultiParamTypeClasses #-}

6+{-# LANGUAGE Rank2Types #-}

7+{-# LANGUAGE ScopedTypeVariables #-}

68{-# LANGUAGE TemplateHaskell #-}

79{-# LANGUAGE TypeFamilies #-}

810{-# LANGUAGE UndecidableInstances #-}

@@ -26,6 +28,7 @@ module Reflex.Dom.Old

2628 , onEventName

2729 , schedulePostBuild

2830 , text'

31+ , wrapElement

2932 ) where

3033

3134import Control.Arrow (first)

@@ -34,6 +37,7 @@ import Control.Monad

3437import Control.Monad.Exception

3538import Control.Monad.Fix

3639import Control.Monad.IO.Class

40+import Control.Monad.Reader

3741import Control.Monad.Ref

3842import Data.Default

3943import Data.Functor.Misc

@@ -193,3 +197,13 @@ _el_keypress = domEvent Keypress

193197{-# DEPRECATED _el_scrolled "Use 'domEvent Scroll' instead" #-}

194198_el_scrolled :: Reflex t => El t -> Event t Int

195199_el_scrolled = domEvent Scroll

200+

201+wrapElement :: forall t m. MonadWidget t m => (forall en. DOM.HTMLElement -> EventName en -> EventM DOM.Element (EventType en) (Maybe (EventResult en))) -> DOM.HTMLElement -> m (El t)

202+wrapElement eh e = do

203+ let h :: (EventName en, GhcjsDomEvent en) -> IO (Maybe (EventResult en))

204+ h (en, GhcjsDomEvent evt) = runReaderT (eh e en) evt

205+ wrapRawElement e $ (def :: RawElementConfig EventResult t m)

206+ { _rawElementConfig_eventSpec = def

207+ { _ghcjsEventSpec_handler = h

208+ }

209+ }