sup39/vervis
1
0
Fork 0
mirror of https://code.sup39.dev/repos/Wqawg synced 2024-12-29 01:34:52 +09:00
Code Issues Activity

PersistQueryRecursive becomes PersistQueryForest

Browse source
This commit is contained in:
fr33domlover 2016-06-13 13:46:03 +00:00
parent 76a627385c
commit 48d7c9e929
4 changed files with 341 additions and 279 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

184
src/Database/Persist/Local/Class/PersistQueryForest.hs Normal file
View file

@ -0,0 +1,184 @@
{- This file is part of Vervis.
-
- Written in 2016 by fr33domlover <fr33domlover@riseup.net>.
-
- ♡ Copying is an act of love. Please copy, reuse and share.
-
- The author(s) have dedicated all copyright and related and neighboring
- rights to this software to the public domain worldwide. This software is
- distributed without any warranty.
-
- You should have received a copy of the CC0 Public Domain Dedication along
- with this software. If not, see
- <http://creativecommons.org/publicdomain/zero/1.0/>.
-}
module Database.Persist.Local.Class.PersistQueryForest
( RecursionDirection (..)
, PersistQueryForest (..)
, selectForestSource
, selectForestKeys
, selectForestList
, selectForestKeysList
)
where
import Prelude
import Control.Monad.IO.Class
import Control.Monad.Reader (MonadReader)
import Control.Monad.Trans.Reader (ReaderT)
import Control.Monad.Trans.Resource (MonadResource, release)
import Data.Acquire (Acquire, allocateAcquire, with)
import Database.Persist.Class
import Database.Persist.Types
import qualified Data.Conduit as C
import qualified Data.Conduit.List as CL
data RecursionDirection
= Ancestors
| Decendants
deriving (Eq, Show)
-- | Backends supporting conditional operations recursively over trees.
class PersistQuery backend => PersistQueryForest backend where
-- | Update individual fields on any record in the transitive closure and
-- matching the given criterion.
updateForestWhere
:: (MonadIO m, PersistEntity val, backend ~ PersistEntityBackend val)
=> RecursionDirection
-> EntityField val (Maybe (Key val))
-> Key val
-> [Filter val]
-> [Update val]
-> ReaderT backend m ()
-- | Delete all records in the transitive closure which match the given
-- criterion.
deleteForestWhere
:: (MonadIO m, PersistEntity val, backend ~ PersistEntityBackend val)
=> RecursionDirection
-> EntityField val (Maybe (Key val))
-> Key val
-> [Filter val]
-> ReaderT backend m ()
-- | Get all records in the transitive closure, which match the given
-- criterion, in the specified order. Returns also the identifiers.
selectForestSourceRes
:: ( PersistEntity val
, PersistEntityBackend val ~ backend
, MonadIO m1
, MonadIO m2
)
=> RecursionDirection
-> EntityField val (Maybe (Key val))
-> Key val
-> [Filter val]
-> [SelectOpt val]
-> ReaderT backend m1 (Acquire (C.Source m2 (Entity val)))
-- | Get the 'Key's of all records in the transitive closure, which match
-- the given criterion.
selectForestKeysRes
:: ( PersistEntity val
, PersistEntityBackend val ~ backend
, MonadIO m1
, MonadIO m2
)
=> RecursionDirection
-> EntityField val (Maybe (Key val))
-> Key val
-> [Filter val]
-> [SelectOpt val]
-> ReaderT backend m1 (Acquire (C.Source m2 (Key val)))
-- | The total number of records in the transitive closure which fulfill
-- the given criterion.
countForest
:: (MonadIO m, PersistEntity val, backend ~ PersistEntityBackend val)
=> RecursionDirection
-> EntityField val (Maybe (Key val))
-> Key val
-> [Filter val]
-> ReaderT backend m Int
-- | Get all records in the transitive closure, which match the given
-- criterion, in the specified order. Returns also the identifiers.
selectForestSource
:: ( PersistQueryForest backend
, MonadResource m
, PersistEntity val
, PersistEntityBackend val ~ backend
, MonadReader env m
, HasPersistBackend env backend
)
=> RecursionDirection
-> EntityField val (Maybe (Key val))
-> Key val
-> [Filter val]
-> [SelectOpt val]
-> C.Source m (Entity val)
selectForestSource dir field root filts opts = do
srcRes <-
liftPersist $ selectForestSourceRes dir field root filts opts
(releaseKey, src) <- allocateAcquire srcRes
src
release releaseKey
-- | Get the 'Key's of all records in the transitive closure, which match the
-- given criterion.
selectForestKeys
:: ( PersistQueryForest backend
, MonadResource m
, PersistEntity val
, backend ~ PersistEntityBackend val
, MonadReader env m
, HasPersistBackend env backend
)
=> RecursionDirection
-> EntityField val (Maybe (Key val))
-> Key val
-> [Filter val]
-> [SelectOpt val]
-> C.Source m (Key val)
selectForestKeys dir field root filts opts = do
srcRes <- liftPersist $ selectForestKeysRes dir field root filts opts
(releaseKey, src) <- allocateAcquire srcRes
src
release releaseKey
-- | Call 'selectForestSource' but return the result as a list.
selectForestList
:: ( PersistQueryForest backend
, MonadIO m
, PersistEntity val
, PersistEntityBackend val ~ backend
)
=> RecursionDirection
-> EntityField val (Maybe (Key val))
-> Key val
-> [Filter val]
-> [SelectOpt val]
-> ReaderT backend m [Entity val]
selectForestList dir field root filts opts = do
srcRes <- selectForestSourceRes dir field root filts opts
liftIO $ with srcRes (C.$$ CL.consume)
-- | Call 'selectForestKeys' but return the result as a list.
selectForestKeysList
:: ( PersistQueryForest backend
, MonadIO m
, PersistEntity val
, PersistEntityBackend val ~ backend
)
=> RecursionDirection
-> EntityField val (Maybe (Key val))
-> Key val
-> [Filter val]
-> [SelectOpt val]
-> ReaderT backend m [Key val]
selectForestKeysList dir field root filts opts = do
srcRes <- selectForestKeysRes dir field root filts opts
liftIO $ with srcRes (C.$$ CL.consume)

