threepenny-gui 0.9.4.0 → 0.9.4.1

raw patch · 31 files changed

+139/−152 lines, 31 filesdep ~basedep ~containersdep ~filepathPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: base, containers, filepath, websockets

API changes (from Hackage documentation)

Files

• CHANGELOG.md +4/−0
• samples/CRUD.hs +0/−3
• samples/Chat.hs +0/−2
• samples/CurrencyConverter.hs +0/−1
• samples/Data/List/Extra.hs +3/−3
• samples/DragNDropExample.hs +0/−2
• samples/DrumMachine.hs +8/−10
• src/Foreign/JavaScript.hs +2/−5
• src/Foreign/JavaScript/CallBuffer.hs +5/−6
• src/Foreign/JavaScript/EventLoop.hs +10/−13
• src/Foreign/JavaScript/Include.hs +2/−3
• src/Foreign/JavaScript/Marshal.hs +1/−2
• src/Foreign/JavaScript/Server.hs +7/−8
• src/Foreign/JavaScript/Types.hs +4/−4
• src/Foreign/RemotePtr.hs +9/−12
• src/Graphics/UI/Threepenny/Attributes.hs +4/−3
• src/Graphics/UI/Threepenny/Canvas.hs +4/−5
• src/Graphics/UI/Threepenny/Core.hs +26/−24
• src/Graphics/UI/Threepenny/DragNDrop.hs +1/−0
• src/Graphics/UI/Threepenny/Elements.hs +1/−1
• src/Graphics/UI/Threepenny/Events.hs +2/−0
• src/Graphics/UI/Threepenny/Internal.hs +3/−4
• src/Graphics/UI/Threepenny/JQuery.hs +0/−3
• src/Graphics/UI/Threepenny/SVG/Attributes.hs +1/−0
• src/Graphics/UI/Threepenny/SVG/Elements.hs +1/−0
• src/Graphics/UI/Threepenny/Timer.hs +2/−2
• src/Graphics/UI/Threepenny/Widgets.hs +4/−2
• src/Reactive/Threepenny.hs +11/−8
• src/Reactive/Threepenny/Memo.hs +1/−2
• src/Reactive/Threepenny/PulseLatch.hs +7/−9
• threepenny-gui.cabal +16/−15

@@ -1,5 +1,9 @@ ## Changelog for the `threepenny-gui` package +**0.9.4.1** – Maintenance and snapshot release++* Bump dependencies for compatibility with GHC-9.8.+ **0.9.4.0** – Maintenance and snapshot release  * Fix support for SSL: Export `ConfigSSL` constructor.

@@ -12,10 +12,7 @@ import Prelude hiding (lookup) import Control.Monad  (void) import Data.List      (isPrefixOf)-import Data.Maybe-import Data.Monoid import qualified Data.Map as Map-import qualified Data.Set as Set  import qualified Graphics.UI.Threepenny as UI import Graphics.UI.Threepenny.Core hiding (delete)

@@ -1,8 +1,6 @@ import Control.Concurrent import qualified Control.Concurrent.Chan as Chan-import Control.Exception import Control.Monad-import Data.Functor import Data.List.Extra import Data.Time import Data.IORef

@@ -1,5 +1,4 @@ import Control.Monad (void)-import Data.Maybe import Text.Printf import Safe          (readMay) 

@@ -1,8 +1,8 @@ module Data.List.Extra where-                  -import Data.List+ import Data.Char-import Data.Maybe+    ( isSpace+    )  trim :: String -> String trim = reverse . dropWhile isSpace . reverse . dropWhile isSpace

@@ -1,7 +1,5 @@-import Control.Applicative import Control.Monad import Data.IORef-import Data.Maybe  import Paths 

