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