DB actions for selecting nodes and edges of single graph

src/Database/Persist/Local/Class/PersistEntityGraph.hs

@@ -22,6 +22,7 @@ where
 
 import Prelude
 
+import Data.Proxy (Proxy)
 import Database.Persist
 
 class (PersistEntity n, PersistEntity e) => PersistEntityGraph n e where
@@ -30,10 +31,13 @@ class (PersistEntity n, PersistEntity e) => PersistEntityGraph n e where
     destParam     :: e -> Key n
     destField     :: EntityField e (Key n)
 
-class PersistEntityGraph n e => PersistEntityGraphSelect n e where
-    type PersistEntityGraphSelector n e
-    selectorParam :: n -> PersistEntityGraphSelector n e
-    selectorField :: EntityField n (PersistEntityGraphSelector n e)
+class (PersistEntityGraph n e, PersistField (PersistEntityGraphSelector n e))
+    => PersistEntityGraphSelect n e where
+        type PersistEntityGraphSelector n e
+        selectorParam
+            :: Proxy (n, e) -> n -> PersistEntityGraphSelector n e
+        selectorField
+            :: Proxy (n, e) -> EntityField n (PersistEntityGraphSelector n e)
 
 class PersistEntityGraphSelect n e => PersistEntityGraphNumbered n e where
     numberParam :: n -> Int

src/Database/Persist/Local/Sql.hs

@@ -32,6 +32,8 @@ module Database.Persist.Local.Sql
     , tcontains
     , sqlUEdge
     , FollowDirection (..)
+    , selectGraphNodesList
+    , selectGraphEdgesList
     )
 where
 
@@ -218,3 +220,60 @@ sqlUEdge dbname filt tEdge bwd fwd =
     in  if T.null filt
             then sqlEdge $ entityDB tEdge
             else sqlBase <> sqlEdge ubase
+
+selectGraphNodesList
+    :: ( MonadIO m
+       , PersistEntityGraphSelect node edge
+       , backend ~ PersistEntityBackend node
+       , backend ~ PersistEntityBackend edge
+       , PersistQuery backend
+       )
+    => PersistEntityGraphSelector node edge
+    -> [Filter node]
+    -> [SelectOpt node]
+    -> Proxy (node, edge)
+    -> ReaderT backend m [Entity node]
+selectGraphNodesList sel filt opts proxy =
+    selectList ((selectorField proxy ==. sel) : filt) opts
+
+selectGraphEdgesList
+    :: ( MonadIO m
+       , PersistEntityGraphSelect node edge
+       , SqlBackend ~ PersistEntityBackend node
+       , SqlBackend ~ PersistEntityBackend edge
+       )
+    => PersistEntityGraphSelector node edge
+    -> [Filter edge]
+    -> [SelectOpt edge]
+    -> Proxy (node, edge)
+    -> ReaderT SqlBackend m [Entity edge]
+selectGraphEdgesList sel filt opts proxy = do
+    conn <- ask
+    let tNode = entityDef $ dummyFromFst proxy
+        tEdge = entityDef $ dummyFromSnd proxy
+        dbname = connEscapeName conn
+        t ^* f = dbname t <> "." <> dbname f
+        t <#> f = dbname t <> " INNER JOIN " <> dbname f
+        (limit, offset, orders) = limitOffsetOrder opts
+        applyLimitOffset =
+            connLimitOffset conn (limit, offset) (not $ null orders)
+        sql = applyLimitOffset $ mconcat
+            [ "SELECT ?? FROM ", entityDB tNode <#> entityDB tEdge, " ON "
+            , entityDB tNode ^* (fieldDB $ entityId tNode)
+            , " = "
+            , entityDB tEdge ^*
+                (fieldDB $ persistFieldDef $ sourceFieldFromProxy proxy)
+            , let   flt = filterClause True conn filt
+              in    if T.null flt
+                        then " WHERE"
+                        else flt
+            , " AND "
+            , entityDB tNode ^*
+                (fieldDB $ persistFieldDef $ selectorField proxy)
+            , " = ? "
+            , case map (orderClause True conn) orders of
+                []   -> ""
+                ords -> " ORDER BY " <> T.intercalate ", " ords
+            ]
+        vals = getFiltsValues conn filt ++ [toPersistValue sel]
+    rawSql sql vals

src/Vervis/Model.hs

@@ -63,8 +63,8 @@ instance PersistEntityGraph Ticket TicketDependency where
 
 instance PersistEntityGraphSelect Ticket TicketDependency where
     type PersistEntityGraphSelector Ticket TicketDependency = ProjectId
-    selectorParam = ticketProject
-    selectorField = TicketProject
+    selectorParam _ = ticketProject
+    selectorField _ = TicketProject
 
 instance PersistEntityGraphNumbered Ticket TicketDependency where
     numberParam = ticketNumber