module EZCouch.Isolation where
import Prelude ()
import ClassyPrelude hiding (delete)
import qualified Data.Time as Time
import EZCouch.Time
import EZCouch.Types
import EZCouch.Action hiding (logM)
import EZCouch.ReadAction
import EZCouch.WriteAction
import EZCouch.Model.Isolation as Isolation
import qualified Util.Logging as Logging
logM lvl = Logging.logM lvl "EZCouch.Isolation"
inIsolation :: MonadAction m
=> Int
-> Text
-> m a
-> m (Maybe a)
inIsolation timeout id action = do
time <- readTime
result <- (try $ createWithId id' $ Isolation time)
case result of
Left (OperationException _) -> do
isolation <- readOne $ readOptions { readOptionsKeys = Just [id'] }
case isolation of
Just isolation -> do
if (Isolation.since . persistedValue) isolation < Time.addUTCTime (negate $ fromIntegral timeout) time
then do
logM 0 $ "Deleting outdated isolation: " ++ id'
tryToDelete isolation
inIsolation timeout id action
else do
logM 0 $ "Skipping a busy isolation: " ++ id'
return Nothing
Nothing -> do
logM 0 $ "Skipping a finished isolation: " ++ id'
return Nothing
Left e -> throwIO e
Right isolation -> do
logM 0 $ "Performing an isolation: " ++ id'
finally (Just <$> action) (delete isolation)
where
id' = "EZCouchIsolation-" ++ id
tryToDelete doc = (const True <$> delete doc) `catch` \e -> case e of
OperationException _ -> return False
_ -> throwIO e