module Database.Persist.Query.Internal
(
PersistQuery (..)
, selectList
, selectKeysList
, SelectOpt (..)
, limitOffsetOrder
, Filter (..)
, PersistUpdate (..)
, Update (..)
, updateFieldDef
, deleteCascadeWhere
, UpdateGetException (..)
) where
import Database.Persist.Store
import Database.Persist.EntityDef
import Control.Monad.Trans.Class (lift)
import Control.Monad.Base (liftBase)
import Control.Exception (Exception, throwIO)
import Data.Typeable (Typeable)
import qualified Data.Conduit as C
import qualified Data.Conduit.List as CL
data UpdateGetException = KeyNotFound String
deriving Typeable
instance Show UpdateGetException where
show (KeyNotFound key) = "Key not found during updateGet: " ++ key
instance Exception UpdateGetException
class PersistStore backend m => PersistQuery backend m where
update :: PersistEntity val => Key backend val -> [Update val] -> backend m ()
updateGet :: PersistEntity val => Key backend val -> [Update val] -> backend m val
updateGet key ups = do
update key ups
get key >>= maybe (liftBase $ throwIO $ KeyNotFound $ show key) return
updateWhere :: PersistEntity val => [Filter val] -> [Update val] -> backend m ()
deleteWhere :: PersistEntity val => [Filter val] -> backend m ()
selectSource
:: (PersistEntity val, PersistEntityBackend val ~ backend)
=> [Filter val]
-> [SelectOpt val]
-> C.Source (C.ResourceT (backend m)) (Entity val)
selectFirst :: (PersistEntity val, PersistEntityBackend val ~ backend)
=> [Filter val]
-> [SelectOpt val]
-> backend m (Maybe (Entity val))
selectFirst filts opts = C.runResourceT
$ selectSource filts ((LimitTo 1):opts) C.$$ CL.head
selectKeys :: PersistEntity val
=> [Filter val]
-> [SelectOpt val]
-> C.Source (C.ResourceT (backend m)) (Key backend val)
count :: PersistEntity val => [Filter val] -> backend m Int
data Filter v = forall typ. PersistField typ => Filter
{ filterField :: EntityField v typ
, filterValue :: Either typ [typ]
, filterFilter :: PersistFilter
}
| FilterAnd [Filter v]
| FilterOr [Filter v]
data SelectOpt v = forall typ. Asc (EntityField v typ)
| forall typ. Desc (EntityField v typ)
| OffsetBy Int
| LimitTo Int
selectList :: (PersistEntity val, PersistQuery backend m, PersistEntityBackend val ~ backend)
=> [Filter val]
-> [SelectOpt val]
-> backend m [Entity val]
selectList a b = C.runResourceT $ selectSource a b C.$$ CL.consume
selectKeysList :: (PersistEntity val, PersistQuery b m, PersistEntityBackend val ~ b)
=> [Filter val]
-> [SelectOpt val]
-> b m [Key b val]
selectKeysList a b = C.runResourceT $ selectKeys a b C.$$ CL.consume
data PersistUpdate = Assign | Add | Subtract | Multiply | Divide
deriving (Read, Show, Enum, Bounded)
data Update v = forall typ. PersistField typ => Update
{ updateField :: EntityField v typ
, updateValue :: typ
, updateUpdate :: PersistUpdate
}
limitOffsetOrder :: PersistEntity val => [SelectOpt val] -> (Int, Int, [SelectOpt val])
limitOffsetOrder opts =
foldr go (0, 0, []) opts
where
go (LimitTo l) (_, b, c) = (l, b ,c)
go (OffsetBy o) (a, _, c) = (a, o, c)
go x (a, b, c) = (a, b, x : c)
updateFieldDef :: PersistEntity v => Update v -> FieldDef
updateFieldDef (Update f _ _) = persistFieldDef f
deleteCascadeWhere :: (DeleteCascade a backend m, PersistQuery backend m)
=> [Filter a] -> backend m ()
deleteCascadeWhere filts = do
C.runResourceT $ selectKeys filts [] C.$$ CL.mapM_ (lift . deleteCascade)