Compare commits
No commits in common. "a672fecbc93700243bb8d0de3049630a43c690d3" and "a4da4f73da5bf51e6957dea75a2436ba335b4a05" have entirely different histories.
a672fecbc9
...
a4da4f73da
@ -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
|
||||
|
12
app/Main.hs
12
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
|
||||
|
10
default.nix
10
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
|
||||
|
@ -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
|
@ -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)
|
||||
|
@ -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)
|
||||
|
||||
|
@ -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"
|
||||
\foo"
|
||||
|
||||
parseToList :: ByteString -> IO [Header]
|
||||
parseToList _ = runConduit (CB.sourceLbs sample .| parseEmail .| CL.consume)
|
||||
|
Loading…
Reference in New Issue
Block a user