1{-# LANGUAGE FlexibleInstances #-} 2{-# LANGUAGE GADTs #-} 3{-# LANGUAGE MultiParamTypeClasses #-} 4{-# LANGUAGE NoImplicitPrelude #-} 5{-# LANGUAGE TypeFamilies #-} 6-- | Utils for the other Stack.Storage modules 7module Stack.Storage.Util 8 ( updateList 9 , updateSet 10 ) where 11 12import qualified Data.Set as Set 13import Database.Persist 14import Stack.Prelude hiding (MigrationFailure) 15 16-- | Efficiently update a set of values stored in a database table 17updateSet :: 18 ( PersistEntityBackend record ~ BaseBackend backend 19 , PersistField parentid 20 , PersistField value 21 , Ord value 22 , PersistEntity record 23 , MonadIO m 24 , PersistQueryWrite backend 25 ) 26 => (parentid -> value -> record) 27 -> EntityField record parentid 28 -> parentid 29 -> EntityField record value 30 -> Set value 31 -> Set value 32 -> ReaderT backend m () 33updateSet recordCons parentFieldCons parentId valueFieldCons old new = 34 when (old /= new) $ do 35 deleteWhere 36 [ parentFieldCons ==. parentId 37 , valueFieldCons <-. Set.toList (Set.difference old new) 38 ] 39 insertMany_ $ 40 map (recordCons parentId) $ Set.toList (Set.difference new old) 41 42-- | Efficiently update a list of values stored in a database table. 43updateList :: 44 ( PersistEntityBackend record ~ BaseBackend backend 45 , PersistField parentid 46 , Ord value 47 , PersistEntity record 48 , MonadIO m 49 , PersistQueryWrite backend 50 ) 51 => (parentid -> Int -> value -> record) 52 -> EntityField record parentid 53 -> parentid 54 -> EntityField record Int 55 -> [value] 56 -> [value] 57 -> ReaderT backend m () 58updateList recordCons parentFieldCons parentId indexFieldCons old new = 59 when (old /= new) $ do 60 let oldSet = Set.fromList (zip [0 ..] old) 61 newSet = Set.fromList (zip [0 ..] new) 62 deleteWhere 63 [ parentFieldCons ==. parentId 64 , indexFieldCons <-. 65 map fst (Set.toList $ Set.difference oldSet newSet) 66 ] 67 insertMany_ $ 68 map (uncurry $ recordCons parentId) $ 69 Set.toList (Set.difference newSet oldSet) 70