255
src/Database/Persist/Local/Class/PersistQueryRecursive.hs
View file

@ -1,255 +0,0 @@
{- This file is part of Vervis.
-
- Written in 2016 by fr33domlover <fr33domlover@riseup.net>.
-
- ♡ Copying is an act of love. Please copy, reuse and share.
-
- The author(s) have dedicated all copyright and related and neighboring
- rights to this software to the public domain worldwide. This software is
- distributed without any warranty.
-
- You should have received a copy of the CC0 Public Domain Dedication along
- with this software. If not, see
- <http://creativecommons.org/publicdomain/zero/1.0/>.
-}
{- The code is based on PersistQuery. Actually, most of the difference is
- slightly different names and 3 additional function parameters.
-}
-- | Recursive queries are performed by taking the output of a recursion step,
-- possibly modifying it, and using the result as the input for the next
-- recursion step.
--
-- This module currently provides a single way to perform that recursive step:
-- Match between the /id/ column and some other column which has the same type.
--
-- For example, suppose we have a `Message` type with a `messageParent` field.
-- For given messages `a` and `b`, if `messageParent b == Just a` then `b` is a
-- reply to `a`. Therefore, all the replies to a given message point to it
-- using the `messageParent` field. And there can be replies to replies and so
-- on, creating a tree of messages.
--
-- > Message
-- > author PersonId
-- > content Text
-- > parent MessageId Maybe
--
-- If we start with a single message and follow the `messageParent` values
-- recursively, we'll be able to get a list (or a tree) of the __ancestors__ of
-- the message. Our message /a/ may be a reply to some other message /b/, and
-- /b/ may be a reply to message /c/ and so on. Eventually, if there are no
-- cycles and it's really a tree structure, we'll reach the root message, which
-- has no parent.
--
-- But there's another way to recurse. What if we wanted to find the replies
-- for a given message? And the replies of the replies, and so on? In other
-- words, the __decendants__ of a given message. Suppose we start with a
-- message /a/. We get a list of the replies of /a/, i.e. message whose parent
-- is `Just a`. Then we find the replies of those messages, i.e. the replies of
-- the replies of /a/. And so on, recursively, until we can't find more replies
-- and then we stop.
--
-- Therefore we can perform the recursion in one of two directions:
--
-- - __Outwards__, i.e. follow from a message to its parents. More generally,
-- given a persistent entity type `Foobar`, follow recursively using a
-- specific field of it, whose type is `FoobarId`. It's called "outwards"
-- because it's like following out-edges of a graph node, i.e. arrows
-- pointing from a node towards other nodes.
-- - __Inwards__, i.e. find the children (i.e. replies) of a message, and then
-- their children, and so on. More generally, given a persistent entity type
-- `Foobar`, find other values referring to it using a specific field, whose
-- type is `FoobarId`, and recursive find such values for the results we get
-- and so on. It's called "inwards" because it's like following in-edges of a
-- graph node, i.e. arrows pointing from other nodes towards that node.
--
-- The 'RecursionDirection' type is used for specifying the direction.
--
-- When you follow all the children of an entity recursively, or all of its
-- parents, we call the result you get the __transitive closure__ of the
-- specific field you used. You can further specify the direction, i.e.
-- __outward transitive closure__ or __inward transitive closure__. For
-- examples, if you follow a message's parents recursively as in the example
-- above, you get an outward transitive closure on the /parent/ field.
--
-- Note that the definition used here is __not__ the same as the mathematical
-- definition. When you perform a recursive query without filters, you get not
-- only the ancestors (or the decendants) of an entity, but also the root
-- entity itself. In other words, even though a message is not a reply of
-- itself, you'll still get it in the query result. If you want to get just the
-- ancestors (or decendants), i.e. the actual transitive closer of the "is
-- reply of" relation in the mathematical sense, use a filter to omit the root
-- message based on the ID, i.e. @[MessageParent /= msgid]@.
--
-- Therefore, when the term "transitive closure" is used below, it means not
-- just the ancestors (or decendants), but also the origin entity too.
module Database.Persist.Local.Class.PersistQueryRecursive
( RecursionDirection (..)
, PersistQueryRecursive (..)
, selectRecursivelySource
, selectRecursivelyKeys
, selectRecursivelyList
, selectRecursivelyKeysList
)
where
import Prelude
import Control.Monad.IO.Class
import Control.Monad.Reader (MonadReader)
import Control.Monad.Trans.Reader (ReaderT)
import Control.Monad.Trans.Resource (MonadResource, release)
import Data.Acquire (Acquire, allocateAcquire, with)
import Database.Persist.Class
import Database.Persist.Types
import qualified Data.Conduit as C
import qualified Data.Conduit.List as CL
data RecursionDirection
= RecOut
| RecIn
deriving (Eq, Show)
-- | Backends supporting recursive conditional operations.
class PersistQuery backend => PersistQueryRecursive backend where
-- | Update individual fields on any record in the transitive closure and
-- matching the given criterion.
updateRecursivelyWhere
:: (MonadIO m, PersistEntity val, backend ~ PersistEntityBackend val)
=> RecursionDirection
-> EntityField val (Maybe (Key val))
-> Key val
-> [Filter val]
-> [Update val]
-> ReaderT backend m ()
-- | Delete all records in the transitive closure which match the given
-- criterion.
deleteRecursivelyWhere
:: (MonadIO m, PersistEntity val, backend ~ PersistEntityBackend val)
=> RecursionDirection
-> EntityField val (Maybe (Key val))
-> Key val
-> [Filter val]
-> ReaderT backend m ()
-- | Get all records in the transitive closure, which match the given
-- criterion, in the specified order. Returns also the identifiers.
selectRecursivelySourceRes
:: ( PersistEntity val
, PersistEntityBackend val ~ backend
, MonadIO m1
, MonadIO m2
)
=> RecursionDirection
-> EntityField val (Maybe (Key val))
-> Key val
-> [Filter val]
-> [SelectOpt val]
-> ReaderT backend m1 (Acquire (C.Source m2 (Entity val)))
-- | Get the 'Key's of all records in the transitive closure, which match
-- the given criterion.
selectRecursivelyKeysRes
:: ( PersistEntity val
, PersistEntityBackend val ~ backend
, MonadIO m1
, MonadIO m2
)
=> RecursionDirection
-> EntityField val (Maybe (Key val))
-> Key val
-> [Filter val]
-> [SelectOpt val]
-> ReaderT backend m1 (Acquire (C.Source m2 (Key val)))
-- | The total number of records in the transitive closure which fulfill
-- the given criterion.
countRecursively
:: (MonadIO m, PersistEntity val, backend ~ PersistEntityBackend val)
=> RecursionDirection
-> EntityField val (Maybe (Key val))
-> Key val
-> [Filter val]
-> ReaderT backend m Int
-- | Get all records in the transitive closure, which match the given
-- criterion, in the specified order. Returns also the identifiers.
selectRecursivelySource
:: ( PersistQueryRecursive backend
, MonadResource m
, PersistEntity val
, PersistEntityBackend val ~ backend
, MonadReader env m
, HasPersistBackend env backend
)
=> RecursionDirection
-> EntityField val (Maybe (Key val))
-> Key val
-> [Filter val]
-> [SelectOpt val]
-> C.Source m (Entity val)
selectRecursivelySource dir field root filts opts = do
srcRes <-
liftPersist $ selectRecursivelySourceRes dir field root filts opts
(releaseKey, src) <- allocateAcquire srcRes
src
release releaseKey
-- | Get the 'Key's of all records in the transitive closure, which match the
-- given criterion.
selectRecursivelyKeys
:: ( PersistQueryRecursive backend
, MonadResource m
, PersistEntity val
, backend ~ PersistEntityBackend val
, MonadReader env m
, HasPersistBackend env backend
)
=> RecursionDirection
-> EntityField val (Maybe (Key val))
-> Key val
-> [Filter val]
-> [SelectOpt val]
-> C.Source m (Key val)
selectRecursivelyKeys dir field root filts opts = do
srcRes <- liftPersist $ selectRecursivelyKeysRes dir field root filts opts
(releaseKey, src) <- allocateAcquire srcRes
src
release releaseKey
-- | Call 'selectRecursivelySource' but return the result as a list.
selectRecursivelyList
:: ( PersistQueryRecursive backend
, MonadIO m
, PersistEntity val
, PersistEntityBackend val ~ backend
)
=> RecursionDirection
-> EntityField val (Maybe (Key val))
-> Key val
-> [Filter val]
-> [SelectOpt val]
-> ReaderT backend m [Entity val]
selectRecursivelyList dir field root filts opts = do
srcRes <- selectRecursivelySourceRes dir field root filts opts
liftIO $ with srcRes (C.$$ CL.consume)
-- | Call 'selectRecursivelyKeys' but return the result as a list.
selectRecursivelyKeysList
:: ( PersistQueryRecursive backend
, MonadIO m
, PersistEntity val
, PersistEntityBackend val ~ backend
)
=> RecursionDirection
-> EntityField val (Maybe (Key val))
-> Key val
-> [Filter val]
-> [SelectOpt val]
-> ReaderT backend m [Key val]
selectRecursivelyKeysList dir field root filts opts = do
srcRes <- selectRecursivelyKeysRes dir field root filts opts
liftIO $ with srcRes (C.$$ CL.consume)

