aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorFélix Sipma <felix.sipma@no-log.org>2016-09-01 17:04:56 +0200
committerFélix Sipma <felix.sipma@no-log.org>2016-09-01 17:06:40 +0200
commit36e363ef6a88103e9c954f96b4e009981fcede6d (patch)
tree321cf142effddec5516c209bc96670d36d6e81a1
parenta5e75772d02d6d1c44f511680fc1118b58ed3ea7 (diff)
Parse: use parseRequest instead of parseUrl (http-conduit >= 0.4.30)
-rw-r--r--perfeed.cabal2
-rw-r--r--src/Parse.hs13
2 files changed, 8 insertions, 7 deletions
diff --git a/perfeed.cabal b/perfeed.cabal
index 78ed228..88190c5 100644
--- a/perfeed.cabal
+++ b/perfeed.cabal
@@ -40,7 +40,7 @@ library
, time >= 1.5
, conduit
, xml-conduit >= 1.3.0
- , http-conduit
+ , http-conduit >= 0.4.30
, lucid
, blaze-markup
, pandoc >= 1.14
diff --git a/src/Parse.hs b/src/Parse.hs
index 752a4bd..9efcdb1 100644
--- a/src/Parse.hs
+++ b/src/Parse.hs
@@ -15,11 +15,11 @@ import Prelude hiding ( readFile )
import Control.Monad.IO.Class ( MonadIO, liftIO )
import Text.XML
import Text.XML.Cursor
-import Network.HTTP.Conduit ( parseUrl, httpLbs, Manager
+import Network.HTTP.Conduit ( parseRequest, httpLbs, Manager
, HttpException, responseBody )
import qualified Data.Text as T
import Control.Monad.Logger ( MonadLogger, logError )
-import qualified Control.Exception as E
+import Control.Exception ( try )
import Types
import Filter
@@ -35,15 +35,15 @@ cursorFromFile file = do
cursorFromUrl :: (MonadIO m, MonadLogger m) => Manager -> Url -> [FeedFilter] -> m (Maybe Cursor)
cursorFromUrl manager u filters = do
let (cursorfilters, externalfilters) = partitionFilters filters
- request <- liftIO $ parseUrl $ T.unpack u
- eresponse <- liftIO $
- (Right <$> httpLbs request manager) `E.catch` \(ex :: HttpException) -> return $ Left ex
+ request <- liftIO $ parseRequest $ T.unpack u
+ eresponse <- liftIO $ try (httpLbs request manager)
case eresponse of
Right res -> do
mbody <- applyExternalFilters externalfilters (responseBody res)
maybe eFilterError (eFilterSuccess cursorfilters) mbody
- Left e -> do
+ Left (e :: HttpException) -> do
$logError $ formatHttpError u (T.pack (show e))
+ -- ^ TODO: store failed feed and do not log again if failing again
return Nothing
where
eFilterError = do
@@ -66,6 +66,7 @@ formatParseXmlError url exception = "cannot get an XML structure from page \"" `
formatHttpError :: T.Text -> T.Text -> T.Text
formatHttpError url exception = "HTTP error while fetching \"" `T.append` url `T.append` "\": " `T.append` exception
+-- ^ TODO: improve formatting (use getResponseStatusCode, ...)
formatContentEmptyError :: T.Text -> T.Text -> T.Text
formatContentEmptyError id' title = "empty content for entry \"" `T.append` title `T.append` "\" (" `T.append` id' `T.append` ")"