From cb7683d57fe142d406fb835967e6003e11a18c69 Mon Sep 17 00:00:00 2001 From: Heinrich Apfelmus Date: Wed, 8 Nov 2023 15:11:03 +0100 Subject: [PATCH] Fix some warnings on GHC 9.6.3 --- src/Foreign/JavaScript.hs | 7 +-- src/Foreign/JavaScript/CallBuffer.hs | 10 ++-- src/Foreign/JavaScript/EventLoop.hs | 23 ++++----- src/Foreign/JavaScript/Include.hs | 4 +- src/Foreign/JavaScript/Marshal.hs | 2 +- src/Foreign/JavaScript/Server.hs | 14 +++--- src/Foreign/RemotePtr.hs | 20 ++++---- src/Graphics/UI/Threepenny/Attributes.hs | 7 +-- src/Graphics/UI/Threepenny/Canvas.hs | 9 ++-- src/Graphics/UI/Threepenny/Core.hs | 50 ++++++++++---------- src/Graphics/UI/Threepenny/DragNDrop.hs | 1 + src/Graphics/UI/Threepenny/Elements.hs | 2 +- src/Graphics/UI/Threepenny/Events.hs | 2 + src/Graphics/UI/Threepenny/Internal.hs | 7 ++- src/Graphics/UI/Threepenny/JQuery.hs | 3 -- src/Graphics/UI/Threepenny/SVG/Attributes.hs | 1 + src/Graphics/UI/Threepenny/SVG/Elements.hs | 1 + src/Graphics/UI/Threepenny/Timer.hs | 4 +- src/Graphics/UI/Threepenny/Widgets.hs | 6 ++- src/Reactive/Threepenny.hs | 19 ++++---- src/Reactive/Threepenny/Memo.hs | 1 + src/Reactive/Threepenny/PulseLatch.hs | 15 +++--- 22 files changed, 104 insertions(+), 104 deletions(-) diff --git a/src/Foreign/JavaScript.hs b/src/Foreign/JavaScript.hs index df56873b..94a9c5de 100644 --- a/src/Foreign/JavaScript.hs +++ b/src/Foreign/JavaScript.hs @@ -31,9 +31,6 @@ module Foreign.JavaScript ( debug, timestamp, ) where -import Control.Concurrent.STM as STM -import Control.Monad (unless) -import qualified Data.Aeson as JSON import Foreign.JavaScript.CallBuffer import Foreign.JavaScript.EventLoop import Foreign.JavaScript.Marshal @@ -49,12 +46,12 @@ serve :: Config -- ^ Configuration options. -> (Window -> IO ()) -- ^ Initialization whenever a client connects. -> IO () -serve config init = httpComm config $ eventLoop $ \w -> do +serve config initialize = httpComm config $ eventLoop $ \w -> do setCallBufferMode w (jsCallBufferMode config) runFunction w $ ffi "connection.setReloadOnDisconnect(%1)" $ jsWindowReloadOnDisconnect config flushCallBuffer w -- make sure that all `runEval` commands are executed - init w + initialize w flushCallBuffer w -- make sure that all `runEval` commands are executed {----------------------------------------------------------------------------- diff --git a/src/Foreign/JavaScript/CallBuffer.hs b/src/Foreign/JavaScript/CallBuffer.hs index 96738a52..f7e4aa11 100644 --- a/src/Foreign/JavaScript/CallBuffer.hs +++ b/src/Foreign/JavaScript/CallBuffer.hs @@ -17,7 +17,7 @@ setCallBufferMode w new = -- | Get the call buffering mode for the given browser window. getCallBufferMode :: Window -> IO CallBufferMode -getCallBufferMode w@Window{..} = atomically $ readTVar wCallBufferMode +getCallBufferMode Window{..} = atomically $ readTVar wCallBufferMode -- | Flush the call buffer, -- i.e. send all outstanding JavaScript to the client in one single message. @@ -26,7 +26,7 @@ flushCallBuffer w = flushCallBufferWithAtomic w $ return () -- | Flush the call buffer, and atomically perform an additional action flushCallBufferWithAtomic :: Window -> STM a -> IO a -flushCallBufferWithAtomic w@Window{..} action = do +flushCallBufferWithAtomic Window{..} action = do -- by taking the call buffer, we ensure that no further code -- is added to the buffer while we execute the current buffer's code. code' <- atomically $ takeTMVar wCallBuffer @@ -39,7 +39,7 @@ flushCallBufferWithAtomic w@Window{..} action = do -- | Schedule a piece of JavaScript code to be run with `runEval`, -- depending on the buffering mode bufferRunEval :: Window -> String -> IO () -bufferRunEval w@Window{..} code = do +bufferRunEval Window{..} code = do action <- atomically $ do mode <- readTVar wCallBufferMode case mode of @@ -50,5 +50,5 @@ bufferRunEval w@Window{..} code = do putTMVar wCallBuffer (msg . (\s -> ";" ++ code ++ s)) return Nothing case action of - Nothing -> return () - Just code -> runEval code + Nothing -> return () + Just code1 -> runEval code1 diff --git a/src/Foreign/JavaScript/EventLoop.hs b/src/Foreign/JavaScript/EventLoop.hs index 2ca86b42..9c999256 100644 --- a/src/Foreign/JavaScript/EventLoop.hs +++ b/src/Foreign/JavaScript/EventLoop.hs @@ -6,7 +6,6 @@ module Foreign.JavaScript.EventLoop ( newHandler, fromJSStablePtr, newJSObjectFromCoupon ) where -import Control.Applicative import Control.Concurrent import Control.Concurrent.Async import Control.Concurrent.STM as STM @@ -15,10 +14,7 @@ import Control.Exception as E import Control.Monad import qualified Data.Aeson as JSON import qualified Data.ByteString.Char8 as BS -import Data.IORef -import qualified Data.Map as Map import qualified Data.Text as T -import qualified System.Mem import Foreign.RemotePtr as Foreign import Foreign.JavaScript.CallBuffer @@ -35,11 +31,12 @@ rebug = return () Event Loop ------------------------------------------------------------------------------} -- | Handle a single event -handleEvent w@(Window{..}) (name, args) = do +handleEvent :: Window -> (Coupon, JSON.Value) -> IO () +handleEvent Window{..} (name, args) = do mhandler <- Foreign.lookup name wEventHandlers case mhandler of Nothing -> return () - Just f -> withRemotePtr f (\_ f -> f args) + Just f -> withRemotePtr f (\_ g -> g args) type Result = Either String JSON.Value @@ -47,7 +44,7 @@ type Result = Either String JSON.Value -- | Event loop for a browser window. -- Supports concurrent invocations of `runEval` and `callEval`. eventLoop :: (Window -> IO void) -> EventLoop -eventLoop init server info comm = void $ do +eventLoop initialize server info comm = void $ do -- To support concurrent FFI calls, we need three threads. -- A fourth thread supports -- @@ -112,12 +109,12 @@ eventLoop init server info comm = void $ do -- Send FFI calls to client and collect results let handleCalls = forever $ do - ref <- atomically $ do - (ref, msg) <- readTQueue calls + mref <- atomically $ do + (mref, msg) <- readTQueue calls writeServer comm msg - return ref + return mref atomically $ - case ref of + case mref of Just ref -> do result <- readTQueue results putTMVar ref result @@ -155,7 +152,7 @@ eventLoop init server info comm = void $ do withAsync multiplexer $ \_ -> withAsync handleCalls $ \_ -> withAsync (flushCallBufferPeriodically w) $ \_ -> - E.finally (init w >> handleEvents) $ do + E.finally (initialize w >> handleEvents) $ do putStrLn "Foreign.JavaScript: Browser window disconnected." -- close communication channel if still necessary commClose comm @@ -175,7 +172,7 @@ flushCallBufferPeriodically w = ------------------------------------------------------------------------------} -- | Turn a Haskell function into an event handler. newHandler :: Window -> ([JSON.Value] -> IO ()) -> IO HsEvent -newHandler w@(Window{..}) handler = do +newHandler Window{..} handler = do coupon <- newCoupon wEventHandlers newRemotePtr coupon (handler . parseArgs) wEventHandlers where diff --git a/src/Foreign/JavaScript/Include.hs b/src/Foreign/JavaScript/Include.hs index f92aa058..7904a1cc 100644 --- a/src/Foreign/JavaScript/Include.hs +++ b/src/Foreign/JavaScript/Include.hs @@ -8,8 +8,8 @@ import System.IO include :: FilePath -> Q Exp include path = do - path <- makeRelativeToProject path - LitE . StringL <$> runIO (readFileUTF8 path) + relativePath <- makeRelativeToProject path + LitE . StringL <$> runIO (readFileUTF8 relativePath) readFileUTF8 :: FilePath -> IO String readFileUTF8 path = do diff --git a/src/Foreign/JavaScript/Marshal.hs b/src/Foreign/JavaScript/Marshal.hs index 5de48dbd..081b8af8 100644 --- a/src/Foreign/JavaScript/Marshal.hs +++ b/src/Foreign/JavaScript/Marshal.hs @@ -19,7 +19,6 @@ import qualified Data.Aeson.Encode as JSON (encodeToTextBuilder) #else import qualified Data.Aeson.Text as JSON (encodeToTextBuilder) #endif -import qualified Data.Aeson.Types as JSON import Data.Functor ((<$>)) import Data.List (intercalate) import qualified Data.Text as T @@ -48,6 +47,7 @@ class ToJS a where ys <- mapM render xs jsCode $ "[" ++ intercalate "," (map unJSCode ys) ++ "]" +jsCode :: String -> IO JSCode jsCode = return . JSCode instance ToJS Float where render = render . JSON.toJSON diff --git a/src/Foreign/JavaScript/Server.hs b/src/Foreign/JavaScript/Server.hs index baac4d1f..0abb74b4 100644 --- a/src/Foreign/JavaScript/Server.hs +++ b/src/Foreign/JavaScript/Server.hs @@ -15,17 +15,16 @@ import Data.ByteString (ByteString) import qualified Data.ByteString.Char8 as BS import qualified Data.ByteString.Lazy.Char8 as LBS import qualified Data.Map as M -import Data.Text +import Data.Text (Text) import qualified Safe as Safe import System.Environment import System.FilePath -- import web libraries -import Data.Aeson ((.=)) import qualified Data.Aeson as JSON import qualified Network.WebSockets as WS import qualified Network.WebSockets.Snap as WS -import Snap.Core as Snap +import Snap.Core as Snap hiding (path, dir) import qualified Snap.Http.Server as Snap import Snap.Util.FileServe @@ -114,15 +113,15 @@ communicationFromWebSocket request = do let commClose = atomically $ STM.writeTVar commOpen False -- read/write data until an exception occurs or the channel is no longer open - forkFinally (sendData `race_` readData `race_` sentry) $ \_ -> void $ do + _ <- forkFinally (sendData `race_` readData `race_` sentry) $ \_ -> void $ do -- close the communication channel explicitly if that didn't happen yet commClose -- attempt to close websocket if still necessary/possible -- ignore any exceptions that may happen if it's already closed - let all :: E.SomeException -> Maybe () - all _ = Just () - E.tryJust all $ WS.sendClose connection $ LBS.pack "close" + let allExceptions :: E.SomeException -> Maybe () + allExceptions _ = Just () + E.tryJust allExceptions $ WS.sendClose connection $ LBS.pack "close" return $ Comm {..} @@ -155,6 +154,7 @@ routeResources server customHTML staticDir = Nothing -> logError "Foreign.JavaScript: Cannot use jsCustomHTML file without jsStatic" Nothing -> writeTextMime defaultHtmlFile "text/html" +writeTextMime :: MonadSnap m => Text -> ByteString -> m () writeTextMime text mime = do modifyResponse (setHeader "Content-type" mime) writeText text diff --git a/src/Foreign/RemotePtr.hs b/src/Foreign/RemotePtr.hs index 9a67fe9c..5dcd7280 100644 --- a/src/Foreign/RemotePtr.hs +++ b/src/Foreign/RemotePtr.hs @@ -17,15 +17,12 @@ module Foreign.RemotePtr ( import Prelude hiding (lookup) import Control.Monad -import Control.Concurrent import qualified Data.Text as T import qualified Data.HashMap.Strict as Map import Data.Functor import Data.IORef -import System.IO.Unsafe (unsafePerformIO) import System.Mem.Weak hiding (addFinalizer) -import qualified System.Mem.Weak as Weak import qualified GHC.Base as GHC import qualified GHC.Weak as GHC @@ -42,14 +39,14 @@ atomicModifyIORef' = atomicModifyIORef mkWeakIORefValue :: IORef a -> value -> IO () -> IO (Weak value) #if CABAL #if MIN_VERSION_base(4,9,0) -mkWeakIORefValue r@(GHC.IORef (GHC.STRef r#)) v (GHC.IO f) = GHC.IO $ \s -> +mkWeakIORefValue (GHC.IORef (GHC.STRef r#)) v (GHC.IO f) = GHC.IO $ \s -> case GHC.mkWeak# r# v f s of (# s1, w #) -> (# s1, GHC.Weak w #) #else -mkWeakIORefValue r@(GHC.IORef (GHC.STRef r#)) v f = GHC.IO $ \s -> +mkWeakIORefValue (GHC.IORef (GHC.STRef r#)) v f = GHC.IO $ \s -> case GHC.mkWeak# r# v f s of (# s1, w #) -> (# s1, GHC.Weak w #) #endif #else -mkWeakIORefValue r@(GHC.IORef (GHC.STRef r#)) v (GHC.IO f) = GHC.IO $ \s -> +mkWeakIORefValue (GHC.IORef (GHC.STRef r#)) v (GHC.IO f) = GHC.IO $ \s -> case GHC.mkWeak# r# v f s of (# s1, w #) -> (# s1, GHC.Weak w #) #endif @@ -133,8 +130,9 @@ newRemotePtr coupon value Vendor{..} = do let self = undefined ptr <- newIORef RemoteData{..} - let finalize = atomicModifyIORef' coupons $ \m -> (Map.delete coupon m, ()) - w <- mkWeakIORef ptr finalize + let doFinalize = + atomicModifyIORef' coupons $ \m -> (Map.delete coupon m, ()) + w <- mkWeakIORef ptr doFinalize atomicModifyIORef' coupons $ \m -> (Map.insert coupon w m, ()) atomicModifyIORef' ptr $ \itemdata -> (itemdata { self = w }, ()) return ptr @@ -148,10 +146,10 @@ newRemotePtr coupon value Vendor{..} = do -- will not be garbage collected -- and its 'Coupon' can be successfully redeemed at the 'Vendor'. withRemotePtr :: RemotePtr a -> (Coupon -> a -> IO b) -> IO b -withRemotePtr ptr f = do - RemoteData{..} <- readIORef ptr +withRemotePtr ptr0 f = do + RemoteData{..} <- readIORef ptr0 b <- f coupon value - touch ptr + touch ptr0 return b where -- make sure that the pointer is alive at this point in the code diff --git a/src/Graphics/UI/Threepenny/Attributes.hs b/src/Graphics/UI/Threepenny/Attributes.hs index 804da1af..e84d29c6 100644 --- a/src/Graphics/UI/Threepenny/Attributes.hs +++ b/src/Graphics/UI/Threepenny/Attributes.hs @@ -1,3 +1,4 @@ +{-# OPTIONS_GHC -Wno-missing-signatures #-} module Graphics.UI.Threepenny.Attributes ( -- * Synopsis -- | Element attributes. @@ -50,13 +51,13 @@ selection = fromJQueryProp "selectedIndex" from (JSON.toJSON . maybe (-1) id) http://hackage.haskell.org/package/html ------------------------------------------------------------------------------} strAttr :: String -> WriteAttr Element String -strAttr name = mkWriteAttr (set' (attr name)) +strAttr attrname = mkWriteAttr (set' (attr attrname)) intAttr :: String -> WriteAttr Element Int -intAttr name = mkWriteAttr (set' (attr name) . show) +intAttr attrname = mkWriteAttr (set' (attr attrname) . show) emptyAttr :: String -> WriteAttr Element Bool -emptyAttr name = mkWriteAttr (set' (attr name) . f) +emptyAttr attrname = mkWriteAttr (set' (attr attrname) . f) where f True = "1" f False = "0" diff --git a/src/Graphics/UI/Threepenny/Canvas.hs b/src/Graphics/UI/Threepenny/Canvas.hs index 8aafcfd9..9ddfc98e 100644 --- a/src/Graphics/UI/Threepenny/Canvas.hs +++ b/src/Graphics/UI/Threepenny/Canvas.hs @@ -20,7 +20,6 @@ import Data.List(intercalate) import Numeric (showHex) import Graphics.UI.Threepenny.Core -import qualified Data.Aeson as JSON {----------------------------------------------------------------------------- Canvas @@ -240,8 +239,8 @@ stroke = runFunction . ffi "%1.getContext('2d').stroke()" -- The 'textAlign' attributes determines the position of the text -- relative to the point. fillText :: String -> Point -> Canvas -> UI () -fillText text (x,y) canvas = - runFunction $ ffi "%1.getContext('2d').fillText(%2, %3, %4)" canvas text x y +fillText t (x,y) canvas = + runFunction $ ffi "%1.getContext('2d').fillText(%2, %3, %4)" canvas t x y -- | Render the outline of a text at a certain point on the canvas. -- @@ -250,8 +249,8 @@ fillText text (x,y) canvas = -- The 'textAlign' attributes determines the position of the text -- relative to the point. strokeText :: String -> Point -> Canvas -> UI () -strokeText text (x,y) canvas = - runFunction $ ffi "%1.getContext('2d').strokeText(%2, %3, %4)" canvas text x y +strokeText t (x,y) canvas = + runFunction $ ffi "%1.getContext('2d').strokeText(%2, %3, %4)" canvas t x y {----------------------------------------------------------------------------- helper functions diff --git a/src/Graphics/UI/Threepenny/Core.hs b/src/Graphics/UI/Threepenny/Core.hs index 392a0c9f..8329a6a2 100644 --- a/src/Graphics/UI/Threepenny/Core.hs +++ b/src/Graphics/UI/Threepenny/Core.hs @@ -175,17 +175,19 @@ getElementById :: Window -- ^ Browser window -> String -- ^ The ID string. -> UI (Maybe Element) -- ^ Element (if any) with given ID. -getElementById _ id = - E.handle (\(e :: JS.JavaScriptException) -> return Nothing) $ - fmap Just . fromJSObject =<< callFunction (ffi "document.getElementById(%1)" id) +getElementById _ ident = + E.handle (\(_ :: JS.JavaScriptException) -> return Nothing) $ + fmap Just . fromJSObject + =<< callFunction (ffi "document.getElementById(%1)" ident) -- | Get a list of elements by particular class. getElementsByClassName :: Window -- ^ Browser window -> String -- ^ The class string. -> UI [Element] -- ^ Elements with given class. -getElementsByClassName window s = - mapM fromJSObject =<< callFunction (ffi "document.getElementsByClassName(%1)" s) +getElementsByClassName _ s = + mapM fromJSObject + =<< callFunction (ffi "document.getElementsByClassName(%1)" s) {----------------------------------------------------------------------------- Layout @@ -222,9 +224,9 @@ grid mrows = do rows0 <- mapM (sequence) mrows rows <- forM rows0 $ \row0 -> do - row <- forM row0 $ \entry -> + row1 <- forM row0 $ \entry -> wrap "table-cell" [entry] - wrap "table-row" row + wrap "table-row" row1 wrap "table" rows where @@ -306,9 +308,9 @@ instance Functor (ReadWriteAttr x i) where -- | Map input and output type of an attribute. bimapAttr :: (i' -> i) -> (o -> o') -> ReadWriteAttr x i o -> ReadWriteAttr x i' o' -bimapAttr from to attr = attr - { get' = fmap to . get' attr - , set' = \i' -> set' attr (from i') +bimapAttr from to attribute = attribute + { get' = fmap to . get' attribute + , set' = \i' -> set' attribute (from i') } -- | Set value of an attribute in the 'UI' monad. @@ -321,47 +323,47 @@ set attr i mx = do { x <- mx; set' attr i x; return x; } -- Note: For reasons of efficiency, the attribute is only -- updated when the value changes. sink :: ReadWriteAttr x i o -> Behavior i -> UI x -> UI x -sink attr bi mx = do +sink attribute bi mx = do x <- mx window <- askWindow liftIOLater $ do - i <- currentValue bi - runUI window $ set' attr i x - Reactive.onChange bi $ \i -> runUI window $ set' attr i x + i0 <- currentValue bi + runUI window $ set' attribute i0 x + Reactive.onChange bi $ \i -> runUI window $ set' attribute i x return x -- | Get attribute value. get :: ReadWriteAttr x i o -> x -> UI o -get attr = get' attr +get attribute = get' attribute -- | Build an attribute from a getter and a setter. mkReadWriteAttr :: (x -> UI o) -- ^ Getter. -> (i -> x -> UI ()) -- ^ Setter. -> ReadWriteAttr x i o -mkReadWriteAttr get set = ReadWriteAttr { get' = get, set' = set } +mkReadWriteAttr geti seto = ReadWriteAttr { get' = geti, set' = seto } -- | Build attribute from a getter. mkReadAttr :: (x -> UI o) -> ReadAttr x o -mkReadAttr get = mkReadWriteAttr get (\_ _ -> return ()) +mkReadAttr geti = mkReadWriteAttr geti (\_ _ -> return ()) -- | Build attribute from a setter. mkWriteAttr :: (i -> x -> UI ()) -> WriteAttr x i -mkWriteAttr set = mkReadWriteAttr (\_ -> return ()) set +mkWriteAttr seto = mkReadWriteAttr (\_ -> return ()) seto -- | Turn a jQuery property @.prop()@ into an attribute. fromJQueryProp :: String -> (JSON.Value -> a) -> (a -> JSON.Value) -> Attr Element a -fromJQueryProp name from to = mkReadWriteAttr get set +fromJQueryProp name from to = mkReadWriteAttr geti seto where - set v el = runFunction $ ffi "$(%1).prop(%2,%3)" el name (to v) - get el = fmap from $ callFunction $ ffi "$(%1).prop(%2)" el name + seto v el = runFunction $ ffi "$(%1).prop(%2,%3)" el name (to v) + geti el = fmap from $ callFunction $ ffi "$(%1).prop(%2)" el name -- | Turn a JavaScript object property @.prop = ...@ into an attribute. fromObjectProperty :: (FromJS a, ToJS a) => String -> Attr Element a -fromObjectProperty name = mkReadWriteAttr get set +fromObjectProperty name = mkReadWriteAttr geti seto where - set v el = runFunction $ ffi ("%1." ++ name ++ " = %2") el v - get el = callFunction $ ffi ("%1." ++ name) el + seto v el = runFunction $ ffi ("%1." ++ name ++ " = %2") el v + geti el = callFunction $ ffi ("%1." ++ name) el {----------------------------------------------------------------------------- Widget class diff --git a/src/Graphics/UI/Threepenny/DragNDrop.hs b/src/Graphics/UI/Threepenny/DragNDrop.hs index 7b3c1a68..a168a3f6 100644 --- a/src/Graphics/UI/Threepenny/DragNDrop.hs +++ b/src/Graphics/UI/Threepenny/DragNDrop.hs @@ -70,6 +70,7 @@ droppable = mkWriteAttr enable -- Change this to 'Maybe String' instead. type DragData = String +withDragData :: Event EventData -> Event String withDragData = fmap (extract . unsafeFromJSON) where extract [s] = s diff --git a/src/Graphics/UI/Threepenny/Elements.hs b/src/Graphics/UI/Threepenny/Elements.hs index 37b19891..9a5ce975 100644 --- a/src/Graphics/UI/Threepenny/Elements.hs +++ b/src/Graphics/UI/Threepenny/Elements.hs @@ -1,3 +1,4 @@ +{-# OPTIONS_GHC -Wno-missing-signatures #-} -- | Predefined DOM elements, for convenience. module Graphics.UI.Threepenny.Elements ( -- * Combinations and utilities @@ -22,7 +23,6 @@ module Graphics.UI.Threepenny.Elements ( ) where import Control.Monad -import Control.Monad.Trans.Reader import Graphics.UI.Threepenny.Core import Prelude hiding (div, map, span) diff --git a/src/Graphics/UI/Threepenny/Events.hs b/src/Graphics/UI/Threepenny/Events.hs index d2fdd8d9..0c605303 100644 --- a/src/Graphics/UI/Threepenny/Events.hs +++ b/src/Graphics/UI/Threepenny/Events.hs @@ -18,6 +18,7 @@ module Graphics.UI.Threepenny.Events ( import Graphics.UI.Threepenny.Attributes import Graphics.UI.Threepenny.Core +silence :: Event a -> Event () silence = fmap (const ()) {----------------------------------------------------------------------------- @@ -27,6 +28,7 @@ silence = fmap (const ()) valueChange :: Element -> Event String valueChange el = unsafeMapUI el (const $ get value el) (domEvent "keydown" el) +unsafeMapUI :: Element -> (t -> UI b) -> Event t -> Event b unsafeMapUI el f = unsafeMapIO (\a -> getWindow el >>= \w -> runUI w (f a)) -- | Event that occurs when the /user/ changes the selection of a @