{-# 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 :: (parentid -> value -> record)
-> EntityField record parentid
-> parentid
-> EntityField record value
-> Set value
-> Set value
-> ReaderT backend m ()
updateSet parentid -> value -> record
recordCons EntityField record parentid
parentFieldCons parentid
parentId EntityField record value
valueFieldCons Set value
old Set value
new =
    Bool -> ReaderT backend m () -> ReaderT backend m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Set value
old Set value -> Set value -> Bool
forall a. Eq a => a -> a -> Bool
/= Set value
new) (ReaderT backend m () -> ReaderT backend m ())
-> ReaderT backend m () -> ReaderT backend m ()
forall a b. (a -> b) -> a -> b
$ do
        [Filter record] -> ReaderT backend m ()
forall backend (m :: * -> *) record.
(PersistQueryWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record] -> ReaderT backend m ()
deleteWhere
            [ EntityField record parentid
parentFieldCons EntityField record parentid -> parentid -> Filter record
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. parentid
parentId
            , EntityField record value
valueFieldCons EntityField record value -> [value] -> Filter record
forall v typ.
PersistField typ =>
EntityField v typ -> [typ] -> Filter v
<-. Set value -> [value]
forall a. Set a -> [a]
Set.toList (Set value -> Set value -> Set value
forall a. Ord a => Set a -> Set a -> Set a
Set.difference Set value
old Set value
new)
            ]
        [record] -> ReaderT backend m ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
[record] -> ReaderT backend m ()
insertMany_ ([record] -> ReaderT backend m ())
-> [record] -> ReaderT backend m ()
forall a b. (a -> b) -> a -> b
$
            (value -> record) -> [value] -> [record]
forall a b. (a -> b) -> [a] -> [b]
map (parentid -> value -> record
recordCons parentid
parentId) ([value] -> [record]) -> [value] -> [record]
forall a b. (a -> b) -> a -> b
$ Set value -> [value]
forall a. Set a -> [a]
Set.toList (Set value -> Set value -> Set value
forall a. Ord a => Set a -> Set a -> Set a
Set.difference Set value
new Set value
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 :: (parentid -> Int -> value -> record)
-> EntityField record parentid
-> parentid
-> EntityField record Int
-> [value]
-> [value]
-> ReaderT backend m ()
updateList parentid -> Int -> value -> record
recordCons EntityField record parentid
parentFieldCons parentid
parentId EntityField record Int
indexFieldCons [value]
old [value]
new =
    Bool -> ReaderT backend m () -> ReaderT backend m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([value]
old [value] -> [value] -> Bool
forall a. Eq a => a -> a -> Bool
/= [value]
new) (ReaderT backend m () -> ReaderT backend m ())
-> ReaderT backend m () -> ReaderT backend m ()
forall a b. (a -> b) -> a -> b
$ do
        let oldSet :: Set (Int, value)
oldSet = [(Int, value)] -> Set (Int, value)
forall a. Ord a => [a] -> Set a
Set.fromList ([Int] -> [value] -> [(Int, value)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 ..] [value]
old)
            newSet :: Set (Int, value)
newSet = [(Int, value)] -> Set (Int, value)
forall a. Ord a => [a] -> Set a
Set.fromList ([Int] -> [value] -> [(Int, value)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 ..] [value]
new)
        [Filter record] -> ReaderT backend m ()
forall backend (m :: * -> *) record.
(PersistQueryWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record] -> ReaderT backend m ()
deleteWhere
            [ EntityField record parentid
parentFieldCons EntityField record parentid -> parentid -> Filter record
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. parentid
parentId
            , EntityField record Int
indexFieldCons EntityField record Int -> [Int] -> Filter record
forall v typ.
PersistField typ =>
EntityField v typ -> [typ] -> Filter v
<-.
              ((Int, value) -> Int) -> [(Int, value)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int, value) -> Int
forall a b. (a, b) -> a
fst (Set (Int, value) -> [(Int, value)]
forall a. Set a -> [a]
Set.toList (Set (Int, value) -> [(Int, value)])
-> Set (Int, value) -> [(Int, value)]
forall a b. (a -> b) -> a -> b
$ Set (Int, value) -> Set (Int, value) -> Set (Int, value)
forall a. Ord a => Set a -> Set a -> Set a
Set.difference Set (Int, value)
oldSet Set (Int, value)
newSet)
            ]
        [record] -> ReaderT backend m ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
[record] -> ReaderT backend m ()
insertMany_ ([record] -> ReaderT backend m ())
-> [record] -> ReaderT backend m ()
forall a b. (a -> b) -> a -> b
$
            ((Int, value) -> record) -> [(Int, value)] -> [record]
forall a b. (a -> b) -> [a] -> [b]
map ((Int -> value -> record) -> (Int, value) -> record
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((Int -> value -> record) -> (Int, value) -> record)
-> (Int -> value -> record) -> (Int, value) -> record
forall a b. (a -> b) -> a -> b
$ parentid -> Int -> value -> record
recordCons parentid
parentId) ([(Int, value)] -> [record]) -> [(Int, value)] -> [record]
forall a b. (a -> b) -> a -> b
$
            Set (Int, value) -> [(Int, value)]
forall a. Set a -> [a]
Set.toList (Set (Int, value) -> Set (Int, value) -> Set (Int, value)
forall a. Ord a => Set a -> Set a -> Set a
Set.difference Set (Int, value)
newSet Set (Int, value)
oldSet)