@@ -1,9 +1,6 @@ import Control.Monad-import Data.IORef-import Data.Functor  import Paths-import System.FilePath  import qualified Graphics.UI.Threepenny as UI import Graphics.UI.Threepenny.Core@@ -11,12 +8,13 @@ {-----------------------------------------------------------------------------     Configuration ------------------------------------------------------------------------------}+bars, beats, defaultBpm :: Int bars  = 4 beats = 4 defaultBpm = 120  bpm2ms :: Int -> Int-bpm2ms bpm = ceiling $ 1000*60 / fromIntegral bpm+bpm2ms bpm = ceiling $ 1000*60 / (fromIntegral bpm :: Double)  -- NOTE: Samples taken from "conductive-examples" @@ -42,7 +40,7 @@     let status = grid [[UI.string "BPM:" , element elBpm]                       ,[UI.string "Beat:", element elTick]]     getBody w #+ [UI.div #. "wrap" #+ (status : map element elInstruments)]-    +     timer <- UI.timer # set UI.interval (bpm2ms defaultBpm)     eBeat <- accumE (0::Int) $         (\beat -> (beat + 1) `mod` (beats * bars)) <$ UI.tick timer@@ -51,12 +49,12 @@         element elTick # set text (show $ beat + 1)         -- play corresponding sounds         sequence_ $ map (!! beat) kit-    +     -- allow user to set BPM     on UI.keydown elBpm $ \keycode -> when (keycode == 13) $ void $ do         bpm <- read <$> get value elBpm         return timer # set UI.interval (bpm2ms bpm)-    +     -- start the timer     UI.start timer @@ -82,13 +80,13 @@             checked <- get UI.checked box             when checked $ do                 runFunction $ ffi "%1.pause()" elAudio-                runFunction $ ffi "%1.currentTime = 0" elAudio +                runFunction $ ffi "%1.currentTime = 0" elAudio                 runFunction $ ffi "%1.play()" elAudio         beats    = map play . concat $ elCheckboxes         elGroups = [UI.span #. "bar" #+ map element bar | bar <- elCheckboxes]-    +     elInstrument <- UI.div #. "instrument"         #+ (element elAudio : UI.string name : elGroups)-    +     return (beats, elInstrument) 