133
src/Database/Persist/Local/RecursionDoc.hs Normal file
View file

@ -0,0 +1,133 @@
{- This file is part of Vervis.
-
- Written in 2016 by fr33domlover <fr33domlover@riseup.net>.
-
- ♡ Copying is an act of love. Please copy, reuse and share.
-
- The author(s) have dedicated all copyright and related and neighboring
- rights to this software to the public domain worldwide. This software is
- distributed without any warranty.
-
- You should have received a copy of the CC0 Public Domain Dedication along
- with this software. If not, see
- <http://creativecommons.org/publicdomain/zero/1.0/>.
-}
-- |
-- = Intro
--
-- Recursive queries are performed by taking the output of a recursion step,
-- possibly modifying it, and using the result as the input for the next
-- recursion step. Like /persistent/ itself, the API provided here is a
-- high-level, safe subset, and you can use 'rawSql' etc. for the less common
-- cases or backend-specific features not covered by it. Instead of talking
-- about recursion concepts, the API uses terms like /tree/ and /graph/.
--
-- This module supports two ways to represent hierarchy using persistent
-- records:
--
-- 1. Forest (i.e. one or more trees)
-- 2. Graph
--
-- If your hierarchy supports up to one parent per node, you'll probably take
-- the forest approach. If multiple parents per node are supported, you'll
-- probably take the graph approach. Note that this API is still new and
-- experimental, and is based on experience working only with SQL. Suggestions
-- and use cases are very welcome.
--
-- = Forest
--
-- In the forest model, the recursive step is done by matching between the /id/
-- column of a certain entity and some other column. The idea is that you have
-- an entity @Ent@ with a field of type @Maybe (Key Ent)@. Through that field,
-- a node points to its parent node. Nodes without a parent are called root
-- nodes. If there's a single such root node, you get a tree structure. Is
-- there are multiple root nodes, there are multiple trees, i.e. a forest.
--
-- For example, suppose we have a `Message` type with a `messageParent` field.
-- For given messages `a` and `b`, if `messageParent b == Just a` then `b` is a
-- reply to `a`. Therefore, all the replies to a given message point to it
-- using the `messageParent` field. And there can be replies to replies and so
-- on, creating a tree of messages.
--
-- > Message
-- > author PersonId
-- > content Text
-- > parent MessageId Maybe
--
-- If we start with a single message and follow the `messageParent` values
-- recursively, we'll be able to get a list (or a tree) of the __ancestors__ of
-- the message. Our message /a/ may be a reply to some other message /b/, and
-- /b/ may be a reply to message /c/ and so on. Eventually, if there are no
-- cycles and it's really a tree structure, we'll reach the root message, which
-- has no parent.
--
-- But there's another way to recurse. What if we wanted to find the replies
-- for a given message? And the replies of the replies, and so on? In other
-- words, the __decendants__ of a given message. Suppose we start with a
-- message /a/. We get a list of the replies of /a/, i.e. message whose parent
-- is `Just a`. Then we find the replies of those messages, i.e. the replies of
-- the replies of /a/. And so on, recursively, until we can't find more replies
-- and then we stop.
--
-- Therefore we can perform the recursion in one of two directions:
--
-- - __Towards the root nodes__, i.e. follow from a message to its parents.
-- More generally, given a persistent entity type `Foobar`, follow
-- recursively using a specific field of it, whose type is `FoobarId`.
-- - __Towards leaf nodes__, i.e. find the children (i.e. replies) of a
-- message, and then their children, and so on. More generally, given a
-- persistent entity type `Foobar`, find other values referring to it using a
-- specific field, whose type is `Maybe FoobarId`, and recursively find such
-- values for the results we get and so on.
--
-- The 'RecursionDirection' type is used for specifying the direction.
--
-- When you follow all the children of an entity recursively, or all of its
-- parents, we call the result you get the __transitive closure__ of the
-- specific field you used. You can further specify the direction, i.e.
-- __outward transitive closure__ or __inward transitive closure__. For
-- examples, if you follow a message's parents recursively as in the example
-- above, you get an outward transitive closure on the /parent/ field.
--
-- Note that the definition used here is __not__ the same as the mathematical
-- definition. When you perform a recursive query without filters, you get not
-- only the ancestors (or the decendants) of an entity, but also the root
-- entity itself. In other words, even though a message is not a reply of
-- itself, you'll still get it in the query result. If you want to get just the
-- ancestors (or decendants), i.e. the actual transitive closer of the "is
-- reply of" relation in the mathematical sense, use a filter to omit the root
-- message based on the ID, i.e. @[MessageParent /= msgid]@.
--
-- Therefore, when the term "transitive closure" is used below, it means not
-- just the ancestors (or decendants), but also the origin entity too.
--
-- = Graph
--
-- Sometimes a tree isn't enough. One common structure for hierarchies which
-- isn't a tree is the DAG, Directed Acyclic Graph. A DAG is a graph which has
-- no cycles. It allows a node to have an arbitrary number of parents, as long
-- as a parent can't be a child of its own child, or more generally, a node
-- can't be an ancestor of its ancestors.
--
-- For example, suppose you'd like to create an application that manages data
-- about human languages. For each language you'd like to specify, from which
-- older languages it developed. Some languages are simply decendants of older
-- versions of themselves, but other languages are a mix of several older
-- languages, or have a variety of influences.
--
-- In this case, each language may have multiple parents (and a language can't
-- be an ancestor of itself). We need something more general than a tree.
--
-- There are probably various ways to represent such a graph in the various
-- backends. This module provides a single way to do that, which is hopefully
-- safe and works well on different kinds of backends. The idea is that you
-- have two separate tables: One for the entities and another one for the
-- parent-child relations between them. For example, we can have a @Language@
-- entity, and a @LanguageOrigin@ entity with two fields, @parent@ and @child@,
-- both of type @LanguageId@.
--
-- Before you can use the graph approach you should define an instance of the
-- 'PersistEntityGraph' class. That class creates a relation between the two
-- entities (@Language@ and @LanguageOrigin@ in the example).
module Database.Persist.Local.RecursionDoc () where

