addressbook.cabal

@@ -21,7 +21,6 @@ library
                      , Data.Email.Header
                      , Data.Email
                      , Control.Addressbook.Streaming
-                     , Control.Addressbook.Query
   -- other-modules:
   -- other-extensions:
   default-extensions:  OverloadedStrings
@@ -37,10 +36,8 @@ library
                      , bytestring-trie
                      , vector
                      , containers
-                     , filepath
   hs-source-dirs:      src
   default-language:    Haskell2010
-  ghc-options:         -Wall
 
 executable addressbook
   main-is:             Main.hs
@@ -48,10 +45,8 @@ executable addressbook
   -- other-extensions:
   build-depends:       base ^>=4.13.0.0, addressbook
                      , optparse-applicative
-                     , text
   hs-source-dirs:      app
   default-language:    Haskell2010
-  ghc-options:         -Wall
 
 test-suite addressbook-test
   default-language:    Haskell2010
@@ -75,4 +70,3 @@ test-suite addressbook-test
                      , vector
                      , conduit
                      , conduit-extra
-  ghc-options:         -Wall

app/Main.hs

@@ -3,28 +3,18 @@ module Main where
 
 import Options.Applicative
 
-import Data.Text
-       (Text)
-import qualified Data.Text as T
-
-import qualified Control.Addressbook.Query as Query
 import qualified Control.Addressbook.Streaming as Streaming
 
 data CmdLine
   = Stream
-  | Query Text
   deriving Show
 
 cmdline :: Parser CmdLine
-cmdline = subparser
-  (  command "stream" (info (pure Stream) (progDesc "Record a stream of filenames"))
-  <> command "query" (info (Query . T.pack <$> argument str (metavar "QUERY")) (progDesc "Query email addresses"))
-  )
+cmdline = subparser (command "stream" (info (pure Stream) (progDesc "Record a stream of filenames")))
 
 handler :: CmdLine -> IO ()
 handler = \case
   Stream -> Streaming.run
-  Query q -> Query.query q
 
 main :: IO ()
 main = execParser opts >>= handler

default.nix

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

src/Control/Addressbook/Query.hs

@@ -1,48 +0,0 @@
-{-# LANGUAGE TypeApplications #-}
-module Control.Addressbook.Query where
-
-import Data.Text
-       (Text)
-import qualified Data.Text as T
-import qualified Data.Text.Encoding as TE
-
-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 qualified Data.Trie as Trie
-
-import System.IO
-       (stdout)
-
-import Data.Maybe
-       (fromMaybe)
-import System.Environment
-       (lookupEnv)
-import System.FilePath
-       ((</>))
-
-import Control.Exception
-       (catch)
-
-query :: Text -> IO ()
-query prefix = do
-  datDir <- fromMaybe "./" <$> lookupEnv "HOME"
-  state <- catch @IOError (runResourceT $ runConduit $ readState datDir) (\_ -> pure Trie.empty)
-  runConduit $ outputResults state
-  where
-    readState :: FilePath -> ConduitM () Void (ResourceT IO) (Trie.Trie [Text])
-    readState dir =
-      CB.sourceFile (dir </> ".addressbook.dat")
-        .| CT.decode CT.utf8
-        .| CT.lines
-        .| C.foldMap (\s -> Trie.singleton (TE.encodeUtf8 $ T.toLower s) [s])
-    outputResults :: Trie.Trie [Text] -> ConduitM () Void IO ()
-    outputResults state =
-      CL.sourceList (Trie.elems $ Trie.submap (TE.encodeUtf8 prefix) state)
-        .| C.concat
-        .| C.map (<> "\n")
-        .| CT.encode CT.utf8
-        .| CB.sinkHandle stdout

src/Control/Addressbook/Streaming.hs

@@ -5,7 +5,6 @@ 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
@@ -17,14 +16,7 @@ import System.IO
 
 import qualified Data.Foldable as F
 
-import qualified Data.Trie as Trie
-
-import Data.Maybe
-       (fromMaybe)
-import System.Environment
-       (lookupEnv)
-import System.FilePath
-       ((</>))
+import qualified Data.Set as S
 
 combine :: (MonadUnliftIO m, MonadResource m, MonadThrow m, MonadIO m) => ConduitM FilePath Header m ()
 combine = await >>= \case
@@ -33,10 +25,8 @@ combine = await >>= \case
 
 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"))
+  x <- runResourceT $ runConduit stream
+  F.for_ x print
   where
     separate = \case
       From x -> [x]
@@ -48,5 +38,4 @@ run = do
         .| C.map T.unpack
         .| combine
         .| C.concatMap separate
-        .| CT.encode CT.utf8
-        .| C.foldMap (`Trie.singleton` ())
+        .| C.foldMap (S.singleton)

src/Data/Email/Header.hs

@@ -38,13 +38,13 @@ decode = parseOnly parseHeader
     bracketEmail :: Parser Text
     bracketEmail = do
       _ <- manyTill anyChar (char '<')
-      email
+      T.pack <$> manyTill anyChar (char '>')
     email :: Parser Text
     email = do
       _ <- many' space
-      name <- T.pack <$> many' (satisfy (\c -> not (isSpace c) && c /= '@'))
+      name <- T.pack <$> many' (notChar '@')
       _ <- char '@'
-      rest <- T.pack <$> many' (satisfy (\c -> not (isSpace c) && c /= ',' && c /= '>'))
+      rest <- T.pack <$> many' (satisfy (\c -> not (isSpace c) && c /= ','))
       _ <- many' (notChar ',')
       pure (name <> "@" <> rest)
 

test/Test/Data/Email.hs

@@ -17,11 +17,9 @@ sample :: ByteString
 sample =
   "Subject: Hello worldddd\n\
   \From: me@example.com\n\
-  \Dkim: asd\n\
   \To: you <you@example.com>\n\
-  \\n\n\
-  \From: foo bar <a mailto=\"me2@example.com\" />\n\
-  \asd\n"
+  \ \n\n \
+  \foo"
 
 parseToList :: ByteString -> IO [Header]
 parseToList _ = runConduit (CB.sourceLbs sample .| parseEmail .| CL.consume)