SQL: Use single recursive CTE reference in undirected traversal
At least in PostgreSQL, at most one reference is allowed. My undirected recursion code used a UNION of two recursive steps, one for each direction. That is invalid, so instead I define a CTE that's a union of the edges and their reverse, and do a single recursion step on that CTE instead of on the edge table itself.
This commit is contained in:
fr33domlover
parent
de384d0427
commit
0904abd7e6
4 changed files with 152 additions and 76 deletions
|
|
@ -120,6 +120,7 @@ xmconnectsm' follow filter msource mdest mlen proxy = do
|
|||
tEdge = entityDef $ dummyFromSnd proxy
|
||||
fwd = persistFieldDef $ destFieldFromProxy proxy
|
||||
bwd = persistFieldDef $ sourceFieldFromProxy proxy
|
||||
uedge = DBName "temp_undirected_edge_cte"
|
||||
temp = DBName "temp_hierarchy_cte"
|
||||
tid = DBName "id"
|
||||
tpath = DBName "path"
|
||||
|
|
@ -129,22 +130,59 @@ xmconnectsm' follow filter msource mdest mlen proxy = do
|
|||
t <#> s = dbname t <> " INNER JOIN " <> dbname s
|
||||
t <# s = dbname t <> " LEFT OUTER JOIN " <> dbname s
|
||||
|
||||
-- HACK NOTE
|
||||
-- The filter refers to the edge table, but in undirectional cases we
|
||||
-- use a temporary uedge table instead. Some possible ways to fix that
|
||||
-- are:
|
||||
--
|
||||
-- * Use 'filterClause' and then apply some text replacement function
|
||||
-- from "Data.Text" to fix the table name
|
||||
-- * Write a modified 'filterClause' that lets me pick a table name
|
||||
-- * Since we already create a temporary uedge table anyway, apply the
|
||||
-- filter there instead of here in the recursive step
|
||||
--
|
||||
-- In the code below I'm taking the 3rd approach.
|
||||
--
|
||||
-- At the time of writing, the SQL is a bit ugly: The uedge table is
|
||||
-- created by an UNION of @SELECT u, v@ and SELECT v, u@, each of these
|
||||
-- applied the filter separately. Feel free to offer and write cleaner
|
||||
-- nicer SQL for this.
|
||||
filt = filterClause False conn filter
|
||||
fvals = getFiltsValues conn filter
|
||||
sqlStep forward backward = mconcat
|
||||
sqlStep forward backward edge' filt' = mconcat
|
||||
[ "SELECT "
|
||||
, entityDB tEdge ^* fieldDB forward, ", "
|
||||
, temp ^* tpath, " || ", entityDB tEdge ^* fieldDB forward, ", "
|
||||
, entityDB tEdge ^* fieldDB forward, " = ANY(", temp ^* tpath, ")"
|
||||
, " FROM ", entityDB tEdge <#> temp
|
||||
, " ON ", entityDB tEdge ^* fieldDB backward, " = ", temp ^* tid
|
||||
, if T.null filt
|
||||
, edge' ^* fieldDB forward, ", "
|
||||
, temp ^* tpath, " || ", edge' ^* fieldDB forward, ", "
|
||||
, edge' ^* fieldDB forward, " = ANY(", temp ^* tpath, ")"
|
||||
, " FROM ", edge' <#> temp
|
||||
, " ON ", edge' ^* fieldDB backward, " = ", temp ^* tid
|
||||
, if T.null filt'
|
||||
then " WHERE NOT " <> temp ^* tcycle
|
||||
else filt <> " AND NOT " <> temp ^* tcycle
|
||||
else filt' <> " AND NOT " <> temp ^* tcycle
|
||||
]
|
||||
|
||||
sql = mconcat
|
||||
[ "WITH RECURSIVE "
|
||||
, case follow of
|
||||
FollowBoth -> mconcat
|
||||
[ dbname uedge
|
||||
, " ("
|
||||
, dbname $ fieldDB bwd, ", ", dbname $ fieldDB fwd
|
||||
, ") AS (SELECT "
|
||||
, entityDB tEdge ^* fieldDB bwd
|
||||
, ", "
|
||||
, entityDB tEdge ^* fieldDB fwd
|
||||
, " FROM ", dbname $ entityDB tEdge
|
||||
, filt
|
||||
, " UNION ALL SELECT "
|
||||
, entityDB tEdge ^* fieldDB fwd
|
||||
, ", "
|
||||
, entityDB tEdge ^* fieldDB bwd
|
||||
, " FROM ", dbname $ entityDB tEdge
|
||||
, filt
|
||||
, "), "
|
||||
]
|
||||
_ -> ""
|
||||
, dbname temp
|
||||
, " ("
|
||||
, T.intercalate "," $ map dbname [tid, tpath, tcycle]
|
||||
|
|
@ -164,15 +202,9 @@ xmconnectsm' follow filter msource mdest mlen proxy = do
|
|||
]
|
||||
, " UNION ALL "
|
||||
, case follow of
|
||||
FollowForward -> sqlStep fwd bwd
|
||||
FollowBackward -> sqlStep bwd fwd
|
||||
FollowBoth -> mconcat
|
||||
[ "("
|
||||
, sqlStep fwd bwd
|
||||
, " UNION ALL "
|
||||
, sqlStep bwd fwd
|
||||
, ")"
|
||||
]
|
||||
FollowForward -> sqlStep fwd bwd (entityDB tEdge) filt
|
||||
FollowBackward -> sqlStep bwd fwd (entityDB tEdge) filt
|
||||
FollowBoth -> sqlStep fwd bwd uedge T.empty
|
||||
, " ) SELECT 1 WHERE EXISTS ( SELECT ", temp ^* tpath
|
||||
, " FROM ", dbname temp
|
||||
, case mdest of
|
||||
|
|
|
|||
|
|
@ -42,7 +42,7 @@ import Database.Persist
|
|||
import Database.Persist.Sql
|
||||
import Database.Persist.Sql.Util
|
||||
|
||||
import qualified Data.Text as T (singleton, null, intercalate)
|
||||
import qualified Data.Text as T (empty, singleton, null, intercalate)
|
||||
|
||||
import Database.Persist.Local.Class.PersistEntityGraph
|
||||
import Database.Persist.Local.Class.PersistQueryForest
|
||||
|
|
@ -94,7 +94,7 @@ xcyclicn' follow filter minitials proxy = do
|
|||
tEdge = entityDef $ dummyFromSnd proxy
|
||||
fwd = persistFieldDef $ destFieldFromProxy proxy
|
||||
bwd = persistFieldDef $ sourceFieldFromProxy proxy
|
||||
start = DBName "temp_start_cte"
|
||||
uedge = DBName "temp_undirected_edge_cte"
|
||||
temp = DBName "temp_hierarchy_cte"
|
||||
tid = DBName "id"
|
||||
tpath = DBName "path"
|
||||
|
|
@ -138,16 +138,16 @@ xcyclicn' follow filter minitials proxy = do
|
|||
|
||||
filt = filterClause False conn filter
|
||||
fvals = getFiltsValues conn filter
|
||||
sqlStep forward backward = mconcat
|
||||
sqlStep forward backward edge' filt' = mconcat
|
||||
[ "SELECT "
|
||||
, entityDB tEdge ^* fieldDB forward, ", "
|
||||
, temp ^* tpath, " || ", entityDB tEdge ^* fieldDB forward, ", "
|
||||
, entityDB tEdge ^* fieldDB forward, " = ANY(", temp ^* tpath, ")"
|
||||
, " FROM ", entityDB tEdge <#> temp
|
||||
, " ON ", entityDB tEdge ^* fieldDB backward, " = ", temp ^* tid
|
||||
, if T.null filt
|
||||
, edge' ^* fieldDB forward, ", "
|
||||
, temp ^* tpath, " || ", edge' ^* fieldDB forward, ", "
|
||||
, edge' ^* fieldDB forward, " = ANY(", temp ^* tpath, ")"
|
||||
, " FROM ", edge' <#> temp
|
||||
, " ON ", edge' ^* fieldDB backward, " = ", temp ^* tid
|
||||
, if T.null filt'
|
||||
then " WHERE NOT " <> temp ^* tcycle
|
||||
else filt <> " AND NOT " <> temp ^* tcycle
|
||||
else filt' <> " AND NOT " <> temp ^* tcycle
|
||||
]
|
||||
|
||||
sqlCycles = mconcat
|
||||
|
|
@ -158,6 +158,26 @@ xcyclicn' follow filter minitials proxy = do
|
|||
|
||||
sql = mconcat
|
||||
[ "WITH RECURSIVE "
|
||||
, case follow of
|
||||
FollowBoth -> mconcat
|
||||
[ dbname uedge
|
||||
, " ("
|
||||
, dbname $ fieldDB bwd, ", ", dbname $ fieldDB fwd
|
||||
, ") AS (SELECT "
|
||||
, entityDB tEdge ^* fieldDB bwd
|
||||
, ", "
|
||||
, entityDB tEdge ^* fieldDB fwd
|
||||
, " FROM ", dbname $ entityDB tEdge
|
||||
, filt
|
||||
, " UNION ALL SELECT "
|
||||
, entityDB tEdge ^* fieldDB fwd
|
||||
, ", "
|
||||
, entityDB tEdge ^* fieldDB bwd
|
||||
, " FROM ", dbname $ entityDB tEdge
|
||||
, filt
|
||||
, "), "
|
||||
]
|
||||
_ -> ""
|
||||
, dbname temp
|
||||
, " ("
|
||||
, T.intercalate "," $ map dbname [tid, tpath, tcycle]
|
||||
|
|
@ -166,15 +186,9 @@ xcyclicn' follow filter minitials proxy = do
|
|||
|
||||
, " UNION ALL "
|
||||
, case follow of
|
||||
FollowForward -> sqlStep fwd bwd
|
||||
FollowBackward -> sqlStep bwd fwd
|
||||
FollowBoth -> mconcat
|
||||
[ "("
|
||||
, sqlStep fwd bwd
|
||||
, " UNION ALL "
|
||||
, sqlStep bwd fwd
|
||||
, ")"
|
||||
]
|
||||
FollowForward -> sqlStep fwd bwd (entityDB tEdge) filt
|
||||
FollowBackward -> sqlStep bwd fwd (entityDB tEdge) filt
|
||||
FollowBoth -> sqlStep fwd bwd uedge T.empty
|
||||
, " ) "
|
||||
, case follow of
|
||||
FollowBoth -> sqlCycles <> " LIMIT 1"
|
||||
|
|
|
|||
|
|
@ -120,6 +120,7 @@ xmpathm' follow filter msource mdest mlen mlim proxy = do
|
|||
tEdge = entityDef $ dummyFromSnd proxy
|
||||
fwd = persistFieldDef $ destFieldFromProxy proxy
|
||||
bwd = persistFieldDef $ sourceFieldFromProxy proxy
|
||||
uedge = DBName "temp_undirected_edge_cte"
|
||||
temp = DBName "temp_hierarchy_cte"
|
||||
tid = DBName "id"
|
||||
tpath = DBName "path"
|
||||
|
|
@ -131,20 +132,40 @@ xmpathm' follow filter msource mdest mlen mlim proxy = do
|
|||
|
||||
filt = filterClause False conn filter
|
||||
fvals = getFiltsValues conn filter
|
||||
sqlStep forward backward = mconcat
|
||||
sqlStep forward backward edge' filt' = mconcat
|
||||
[ "SELECT "
|
||||
, entityDB tEdge ^* fieldDB forward, ", "
|
||||
, temp ^* tpath, " || ", entityDB tEdge ^* fieldDB forward, ", "
|
||||
, entityDB tEdge ^* fieldDB forward, " = ANY(", temp ^* tpath, ")"
|
||||
, " FROM ", entityDB tEdge <#> temp
|
||||
, " ON ", entityDB tEdge ^* fieldDB backward, " = ", temp ^* tid
|
||||
, if T.null filt
|
||||
, edge' ^* fieldDB forward, ", "
|
||||
, temp ^* tpath, " || ", edge' ^* fieldDB forward, ", "
|
||||
, edge' ^* fieldDB forward, " = ANY(", temp ^* tpath, ")"
|
||||
, " FROM ", edge' <#> temp
|
||||
, " ON ", edge' ^* fieldDB backward, " = ", temp ^* tid
|
||||
, if T.null filt'
|
||||
then " WHERE NOT " <> temp ^* tcycle
|
||||
else filt <> " AND NOT " <> temp ^* tcycle
|
||||
else filt' <> " AND NOT " <> temp ^* tcycle
|
||||
]
|
||||
|
||||
sql = mconcat
|
||||
[ "WITH RECURSIVE "
|
||||
, case follow of
|
||||
FollowBoth -> mconcat
|
||||
[ dbname uedge
|
||||
, " ("
|
||||
, dbname $ fieldDB bwd, ", ", dbname $ fieldDB fwd
|
||||
, ") AS (SELECT "
|
||||
, entityDB tEdge ^* fieldDB bwd
|
||||
, ", "
|
||||
, entityDB tEdge ^* fieldDB fwd
|
||||
, " FROM ", dbname $ entityDB tEdge
|
||||
, filt
|
||||
, " UNION ALL SELECT "
|
||||
, entityDB tEdge ^* fieldDB fwd
|
||||
, ", "
|
||||
, entityDB tEdge ^* fieldDB bwd
|
||||
, " FROM ", dbname $ entityDB tEdge
|
||||
, filt
|
||||
, "), "
|
||||
]
|
||||
_ -> ""
|
||||
, dbname temp
|
||||
, " ("
|
||||
, T.intercalate "," $ map dbname [tid, tpath, tcycle]
|
||||
|
|
@ -152,11 +173,11 @@ xmpathm' follow filter msource mdest mlen mlim proxy = do
|
|||
, entityDB tNode ^* fieldDB (entityId tNode), ", "
|
||||
, "ARRAY[", entityDB tNode ^* fieldDB (entityId tNode), "], "
|
||||
, "FALSE"
|
||||
, " FROM ", dbname $ entityDB tNode
|
||||
, case msource of
|
||||
Nothing -> " FROM " <> dbname (entityDB tNode)
|
||||
Nothing -> T.empty
|
||||
Just l -> mconcat
|
||||
[ " FROM ", dbname $ entityDB tNode
|
||||
, " WHERE ", entityDB tNode ^* fieldDB (entityId tNode)
|
||||
[ " WHERE ", entityDB tNode ^* fieldDB (entityId tNode)
|
||||
, " IN ("
|
||||
, T.intercalate ", " $
|
||||
replicate (length l) (T.singleton '?')
|
||||
|
|
@ -164,15 +185,9 @@ xmpathm' follow filter msource mdest mlen mlim proxy = do
|
|||
]
|
||||
, " UNION ALL "
|
||||
, case follow of
|
||||
FollowForward -> sqlStep fwd bwd
|
||||
FollowBackward -> sqlStep bwd fwd
|
||||
FollowBoth -> mconcat
|
||||
[ "("
|
||||
, sqlStep fwd bwd
|
||||
, " UNION ALL "
|
||||
, sqlStep bwd fwd
|
||||
, ")"
|
||||
]
|
||||
FollowForward -> sqlStep fwd bwd (entityDB tEdge) filt
|
||||
FollowBackward -> sqlStep bwd fwd (entityDB tEdge) filt
|
||||
FollowBoth -> sqlStep fwd bwd uedge T.empty
|
||||
, " ) SELECT ", temp ^* tpath
|
||||
, " FROM ", dbname temp
|
||||
, case mdest of
|
||||
|
|
@ -185,11 +200,11 @@ xmpathm' follow filter msource mdest mlen mlim proxy = do
|
|||
, ")"
|
||||
]
|
||||
, case mlen of
|
||||
Nothing -> ""
|
||||
Nothing -> T.empty
|
||||
Just _ -> " AND array_length(" <> temp ^* tpath <> ", 1) <= ?"
|
||||
, " ORDER BY array_length(", temp ^* tpath, ", 1)"
|
||||
, case mlim of
|
||||
Nothing -> ""
|
||||
Nothing -> T.empty
|
||||
Just _ -> " LIMIT ?"
|
||||
]
|
||||
toP = fmap toPersistValue
|
||||
|
|
|
|||
|
|
@ -38,7 +38,7 @@ import Database.Persist
|
|||
import Database.Persist.Sql
|
||||
import Database.Persist.Sql.Util
|
||||
|
||||
import qualified Data.Text as T (singleton, null, intercalate)
|
||||
import qualified Data.Text as T (empty, singleton, null, intercalate)
|
||||
|
||||
import Database.Persist.Local.Class.PersistEntityGraph
|
||||
import Database.Persist.Local.Class.PersistQueryForest
|
||||
|
|
@ -93,6 +93,7 @@ xreachable' follow filter initials mlen proxy = do
|
|||
tEdge = entityDef $ dummyFromSnd proxy
|
||||
fwd = persistFieldDef $ destFieldFromProxy proxy
|
||||
bwd = persistFieldDef $ sourceFieldFromProxy proxy
|
||||
uedge = DBName "temp_undirected_edge_cte"
|
||||
temp = DBName "temp_hierarchy_cte"
|
||||
tid = DBName "id"
|
||||
tpath = DBName "path"
|
||||
|
|
@ -104,20 +105,40 @@ xreachable' follow filter initials mlen proxy = do
|
|||
|
||||
filt = filterClause False conn filter
|
||||
fvals = getFiltsValues conn filter
|
||||
sqlStep forward backward = mconcat
|
||||
sqlStep forward backward edge' filt' = mconcat
|
||||
[ "SELECT "
|
||||
, entityDB tEdge ^* fieldDB forward, ", "
|
||||
, temp ^* tpath, " || ", entityDB tEdge ^* fieldDB forward, ", "
|
||||
, entityDB tEdge ^* fieldDB forward, " = ANY(", temp ^* tpath, ")"
|
||||
, " FROM ", entityDB tEdge <#> temp
|
||||
, " ON ", entityDB tEdge ^* fieldDB backward, " = ", temp ^* tid
|
||||
, if T.null filt
|
||||
, edge' ^* fieldDB forward, ", "
|
||||
, temp ^* tpath, " || ", edge' ^* fieldDB forward, ", "
|
||||
, edge' ^* fieldDB forward, " = ANY(", temp ^* tpath, ")"
|
||||
, " FROM ", edge' <#> temp
|
||||
, " ON ", edge' ^* fieldDB backward, " = ", temp ^* tid
|
||||
, if T.null filt'
|
||||
then " WHERE NOT " <> temp ^* tcycle
|
||||
else filt <> " AND NOT " <> temp ^* tcycle
|
||||
else filt' <> " AND NOT " <> temp ^* tcycle
|
||||
]
|
||||
|
||||
sql = mconcat
|
||||
[ "WITH RECURSIVE "
|
||||
, case follow of
|
||||
FollowBoth -> mconcat
|
||||
[ dbname uedge
|
||||
, " ("
|
||||
, dbname $ fieldDB bwd, ", ", dbname $ fieldDB fwd
|
||||
, ") AS (SELECT "
|
||||
, entityDB tEdge ^* fieldDB bwd
|
||||
, ", "
|
||||
, entityDB tEdge ^* fieldDB fwd
|
||||
, " FROM ", dbname $ entityDB tEdge
|
||||
, filt
|
||||
, " UNION ALL SELECT "
|
||||
, entityDB tEdge ^* fieldDB fwd
|
||||
, ", "
|
||||
, entityDB tEdge ^* fieldDB bwd
|
||||
, " FROM ", dbname $ entityDB tEdge
|
||||
, filt
|
||||
, "), "
|
||||
]
|
||||
_ -> ""
|
||||
, dbname temp
|
||||
, " ("
|
||||
, T.intercalate "," $ map dbname [tid, tpath, tcycle]
|
||||
|
|
@ -133,15 +154,9 @@ xreachable' follow filter initials mlen proxy = do
|
|||
, ")"
|
||||
, " UNION ALL "
|
||||
, case follow of
|
||||
FollowForward -> sqlStep fwd bwd
|
||||
FollowBackward -> sqlStep bwd fwd
|
||||
FollowBoth -> mconcat
|
||||
[ "("
|
||||
, sqlStep fwd bwd
|
||||
, " UNION ALL "
|
||||
, sqlStep bwd fwd
|
||||
, ")"
|
||||
]
|
||||
FollowForward -> sqlStep fwd bwd (entityDB tEdge) filt
|
||||
FollowBackward -> sqlStep bwd fwd (entityDB tEdge) filt
|
||||
FollowBoth -> sqlStep fwd bwd uedge T.empty
|
||||
, " ) SELECT DISTINCT ", temp ^* tid
|
||||
, " FROM ", dbname temp
|
||||
, " WHERE NOT ", temp ^* tcycle
|
||||
|
|
|
|||
Loading…
Reference in a new issue