naskya/vervis
1
0
Fork 0
mirror of https://code.naskya.net/repos/ndqEd synced 2025-01-11 00:16:46 +09:00
Code Activity

SQL: Define the undirected edge table once, use everywhere

Browse source
This commit is contained in:
fr33domlover 2016-07-30 11:29:23 +00:00
parent c111f66d7d
commit 9cfaabc035
5 changed files with 32 additions and 76 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

24
src/Database/Persist/Local/Sql.hs
View file

@ -30,6 +30,7 @@ module Database.Persist.Local.Sql
, tpath , tpath
, tcycle , tcycle
, tcontains , tcontains
, sqlUEdge
, FollowDirection (..) , FollowDirection (..)
) )
where where
@ -182,3 +183,26 @@ tcycle = DBName "cycle"
tcontains :: DBName tcontains :: DBName
tcontains = DBName "contains" tcontains = DBName "contains"
sqlUEdge
:: (DBName -> Text) -> Text -> EntityDef -> FieldDef -> FieldDef -> Text
sqlUEdge dbname filt tEdge bwd fwd =
let t ^* f = dbname t <> "." <> dbname f
in 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
, ")"
]

21
src/Database/Persist/Sql/Graph/Connects.hs
View file

@ -159,25 +159,8 @@ xmconnectsm' follow filter msource mdest mlen proxy = do
sql = mconcat sql = mconcat
[ "WITH RECURSIVE " [ "WITH RECURSIVE "
, case follow of , case follow of
FollowBoth -> mconcat FollowBoth -> sqlUEdge dbname filt tEdge bwd fwd <> ", "
[ dbname uedge _ -> T.empty
, " ("
, 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 , dbname temp
, " (" , " ("
, T.intercalate "," $ map dbname [tid, tpath, tcycle] , T.intercalate "," $ map dbname [tid, tpath, tcycle]

21
src/Database/Persist/Sql/Graph/Cyclic.hs
View file

@ -154,25 +154,8 @@ xcyclicn' follow filter minitials proxy = do
sql = mconcat sql = mconcat
[ "WITH RECURSIVE " [ "WITH RECURSIVE "
, case follow of , case follow of
FollowBoth -> mconcat FollowBoth -> sqlUEdge dbname filt tEdge bwd fwd <> ", "
[ dbname uedge _ -> T.empty
, " ("
, 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 , dbname temp
, " (" , " ("
, T.intercalate "," $ map dbname [tid, tpath, tcycle] , T.intercalate "," $ map dbname [tid, tpath, tcycle]

21
src/Database/Persist/Sql/Graph/Path.hs
View file

@ -142,25 +142,8 @@ xmpathm' follow filter msource mdest mlen mlim proxy = do
sql = mconcat sql = mconcat
[ "WITH RECURSIVE " [ "WITH RECURSIVE "
, case follow of , case follow of
FollowBoth -> mconcat FollowBoth -> sqlUEdge dbname filt tEdge bwd fwd <> ", "
[ dbname uedge _ -> T.empty
, " ("
, 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 , dbname temp
, " (" , " ("
, T.intercalate "," $ map dbname [tid, tpath, tcycle] , T.intercalate "," $ map dbname [tid, tpath, tcycle]

21
src/Database/Persist/Sql/Graph/Reachable.hs
View file

@ -115,25 +115,8 @@ xreachable' follow filter initials mlen proxy = do
sql = mconcat sql = mconcat
[ "WITH RECURSIVE " [ "WITH RECURSIVE "
, case follow of , case follow of
FollowBoth -> mconcat FollowBoth -> sqlUEdge dbname filt tEdge bwd fwd <> ", "
[ dbname uedge _ -> T.empty
, " ("
, 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 , dbname temp
, " (" , " ("
, T.intercalate "," $ map dbname [tid, tpath, tcycle] , T.intercalate "," $ map dbname [tid, tpath, tcycle]