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

SQL: IN (1, 2, 3) instead of invalid ANY('[1, 2, 3]')

Browse source 
I thought SQL arrays were common and PersistList corresponded to SQL
array values. But that isn't the case. PersistList seems to be
serialized as a JSON list, and `filterClause` uses IN, not ANY. So I'm
doing the same thing here and using IN.

Note that I'm building the list myself using Text concatenation, not
using `filterClause`, because the latter takes a filter on an existing
`PersistEntity` while my filters often apply to temporary tables.
This commit is contained in:
fr33domlover 2016-07-29 22:57:52 +00:00
parent 1c2e5f86af
commit dad1ed2e1f
5 changed files with 55 additions and 27 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

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

@ -23,6 +23,7 @@ module Database.Persist.Local.Sql
, destFieldFromProxy , destFieldFromProxy
, sourceFieldFromProxy , sourceFieldFromProxy
, (?:) , (?:)
, (?++)
, FollowDirection (..) , FollowDirection (..)
) )
where where
@ -153,3 +154,7 @@ rawSqlWithGraph dir root parent child sub vals = do
(?:) :: Maybe a -> [a] -> [a] (?:) :: Maybe a -> [a] -> [a]
(?:) = maybe id (:) (?:) = maybe id (:)
infixr 5 ?: infixr 5 ?:
(?++) :: Maybe [a] -> [a] -> [a]
(?++) = maybe id (++)
infixr 5 ?++

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

@ -50,7 +50,7 @@ import Database.Persist
import Database.Persist.Sql import Database.Persist.Sql
import Database.Persist.Sql.Util import Database.Persist.Sql.Util
import qualified Data.Text as T (null, intercalate) import qualified Data.Text as T (empty, singleton, null, intercalate)
import Database.Persist.Local.Class.PersistEntityGraph import Database.Persist.Local.Class.PersistEntityGraph
import Database.Persist.Local.Class.PersistQueryForest import Database.Persist.Local.Class.PersistQueryForest
@ -152,12 +152,15 @@ xmconnectsm' follow filter msource mdest mlen proxy = do
, entityDB tNode ^* fieldDB (entityId tNode), ", " , entityDB tNode ^* fieldDB (entityId tNode), ", "
, "ARRAY[", entityDB tNode ^* fieldDB (entityId tNode), "], " , "ARRAY[", entityDB tNode ^* fieldDB (entityId tNode), "], "
, "FALSE" , "FALSE"
, " FROM ", dbname $ entityDB tNode
, case msource of , case msource of
Nothing -> " FROM " <> dbname (entityDB tNode) Nothing -> T.empty
Just _ -> mconcat Just l -> mconcat
[ " FROM ", dbname $ entityDB tNode [ " WHERE ", entityDB tNode ^* fieldDB (entityId tNode)
, " WHERE ", entityDB tNode ^* fieldDB (entityId tNode) , " IN ("
, " = ANY(?)" , T.intercalate ", " $
replicate (length l) (T.singleton '?')
, ")"
] ]
, " UNION ALL " , " UNION ALL "
, case follow of , case follow of
@ -173,16 +176,21 @@ xmconnectsm' follow filter msource mdest mlen proxy = do
, " ) SELECT 1 WHERE EXISTS ( SELECT ", temp ^* tpath , " ) SELECT 1 WHERE EXISTS ( SELECT ", temp ^* tpath
, " FROM ", dbname temp , " FROM ", dbname temp
, case mdest of , case mdest of
Nothing -> "" Nothing -> T.empty
Just _ -> " WHERE " <> temp ^* tid <> " = ANY(?)" Just l -> mconcat
[ " WHERE ", temp ^* tid, " IN ("
, T.intercalate ", " $
replicate (length l) (T.singleton '?')
, ")"
]
, case mlen of , case mlen of
Nothing -> "" Nothing -> T.empty
Just _ -> " AND array_length(" <> temp ^* tpath <> ", 1) <= ?" Just _ -> " AND array_length(" <> temp ^* tpath <> ", 1) <= ?"
, " )" , " )"
] ]
toP = fmap toPersistValue toP = fmap toPersistValue
toPL = fmap $ PersistList . map toPersistValue toPL = fmap $ map toPersistValue
vals = toPL msource ?: fvals ++ toPL mdest ?: toP mlen ?: [] vals = toPL msource ?++ fvals ++ toPL mdest ?++ toP mlen ?: []
rawSql sql vals rawSql sql vals
connects connects

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

@ -42,7 +42,7 @@ import Database.Persist
import Database.Persist.Sql import Database.Persist.Sql
import Database.Persist.Sql.Util import Database.Persist.Sql.Util
import qualified Data.Text as T (null, intercalate) import qualified Data.Text as T (singleton, null, intercalate)
import Database.Persist.Local.Class.PersistEntityGraph import Database.Persist.Local.Class.PersistEntityGraph
import Database.Persist.Local.Class.PersistQueryForest import Database.Persist.Local.Class.PersistQueryForest
@ -129,10 +129,13 @@ xcyclicn' follow filter minitials proxy = do
FollowForward -> sqlStartFrom fwd FollowForward -> sqlStartFrom fwd
FollowBackward -> sqlStartFrom bwd FollowBackward -> sqlStartFrom bwd
FollowBoth -> " FROM " <> dbname (entityDB tNode) FollowBoth -> " FROM " <> dbname (entityDB tNode)
Just initials -> mconcat Just l -> mconcat
[ " FROM ", dbname $ entityDB tNode [ " FROM ", dbname $ entityDB tNode
, " WHERE ", entityDB tNode ^* fieldDB (entityId tNode) , " WHERE ", entityDB tNode ^* fieldDB (entityId tNode)
, " = ANY(?)" , " IN ("
, T.intercalate ", " $
replicate (length l) (T.singleton '?')
, ")"
] ]
] ]
@ -199,8 +202,8 @@ xcyclicn' follow filter minitials proxy = do
, ") LIMIT 1" , ") LIMIT 1"
] ]
] ]
msval = PersistList . map toPersistValue <$> minitials toPL = fmap $ map toPersistValue
vals = maybe id (:) msval fvals vals = toPL minitials ?++ fvals
rawSql sql vals rawSql sql vals
-- $cyclic -- $cyclic

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

