diff options
Diffstat (limited to 'lib/Server/Subscribe.hs')
| -rw-r--r-- | lib/Server/Subscribe.hs | 33 |
1 files changed, 23 insertions, 10 deletions
diff --git a/lib/Server/Subscribe.hs b/lib/Server/Subscribe.hs index 831f4c9..8559659 100644 --- a/lib/Server/Subscribe.hs +++ b/lib/Server/Subscribe.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE BlockArguments#-} module Server.Subscribe where import Conduit (MonadIO (..)) @@ -13,15 +14,12 @@ 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 Persist import Server.Base (ServerState) import Server.Util (ServiceM) - +import Database.Esqueleto.Experimental hiding ((<&>)) handleSubscribe :: Pool SqlBackend @@ -38,8 +36,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 @TrainPing) + where_ (ping ^. TrainPingTicket ==. val (coerce ticketId)) + orderBy [desc (ping ^. TrainPingTimestamp)] + pure ping) <&> fmap entityVal >>= flip whenJust (WS.sendTextData conn . A.encode) @@ -57,7 +58,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)]) [] |