Compare commits
No commits in common. "5182c47a196dc82e69eec3544b23a743fddb240a" and "03860c370ae1dd5f963910fe8f70577e6f6e6982" have entirely different histories.
5182c47a19
...
03860c370a
@ -29,7 +29,6 @@ import qualified Data.ByteString.Lazy.Char8 as LBC
|
|||||||
import System.IO.Unsafe (unsafeInterleaveIO)
|
import System.IO.Unsafe (unsafeInterleaveIO)
|
||||||
import Control.Parallel.Strategies (rseq, parMap)
|
import Control.Parallel.Strategies (rseq, parMap)
|
||||||
import qualified Data.List as L
|
import qualified Data.List as L
|
||||||
import Control.Monad (unless)
|
|
||||||
|
|
||||||
combine :: (MonadUnliftIO m, 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
|
||||||
@ -47,8 +46,7 @@ run = do
|
|||||||
let datFile = datDir </> ".addressbook.dat"
|
let datFile = datDir </> ".addressbook.dat"
|
||||||
original <- Set.fromList . map LBS.toStrict . lbsLines <$> LBS.readFile datFile
|
original <- Set.fromList . map LBS.toStrict . lbsLines <$> LBS.readFile datFile
|
||||||
xs <- LBS.getContents >>= stream
|
xs <- LBS.getContents >>= stream
|
||||||
let set = original `Set.union` F.fold (parMap rseq F.fold (chunks 200 xs))
|
let set = original `Set.union` F.fold (parMap rseq F.fold (chunks 20 xs))
|
||||||
unless (original == set) $
|
|
||||||
runResourceT $
|
runResourceT $
|
||||||
runConduit $
|
runConduit $
|
||||||
CL.sourceList (Set.elems set)
|
CL.sourceList (Set.elems set)
|
||||||
|
@ -1,5 +1,4 @@
|
|||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
{-# LANGUAGE ApplicativeDo #-}
|
|
||||||
module Data.Email.Header where
|
module Data.Email.Header where
|
||||||
|
|
||||||
import qualified Data.Foldable as F
|
import qualified Data.Foldable as F
|
||||||
@ -22,39 +21,28 @@ data Header
|
|||||||
|
|
||||||
decode :: ByteString -> Either String Header
|
decode :: ByteString -> Either String Header
|
||||||
decode = parseOnly parseHeader
|
decode = parseOnly parseHeader
|
||||||
{-# INLINE decode #-}
|
where
|
||||||
|
|
||||||
parseHeader :: Parser Header
|
parseHeader :: Parser Header
|
||||||
parseHeader = parseFrom <|> parseTo
|
parseHeader = parseFrom <|> parseTo
|
||||||
{-# INLINE parseHeader #-}
|
|
||||||
|
|
||||||
parseFrom :: Parser Header
|
parseFrom :: Parser Header
|
||||||
parseFrom = From <$> (string "From:" *> emptySpace *> (bracketEmail <|> email))
|
parseFrom = From <$> (string "From:" *> emptySpace *> (bracketEmail <|> email))
|
||||||
|
|
||||||
parseTo :: Parser Header
|
parseTo :: Parser Header
|
||||||
parseTo = To <$> (string "To:" *> emptySpace *> emails)
|
parseTo = To <$> (string "To:" *> emptySpace *> emails)
|
||||||
|
emptySpace = many' space
|
||||||
emptySpace :: Parser ()
|
|
||||||
emptySpace = () <$ many' space
|
|
||||||
|
|
||||||
emails :: Parser (Vector ByteString)
|
emails :: Parser (Vector ByteString)
|
||||||
emails = V.fromList <$> (bracketEmail <|> email) `sepBy` char ','
|
emails = V.fromList <$> (bracketEmail <|> email) `sepBy` char ','
|
||||||
|
|
||||||
bracketEmail :: Parser ByteString
|
bracketEmail :: Parser ByteString
|
||||||
bracketEmail = do
|
bracketEmail = do
|
||||||
_ <- manyTill anyChar (char '<')
|
_ <- manyTill anyChar (char '<')
|
||||||
email
|
email
|
||||||
{-# INLINE bracketEmail #-}
|
|
||||||
|
|
||||||
email :: Parser ByteString
|
email :: Parser ByteString
|
||||||
email = do
|
email = do
|
||||||
_ <- many' space
|
_ <- many' space
|
||||||
name <- BC.pack <$> many' (satisfy (\c -> not (isSpace c) && c /= '@'))
|
name <- BC.pack <$> many' (satisfy (\c -> not (isSpace c) && c /= '@'))
|
||||||
_ <- char '@'
|
_ <- char '@'
|
||||||
rest <- BC.pack <$> many' (satisfy (\c -> not (isSpace c) && c /= ',' && c /= '>' && c /= '<'))
|
rest <- BC.pack <$> many' (satisfy (\c -> not (isSpace c) && c /= ',' && c /= '>'))
|
||||||
_ <- many' (notChar ',')
|
_ <- many' (notChar ',')
|
||||||
pure (name <> "@" <> rest)
|
pure (name <> "@" <> rest)
|
||||||
{-# INLINE email #-}
|
|
||||||
|
|
||||||
|
|
||||||
encode :: Header -> ByteString
|
encode :: Header -> ByteString
|
||||||
|
@ -31,7 +31,4 @@ tests = testGroup "Data.Email"
|
|||||||
[ testCase "Can parse a sample email" $ do
|
[ testCase "Can parse a sample email" $ do
|
||||||
got <- parseToList sample
|
got <- parseToList sample
|
||||||
got @?= [ From "me@example.com", To ["you@example.com"]]
|
got @?= [ From "me@example.com", To ["you@example.com"]]
|
||||||
, testCase "Combined mailto" $ do
|
|
||||||
let got = decode "To: James Doe<james.doe@example.com<mailto:james.doe@example.com>>"
|
|
||||||
got @?= Right (To ["james.doe@example.com"])
|
|
||||||
]
|
]
|
||||||
|
Loading…
Reference in New Issue
Block a user