fraport/fradrive-old
fraport/fradrive-old
Archived
3
1
Fork 0
Code Issues 65 Pull Requests 5 Actions Packages Projects Releases 197 Wiki Activity

Versionbump: Removed redundant constraints, added missing constraints.

Browse Source
This commit is contained in:
Stephan Barth 2024-02-15 05:17:51 +01:00
parent 98626ecb4e
commit 38aaed87db
2 changed files with 4 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
src/Utils/DB.hs
View File

@ -99,7 +99,7 @@ updateGetEntity k = fmap (Entity k) . updateGet k
-- | insert or replace a record based on a single uniqueness constraint -- | insert or replace a record based on a single uniqueness constraint
-- this function was meant to be supplied with the uniqueness constraint, but it would be unsafe if the uniqueness constraint would not match the supplied record -- this function was meant to be supplied with the uniqueness constraint, but it would be unsafe if the uniqueness constraint would not match the supplied record
replaceBy :: (PersistUniqueWrite backend, MonadIO m, OnlyOneUniqueKey record, PersistEntityBackend record ~ BaseBackend backend) replaceBy :: (SafeToInsert record, PersistUniqueWrite backend, MonadIO m, OnlyOneUniqueKey record, PersistEntityBackend record ~ BaseBackend backend)
=> record -> ReaderT backend m () => record -> ReaderT backend m ()
replaceBy r = do replaceBy r = do
u <- onlyUnique r u <- onlyUnique r
@ -158,6 +158,7 @@ checkUniqueKeys (x:xs) = do
put :: ( MonadIO m put :: ( MonadIO m
, PersistUniqueWrite backend , PersistUniqueWrite backend
, PersistRecordBackend record backend , PersistRecordBackend record backend
, SafeToInsert record
) )
=> record -> ReaderT backend m (Key record) => record -> ReaderT backend m (Key record)
-- ^ `insert`, but remove all records with matching uniqueness constraints first -- ^ `insert`, but remove all records with matching uniqueness constraints first

4
src/Yesod/Core/Instances.hs
View File

@ -55,7 +55,7 @@ routeToPathPiece
. renderRoute . renderRoute
instance (RenderRoute site, ParseRoute site) => PathPiece (Route site) where instance ParseRoute site => PathPiece (Route site) where
fromPathPiece = routeFromPathPiece fromPathPiece = routeFromPathPiece
toPathPiece = routeToPathPiece toPathPiece = routeToPathPiece
@ -71,7 +71,7 @@ instance ParseRoute site => FromJSONKey (Route site) where
instance RenderRoute site => ToJSONKey (Route site) where instance RenderRoute site => ToJSONKey (Route site) where
toJSONKey = toJSONKeyText routeToPathPiece toJSONKey = toJSONKeyText routeToPathPiece
instance (RenderRoute site, ParseRoute site) => Binary (Route site) where instance ParseRoute site => Binary (Route site) where
put = Binary.put . toPathPiece put = Binary.put . toPathPiece
get = Binary.get >>= maybe (fail "Could not parse route") return . fromPathPiece get = Binary.get >>= maybe (fail "Could not parse route") return . fromPathPiece