@ -50,7 +50,7 @@ import Database.Persist
import Database.Persist.Sql import Database.Persist.Sql
import Database.Persist.Sql.Util import Database.Persist.Sql.Util
import qualified Data.Text as T (null, intercalate) import qualified Data.Text as T (empty, singleton, null, intercalate)
import Database.Persist.Local.Class.PersistEntityGraph import Database.Persist.Local.Class.PersistEntityGraph
import Database.Persist.Local.Class.PersistQueryForest import Database.Persist.Local.Class.PersistQueryForest
@ -154,10 +154,13 @@ xmpathm' follow filter msource mdest mlen mlim proxy = do
, "FALSE" , "FALSE"
, case msource of , case msource of
Nothing -> " FROM " <> dbname (entityDB tNode) Nothing -> " FROM " <> dbname (entityDB tNode)
Just _ -> mconcat Just l -> mconcat
[ " FROM ", dbname $ entityDB tNode [ " FROM ", dbname $ entityDB tNode
, " WHERE ", entityDB tNode ^* fieldDB (entityId tNode) , " WHERE ", entityDB tNode ^* fieldDB (entityId tNode)
, " = ANY(?)" , " IN ("
, T.intercalate ", " $
replicate (length l) (T.singleton '?')
, ")"
] ]
, " UNION ALL " , " UNION ALL "
, case follow of , case follow of
@ -173,8 +176,14 @@ xmpathm' follow filter msource mdest mlen mlim proxy = do
, " ) SELECT ", temp ^* tpath , " ) SELECT ", temp ^* tpath
, " FROM ", dbname temp , " FROM ", dbname temp
, case mdest of , case mdest of
Nothing -> "" Nothing -> T.empty
Just _ -> " WHERE " <> temp ^* tid <> " = ANY(?)" Just l -> mconcat
[ " WHERE ", temp ^* tid
, " IN ("
, T.intercalate ", " $
replicate (length l) (T.singleton '?')
, ")"
]
, case mlen of , case mlen of
Nothing -> "" Nothing -> ""
Just _ -> " AND array_length(" <> temp ^* tpath <> ", 1) <= ?" Just _ -> " AND array_length(" <> temp ^* tpath <> ", 1) <= ?"
@ -184,9 +193,9 @@ xmpathm' follow filter msource mdest mlen mlim proxy = do
Just _ -> " LIMIT ?" Just _ -> " LIMIT ?"
] ]
toP = fmap toPersistValue toP = fmap toPersistValue
toPL = fmap $ PersistList . map toPersistValue toPL = fmap $ map toPersistValue
vals = vals =
toPL msource ?: fvals ++ toPL mdest ?: toP mlen ?: toP mlim ?: [] toPL msource ?++ fvals ++ toPL mdest ?++ toP mlen ?: toP mlim ?: []
rawSql sql vals rawSql sql vals
path path

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

@ -38,7 +38,7 @@ import Database.Persist
import Database.Persist.Sql import Database.Persist.Sql
import Database.Persist.Sql.Util import Database.Persist.Sql.Util
import qualified Data.Text as T (null, intercalate) import qualified Data.Text as T (singleton, null, intercalate)
import Database.Persist.Local.Class.PersistEntityGraph import Database.Persist.Local.Class.PersistEntityGraph
import Database.Persist.Local.Class.PersistQueryForest import Database.Persist.Local.Class.PersistQueryForest
@ -127,7 +127,10 @@ xreachable' follow filter initials mlen proxy = do
, "FALSE" , "FALSE"
, " FROM ", dbname $ entityDB tNode , " FROM ", dbname $ entityDB tNode
, " WHERE ", entityDB tNode ^* fieldDB (entityId tNode) , " WHERE ", entityDB tNode ^* fieldDB (entityId tNode)
, " = ANY(?)" , " IN ("
, T.intercalate ", " $
replicate (length initials) (T.singleton '?')
, ")"
, " UNION ALL " , " UNION ALL "
, case follow of , case follow of
FollowForward -> sqlStep fwd bwd FollowForward -> sqlStep fwd bwd
@ -147,8 +150,8 @@ xreachable' follow filter initials mlen proxy = do
Just _ -> " AND array_length(" <> temp ^* tpath <> ", 1) <= ?" Just _ -> " AND array_length(" <> temp ^* tpath <> ", 1) <= ?"
] ]
toP = fmap toPersistValue toP = fmap toPersistValue
toPL = PersistList . map toPersistValue toPL = map toPersistValue
vals = toPL initials : fvals ++ toP mlen ?: [] vals = toPL initials ++ fvals ++ toP mlen ?: []
rawSql sql vals rawSql sql vals
reachable reachable