diff options
Diffstat (limited to '')
| -rw-r--r-- | lib/Server/Subscribe.hs | 66 |
1 files changed, 40 insertions, 26 deletions
diff --git a/lib/Server/Subscribe.hs b/lib/Server/Subscribe.hs index 831f4c9..86b67a6 100644 --- a/lib/Server/Subscribe.hs +++ b/lib/Server/Subscribe.hs @@ -1,27 +1,26 @@ +{-# LANGUAGE BlockArguments #-} module Server.Subscribe where -import Conduit (MonadIO (..)) -import Control.Concurrent.STM (atomically, newTQueue, readTQueue, - readTVar, writeTVar) -import Control.Exception (handle) -import Control.Monad.Extra (forever, whenJust) -import qualified Data.Aeson as A -import qualified Data.ByteString.Char8 as C8 -import Data.Coerce (coerce) -import Data.Functor ((<&>)) -import Data.Map (Map) -import qualified Data.Map as M +import Conduit (MonadIO (..)) +import Control.Concurrent.STM (atomically, newTQueue, + readTQueue, readTVar, + writeTVar) +import Control.Exception (handle) +import Control.Monad.Extra (forever, whenJust) +import qualified Data.Aeson as A +import qualified Data.ByteString.Char8 as C8 +import Data.Coerce (coerce) +import Data.Functor ((<&>)) +import Data.Map (Map) +import qualified Data.Map as M import Data.Pool -import Data.UUID (UUID) -import Database.Persist (Entity (entityKey), SelectOpt (Desc), - entityVal, selectFirst, selectList, - (<-.), (==.), (||.)) -import Database.Persist.Sql (SqlBackend) -import qualified Network.WebSockets as WS +import Data.UUID (UUID) +import Database.Esqueleto.Experimental hiding ((<&>)) +import Database.Persist.Sql (SqlBackend) +import qualified Network.WebSockets as WS import Persist -import Server.Base (ServerState) -import Server.Util (ServiceM) - +import Server.Base (ServerState) +import Server.Util (ServiceM) handleSubscribe :: Pool SqlBackend @@ -38,8 +37,11 @@ handleSubscribe dbpool subscribers (ticketId :: UUID) conn = liftIO $ WS.withPin pure queue -- send most recent ping, if any (so we won't have to wait for movement) - runSqlWithoutLog dbpool - (selectFirst [TrainPingTicket ==. coerce ticketId] [Desc TrainPingTimestamp]) + runSqlWithoutLog dbpool (selectOne do + ping <- from (table @Ping) + where_ (ping ^. PingTicket ==. val (Just (coerce ticketId))) + orderBy [desc (ping ^. PingTimestamp)] + pure ping) <&> fmap entityVal >>= flip whenJust (WS.sendTextData conn . A.encode) @@ -57,7 +59,19 @@ handleSubscribe dbpool subscribers (ticketId :: UUID) conn = liftIO $ WS.withPin -- getTicketTrackers :: (MonadLogger (t (ResourceT IO)), MonadIO (t (ResourceT IO))) -- => UUID -> ReaderT SqlBackend (t (ResourceT IO)) [Entity Tracker] -getTicketTrackers ticketId = do - joins <- selectList [TrackerTicketTicket ==. TicketKey ticketId] [] - <&> fmap (trackerTicketTracker . entityVal) - selectList ([TrackerId <-. joins] ||. [TrackerCurrentTicket ==. Just (TicketKey ticketId)]) [] +getTicketTrackers ticketId = select do + (tracker :& trackerticket) <- from $ + table @Tracker + `innerJoin` + table @TrackerTicket + `on` \(tr :& ti) -> tr ^. TrackerId ==. ti ^. TrackerTicketTracker + + where_ $ + tracker ^. TrackerCurrentTicket ==. val (Just (TicketKey ticketId)) + ||. trackerticket ^. TrackerTicketTicket ==. val (TicketKey ticketId) + + pure tracker + + -- joins <- selectList [TrackerTicketTicket ==. TicketKey ticketId] [] + -- <&> fmap (trackerTicketTracker . entityVal) + -- selectList ([TrackerId <-. joins] ||. [TrackerCurrentTicket ==. Just (TicketKey ticketId)]) [] |