@@ -31,9 +31,6 @@     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 @@     :: 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  {-----------------------------------------------------------------------------

@@ -1,7 +1,6 @@ {-# LANGUAGE RecordWildCards #-} module Foreign.JavaScript.CallBuffer where -import Control.Concurrent import Control.Concurrent.STM as STM import Control.Monad @@ -17,7 +16,7 @@  -- | 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 +25,7 @@  -- | 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 +38,7 @@ -- | 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 +49,5 @@                 putTMVar wCallBuffer (msg . (\s -> ";" ++ code ++ s))                 return Nothing     case action of-        Nothing   -> return ()-        Just code -> runEval code+        Nothing    -> return ()+        Just code1 -> runEval code1

@@ -6,7 +6,6 @@     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.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 @@     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 @@ -- | 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 @@      -- 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 @@         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 @@ ------------------------------------------------------------------------------} -- | 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

@@ -1,15 +1,14 @@ {-# LANGUAGE TemplateHaskell, CPP #-} module Foreign.JavaScript.Include (include) where -import           Data.Functor import           Data.FileEmbed      (makeRelativeToProject) import           Language.Haskell.TH 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

@@ -19,8 +19,6 @@ #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 import qualified Data.Text.Lazy@@ -48,6 +46,7 @@         ys <- mapM render xs         jsCode $ "[" ++ intercalate "," (map unJSCode ys) ++ "]" +jsCode :: String -> IO JSCode jsCode = return . JSCode  instance ToJS Float      where render   = render . JSON.toJSON

@@ -4,7 +4,6 @@     ) where  -- import general libraries-import           Control.Applicative import           Control.Concurrent import           Control.Concurrent.Async import           Control.Concurrent.STM     as STM@@ -15,17 +14,16 @@ 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 +112,15 @@     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 +153,7 @@             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

@@ -1,16 +1,13 @@ {-# LANGUAGE OverloadedStrings, DeriveDataTypeable #-} module Foreign.JavaScript.Types where -import           Control.Applicative import qualified Control.Exception       as E import           Control.Concurrent.STM  as STM-import           Control.Concurrent.Chan as Chan import           Control.Concurrent.MVar import           Control.DeepSeq import           Data.Aeson              as JSON import           Data.ByteString.Char8           (ByteString) import qualified Data.ByteString.Char8   as BS   (hPutStrLn)-import           Data.IORef import           Data.Map                as Map import           Data.String import           Data.Text@@ -167,6 +164,8 @@     , sLog   :: ByteString -> IO () -- function for logging     } type Filepaths = (Integer, Map ByteString (FilePath, MimeType))++newFilepaths :: Filepaths newFilepaths = (0, Map.empty)  {-----------------------------------------------------------------------------@@ -233,7 +232,8 @@     toJSON (RunEval  x) = object [ "tag" .= t "RunEval" , "contents" .= toJSON x]     toJSON (CallEval x) = object [ "tag" .= t "CallEval", "contents" .= toJSON x] -t s = fromString s :: Text+t :: String -> Text+t s = fromString s  writeServer :: Comm -> ServerMsg -> STM () writeServer c = writeComm c . toJSON . force

@@ -17,15 +17,11 @@  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 +38,14 @@ 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 +129,9 @@     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 +145,10 @@ -- 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

@@ -1,3 +1,4 @@+{-# OPTIONS_GHC -Wno-missing-signatures #-} module Graphics.UI.Threepenny.Attributes (     -- * Synopsis     -- | Element attributes.@@ -50,13 +51,13 @@     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"

@@ -20,7 +20,6 @@ import Numeric (showHex)  import Graphics.UI.Threepenny.Core-import qualified Data.Aeson as JSON  {-----------------------------------------------------------------------------     Canvas@@ -240,8 +239,8 @@ -- 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 @@ -- 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

@@ -175,17 +175,19 @@     :: 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 @@         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 @@ -- | 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 @@ -- 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

@@ -70,6 +70,7 @@ -- Change this to 'Maybe String' instead. type DragData = String +withDragData :: Event EventData -> Event String withDragData = fmap (extract . unsafeFromJSON)     where     extract [s] = s

@@ -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 @@     ) where  import           Control.Monad-import           Control.Monad.Trans.Reader import           Graphics.UI.Threepenny.Core import           Prelude                     hiding (div, map, span) 

@@ -18,6 +18,7 @@ import Graphics.UI.Threepenny.Attributes import Graphics.UI.Threepenny.Core +silence :: Event a -> Event () silence = fmap (const ())  {-----------------------------------------------------------------------------@@ -27,6 +28,7 @@ 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 @<select>@ element.

@@ -21,7 +21,6 @@     EventData, domEvent, unsafeFromJSON,     ) where -import           Control.Applicative                   (Applicative(..)) import           Control.Monad import           Control.Monad.Catch import           Control.Monad.Fix@@ -57,7 +56,7 @@     :: Config               -- ^ Server configuration.     -> (Window -> UI ())    -- ^ Action to run whenever a client browser connects.     -> IO ()-startGUI config init = JS.serve config $ \w -> do+startGUI config initialize = JS.serve config $ \w -> do     -- set up disconnect event     (eDisconnect, handleDisconnect) <- RB.newEvent     JS.onDisconnect w $ handleDisconnect ()@@ -73,7 +72,7 @@             }      -- run initialization-    runUI window $ init window+    runUI window $ initialize window  -- | Event that occurs whenever the client has disconnected, -- be it by closing the browser window or by exception.@@ -119,7 +118,7 @@ -- | Lookup or create reachability information for the children of -- an element that is represented by a JavaScript object. getChildren :: JS.JSObject -> Window -> IO Children-getChildren el window@Window{ wChildren = wChildren } =+getChildren el Window{ wChildren = wChildren } =     Foreign.withRemotePtr el $ \coupon _ -> do         mptr <- Foreign.lookup coupon wChildren         case mptr of

@@ -1,10 +1,7 @@ module Graphics.UI.Threepenny.JQuery where -import Control.Arrow-import Data.String import Data.Char import Data.Default-import Data.Maybe  import Graphics.UI.Threepenny.Core 

@@ -1,3 +1,4 @@+{-# OPTIONS_GHC -Wno-missing-signatures #-} module Graphics.UI.Threepenny.SVG.Attributes (     -- * Synopsis     -- | SVG attributes as defined by W3C, Scalable Vector Graphics (SVG) 1.1

@@ -1,3 +1,4 @@+{-# OPTIONS_GHC -Wno-missing-signatures #-} module Graphics.UI.Threepenny.SVG.Elements (     -- * Synopsis     -- | SVG elements as defined by W3C, Scalable Vector Graphics (SVG) 1.1

@@ -13,7 +13,7 @@     ) where  import Data.Typeable-import Control.Monad (when, forever, void)+import Control.Monad (when, forever) import Control.Concurrent import Control.Concurrent.STM import Reactive.Threepenny@@ -34,7 +34,7 @@     tvInterval    <- newTVarIO 1000     (tTick, fire) <- newEvent     -    forkIO $ forever $ do+    _ <- forkIO $ forever $ do         atomically $ do             b <- readTVar tvRunning             when (not b) retry

@@ -1,4 +1,5 @@ {-# LANGUAGE RecordWildCards, ScopedTypeVariables #-}+{-# OPTIONS_GHC -Wno-unused-do-bind #-} module Graphics.UI.Threepenny.Widgets (     -- * Synopsis     -- | Widgets are reusable building blocks for a graphical user interface.@@ -92,7 +93,7 @@         bindices = (Map.fromList . flip zip [0..]) <$> bitems         bindex   = lookupIndex <$> bindices <*> bsel -        lookupIndex indices Nothing    = Nothing+        lookupIndex _indices Nothing   = Nothing         lookupIndex indices (Just sel) = Map.lookup sel indices      element list # sink UI.selection bindex@@ -111,8 +112,9 @@      return ListBox {..} +items :: WriteAttr Element [UI Element] items = mkWriteAttr $ \i x -> void $ do-    return x # set children [] #+ map (\i -> UI.option #+ [i]) i+    return x # set children [] #+ map (\j -> UI.option #+ [j]) i   

@@ -42,6 +42,9 @@     -- | Functions reserved for special circumstances.     -- Do not use unless you know what you're doing.     onChange, unsafeMapIO, newEventsNamed,+    +    -- * Testing+    test, test_recursion1     ) where  import Control.Applicative@@ -55,7 +58,6 @@  type Pulse = Prim.Pulse type Latch = Prim.Latch-type Map   = Map.Map  {-----------------------------------------------------------------------------     Types@@ -104,7 +106,7 @@ newEventsNamed :: Ord name     => Handler (name, Event a, Handler a)   -- ^ Initialization procedure.     -> IO (name -> Event a)                 -- ^ Series of events.-newEventsNamed init = do+newEventsNamed initialize = do     eventsRef <- newIORef Map.empty     return $ \name -> E $ memoize $ do         events <- readIORef eventsRef@@ -113,7 +115,7 @@             Nothing -> do                 (p, fire) <- Prim.newPulse                 writeIORef eventsRef $ Map.insert name p events-                init (name, E $ fromPure p, fire)+                initialize (name, E $ fromPure p, fire)                 return p  @@ -165,6 +167,7 @@ -- Think of it as -- -- > filterJust es = [(time,a) | (time,Just a) <- es]+filterJust :: Event (Maybe a) -> Event a filterJust e = E $ liftMemo1 Prim.filterJustP (unE e)  -- | Merge two event streams of the same type.@@ -308,8 +311,8 @@ split e = (filterJust $ fromLeft <$> e, filterJust $ fromRight <$> e)     where     fromLeft  (Left  a) = Just a-    fromLeft  (Right b) = Nothing-    fromRight (Left  a) = Nothing+    fromLeft  (Right _) = Nothing+    fromRight (Left  _) = Nothing     fromRight (Right b) = Just b  -- | Collect simultaneous event occurrences in a list.@@ -366,9 +369,9 @@ pair (T bx ex) (T by ey) = T b e     where     b = (,) <$> bx <*> by-    x = flip (,) <$> by <@> ex-    y = (,) <$> bx <@> ey-    e = unionWith (\(x,_) (_,y) -> (x,y)) x y+    ex' = flip (,) <$> by <@> ex+    ey' = (,) <$> bx <@> ey+    e = unionWith (\(x,_) (_,y) -> (x,y)) ex' ey'   {-----------------------------------------------------------------------------

@@ -3,8 +3,6 @@     Memo, fromPure, memoize, at, liftMemo1, liftMemo2,     ) where -import Control.Monad-import Data.Functor import Data.IORef import System.IO.Unsafe @@ -17,6 +15,7 @@  type MemoD a = Either (IO a) a +fromPure :: a -> Memo a fromPure = Const  at :: Memo a -> IO a

@@ -6,18 +6,18 @@     Latch,     pureL, mapL, applyL, accumL, applyP,     readLatch,+    +    -- * Internal+    test, test_recursion1     ) where  -import Control.Applicative import Control.Monad import Control.Monad.Trans.Class import Control.Monad.Trans.RWS     as Monad  import Data.IORef-import Data.Monoid (Endo(..)) -import           Data.Hashable import qualified Data.HashMap.Strict as Map import qualified Data.Vault.Strict   as Vault import           Data.Unique.Really@@ -25,8 +25,6 @@ import Reactive.Threepenny.Monads import Reactive.Threepenny.Types -type Map = Map.HashMap- {-----------------------------------------------------------------------------     Pulse ------------------------------------------------------------------------------}@@ -114,11 +112,11 @@  -- | Map an IO function over pulses. Is only executed once. unsafeMapIOP :: (a -> IO b) -> Pulse a -> Build (Pulse b)-unsafeMapIOP f p = (`dependOn` p) <$> cacheEval (traverse . fmap f =<< evalP p)+unsafeMapIOP f p = (`dependOn` p) <$> cacheEval (traverse' . fmap f =<< evalP p)     where-    traverse :: Maybe (IO a) -> EvalP (Maybe a)-    traverse Nothing  = return Nothing-    traverse (Just m) = Just <$> lift m+    traverse' :: Maybe (IO a) -> EvalP (Maybe a)+    traverse' Nothing  = return Nothing+    traverse' (Just m) = Just <$> lift m  -- | Filter occurrences. Only keep those of the form 'Just'. filterJustP :: Pulse (Maybe a) -> Build (Pulse a)

@@ -1,5 +1,5 @@ Name:                threepenny-gui-Version:             0.9.4.0+Version:             0.9.4.1 Synopsis:            GUI framework that uses the web browser as a display. Description:     Threepenny-GUI is a GUI framework that uses the web browser as a display.@@ -28,15 +28,16 @@ Category:            Web, GUI Build-type:          Simple Cabal-version:       >=1.10-Tested-With:         GHC == 7.10.3-                    ,GHC == 8.0.2+Tested-With:         GHC == 8.0.2                     ,GHC == 8.2.2                     ,GHC == 8.4.4                     ,GHC == 8.6.5                     ,GHC == 8.8.4                     ,GHC == 8.10.7-                    ,GHC == 9.2.4-                    ,GHC == 9.4.1+                    ,GHC == 9.2.8+                    ,GHC == 9.4.7+                    ,GHC == 9.6.3+                    ,GHC == 9.8.1  Extra-Source-Files:  CHANGELOG.md                     ,README.md@@ -111,26 +112,26 @@   if flag(rebug)       cpp-options:  -DREBUG       ghc-options:  -O2-  build-depends:     base                   >= 4.8   && < 4.19-                    ,aeson                  (>= 0.7 && < 0.10) || == 0.11.* || (>= 1.0 && < 2.2)+  build-depends:     base                   >= 4.8   && < 4.20+                    ,aeson                  (>= 0.7 && < 0.10) || == 0.11.* || (>= 1.0 && < 2.3)                     ,async                  >= 2.0   && < 2.3-                    ,bytestring             >= 0.9.2 && < 0.12-                    ,containers             >= 0.4.2 && < 0.7+                    ,bytestring             >= 0.9.2 && < 0.13+                    ,containers             >= 0.4.2 && < 0.8                     ,data-default           >= 0.5.0 && < 0.8-                    ,deepseq                >= 1.3.0 && < 1.5+                    ,deepseq                >= 1.3.0 && < 1.6                     ,exceptions             >= 0.6   && < 0.11-                    ,filepath               >= 1.3.0 && < 1.5.0+                    ,filepath               >= 1.3.0 && < 1.6.0                     ,file-embed             >= 0.0.10 && < 0.1                     ,hashable               >= 1.2.0 && < 1.5                     ,safe                   == 0.3.*                     ,snap-server            >= 0.9.0 && < 1.2                     ,snap-core              >= 0.9.0 && < 1.1                     ,stm                    >= 2.2    && < 2.6-                    ,template-haskell       >= 2.7.0  && < 2.20-                    ,text                   >= 0.11   && < 2.1-                    ,transformers           >= 0.3.0  && < 0.6+                    ,template-haskell       >= 2.7.0  && < 2.22+                    ,text                   >= 0.11   && < 2.2+                    ,transformers           >= 0.3.0  && < 0.7                     ,unordered-containers   == 0.2.*-                    ,websockets             (>= 0.8    && < 0.12.5) || (> 0.12.5.0 && < 0.13)+                    ,websockets             (>= 0.8    && < 0.12.5) || (> 0.12.5.0 && < 0.14)                     ,websockets-snap        >= 0.8    && < 0.11                     ,vault                  == 0.3.*                     ,vector                 >= 0.10   && < 0.14