addressbook.cabal

@@ -41,6 +41,7 @@ library
                      , vector
                      , containers
                      , filepath
+                     , parallel
   hs-source-dirs:      src
   default-language:    Haskell2010
   ghc-options:         -Wall

default.nix

@@ -1,7 +1,7 @@
 { mkDerivation, attoparsec, base, bytestring, conduit
 , conduit-extra, containers, criterion, filepath, hedgehog
 , hedgehog-corpus, HUnit, lens, lib, mtl, optparse-applicative
-, tasty, tasty-hedgehog, tasty-hunit, text, vector
+, parallel, tasty, tasty-hedgehog, tasty-hunit, text, vector
 }:
 mkDerivation {
   pname = "addressbook";
@@ -11,10 +11,11 @@ mkDerivation {
   isExecutable = true;
   libraryHaskellDepends = [
     attoparsec base bytestring conduit conduit-extra containers
-    filepath lens mtl text vector
+    filepath lens mtl parallel text vector
   ];
   executableHaskellDepends = [
-    base criterion hedgehog-corpus optparse-applicative text
+    base bytestring containers criterion hedgehog-corpus
+    optparse-applicative text
   ];
   testHaskellDepends = [
     base bytestring conduit conduit-extra containers hedgehog

src/Control/Addressbook/Streaming.hs

@@ -25,6 +25,12 @@ import System.Environment
        (lookupEnv)
 import System.FilePath
        ((</>))
+import Data.Set (Set)
+import Data.ByteString (ByteString)
+import qualified Data.Set as Set
+import qualified Data.ByteString.Lazy as LBS
+import Data.Char (ord)
+import qualified Data.ByteString.Lazy.Char8 as LBC
 
 combine :: (MonadUnliftIO m, MonadResource m, MonadThrow m, MonadIO m) => ConduitM FilePath Header m ()
 combine = await >>= \case
@@ -33,6 +39,23 @@ combine = await >>= \case
 
 run :: IO ()
 run = do
+  datDir <- fromMaybe "./" <$> lookupEnv "HOME"
+  x <- LBS.getContents >>= stream
+  runResourceT $
+    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 :: LBS.ByteString -> IO (Set ByteString)
+    stream xs = F.fold <$> traverse (parse . LBC.unpack) (LBS.split (fromIntegral $ ord '\n') xs)
+    parse path =
+      runResourceT $
+        runConduit $
+          CB.sourceFile path .| parseEmail .| C.concatMap separate .| CT.encode CT.utf8 .| C.foldMap Set.singleton
+
+run_ :: IO ()
+run_ = do
   datDir <- fromMaybe "./" <$> lookupEnv "HOME"
   runResourceT $ do
     x <- runConduit stream