{-# LANGUAGE CPP #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Web.Scotty.Comet
( connect
, kCometPlugin
, send
, Document
, Options(..)
, getReply
, eventQueue
, debugDocument
, debugReplyDocument
, defaultOptions
) where
import qualified Web.Scotty as Scotty
import Web.Scotty (ScottyM, text, post, capture, setHeader, get, ActionM, jsonData)
import Data.Aeson (Value(..))
import Control.Monad
import Control.Concurrent.STM as STM
import Control.Concurrent.MVar as STM
import Control.Monad.IO.Class
import Paths_kansas_comet (getDataFileName)
import qualified Data.Map as Map
import Control.Concurrent
import Data.Default.Class
import Data.Maybe ( fromJust )
import System.Exit
import qualified Data.Text.Lazy as LT
import qualified Data.Text as T
import Data.Time.Calendar
import Data.Time.Clock
import Numeric
#if MIN_VERSION_aeson(2,0,0)
import qualified Data.Aeson.KeyMap as KeyMap
#else
import qualified Data.HashMap.Strict as HashMap
#endif
connect :: Options
-> (Document -> IO ())
-> IO (ScottyM ())
connect :: Options -> (Document -> IO ()) -> IO (ScottyM ())
connect Options
opt Document -> IO ()
callback = do
if Bool -> Bool
not Bool
rtsSupportsBoundThreads
then do [Char] -> IO ()
putStrLn [Char]
"Application needs to be re-compiled with -threaded flag"
forall a. IO a
exitFailure
else forall (m :: * -> *) a. Monad m => a -> m a
return ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Options -> Int
verbose Options
opt forall a. Ord a => a -> a -> Bool
>= Int
1) forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ [Char]
"kansas-comet connect with prefix=" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show (Options -> [Char]
prefix Options
opt)
MVar Int
uniqVar <- forall a. a -> IO (MVar a)
newMVar Int
0
let getUniq :: IO Int
getUniq :: IO Int
getUniq = do
Int
u <- forall a. MVar a -> IO a
takeMVar MVar Int
uniqVar
forall a. MVar a -> a -> IO ()
putMVar MVar Int
uniqVar (Int
u forall a. Num a => a -> a -> a
+ Int
1)
forall (m :: * -> *) a. Monad m => a -> m a
return Int
u
UTCTime
tm :: UTCTime <- IO UTCTime
getCurrentTime
let server_id :: [Char]
server_id
= forall a. (Integral a, Show a) => a -> ShowS
Numeric.showHex (Day -> Integer
toModifiedJulianDay (UTCTime -> Day
utctDay UTCTime
tm))
forall a b. (a -> b) -> a -> b
$ ([Char]
"-" forall a. [a] -> [a] -> [a]
++)
forall a b. (a -> b) -> a -> b
$ forall a. (Integral a, Show a) => a -> ShowS
Numeric.showHex (forall a b. (RealFrac a, Integral b) => a -> b
floor (UTCTime -> DiffTime
utctDayTime UTCTime
tm forall a. Num a => a -> a -> a
* DiffTime
1000) :: Integer)
forall a b. (a -> b) -> a -> b
$ [Char]
""
TVar (Map Int Document)
contextDB <- forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ forall a. a -> STM (TVar a)
newTVar forall a b. (a -> b) -> a -> b
$ (forall k a. Map k a
Map.empty :: Map.Map Int Document)
let newContext :: IO Int
newContext :: IO Int
newContext = do
Int
uq <- IO Int
getUniq
TMVar Text
picture <- forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ forall a. STM (TMVar a)
newEmptyTMVar
TVar (Map Int Value)
callbacks <- forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ forall a. a -> STM (TVar a)
newTVar forall a b. (a -> b) -> a -> b
$ forall k a. Map k a
Map.empty
TChan Value
queue <- forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ forall a. STM (TChan a)
newTChan
let cxt :: Document
cxt = TMVar Text
-> TVar (Map Int Value) -> TChan Value -> Int -> Document
Document TMVar Text
picture TVar (Map Int Value)
callbacks TChan Value
queue Int
uq
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ do
Map Int Document
db <- forall a. TVar a -> STM a
readTVar TVar (Map Int Document)
contextDB
forall a. TVar a -> a -> STM ()
writeTVar TVar (Map Int Document)
contextDB forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Int
uq Document
cxt Map Int Document
db
ThreadId
_ <- IO () -> IO ThreadId
forkIO forall a b. (a -> b) -> a -> b
$ Document -> IO ()
callback Document
cxt
forall (m :: * -> *) a. Monad m => a -> m a
return Int
uq
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ do
RoutePattern -> ActionM () -> ScottyM ()
post ([Char] -> RoutePattern
capture forall a b. (a -> b) -> a -> b
$ Options -> [Char]
prefix Options
opt forall a. [a] -> [a] -> [a]
++ [Char]
"/") forall a b. (a -> b) -> a -> b
$ do
Int
uq <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ IO Int
newContext
Text -> ActionM ()
text ([Char] -> Text
LT.pack forall a b. (a -> b) -> a -> b
$ [Char]
"$.kc.session(" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show [Char]
server_id forall a. [a] -> [a] -> [a]
++ [Char]
"," forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
uq forall a. [a] -> [a] -> [a]
++ [Char]
");")
RoutePattern -> ActionM () -> ScottyM ()
get ([Char] -> RoutePattern
capture forall a b. (a -> b) -> a -> b
$ Options -> [Char]
prefix Options
opt forall a. [a] -> [a] -> [a]
++ [Char]
"/act/" forall a. [a] -> [a] -> [a]
++ [Char]
server_id forall a. [a] -> [a] -> [a]
++ [Char]
"/:id/:act") forall a b. (a -> b) -> a -> b
$ do
Text -> Text -> ActionM ()
setHeader Text
"Cache-Control" Text
"max-age=0, no-cache, private, no-store, must-revalidate"
Int
num <- Text -> ActionT IO Int
captureParam Text
"id"
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Options -> Int
verbose Options
opt forall a. Ord a => a -> a -> Bool
>= Int
2) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$
[Char]
"Kansas Comet: get .../act/" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
num
let tryPushAction :: TMVar T.Text -> Int -> ActionM ()
tryPushAction :: TMVar Text -> Int -> ActionM ()
tryPushAction TMVar Text
var Int
n = do
TVar Bool
ping <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Int -> IO (TVar Bool)
registerDelay (Int
3 forall a. Num a => a -> a -> a
* Int
1000 forall a. Num a => a -> a -> a
* Int
1000)
Maybe Text
res <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ do
Bool
b <- forall a. TVar a -> STM a
readTVar TVar Bool
ping
if Bool
b then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing else do
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall a. a -> Maybe a
Just (forall a. TMVar a -> STM a
takeTMVar TMVar Text
var)
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Options -> Int
verbose Options
opt forall a. Ord a => a -> a -> Bool
>= Int
2) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$
[Char]
"Kansas Comet (sending to " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
n forall a. [a] -> [a] -> [a]
++ [Char]
"):\n" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Maybe Text
res
case Maybe Text
res of
Just Text
js -> do
Text -> ActionM ()
text forall a b. (a -> b) -> a -> b
$ [Text] -> Text
LT.fromChunks [Text
js]
Maybe Text
Nothing ->
Text -> ActionM ()
text Text
LT.empty
Map Int Document
db <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ forall a. TVar a -> STM a
readTVar TVar (Map Int Document)
contextDB
case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Int
num Map Int Document
db of
Maybe Document
Nothing -> Text -> ActionM ()
text ([Char] -> Text
LT.pack forall a b. (a -> b) -> a -> b
$ [Char]
"console.warn('Can not find act #" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
num forall a. [a] -> [a] -> [a]
++ [Char]
"');")
Just Document
doc -> TMVar Text -> Int -> ActionM ()
tryPushAction (Document -> TMVar Text
sending Document
doc) Int
num
RoutePattern -> ActionM () -> ScottyM ()
post ([Char] -> RoutePattern
capture forall a b. (a -> b) -> a -> b
$ Options -> [Char]
prefix Options
opt forall a. [a] -> [a] -> [a]
++ [Char]
"/reply/" forall a. [a] -> [a] -> [a]
++ [Char]
server_id forall a. [a] -> [a] -> [a]
++ [Char]
"/:id/:uq") forall a b. (a -> b) -> a -> b
$ do
Text -> Text -> ActionM ()
setHeader Text
"Cache-Control" Text
"max-age=0, no-cache, private, no-store, must-revalidate"
Int
num <- Text -> ActionT IO Int
captureParam Text
"id"
Int
uq :: Int <- Text -> ActionT IO Int
captureParam Text
"uq"
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Options -> Int
verbose Options
opt forall a. Ord a => a -> a -> Bool
>= Int
2) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$
[Char]
"Kansas Comet: post .../reply/" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
num forall a. [a] -> [a] -> [a]
++ [Char]
"/" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
uq
Value
wrappedVal :: Value <- forall a. FromJSON a => ActionM a
jsonData
Object
m <- case Value
wrappedVal of
Object Object
m -> forall (m :: * -> *) a. Monad m => a -> m a
return Object
m
Value
_ -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$ [Char]
"Expected Object, received: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Value
wrappedVal
let val :: Value
val = forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ forall {v}. Key -> KeyMap v -> Maybe v
lookupKM Key
"data" Object
m
Map Int Document
db <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ forall a. TVar a -> STM a
readTVar TVar (Map Int Document)
contextDB
case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Int
num Map Int Document
db of
Maybe Document
Nothing -> do
Text -> ActionM ()
text ([Char] -> Text
LT.pack forall a b. (a -> b) -> a -> b
$ [Char]
"console.warn('Ignore reply for session #" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
num forall a. [a] -> [a] -> [a]
++ [Char]
"');")
Just Document
doc -> do
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ do
Map Int Value
mv <- forall a. TVar a -> STM a
readTVar (Document -> TVar (Map Int Value)
replies Document
doc)
forall a. TVar a -> a -> STM ()
writeTVar (Document -> TVar (Map Int Value)
replies Document
doc) forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Int
uq Value
val Map Int Value
mv
Text -> ActionM ()
text forall a b. (a -> b) -> a -> b
$ [Char] -> Text
LT.pack [Char]
""
RoutePattern -> ActionM () -> ScottyM ()
post ([Char] -> RoutePattern
capture forall a b. (a -> b) -> a -> b
$ Options -> [Char]
prefix Options
opt forall a. [a] -> [a] -> [a]
++ [Char]
"/event/" forall a. [a] -> [a] -> [a]
++ [Char]
server_id forall a. [a] -> [a] -> [a]
++ [Char]
"/:id") forall a b. (a -> b) -> a -> b
$ do
Text -> Text -> ActionM ()
setHeader Text
"Cache-Control" Text
"max-age=0, no-cache, private, no-store, must-revalidate"
Int
num <- Text -> ActionT IO Int
captureParam Text
"id"
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Options -> Int
verbose Options
opt forall a. Ord a => a -> a -> Bool
>= Int
2) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$
[Char]
"Kansas Comet: post .../event/" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
num
Value
wrappedVal :: Value <- forall a. FromJSON a => ActionM a
jsonData
Object
m <- case Value
wrappedVal of
Object Object
m -> forall (m :: * -> *) a. Monad m => a -> m a
return Object
m
Value
_ -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$ [Char]
"Expected Object, received: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Value
wrappedVal
let val :: Value
val = forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ forall {v}. Key -> KeyMap v -> Maybe v
lookupKM Key
"data" Object
m
Map Int Document
db <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ forall a. TVar a -> STM a
readTVar TVar (Map Int Document)
contextDB
case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Int
num Map Int Document
db of
Maybe Document
Nothing -> do
Text -> ActionM ()
text ([Char] -> Text
LT.pack forall a b. (a -> b) -> a -> b
$ [Char]
"console.warn('Ignore reply for session #" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
num forall a. [a] -> [a] -> [a]
++ [Char]
"');")
Just Document
doc -> do
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ do
forall a. TChan a -> a -> STM ()
writeTChan (Document -> TChan Value
eventQueue Document
doc) Value
val
Text -> ActionM ()
text forall a b. (a -> b) -> a -> b
$ [Char] -> Text
LT.pack [Char]
""
where
#if MIN_VERSION_aeson(2,0,0)
lookupKM :: Key -> KeyMap v -> Maybe v
lookupKM = forall {v}. Key -> KeyMap v -> Maybe v
KeyMap.lookup
#else
lookupKM = HashMap.lookup
#endif
#if MIN_VERSION_scotty(0,20,0)
captureParam :: Text -> ActionT IO Int
captureParam = forall a. Parsable a => Text -> ActionM a
Scotty.captureParam
#else
captureParam = Scotty.param
#endif
kCometPlugin :: IO String
kCometPlugin :: IO [Char]
kCometPlugin = [Char] -> IO [Char]
getDataFileName [Char]
"static/js/kansas-comet.js"
send :: Document -> T.Text -> IO ()
send :: Document -> Text -> IO ()
send Document
doc Text
js = forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ forall a. TMVar a -> a -> STM ()
putTMVar (Document -> TMVar Text
sending Document
doc) forall a b. (a -> b) -> a -> b
$! Text
js
getReply :: Document -> Int -> IO Value
getReply :: Document -> Int -> IO Value
getReply Document
doc Int
num = do
forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ do
Map Int Value
db <- forall a. TVar a -> STM a
readTVar (Document -> TVar (Map Int Value)
replies Document
doc)
case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Int
num Map Int Value
db of
Maybe Value
Nothing -> forall a. STM a
retry
Just Value
r -> do
forall a. TVar a -> a -> STM ()
writeTVar (Document -> TVar (Map Int Value)
replies Document
doc) forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Map k a
Map.delete Int
num Map Int Value
db
forall (m :: * -> *) a. Monad m => a -> m a
return Value
r
data Document = Document
{ Document -> TMVar Text
sending :: TMVar T.Text
, Document -> TVar (Map Int Value)
replies :: TVar (Map.Map Int Value)
, Document -> TChan Value
eventQueue :: TChan Value
, Document -> Int
_secret :: Int
} deriving Document -> Document -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Document -> Document -> Bool
$c/= :: Document -> Document -> Bool
== :: Document -> Document -> Bool
$c== :: Document -> Document -> Bool
Eq
data Options = Options
{ Options -> [Char]
prefix :: String
, Options -> Int
verbose :: Int
} deriving (Options -> Options -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Options -> Options -> Bool
$c/= :: Options -> Options -> Bool
== :: Options -> Options -> Bool
$c== :: Options -> Options -> Bool
Eq, Eq Options
Options -> Options -> Bool
Options -> Options -> Ordering
Options -> Options -> Options
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Options -> Options -> Options
$cmin :: Options -> Options -> Options
max :: Options -> Options -> Options
$cmax :: Options -> Options -> Options
>= :: Options -> Options -> Bool
$c>= :: Options -> Options -> Bool
> :: Options -> Options -> Bool
$c> :: Options -> Options -> Bool
<= :: Options -> Options -> Bool
$c<= :: Options -> Options -> Bool
< :: Options -> Options -> Bool
$c< :: Options -> Options -> Bool
compare :: Options -> Options -> Ordering
$ccompare :: Options -> Options -> Ordering
Ord, Int -> Options -> ShowS
[Options] -> ShowS
Options -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Options] -> ShowS
$cshowList :: [Options] -> ShowS
show :: Options -> [Char]
$cshow :: Options -> [Char]
showsPrec :: Int -> Options -> ShowS
$cshowsPrec :: Int -> Options -> ShowS
Show)
instance Default Options where
def :: Options
def = Options
{ prefix :: [Char]
prefix = [Char]
""
, verbose :: Int
verbose = Int
0
}
defaultOptions :: Options
defaultOptions :: Options
defaultOptions = forall a. Default a => a
def
debugDocument :: IO Document
debugDocument :: IO Document
debugDocument = do
TMVar Text
picture <- forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ forall a. STM (TMVar a)
newEmptyTMVar
TVar (Map Int Value)
callbacks <- forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ forall a. a -> STM (TVar a)
newTVar forall a b. (a -> b) -> a -> b
$ forall k a. Map k a
Map.empty
ThreadId
_ <- IO () -> IO ThreadId
forkIO forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Applicative f => f a -> f b
forever forall a b. (a -> b) -> a -> b
$ do
Text
res <- forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ forall a. TMVar a -> STM a
takeTMVar forall a b. (a -> b) -> a -> b
$ TMVar Text
picture
[Char] -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ [Char]
"Sending: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Text
res
TChan Value
q <- forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ forall a. STM (TChan a)
newTChan
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ TMVar Text
-> TVar (Map Int Value) -> TChan Value -> Int -> Document
Document TMVar Text
picture TVar (Map Int Value)
callbacks TChan Value
q Int
0
debugReplyDocument :: Document -> Int -> Value -> IO ()
debugReplyDocument :: Document -> Int -> Value -> IO ()
debugReplyDocument Document
doc Int
uq Value
val = forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ do
Map Int Value
m <- forall a. TVar a -> STM a
readTVar (Document -> TVar (Map Int Value)
replies Document
doc)
forall a. TVar a -> a -> STM ()
writeTVar (Document -> TVar (Map Int Value)
replies Document
doc) forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Int
uq Value
val Map Int Value
m