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 Control.Parallel.Strategies (rseq, parMap)
|
||||
import qualified Data.List as L
|
||||
import Control.Monad (unless)
|
||||
|
||||
combine :: (MonadUnliftIO m, MonadResource m, MonadThrow m, MonadIO m) => ConduitM FilePath Header m ()
|
||||
combine = await >>= \case
|
||||
@ -47,8 +46,7 @@ run = do
|
||||
let datFile = datDir </> ".addressbook.dat"
|
||||
original <- Set.fromList . map LBS.toStrict . lbsLines <$> LBS.readFile datFile
|
||||
xs <- LBS.getContents >>= stream
|
||||
let set = original `Set.union` F.fold (parMap rseq F.fold (chunks 200 xs))
|
||||
unless (original == set) $
|
||||
let set = original `Set.union` F.fold (parMap rseq F.fold (chunks 20 xs))
|
||||
runResourceT $
|
||||
runConduit $
|
||||
CL.sourceList (Set.elems set)
|
||||
|
@ -1,5 +1,4 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE ApplicativeDo #-}
|
||||
module Data.Email.Header where
|
||||
|
||||
import qualified Data.Foldable as F
|
||||
@ -22,39 +21,28 @@ data Header
|
||||
|
||||
decode :: ByteString -> Either String Header
|
||||
decode = parseOnly parseHeader
|
||||
{-# INLINE decode #-}
|
||||
|
||||
parseHeader :: Parser Header
|
||||
parseHeader = parseFrom <|> parseTo
|
||||
{-# INLINE parseHeader #-}
|
||||
|
||||
parseFrom :: Parser Header
|
||||
parseFrom = From <$> (string "From:" *> emptySpace *> (bracketEmail <|> email))
|
||||
|
||||
parseTo :: Parser Header
|
||||
parseTo = To <$> (string "To:" *> emptySpace *> emails)
|
||||
|
||||
emptySpace :: Parser ()
|
||||
emptySpace = () <$ many' space
|
||||
|
||||
emails :: Parser (Vector ByteString)
|
||||
emails = V.fromList <$> (bracketEmail <|> email) `sepBy` char ','
|
||||
|
||||
bracketEmail :: Parser ByteString
|
||||
bracketEmail = do
|
||||
where
|
||||
parseHeader :: Parser Header
|
||||
parseHeader = parseFrom <|> parseTo
|
||||
parseFrom :: Parser Header
|
||||
parseFrom = From <$> (string "From:" *> emptySpace *> (bracketEmail <|> email))
|
||||
parseTo :: Parser Header
|
||||
parseTo = To <$> (string "To:" *> emptySpace *> emails)
|
||||
emptySpace = many' space
|
||||
emails :: Parser (Vector ByteString)
|
||||
emails = V.fromList <$> (bracketEmail <|> email) `sepBy` char ','
|
||||
bracketEmail :: Parser ByteString
|
||||
bracketEmail = do
|
||||
_ <- manyTill anyChar (char '<')
|
||||
email
|
||||
{-# INLINE bracketEmail #-}
|
||||
|
||||
email :: Parser ByteString
|
||||
email = do
|
||||
email :: Parser ByteString
|
||||
email = do
|
||||
_ <- many' space
|
||||
name <- BC.pack <$> many' (satisfy (\c -> not (isSpace c) && c /= '@'))
|
||||
_ <- 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 ',')
|
||||
pure (name <> "@" <> rest)
|
||||
{-# INLINE email #-}
|
||||
|
||||
|
||||
encode :: Header -> ByteString
|
||||
|
@ -31,7 +31,4 @@ tests = testGroup "Data.Email"
|
||||
[ testCase "Can parse a sample email" $ do
|
||||
got <- parseToList sample
|
||||
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