48
src/Database/Persist/Local/Sql/Orphan/PersistQueryRecursive.hs → src/Database/Persist/Local/Sql/Orphan/PersistQueryForest.hs
View file

@ -13,9 +13,9 @@
- <http://creativecommons.org/publicdomain/zero/1.0/>. - <http://creativecommons.org/publicdomain/zero/1.0/>.
-} -}
module Database.Persist.Local.Sql.Orphan.PersistQueryRecursive module Database.Persist.Local.Sql.Orphan.PersistQueryForest
( deleteRecursivelyWhereCount ( deleteForestWhereCount
, updateRecursivelyWhereCount , updateForestWhereCount
) )
where where
@ -39,17 +39,17 @@ import Database.Persist.Sql.Util
import qualified Data.Conduit.List as CL (head, mapM) import qualified Data.Conduit.List as CL (head, mapM)
import qualified Data.Text as T (pack, unpack, intercalate) import qualified Data.Text as T (pack, unpack, intercalate)
import Database.Persist.Local.Class.PersistQueryRecursive import Database.Persist.Local.Class.PersistQueryForest
import Database.Persist.Local.Sql.Orphan.Common import Database.Persist.Local.Sql.Orphan.Common
instance PersistQueryRecursive SqlBackend where instance PersistQueryForest SqlBackend where
updateRecursivelyWhere dir field root filts upds = updateForestWhere dir field root filts upds =
void $ updateRecursivelyWhereCount dir field root filts upds void $ updateForestWhereCount dir field root filts upds
deleteRecursivelyWhere dir field root filts = deleteForestWhere dir field root filts =
void $ deleteRecursivelyWhereCount dir field root filts void $ deleteForestWhereCount dir field root filts
selectRecursivelySourceRes dir field root filts opts = do selectForestSourceRes dir field root filts opts = do
conn <- ask conn <- ask
let (sql, vals, parse) = sqlValsParse conn let (sql, vals, parse) = sqlValsParse conn
srcRes <- rawQueryRes sql vals srcRes <- rawQueryRes sql vals
@ -88,7 +88,7 @@ instance PersistQueryRecursive SqlBackend where
] ]
vals = getFiltsValues conn $ isRoot : filts vals = getFiltsValues conn $ isRoot : filts
selectRecursivelyKeysRes dir field root filts opts = do selectForestKeysRes dir field root filts opts = do
conn <- ask conn <- ask
let (sql, vals, parse) = sqlValsParse conn let (sql, vals, parse) = sqlValsParse conn
srcRes <- rawQueryRes sql vals srcRes <- rawQueryRes sql vals
@ -151,7 +151,7 @@ instance PersistQueryRecursive SqlBackend where
] ]
vals = getFiltsValues conn $ isRoot : filts vals = getFiltsValues conn $ isRoot : filts
countRecursively dir field root filts = do countForest dir field root filts = do
conn <- ask conn <- ask
let (sql, vals) = sqlAndVals conn let (sql, vals) = sqlAndVals conn
withRawQuery sql vals $ do withRawQuery sql vals $ do
@ -183,15 +183,15 @@ instance PersistQueryRecursive SqlBackend where
] ]
vals = getFiltsValues conn $ isRoot : filts vals = getFiltsValues conn $ isRoot : filts
-- | Same as 'deleteRecursivelyWhere', but returns the number of rows affected. -- | Same as 'deleteForestWhere', but returns the number of rows affected.
deleteRecursivelyWhereCount deleteForestWhereCount
:: (PersistEntity val, MonadIO m, PersistEntityBackend val ~ SqlBackend) :: (PersistEntity val, MonadIO m, PersistEntityBackend val ~ SqlBackend)
=> RecursionDirection => RecursionDirection
-> EntityField val (Maybe (Key val)) -> EntityField val (Maybe (Key val))
-> Key val -> Key val
-> [Filter val] -> [Filter val]
-> ReaderT SqlBackend m Int64 -> ReaderT SqlBackend m Int64
deleteRecursivelyWhereCount dir field root filts = do deleteForestWhereCount dir field root filts = do
conn <- ask conn <- ask
let (sql, vals) = sqlAndVals conn let (sql, vals) = sqlAndVals conn
rawExecuteCount sql vals rawExecuteCount sql vals
@ -221,8 +221,8 @@ deleteRecursivelyWhereCount dir field root filts = do
] ]
vals = getFiltsValues conn $ isRoot : filts vals = getFiltsValues conn $ isRoot : filts
-- | Same as 'updateRecursivelyWhere', but returns the number of rows affected. -- | Same as 'updateForestWhere', but returns the number of rows affected.
updateRecursivelyWhereCount updateForestWhereCount
:: (PersistEntity val, MonadIO m, SqlBackend ~ PersistEntityBackend val) :: (PersistEntity val, MonadIO m, SqlBackend ~ PersistEntityBackend val)
=> RecursionDirection => RecursionDirection
-> EntityField val (Maybe (Key val)) -> EntityField val (Maybe (Key val))
@ -230,8 +230,8 @@ updateRecursivelyWhereCount
-> [Filter val] -> [Filter val]
-> [Update val] -> [Update val]
-> ReaderT SqlBackend m Int64 -> ReaderT SqlBackend m Int64
updateRecursivelyWhereCount _ _ _ _ [] = return 0 updateForestWhereCount _ _ _ _ [] = return 0
updateRecursivelyWhereCount dir field root filts upds = do updateForestWhereCount dir field root filts upds = do
conn <- ask conn <- ask
let (sql, vals) = sqlAndVals conn let (sql, vals) = sqlAndVals conn
rawExecuteCount sql vals rawExecuteCount sql vals
@ -311,7 +311,7 @@ withRecursive dir field root conn t getcols =
--, connEscapeName conn $ fieldDB $ entityId t --, connEscapeName conn $ fieldDB $ entityId t
--, " = ?" --, " = ?"
, " UNION SELECT " , " UNION SELECT "
, qcols temp , qcols $ entityDB t
, " FROM " , " FROM "
, connEscapeName conn $ entityDB t , connEscapeName conn $ entityDB t
, ", " , ", "
@ -320,14 +320,14 @@ withRecursive dir field root conn t getcols =
, connEscapeName conn $ entityDB t , connEscapeName conn $ entityDB t
, "." , "."
, connEscapeName conn $ fieldDB $ case dir of , connEscapeName conn $ fieldDB $ case dir of
RecOut -> persistFieldDef field Ancestors -> persistFieldDef field
RecIn -> entityId t Decendants -> entityId t
, " = " , " = "
, connEscapeName conn temp , connEscapeName conn temp
, "." , "."
, connEscapeName conn $ fieldDB $ case dir of , connEscapeName conn $ fieldDB $ case dir of
RecOut -> entityId t Ancestors -> entityId t
RecIn -> persistFieldDef field Decendants -> persistFieldDef field
, " ) " , " ) "
] ]
in (temp, isRoot, cols, qcols, sql) in (temp, isRoot, cols, qcols, sql)