fraport/fradrive
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Fix haddock

Browse Source
This commit is contained in:
Gregor Kleen 2019-05-04 17:20:53 +02:00
parent f4b93644a8
commit c0b2991c16
1 changed files with 26 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

50
src/Utils/DB.hs
View File

@ -20,8 +20,8 @@ flipMaybe _ (Just _) = Nothing
emptyOrIn :: PersistField typ =>
E.SqlExpr (E.Value typ) -> Set typ -> E.SqlExpr (E.Value Bool)
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)
@ -30,42 +30,44 @@ entities2map :: PersistEntity record => [Entity record] -> Map (Key record) reco
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))
=> 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)
=> 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
=> 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
=> 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 ()
=> 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 :: ( 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
myReplaceUnique -- | Identical to 'Database.Persist.Class', except for the better type signature (original requires Eq record which is not needed anyway)
:: (MonadIO m
,Eq (Unique record)
,PersistRecordBackend record backend
,PersistUniqueWrite backend)
=> Key record -> record -> ReaderT backend m (Maybe (Unique record))
-- | 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
@ -78,12 +80,12 @@ myReplaceUnique key datumNew = getJust key >>= replaceOriginal
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 :: ( 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