content: {-# LANGUAGE NoImplicitPrelude     #-}
  {-# LANGUAGE TypeFamilies          #-}
  
  {-|
  Module      : Stack.Storage.Util
  Description : Utilities for other @Stack.Storage@ modules.
  License     : BSD-3-Clause
  
  Utilities for the other @Stack.Storage@ modules.
  -}
  
  module Stack.Storage.Util
    ( handleMigrationException
    , updateCollection
    , setUpdateDiff
    , listUpdateDiff
    ) where
  
  import qualified Data.Set as Set
  import           Database.Persist
                     ( BaseBackend, EntityField, Filter, PersistEntity
                     , PersistEntityBackend, PersistField, PersistQueryWrite
                     , SafeToInsert, (<-.), deleteWhere, insertMany_
                     )
  import           Stack.Prelude
  import           Stack.Types.Storage ( StoragePrettyException (..) )
  
  -- | Efficiently update a collection of values with a given diff function.
  updateCollection ::
       ( PersistEntityBackend record ~ BaseBackend backend
       , Eq (collection rawValue)
       , PersistEntity record
       , PersistField value
       , MonadIO m
       , PersistQueryWrite backend
       , SafeToInsert record
       , Foldable collection
       )
    => (collection rawValue -> collection rawValue -> ([Filter record], [value]))
       -- ^ Function to yield items in old not in new, to delete, and values in
       -- new not in old, to add, from the old and new collections of values.
    -> (value -> record)
       -- ^ Function to yield new records from values in new not in old.
    -> [Filter record]
       -- ^ Extra items to delete, if there are other items to delete.
    -> collection rawValue
       -- ^ The old collection of values.
    -> collection rawValue
       -- ^ The new collection of values.
    -> ReaderT backend m ()
  updateCollection fnDiffer recordCons extra old new =
    when (old /= new) $ do
      let (oldMinusNewFilter, newMinusOld) = fnDiffer old new
      unless (null oldMinusNewFilter) $ deleteWhere
        (extra ++ oldMinusNewFilter)
      unless (null newMinusOld) $ insertMany_ $
        map recordCons $ toList newMinusOld
  
  setUpdateDiff ::
       (Ord value, PersistField value)
    => EntityField record value
    -> Set value
    -> Set value
    -> ([Filter record], [value])
  setUpdateDiff indexFieldCons old new =
    let oldMinusNew = Set.difference old new
    in  ([indexFieldCons <-. toList oldMinusNew], toList $ Set.difference new old)
  
  listUpdateDiff ::
       (Ord value)
    => EntityField record Int
    -> [value]
    -> [value]
    -> ([Filter record], [(Int, value)])
  listUpdateDiff indexFieldCons old new =
    let oldSet = Set.fromList (zip [0 ..] old)
        newSet = Set.fromList (zip [0 ..] new)
        oldMinusNew = Set.difference oldSet newSet
        indexList = map fst (Set.toList oldMinusNew)
    in  ([indexFieldCons <-. indexList], toList $ Set.difference newSet oldSet)
  
  handleMigrationException :: HasLogFunc env => RIO env a -> RIO env a
  handleMigrationException inner = do
    eres <- try inner
    either
      ( \e -> case e :: PantryException of
                MigrationFailure desc fp ex ->
                  prettyThrowIO $ StorageMigrationFailure desc fp ex
                _ -> throwIO e
      )
      pure
      eres
  