Compare commits
No commits in common. "0c75d66122596a9a168c4acee7d65348b02067a2" and "87f6eb00f6e649b3c59aa371a4bfa1b5b4dc4f52" have entirely different histories.
0c75d66122
...
87f6eb00f6
@ -4,12 +4,15 @@ module Control.Addressbook.Query where
|
|||||||
import Data.Text
|
import Data.Text
|
||||||
(Text)
|
(Text)
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
|
import qualified Data.Text.Encoding as TE
|
||||||
|
|
||||||
import Conduit
|
import Conduit
|
||||||
import qualified Data.Conduit.Binary as CB
|
import qualified Data.Conduit.Binary as CB
|
||||||
import qualified Data.Conduit.Combinators as C
|
import qualified Data.Conduit.Combinators as C
|
||||||
|
import qualified Data.Conduit.List as CL
|
||||||
import qualified Data.Conduit.Text as CT
|
import qualified Data.Conduit.Text as CT
|
||||||
|
|
||||||
|
import qualified Data.Map.Strict as Map
|
||||||
|
|
||||||
import System.IO
|
import System.IO
|
||||||
(stdout)
|
(stdout)
|
||||||
@ -23,20 +26,27 @@ import System.FilePath
|
|||||||
|
|
||||||
import Control.Exception
|
import Control.Exception
|
||||||
(catch)
|
(catch)
|
||||||
|
import Data.ByteString (ByteString)
|
||||||
|
import qualified Data.ByteString.Char8 as B
|
||||||
|
|
||||||
-- XXX: The current Data.Trie implementation is much slower than Data.Set
|
-- XXX: The current Data.Trie implementation is much slower than Data.Set
|
||||||
query :: Text -> IO ()
|
query :: Text -> IO ()
|
||||||
query prefix = do
|
query prefix = do
|
||||||
datDir <- fromMaybe "./" <$> lookupEnv "HOME"
|
datDir <- fromMaybe "./" <$> lookupEnv "HOME"
|
||||||
catch @IOError (runResourceT $ runConduit $ filterAddresses datDir) $ \e -> print e
|
state <- catch @IOError (runResourceT $ runConduit $ readState datDir) (\_ -> pure Map.empty)
|
||||||
|
runConduit $ outputResults state
|
||||||
where
|
where
|
||||||
prefixLC = T.toLower prefix
|
readState :: FilePath -> ConduitM () Void (ResourceT IO) (Map.Map ByteString [Text])
|
||||||
filterAddresses :: FilePath -> ConduitT () Void (ResourceT IO) ()
|
readState dir =
|
||||||
filterAddresses dir =
|
|
||||||
CB.sourceFile (dir </> ".addressbook.dat")
|
CB.sourceFile (dir </> ".addressbook.dat")
|
||||||
.| CT.decode CT.utf8
|
.| CT.decode CT.utf8
|
||||||
.| CT.lines
|
.| CT.lines
|
||||||
.| C.filter (\v -> prefixLC `T.isPrefixOf` (T.toLower v))
|
.| C.foldMap (\s -> Map.singleton (TE.encodeUtf8 $ T.toLower s) [s])
|
||||||
.| CT.encode CT.utf8
|
prefixB = TE.encodeUtf8 prefix
|
||||||
|
outputResults :: Map.Map ByteString [Text] -> ConduitM () Void IO ()
|
||||||
|
outputResults state =
|
||||||
|
CL.sourceList (Map.elems $ Map.filterWithKey (\k _ -> prefixB `B.isPrefixOf` k) state)
|
||||||
|
.| C.concat
|
||||||
.| C.map (<> "\n")
|
.| C.map (<> "\n")
|
||||||
|
.| CT.encode CT.utf8
|
||||||
.| CB.sinkHandle stdout
|
.| CB.sinkHandle stdout
|
||||||
|
@ -17,7 +17,7 @@ import System.IO
|
|||||||
|
|
||||||
import qualified Data.Foldable as F
|
import qualified Data.Foldable as F
|
||||||
|
|
||||||
import qualified Data.Map.Strict as Map
|
import qualified Data.Trie as Trie
|
||||||
|
|
||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
(fromMaybe)
|
(fromMaybe)
|
||||||
@ -36,7 +36,7 @@ run = do
|
|||||||
datDir <- fromMaybe "./" <$> lookupEnv "HOME"
|
datDir <- fromMaybe "./" <$> lookupEnv "HOME"
|
||||||
runResourceT $ do
|
runResourceT $ do
|
||||||
x <- runConduit stream
|
x <- runConduit stream
|
||||||
runConduit (CL.sourceList (Map.keys x) .| C.map (<> "\n") .| CB.sinkFileCautious (datDir </> ".addressbook.dat"))
|
runConduit (CL.sourceList (Trie.keys x) .| C.map (<> "\n") .| CB.sinkFileCautious (datDir </> ".addressbook.dat"))
|
||||||
where
|
where
|
||||||
separate = \case
|
separate = \case
|
||||||
From x -> [x]
|
From x -> [x]
|
||||||
@ -49,4 +49,4 @@ run = do
|
|||||||
.| combine
|
.| combine
|
||||||
.| C.concatMap separate
|
.| C.concatMap separate
|
||||||
.| CT.encode CT.utf8
|
.| CT.encode CT.utf8
|
||||||
.| C.foldMap (`Map.singleton` ())
|
.| C.foldMap (`Trie.singleton` ())
|
||||||
|
Loading…
Reference in New Issue
Block a user