aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorFélix Sipma <felix.sipma@no-log.org>2019-08-07 19:48:09 +0200
committerFélix Sipma <felix.sipma@no-log.org>2019-08-07 19:48:09 +0200
commit70d26e78d8a5e2d62d982a8c0a797c6e4535956d (patch)
tree8f65d8a991dc666a0e4ce81dbdd7a1b01f6d89be
parent966a1a5a6dfe1a0d6c08fb532d5ab591a25e1a0d (diff)
try to catch Filter buffers closing errors
-rw-r--r--src/Filter.hs12
1 files changed, 8 insertions, 4 deletions
diff --git a/src/Filter.hs b/src/Filter.hs
index ad31f65..9284c11 100644
--- a/src/Filter.hs
+++ b/src/Filter.hs
@@ -37,7 +37,7 @@ getCursorFilter s = fail $ "Invalid filter \"" <> toS s <> "\""
data FeedFilter
= CursorFilter Text (Cursor -> Cursor)
- | ExternalFilter FilePath [[Char]]
+ | ExternalFilter FilePath [String]
instance FromJSON FeedFilter where
parseJSON (Object o) =
@@ -45,7 +45,7 @@ instance FromJSON FeedFilter where
<|> parseExternalFilter <$> o .: "external"
parseJSON _ = mzero
-parseExternalFilter :: [Char] -> FeedFilter
+parseExternalFilter :: String -> FeedFilter
parseExternalFilter s = case words s of
[] -> ExternalFilter "" []
(c : opts) -> ExternalFilter (c :: FilePath) opts
@@ -93,7 +93,7 @@ applyExternalFilters fs lbs = foldM (\ms f -> maybe (return Nothing) (applyExter
applyExternalFilter (ExternalFilter fp opts) lbs' = applyExternalFilter' fp opts lbs'
applyExternalFilter (CursorFilter _ _) lbs' = return $ Just lbs'
-applyExternalFilter' :: (MonadIO m, MonadLogger m, MonadFail m) => FilePath -> [[Char]] -> LBS.ByteString -> m (Maybe LBS.ByteString)
+applyExternalFilter' :: (MonadIO m, MonadLogger m, MonadFail m) => FilePath -> [String] -> LBS.ByteString -> m (Maybe LBS.ByteString)
applyExternalFilter' fp opts lbs = do
(Just hin, mHOut, mHErr, phandle) <- liftIO $ createProcess (proc fp opts)
{ std_in = CreatePipe
@@ -107,7 +107,11 @@ applyExternalFilter' fp opts lbs = do
case eresult of
Right _ -> return ()
Left ex -> $logError $ "external filter \"" <> toS fp <> toS (unwords opts) <> "\" failed: " <> show ex
- liftIO $ hClose hin
+ ecloseresult <- liftIO $
+ (Right <$> hClose hin) `E.catch` \(ex :: E.SomeException) -> return $ Left ex
+ case ecloseresult of
+ Right _ -> return ()
+ Left ex -> $logError $ "perfeed error: " <> show ex
case (mHOut, mHErr) of
(Nothing, Nothing) -> return ()
(Just hOut, Just hErr) -> do