{-# LANGUAGE ExplicitForAll #-}
module Database.Persist.Class.DeleteCascade
    ( DeleteCascade (..)
    , deleteCascadeWhere
    ) where

import Control.Monad.IO.Class (MonadIO, liftIO)
import Control.Monad.Reader (ReaderT, ask, runReaderT)
import Data.Conduit
import qualified Data.Conduit.List as CL
import Data.Acquire (with)

import Database.Persist.Class.PersistStore
import Database.Persist.Class.PersistQuery
import Database.Persist.Class.PersistEntity

-- | For combinations of backends and entities that support
-- cascade-deletion. “Cascade-deletion” means that entries that depend on
-- other entries to be deleted will be deleted as well.
class (PersistStoreWrite backend, PersistEntity record, BaseBackend backend ~ PersistEntityBackend record)
  => DeleteCascade record backend where

    -- | Perform cascade-deletion of single database
    -- entry.
    deleteCascade :: MonadIO m => Key record -> ReaderT backend m ()

-- | Cascade-deletion of entries satisfying given filters.
deleteCascadeWhere :: forall record backend m. (MonadIO m, DeleteCascade record backend, PersistQueryWrite backend)
                   => [Filter record] -> ReaderT backend m ()
deleteCascadeWhere :: [Filter record] -> ReaderT backend m ()
deleteCascadeWhere [Filter record]
filts = do
    Acquire (ConduitM () (Key record) IO ())
srcRes <- [Filter record]
-> [SelectOpt record]
-> ReaderT backend m (Acquire (ConduitM () (Key record) IO ()))
forall backend (m1 :: * -> *) (m2 :: * -> *) record.
(PersistQueryRead backend, MonadIO m1, MonadIO m2,
 PersistRecordBackend record backend) =>
[Filter record]
-> [SelectOpt record]
-> ReaderT backend m1 (Acquire (ConduitM () (Key record) m2 ()))
selectKeysRes [Filter record]
filts []
    backend
conn <- ReaderT backend m backend
forall r (m :: * -> *). MonadReader r m => m r
ask
    IO () -> ReaderT backend m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ReaderT backend m ()) -> IO () -> ReaderT backend m ()
forall a b. (a -> b) -> a -> b
$ Acquire (ConduitM () (Key record) IO ())
-> (ConduitM () (Key record) IO () -> IO ()) -> IO ()
forall (m :: * -> *) a b.
MonadUnliftIO m =>
Acquire a -> (a -> m b) -> m b
with Acquire (ConduitM () (Key record) IO ())
srcRes (\ConduitM () (Key record) IO ()
src -> ConduitT () Void IO () -> IO ()
forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit (ConduitT () Void IO () -> IO ())
-> ConduitT () Void IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ ConduitM () (Key record) IO ()
src ConduitM () (Key record) IO ()
-> ConduitM (Key record) Void IO () -> ConduitT () Void IO ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| (Key record -> IO ()) -> ConduitM (Key record) Void IO ()
forall (m :: * -> *) a o.
Monad m =>
(a -> m ()) -> ConduitT a o m ()
CL.mapM_ ((ReaderT backend IO () -> backend -> IO ())
-> backend -> ReaderT backend IO () -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT backend IO () -> backend -> IO ()
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT backend
conn (ReaderT backend IO () -> IO ())
-> (Key record -> ReaderT backend IO ()) -> Key record -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key record -> ReaderT backend IO ()
forall record backend (m :: * -> *).
(DeleteCascade record backend, MonadIO m) =>
Key record -> ReaderT backend m ()
deleteCascade))