{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE TypeFamilies #-} -- | Utils for the other Stack.Storage modules module Stack.Storage.Util ( updateList , updateSet ) where import qualified Data.Set as Set import Database.Persist import Stack.Prelude hiding (MigrationFailure) -- | Efficiently update a set of values stored in a database table updateSet :: ( PersistEntityBackend record ~ BaseBackend backend , PersistField parentid , PersistField value , Ord value , PersistEntity record , MonadIO m , PersistQueryWrite backend ) => (parentid -> value -> record) -> EntityField record parentid -> parentid -> EntityField record value -> Set value -> Set value -> ReaderT backend m () updateSet recordCons parentFieldCons parentId valueFieldCons old new = when (old /= new) $ do deleteWhere [ parentFieldCons ==. parentId , valueFieldCons <-. Set.toList (Set.difference old new) ] insertMany_ $ map (recordCons parentId) $ Set.toList (Set.difference new old) -- | Efficiently update a list of values stored in a database table. updateList :: ( PersistEntityBackend record ~ BaseBackend backend , PersistField parentid , Ord value , PersistEntity record , MonadIO m , PersistQueryWrite backend ) => (parentid -> Int -> value -> record) -> EntityField record parentid -> parentid -> EntityField record Int -> [value] -> [value] -> ReaderT backend m () updateList recordCons parentFieldCons parentId indexFieldCons old new = when (old /= new) $ do let oldSet = Set.fromList (zip [0 ..] old) newSet = Set.fromList (zip [0 ..] new) deleteWhere [ parentFieldCons ==. parentId , indexFieldCons <-. map fst (Set.toList $ Set.difference oldSet newSet) ] insertMany_ $ map (uncurry $ recordCons parentId) $ Set.toList (Set.difference newSet oldSet)