MasseR/addressbook
1
0
Fork 0
Code Issues 1 Pull Requests Releases Wiki Activity

Catch exceptions

Browse Source
This commit is contained in:
Mats Rauhala
2020-12-10 23:13:23 +02:00
parent 55ddbd55e2
commit c9cf4c1d59
2 changed files with 6 additions and 4 deletions
Download Patch File Download Diff File Expand all files Collapse all files

3
src/Control/Addressbook/Streaming.hs
View File

@@ -5,7 +5,6 @@ import qualified Data.Text as T
import Conduit
import qualified Data.Conduit.Binary as CB
import qualified Data.Conduit.Combinators as C
import qualified Data.Conduit.List as CL
import qualified Data.Conduit.Text as CT
import Data.Email
@@ -15,7 +14,7 @@ import Data.Email.Header
import System.IO
(stdin)
combine :: (MonadResource m, MonadThrow m, MonadIO m) => ConduitM FilePath Header m ()
combine :: (MonadUnliftIO m, MonadResource m, MonadThrow m, MonadIO m) => ConduitM FilePath Header m ()
combine = await >>= \case
Nothing -> pure ()
Just path -> (CB.sourceFile path .| parseEmail) >> combine

7
src/Data/Email.hs
View File

@@ -1,3 +1,4 @@
{-# LANGUAGE TypeApplications #-}
module Data.Email where
import Data.Email.Header
@@ -9,5 +10,7 @@ import qualified Data.Conduit.Text as CT
import Data.ByteString
(ByteString)
parseEmail :: (MonadThrow m, Monad m) => ConduitM ByteString Header m ()
parseEmail = CT.decode CT.utf8 .| CT.lines .| C.concatMap decode
parseEmail :: (MonadUnliftIO m, MonadThrow m, Monad m) => ConduitM ByteString Header m ()
parseEmail = catchC (CT.decode CT.utf8) err .| CT.lines .| C.concatMap decode
where
err e = liftIO (print @CT.TextException e) >> yield ""