addressbook/src/Control/Addressbook/Streaming.hs

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.Trie as Trie

import Data.Maybe
       (fromMaybe)
import System.Environment
       (lookupEnv)
import System.FilePath
       ((</>))

combine :: (MonadUnliftIO m, MonadResource m, MonadThrow m, MonadIO m) => ConduitM FilePath Header m ()
combine = await >>= \case
  Nothing -> pure ()
  Just path -> (CB.sourceFile path .| parseEmail) >> combine

run :: IO ()
run = do
  datDir <- fromMaybe "./" <$> lookupEnv "HOME"
  runResourceT $ do
    x <- runConduit stream
    runConduit (CL.sourceList (Trie.keys 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
        .| CT.encode CT.utf8
        .| C.foldMap (`Trie.singleton` ())