diff --git a/src/Database/Persist/Sql/Graph/Connects.hs b/src/Database/Persist/Sql/Graph/Connects.hs index 8c8bb95..5fce10f 100644 --- a/src/Database/Persist/Sql/Graph/Connects.hs +++ b/src/Database/Persist/Sql/Graph/Connects.hs @@ -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 diff --git a/src/Database/Persist/Sql/Graph/Cyclic.hs b/src/Database/Persist/Sql/Graph/Cyclic.hs index 378ca39..52f4c66 100644 --- a/src/Database/Persist/Sql/Graph/Cyclic.hs +++ b/src/Database/Persist/Sql/Graph/Cyclic.hs @@ -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" diff --git a/src/Database/Persist/Sql/Graph/Path.hs b/src/Database/Persist/Sql/Graph/Path.hs index ec226d0..18d75eb 100644 --- a/src/Database/Persist/Sql/Graph/Path.hs +++ b/src/Database/Persist/Sql/Graph/Path.hs @@ -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 diff --git a/src/Database/Persist/Sql/Graph/Reachable.hs b/src/Database/Persist/Sql/Graph/Reachable.hs index 1f728ed..bc45b9e 100644 --- a/src/Database/Persist/Sql/Graph/Reachable.hs +++ b/src/Database/Persist/Sql/Graph/Reachable.hs @@ -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