deal with http-conduit changing a data type

Pity that the library does not provide a function to extract the status
code from the StatusCodeException, so when they had to add a new field, it
breaks every single place that does it.
This commit is contained in:
Joey Hess 2013-02-27 00:07:28 -04:00
parent 3a210490b7
commit b117efc19b
3 changed files with 20 additions and 5 deletions

View file

@ -6,7 +6,7 @@ BASEFLAGS=-Wall -outputdir $(GIT_ANNEX_TMP_BUILD_DIR) -IUtility
# you can turn off some of these features. # you can turn off some of these features.
# #
# If you're using an old version of yesod, enable -DWITH_OLD_YESOD # If you're using an old version of yesod, enable -DWITH_OLD_YESOD
FEATURES?=$(GIT_ANNEX_LOCAL_FEATURES) -DWITH_ASSISTANT -DWITH_S3 -DWITH_WEBDAV -DWITH_WEBAPP -DWITH_PAIRING -DWITH_XMPP -DWITH_DNS FEATURES?=$(GIT_ANNEX_LOCAL_FEATURES) -DWITH_ASSISTANT -DWITH_S3 -DWITH_WEBDAV -DWITH_WEBAPP -DWITH_PAIRING -DWITH_XMPP -DWITH_DNS -DWITH_OLD_HTTP_CONDUIT
bins=git-annex bins=git-annex
mans=git-annex.1 git-annex-shell.1 mans=git-annex.1 git-annex-shell.1

View file

@ -5,7 +5,13 @@
- Licensed under the GNU GPL version 3 or higher. - Licensed under the GNU GPL version 3 or higher.
-} -}
{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ScopedTypeVariables, CPP #-}
#if defined VERSION_http_conduit
#if ! MIN_VERSION_http_conduit(1,9,0)
#define WITH_OLD_HTTP_CONDUIT
#endif
#endif
module Remote.WebDAV (remote, davCreds, setCredsEnv) where module Remote.WebDAV (remote, davCreds, setCredsEnv) where
@ -228,7 +234,11 @@ davUrlExists :: DavUrl -> DavUser -> DavPass -> IO (Either String Bool)
davUrlExists url user pass = decode <$> catchHttp (getProps url user pass) davUrlExists url user pass = decode <$> catchHttp (getProps url user pass)
where where
decode (Right _) = Right True decode (Right _) = Right True
#ifdef WITH_OLD_HTTP_CONDUIT
decode (Left (Left (StatusCodeException status _))) decode (Left (Left (StatusCodeException status _)))
#else
decode (Left (Left (StatusCodeException status _ _)))
#endif
| statusCode status == statusCode notFound404 = Right False | statusCode status == statusCode notFound404 = Right False
decode (Left e) = Left $ showEitherException e decode (Left e) = Left $ showEitherException e
@ -275,7 +285,12 @@ catchHttp a = (Right <$> a) `E.catches`
type EitherException = Either HttpException E.IOException type EitherException = Either HttpException E.IOException
showEitherException :: EitherException -> String showEitherException :: EitherException -> String
showEitherException (Left (StatusCodeException status _)) = show $ statusMessage status #ifdef WITH_OLD_HTTP_CONDUIT
showEitherException (Left (StatusCodeException status _)) =
#else
showEitherException (Left (StatusCodeException status _ _)) =
#endif
show $ statusMessage status
showEitherException (Left httpexception) = show httpexception showEitherException (Left httpexception) = show httpexception
showEitherException (Right ioexception) = show ioexception showEitherException (Right ioexception) = show ioexception

4
debian/rules vendored
View file

@ -1,9 +1,9 @@
#!/usr/bin/make -f #!/usr/bin/make -f
ifeq (install ok installed,$(shell dpkg-query -W -f '$${Status}' libghc-yesod-dev 2>/dev/null)) ifeq (install ok installed,$(shell dpkg-query -W -f '$${Status}' libghc-yesod-dev 2>/dev/null))
export FEATURES=-DWITH_ASSISTANT -DWITH_S3 -DWITH_HOST -DWITH_PAIRING -DWITH_XMPP -DWITH_WEBAPP -DWITH_OLD_YESOD export FEATURES=-DWITH_ASSISTANT -DWITH_S3 -DWITH_HOST -DWITH_PAIRING -DWITH_XMPP -DWITH_OLD_HTTP_CONDUIT -DWITH_WEBAPP -DWITH_OLD_YESOD
else else
export FEATURES=-DWITH_ASSISTANT -DWITH_S3 -DWITH_HOST -DWITH_PAIRING -DWITH_XMPP export FEATURES=-DWITH_ASSISTANT -DWITH_S3 -DWITH_HOST -DWITH_PAIRING -DWITH_XMPP -DWITH_OLD_HTTP_CONDUIT
endif endif
ifeq (install ok installed,$(shell dpkg-query -W -f '$${Status}' libghc-dav-dev 2>/dev/null)) ifeq (install ok installed,$(shell dpkg-query -W -f '$${Status}' libghc-dav-dev 2>/dev/null))
export FEATURES:=${FEATURES} -DWITH_WEBDAV export FEATURES:=${FEATURES} -DWITH_WEBDAV