packages feed

DAV 1.1 → 1.2

raw patch · 2 files changed

+19/−30 lines, 2 filesdep ~http-client

Dependency ranges changed: http-client

Files

DAV.cabal view
@@ -1,5 +1,5 @@ name:                DAV-version:             1.1+version:             1.2 synopsis:            RFC 4918 WebDAV support description:    This is a library for the Web Distributed Authoring and Versioning@@ -35,7 +35,7 @@                      , containers                      , data-default                      , exceptions >= 0.7-                     , http-client >= 0.2+                     , http-client >= 0.4                      , http-client-tls >= 0.2                      , http-types >= 0.7                      , lens >= 3.0@@ -57,7 +57,7 @@                      , containers                      , data-default                      , exceptions >= 0.7-                     , http-client >= 0.2+                     , http-client >= 0.4                      , http-client-tls >= 0.2                      , http-types >= 0.7                      , lens >= 3.0@@ -83,4 +83,4 @@ source-repository this   type:     git   location: git://anonscm.debian.org/users/clint/DAV.git-  tag:      DAV/1.1+  tag:      DAV/1.2
Network/Protocol/HTTP/DAV.hs view
@@ -53,13 +53,13 @@ import Network.Protocol.HTTP.DAV.TH  import Control.Applicative (liftA2, Alternative, Applicative)-import Control.Monad.Trans.Except (ExceptT(..), throwE)+import Control.Monad.Trans.Except (ExceptT(..), throwE, runExceptT) import Control.Lens ((^.), (.=), (%=), (.~)) import Control.Monad (when, MonadPlus) import Control.Monad.Base (MonadBase(..))-import Control.Monad.Catch (bracket, bracketOnError, catchJust, finally, throwM, mask, uninterruptibleMask, MonadCatch, MonadMask, MonadThrow)+import Control.Monad.Catch (bracket, bracketOnError, catchJust, finally, throwM, mask, uninterruptibleMask, MonadCatch, MonadThrow) import qualified Control.Monad.Catch as MonadCatch-import Control.Monad.Except (MonadError)+import Control.Monad.Except (MonadError, catchError, throwError) import Control.Monad.Fix (MonadFix) import Control.Monad.Trans.Class (lift, MonadTrans) import Control.Monad.IO.Class (liftIO, MonadIO)@@ -74,7 +74,7 @@  import Data.Maybe (catMaybes, fromMaybe) -import Network.HTTP.Client (RequestBody(..), httpLbs, parseUrl, applyBasicAuth, Request(..), Response(..), newManager, closeManager, HttpException(..), BodyReader, withResponse, path)+import Network.HTTP.Client (RequestBody(..), httpLbs, parseUrl, applyBasicAuth, Request(..), Response(..), newManager, HttpException(..), BodyReader, withResponse, path) import Network.HTTP.Client.TLS (tlsManagerSettings) import Network.HTTP.Types (hContentType, Method, Status, RequestHeaders, unauthorized401, conflict409) @@ -90,22 +90,9 @@ newtype DAVT m a = DAVT { runDAVT :: ExceptT String (StateT DAVContext m) a }     deriving (Alternative, Applicative, Functor, Monad, MonadBase b, MonadError String, MonadFix, MonadIO, MonadPlus, MonadState DAVContext) --- this orphan instance is probably a bad idea-instance MonadMask m => MonadMask (ExceptT e m) where-    mask a = ExceptT $ mask $ \u -> runExceptT (a $ q u)-        where q u = ExceptT . u . runExceptT-    uninterruptibleMask a = ExceptT $ uninterruptibleMask $ \u -> runExceptT (a $ q u)-        where q u = ExceptT . u . runExceptT- instance MonadCatch m => MonadCatch (DAVT m) where     catch (DAVT m) f = DAVT $ MonadCatch.catch m (runDAVT . f) -instance MonadMask m => MonadMask (DAVT m) where-    mask a = DAVT $ mask $ \u -> runDAVT (a $ q u)-        where q u = DAVT . u . runDAVT-    uninterruptibleMask a = DAVT $ uninterruptibleMask $ \u -> runDAVT (a $ q u)-        where q u = DAVT . u . runDAVT- instance MonadThrow m => MonadThrow (DAVT m) where     throwM = lift . throwM @@ -127,11 +114,12 @@     req <- liftIO $ parseUrl u     return $ def { _baseRequest = req, _httpManager = Just mgr } +{-# DEPRECATED closeDAVContext "deprecated because http-client deprecated closeManager" #-} closeDAVContext :: MonadIO m => DAVContext -> m ()-closeDAVContext ctx = liftIO $ maybe (return ()) closeManager (ctx ^. httpManager)+closeDAVContext _ = return () -withDAVContext :: (MonadIO m, MonadMask m) => DAVURL -> (DAVContext -> m a) -> m a-withDAVContext u = bracket (mkDAVContext u) closeDAVContext+withDAVContext :: MonadIO m => DAVURL -> (DAVContext -> m a) -> m a+withDAVContext u f = mkDAVContext u >>= f  runDAVContext :: MonadIO m => DAVContext -> DAVT m a -> m (Either String a, DAVContext) runDAVContext ctx f = (runStateT . runExceptT . runDAVT) f ctx@@ -307,21 +295,22 @@ getOptionsOnce :: MonadIO m => DAVT m () getOptionsOnce = getOptions -- this should only happen once -withLockIfPossible :: (MonadIO m, MonadBase IO m, MonadCatch m, MonadMask m) => Bool -> DAVT m a -> DAVT m a+withLockIfPossible :: (MonadIO m, MonadBase IO m) => Bool -> DAVT m a -> DAVT m a withLockIfPossible nocreate f = do     getOptionsOnce     o <- get     when (supportsLocking o) (lockResource nocreate)-    f `finally` when (supportsLocking o) unlockResource+    res <- f+    when (supportsLocking o) unlockResource+    return res -withLockIfPossibleForDelete :: (MonadIO m, MonadBase IO m, MonadCatch m, MonadMask m) => Bool -> DAVT m a -> DAVT m a+withLockIfPossibleForDelete :: (MonadIO m, MonadBase IO m) => Bool -> DAVT m a -> DAVT m a withLockIfPossibleForDelete nocreate f = do     getOptionsOnce     o <- get-    let lock = when (supportsLocking o) (lockResource nocreate)+    when (supportsLocking o) (lockResource nocreate)     -- a successful delete destroys locks, so only unlock on error-    let unlock = when (supportsLocking o) unlockResource-    bracketOnError lock (const unlock) (const f)+    catchError f (\e -> when (supportsLocking o) unlockResource >> throwError e)  propname :: XML.Document propname = XML.Document (XML.Prologue [] Nothing []) root []