module Utils.DB where

import ClassyPrelude.Yesod

import qualified Data.List as List
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Set (Set)
import qualified Data.Set as Set
import qualified Database.Esqueleto as E
-- import Database.Persist -- currently not needed here

import Utils




emptyOrIn :: PersistField typ
          => E.SqlExpr (E.Value typ) -> Set typ -> E.SqlExpr (E.Value Bool)
emptyOrIn criterion testSet
  | Set.null testSet = E.val True
  | otherwise        = criterion `E.in_` E.valList (Set.toList testSet)

entities2map :: PersistEntity record => [Entity record] -> Map (Key record) record
entities2map = foldl' (\m entity -> Map.insert (entityKey entity) (entityVal entity) m) Map.empty

getKeyBy :: (PersistEntityBackend record ~ BaseBackend backend, PersistEntity record, PersistUniqueRead backend, MonadIO m)
         => Unique record -> ReaderT backend m (Maybe (Key record))
getKeyBy u = fmap entityKey <$> getBy u -- TODO optimize this, so that DB does not deliver entire record!

getKeyBy404 :: (PersistEntityBackend record ~ BaseBackend backend, PersistEntity record, PersistUniqueRead backend, MonadIO m)
            => Unique record -> ReaderT backend m (Key record)
getKeyBy404 = fmap entityKey . getBy404 -- TODO optimize this, so that DB does not deliver entire record!

existsBy :: (PersistEntityBackend record ~ BaseBackend backend, PersistEntity record, PersistUniqueRead backend, MonadIO m)
         => Unique record -> ReaderT backend m Bool
existsBy = fmap isJust . getBy -- TODO optimize, so that DB does not deliver entire record

existsKey :: (PersistEntityBackend record ~ BaseBackend backend, PersistEntity record, PersistStoreRead backend, MonadIO m)
          => Key record -> ReaderT backend m Bool
existsKey = fmap isJust . get -- TODO optimize, so that DB does not deliver entire record

updateBy :: (PersistUniqueRead backend, PersistStoreWrite backend, MonadIO m, PersistRecordBackend record backend )
         => Unique record -> [Update record] -> ReaderT backend m ()
updateBy uniq updates = do
  key <- getKeyBy uniq
  for_ key $ flip update updates

-- | Like 'myReplaceUnique' or 'replaceUnique' but with reversed result: returns 'Nothing' if the replacement was not possible,
--   and 'Just key' for the successfully replaced record
uniqueReplace :: ( MonadIO m
                 , Eq (Unique record)
                 , PersistRecordBackend record backend
                 , PersistUniqueWrite backend
                 )
              => Key record -> record -> ReaderT backend m (Maybe (Key record))
uniqueReplace key datumNew = flipMaybe key <$> myReplaceUnique key datumNew

-- | Identical to 'Database.Persist.Class', except for the better type signature (original requires Eq  record which is not needed anyway)
myReplaceUnique :: ( MonadIO m
                   , Eq (Unique record)
                   , PersistRecordBackend record backend
                   , PersistUniqueWrite backend
                   )
                => Key record -> record -> ReaderT backend m (Maybe (Unique record))
myReplaceUnique key datumNew = getJust key >>= replaceOriginal
  where
    uniqueKeysNew = persistUniqueKeys datumNew
    replaceOriginal original = do
        conflict <- checkUniqueKeys changedKeys
        case conflict of
            Nothing -> replace key datumNew >> return Nothing
            (Just conflictingKey) -> return $ Just conflictingKey
      where
        changedKeys = uniqueKeysNew List.\\ uniqueKeysOriginal
        uniqueKeysOriginal = persistUniqueKeys original

checkUniqueKeys :: ( MonadIO m
                   , PersistEntity record
                   , PersistUniqueRead backend
                   , PersistRecordBackend record backend
                   )
                => [Unique record] -> ReaderT backend m (Maybe (Unique record))
checkUniqueKeys [] = return Nothing
checkUniqueKeys (x:xs) = do
    y <- getBy x
    case y of
        Nothing -> checkUniqueKeys xs
        Just _ -> return (Just x)