module Web.DDP.Deadpan
( module Web.DDP.Deadpan
, module ReExports
, getURI
, Error
, Params
, liftIO
)
where
import Web.DDP.Deadpan.DSL as ReExports
import Web.DDP.Deadpan.Callbacks as ReExports
import Control.Monad as ReExports
import Web.DDP.Deadpan.Websockets
import Data.Maybe
import Control.Concurrent.STM
import Control.Concurrent.Chan
import Control.Monad.IO.Class
import Data.Sequence (empty)
runBareClient :: Params -> DeadpanApp a -> IO a
runBareClient params app = flip execURI params
$ \conn -> do appState <- newTVarIO $ AppState empty (ejobject []) conn
runDeadpan app appState
runConnectClient :: Params -> DeadpanApp a -> IO a
runConnectClient params app = runBareClient params (fetchMessagesThenExit $ connect >> app)
runConnectClientVersion :: Params -> Version -> DeadpanApp a -> IO a
runConnectClientVersion params v app = runBareClient params (fetchMessagesThenExit $ connectVersion v >> app)
runPingClient :: Params -> DeadpanApp a -> IO a
runPingClient params app = runConnectClient params (handlePings >> app)
runPingClientVersion :: Params -> Version -> DeadpanApp a -> IO a
runPingClientVersion params v app = runConnectClientVersion params v (handlePings >> app)
handlePings :: DeadpanApp GUID
handlePings = setMsgHandler "ping" pingCallback
logEverything :: DeadpanApp (Chan String)
logEverything = do pipe <- liftIO newChan
_ <- setCatchAllHandler (liftIO . writeChan pipe . show)
_ <- fork $ liftIO $ getChanContents pipe >>= mapM_ putStrLn
return pipe
logEverythingVia :: DeadpanApp (Chan String)
logEverythingVia = do pipe <- liftIO newChan
_ <- setCatchAllHandler (liftIO . writeChan pipe . show)
return pipe
collect :: DeadpanApp ()
collect = void $ setMsgHandler "added" dataAdded
>> setMsgHandler "removed" dataRemoved
>> setMsgHandler "changed" dataChanged
dataOver :: ([Text] -> EJsonValue -> EJsonValue -> EJsonValue) -> Callback
dataOver f m = fromMaybe (return ()) $ do
collectionName <- m ^? _EJObjectKeyString "collection"
itemId <- m ^? _EJObjectKeyString "id"
fields <- m ^. _EJObjectKey "fields"
return $ modifyAppState (over collections (f ["subscription-data", collectionName, itemId] fields))
dataAdded :: Callback
dataAdded = dataOver putInPath'
dataChanged :: Callback
dataChanged = dataOver modifyInPath'
dataRemoved :: Callback
dataRemoved m = fromMaybe (return ()) $ do
collectionName <- m ^? _EJObjectKeyString "collection"
itemId <- m ^? _EJObjectKeyString "id"
return $ modifyAppState (over collections (removeFromPath' ["subscription-data", collectionName, itemId]))
subscriptions :: Traversal' (AppState a) EJsonValue
subscriptions = collections . _EJObjectKey "subscription-data" . _Just
setServerID :: DeadpanApp ()
setServerID = do
hid <- newID
void $ setHandler hid
$ \e -> forOf_ (_EJObjectKey "server_id" . _Just) e
$ \x -> putInBase "server_id" x
>> deleteHandlerID hid
putInBase :: Text -> EJsonValue -> DeadpanApp ()
putInBase k v = modifyAppState $ set (collections . _EJObjectKey k) (Just v)
setSession :: DeadpanApp GUID
setSession = setMsgHandler "connected" $
\e -> forOf_ (_EJObjectKey "session" . _Just) e (putInBase "session")