Querying
This commit is contained in:
parent
91578bfb03
commit
a672fecbc9
@ -21,6 +21,7 @@ library
|
||||
, Data.Email.Header
|
||||
, Data.Email
|
||||
, Control.Addressbook.Streaming
|
||||
, Control.Addressbook.Query
|
||||
-- other-modules:
|
||||
-- other-extensions:
|
||||
default-extensions: OverloadedStrings
|
||||
|
12
app/Main.hs
12
app/Main.hs
@ -3,18 +3,28 @@ 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")))
|
||||
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"))
|
||||
)
|
||||
|
||||
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, hedgehog, hedgehog-corpus
|
||||
, HUnit, lens, mtl, optparse-applicative, stdenv, tasty
|
||||
, tasty-hedgehog, tasty-hunit, text, vector
|
||||
, conduit, conduit-extra, containers, filepath, 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 lens mtl text vector
|
||||
containers filepath lens mtl text vector
|
||||
];
|
||||
executableHaskellDepends = [ base optparse-applicative ];
|
||||
executableHaskellDepends = [ base optparse-applicative text ];
|
||||
testHaskellDepends = [
|
||||
base bytestring conduit conduit-extra hedgehog hedgehog-corpus
|
||||
HUnit tasty tasty-hedgehog tasty-hunit text vector
|
||||
|
48
src/Control/Addressbook/Query.hs
Normal file
48
src/Control/Addressbook/Query.hs
Normal file
@ -0,0 +1,48 @@
|
||||
{-# 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
|
Loading…
Reference in New Issue
Block a user