Got a working example of cascading delete but it requires a select followed by a delete

This commit is contained in:
Fintan Halpenny 2017-07-23 23:49:34 +01:00
parent 9fc64131b0
commit de2d9f8a0b

View File

@ -5,6 +5,7 @@
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
@ -17,6 +18,7 @@ module Main
-------------------------------------------------------------------------------
import Blog
import Control.Monad (void)
import Control.Monad (forM_)
import Control.Monad.IO.Class (MonadIO, liftIO)
import Control.Monad.Logger (MonadLogger)
import Control.Monad.Reader (MonadReader (..), runReaderT)
@ -31,7 +33,9 @@ import Database.Persist.TH (mkDeleteCascade, mkMigrate,
-------------------------------------------------------------------------------
share [mkPersist sqlSettings, mkDeleteCascade sqlSettings, mkMigrate "migrateAll"] [persistLowerCase|
share [ mkPersist sqlSettings
, mkDeleteCascade sqlSettings
, mkMigrate "migrateAll"] [persistLowerCase|
Person
name String
age Int Maybe
@ -136,12 +140,18 @@ updateJoao =
-------------------------------------------------------------------------------
deleteYoungsters :: (MonadIO m, MonadLogger m)
=> SqlWriteT m ()
=> SqlPersistT m ()
deleteYoungsters = do
-- | Delete any persons under the age of 14
delete $
-- | In this case where `ON DELETE CASCADE` is not generated by migration
-- | we select all the entities we want to delete and then for each one
-- | one we extract the key and use Persistent's `deleteCascade`
youngsters <- select $
from $ \p -> do
where_ (p ^. PersonAge <. just (val 14))
pure p
forM_ youngsters (deleteCascade . entityKey)
-------------------------------------------------------------------------------
@ -198,7 +208,6 @@ cleanDb = do
where
dropTable tableName = rawExecute ("DROP TABLE " <> tableName) []
-------------------------------------------------------------------------------
main :: IO ()
main = do
@ -229,4 +238,4 @@ main = do
where
say :: (MonadIO m, Show a) => a -> m ()
say = liftIO . print
connection = "host=localhost port=5433 user=postgres dbname=esqueleto_blog_example password=Leon93"
connection = "host=localhost port=5433 user=postgres dbname=esqueleto_blog_example password=***"