Update tests

src/Control/Addressbook/Streaming.hs

@@ -1,23 +1,18 @@
 module Control.Addressbook.Streaming where
 
-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
 import Data.Email.Header
        (Header(..))
 
-import System.IO
-       (stdin)
 
 import qualified Data.Foldable as F
 
-import qualified Data.Map.Strict as Map
 
 import Data.Maybe
        (fromMaybe)
@@ -32,10 +27,8 @@ import qualified Data.ByteString.Lazy as LBS
 import Data.Char (ord)
 import qualified Data.ByteString.Lazy.Char8 as LBC
 import System.IO.Unsafe (unsafeInterleaveIO)
-import Control.Parallel.Strategies (using, parList, rseq, parBuffer, rdeepseq, parMap)
+import Control.Parallel.Strategies (rseq, parMap)
 import qualified Data.List as L
-import Control.Concurrent (getNumCapabilities)
-import Debug.Trace (traceShow)
 
 combine :: (MonadUnliftIO m, MonadResource m, MonadThrow m, MonadIO m) => ConduitM FilePath Header m ()
 combine = await >>= \case
@@ -51,35 +44,23 @@ run :: IO ()
 run = do
   datDir <- fromMaybe "./" <$> lookupEnv "HOME"
   xs <- LBS.getContents >>= stream
-  let x = F.fold (parMap rseq F.fold (chunks 200 xs))
+  let set = F.fold (parMap rseq F.fold (chunks 20 xs))
   runResourceT $
-    runConduit (CL.sourceList (Set.elems x) .| C.map (<> "\n") .| CB.sinkFileCautious (datDir </> ".addressbook.dat"))
+    runConduit $
+         CL.sourceList (Set.elems set)
+      .| C.map (<> "\n")
+      .| CB.sinkFileCautious (datDir </> ".addressbook.dat")
   where
     separate = \case
       From x -> [x]
       To xs -> F.toList xs
-    stream :: LBS.ByteString -> IO ([Set ByteString])
+    -- A set of (locally) unique addresses. Composes with parMap
-    stream = traverse (unsafeInterleaveIO . parse . LBC.unpack) . filter (not . LBS.null) . LBS.split (fromIntegral $ ord '\n')
+    stream :: LBS.ByteString -> IO [Set ByteString]
+    stream =
+        traverse (unsafeInterleaveIO . parse . LBC.unpack)
+      . filter (not . LBS.null)
+      . LBS.split (fromIntegral $ ord '\n')
     parse path =
       runResourceT $
         runConduit $
           CB.sourceFile path .| parseEmail .| C.concatMap separate .| C.foldMap Set.singleton
-
-run_ :: IO ()
-run_ = do
-  datDir <- fromMaybe "./" <$> lookupEnv "HOME"
-  runResourceT $ do
-    x <- runConduit stream
-    runConduit (CL.sourceList (Set.elems x) .| C.map (<> "\n") .| CB.sinkFileCautious (datDir </> ".addressbook.dat"))
-  where
-    separate = \case
-      From x -> [x]
-      To xs -> F.toList xs
-    stream =
-      CB.sourceHandle stdin
-        .| CT.decode CT.utf8
-        .| CT.lines
-        .| C.map T.unpack
-        .| combine
-        .| C.concatMap separate
-        .| C.foldMap (Set.singleton)

test/Test/Data/Email/Header.hs

@@ -10,11 +10,12 @@ import qualified Hedgehog.Corpus as Corpus
 import qualified Hedgehog.Gen as Gen
 import qualified Hedgehog.Range as Range
 
-import Data.Text
+import Data.ByteString
-import qualified Data.Text as T
+import qualified Data.ByteString as T
 import qualified Data.Vector as V
 
 import Data.Email.Header
+import qualified Data.ByteString.Char8 as BC
 
 genHeader :: Gen Header
 genHeader = Gen.choice
@@ -22,17 +23,17 @@ genHeader = Gen.choice
   , To . V.fromList <$> Gen.list (Range.linear 0 10) genEmail
   ]
 
-genEmail :: Gen Text
+genEmail :: Gen ByteString
 genEmail = do
   name <- Gen.element Corpus.simpsons
   domain <- Gen.element Corpus.cooking
   tld <- Gen.element ["com","fi","org"]
   pure $ name <> "@" <> domain <> "." <> tld
 
-wrapped :: Char -> Text -> Char -> Text
+wrapped :: Char -> ByteString -> Char -> ByteString
-wrapped l x r = T.singleton l <> x <> T.singleton r
+wrapped l x r = BC.singleton l <> x <> BC.singleton r
 
-genComment :: Gen Text
+genComment :: Gen ByteString
 genComment = do
   x <- Gen.element Corpus.simpsons
   Gen.element [x, wrapped '"' x '"']