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

refactor: hlint

Browse Source
This commit is contained in:
Gregor Kleen 2021-03-23 15:52:28 +01:00
parent c23222aef6
commit 3ff97aca77
1 changed files with 3 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
src/Utils/DB.hs
View File

@ -188,7 +188,7 @@ class WithRunDB backend m' m | m -> backend m' where
instance WithRunDB backend m (ReaderT backend m) where instance WithRunDB backend m (ReaderT backend m) where
useRunDB = id useRunDB = id
data DBRunner' backend m = DBRunner' { runDBRunner' :: forall b. ReaderT backend m b -> m b } newtype DBRunner' backend m = DBRunner' { runDBRunner' :: forall b. ReaderT backend m b -> m b }
_DBRunner' :: Iso' (DBRunner site) (DBRunner' (YesodPersistBackend site) (HandlerFor site)) _DBRunner' :: Iso' (DBRunner site) (DBRunner' (YesodPersistBackend site) (HandlerFor site))
_DBRunner' = iso fromDBRunner' toDBRunner _DBRunner' = iso fromDBRunner' toDBRunner
@ -210,7 +210,7 @@ newtype CachedDBRunner backend m a = CachedDBRunner { runCachedDBRunnerUsing ::
deriving (Functor, Applicative, Monad, MonadFix, MonadFail, Contravariant, MonadIO, Alternative, MonadPlus, MonadUnliftIO, MonadResource, MonadLogger, MonadThrow, MonadCatch, MonadMask) via (ReaderT (m (DBRunner' backend m)) m) deriving (Functor, Applicative, Monad, MonadFix, MonadFail, Contravariant, MonadIO, Alternative, MonadPlus, MonadUnliftIO, MonadResource, MonadLogger, MonadThrow, MonadCatch, MonadMask) via (ReaderT (m (DBRunner' backend m)) m)
instance MonadTrans (CachedDBRunner backend) where instance MonadTrans (CachedDBRunner backend) where
lift act = CachedDBRunner (\_ -> act) lift act = CachedDBRunner (const act)
instance MonadHandler m => MonadHandler (CachedDBRunner backend m) where instance MonadHandler m => MonadHandler (CachedDBRunner backend m) where
type HandlerSite (CachedDBRunner backend m) = HandlerSite m type HandlerSite (CachedDBRunner backend m) = HandlerSite m
@ -238,10 +238,6 @@ runCachedDBRunnerSTM doAcquire act = do
runner <- doAcquire runner <- doAcquire
void . atomically $ tryPutTMVar runnerTMVar runner void . atomically $ tryPutTMVar runnerTMVar runner
return runner return runner
getRunnerNoLock = do getRunnerNoLock = maybe getRunner return =<< atomically (tryReadTMVar runnerTMVar)
cachedRunner <- atomically $ tryReadTMVar runnerTMVar
case cachedRunner of
Just cachedRunner' -> return cachedRunner'
Nothing -> getRunner
runCachedDBRunnerUsing act getRunnerNoLock runCachedDBRunnerUsing act getRunnerNoLock