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
Show Stats 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 Conduit
import qualified Data.Conduit.Binary as CB import qualified Data.Conduit.Binary as CB
import qualified Data.Conduit.Combinators as C import qualified Data.Conduit.Combinators as C
import qualified Data.Conduit.List as CL
import qualified Data.Conduit.Text as CT import qualified Data.Conduit.Text as CT
import Data.Email import Data.Email
@ -15,7 +14,7 @@ import Data.Email.Header
import System.IO import System.IO
(stdin) (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 combine = await >>= \case
Nothing -> pure () Nothing -> pure ()
Just path -> (CB.sourceFile path .| parseEmail) >> combine Just path -> (CB.sourceFile path .| parseEmail) >> combine

7
src/Data/Email.hs
View File

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