diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -92,8 +92,9 @@ History ------- Originally written by Tupil and maintained by Chris Eidhof for an earlier version of sphinx. -Greg Weber improved the library and updated it for the latest version of sphinx, and is now maintaining it. +Greg Weber improved the library and updated it for the latest version of sphinx. Aleksandar Dimitrov updated the library to use Text. +The Haskell team of [Chordify](https://chordify.net) is now maintaining the library. Usage of this haskell client ---------------------------- diff --git a/Text/Search/Sphinx.hs b/Text/Search/Sphinx.hs --- a/Text/Search/Sphinx.hs +++ b/Text/Search/Sphinx.hs @@ -28,6 +28,7 @@ QueryStatus(..), toStatus, Status(..), SingleResult(..), Result(..), QueryResult(..)) +import Text.Search.Sphinx.Types ( Rank(..) ) import Text.Search.Sphinx.Configuration (Configuration(..), defaultConfig) import qualified Text.Search.Sphinx.ExcerptConfiguration as ExConf (ExcerptConfiguration(..)) import Text.Search.Sphinx.Get (times, getResult, readHeader, getStr, getTxt) @@ -40,7 +41,7 @@ import qualified Data.ByteString.Lazy.Char8 as BS8 import Data.Int (Int64) -import Network (connectTo, PortID(PortNumber)) +import qualified Network.Simple.TCP as TCP import System.IO (Handle, hFlush) import Data.Bits ((.|.)) @@ -51,6 +52,9 @@ import qualified Data.Text as X import qualified Data.Text.ICU.Convert as ICU +import Control.Monad.Catch ( MonadMask ) +import Control.Monad.IO.Class ( MonadIO ) + {- the funnest way to debug this is to run the same query with an existing working client and look at the difference - sudo tcpflow -i lo dst port 9306 import Debug.Trace; debug a = trace (show a) a @@ -97,14 +101,13 @@ -> T.Query -- ^ A query value that can be sent to 'runQueries' simpleQuery q = T.Query q "*" X.empty -connect :: String -> Int -> IO Handle -connect host port = do - connection <- connectTo host (PortNumber $ fromIntegral $ port) - bs <- BS.hGet connection 4 - let version = runGet getWord32be bs +withConnection :: (MonadIO m, MonadMask m, MonadFail m) => String -> Int -> (TCP.Socket -> m r) -> m r +withConnection host port cont = TCP.connect host (show port) $ \(socket,_) -> do + Just bs <- TCP.recv socket 4 + let version = runGet getWord32be $ BS.fromStrict bs myVersion = runPut (num 1) - BS.hPut connection myVersion - return connection + TCP.send socket $ BS.toStrict myVersion + cont socket -- | TODO: add configuration options buildExcerpts :: ExConf.ExcerptConfiguration -- ^ Contains host and port for connection and optional configuration for buildExcerpts @@ -112,12 +115,10 @@ -> Text -- ^ The indexes, \"*\" means every index -> Text -- ^ The query string to use for excerpts -> IO (T.Result [Text]) -- ^ the documents with excerpts highlighted -buildExcerpts config docs indexes words = do - conn <- connect (ExConf.host config) (ExConf.port config) +buildExcerpts config docs indexes words = withConnection (ExConf.host config) (ExConf.port config) $ \conn -> do conv <- ICU.open (ExConf.encoding config) Nothing let req = runPut $ makeBuildExcerpt (addExcerpt conv) - BS.hPut conn req - hFlush conn + TCP.send conn $ BS.toStrict req (status, response) <- getResponse conn case status of T.OK -> return $ T.Ok (getResults response conv) @@ -204,12 +205,10 @@ -- | Lower level- called by 'runQueries'. -- This may be useful for debugging problems- warning messages won't get compressed runQueries' :: Configuration -> [T.Query] -> IO (T.Result [T.SingleResult]) -runQueries' config qs = do - conn <- connect (host config) (port config) +runQueries' config qs = withConnection (host config) (port config) $ \conn -> do conv <- ICU.open (encoding config) Nothing let queryReq = foldPuts $ map (serializeQuery config conv) qs - BS.hPut conn (request queryReq) - hFlush conn + TCP.send conn $ BS.toStrict $ request queryReq getSearchResult conn conv where numQueries = length qs @@ -229,7 +228,7 @@ num numQueries qr - getSearchResult :: Handle -> ICU.Converter -> IO (T.Result [T.SingleResult]) + getSearchResult :: TCP.Socket -> ICU.Converter -> IO (T.Result [T.SingleResult]) getSearchResult conn conv = do (status, response) <- getResponse conn case status of @@ -267,15 +266,15 @@ T.Error code msg -> logCallback (X.concat ["Error code ",X.pack $ show code,". ",msg]) >> return Nothing -getResponse :: Handle -> IO (T.Status, BS.ByteString) +getResponse :: TCP.Socket -> IO (T.Status, BS.ByteString) getResponse conn = do - header <- BS.hGet conn 8 - let (status, version, len) = readHeader header + Just header <- TCP.recv conn 8 + let (status, version, len) = readHeader $ BS.fromStrict header if len == 0 then error "received zero-sized searchd response (bad query?)" else return () - response <- BS.hGet conn (fromIntegral len) - return (status, response) + Just response <- TCP.recv conn (fromIntegral len) + return (status, BS.fromStrict response) -- | use with runQueries to pipeline a batch of queries serializeQuery :: Configuration -> ICU.Converter -> T.Query -> Put @@ -284,7 +283,12 @@ , limit , fromEnum . mode , fromEnum . ranker - , fromEnum . sort] + ] + case ranker cfg of + RankExpr -> str (rankExpr cfg) + _ -> pure () + + num (fromEnum (sort cfg)) str (sortBy cfg) txt conv qry list num (weights cfg) diff --git a/Text/Search/Sphinx/Configuration.hs b/Text/Search/Sphinx/Configuration.hs --- a/Text/Search/Sphinx/Configuration.hs +++ b/Text/Search/Sphinx/Configuration.hs @@ -35,6 +35,8 @@ , mode :: T.MatchMode -- | Ranking mode , ranker :: T.Rank + -- | Ranking expression, used when ranker = RankExpr + , rankExpr :: String -- | Match sorting mode , sort :: T.Sort -- | Attribute to sort by @@ -82,6 +84,7 @@ , limit = 20 , mode = T.All , ranker = T.ProximityBm25 + , rankExpr = "" , sort = T.Relevance , sortBy = "" , minId = 0 diff --git a/Text/Search/Sphinx/Types.hs b/Text/Search/Sphinx/Types.hs --- a/Text/Search/Sphinx/Types.hs +++ b/Text/Search/Sphinx/Types.hs @@ -86,6 +86,7 @@ | MatchAny -- internaly used to emulate SPHINX_MATCH_ANY searching mode | Fieldmask -- ? | Sph04 -- like ProximityBm25, but more weight given to matches at beginning or end of field + | RankExpr -- Custom expression, set with rankExpr | Total deriving (Show, Enum) diff --git a/sphinx.cabal b/sphinx.cabal --- a/sphinx.cabal +++ b/sphinx.cabal @@ -1,15 +1,15 @@ Name: sphinx -Version: 0.6.0.2 +Version: 0.6.1 Synopsis: Haskell bindings to the Sphinx full-text searching daemon. Description: Haskell bindings to the Sphinx full-text searching daemon. Compatible with Sphinx version 2.0 Category: Text, Search, Database License: BSD3 License-file: LICENSE -Author: Chris Eidhof , Greg Weber -Maintainer: Greg Weber , Aleksandar Dimitrov -homepage: https://github.com/gregwebs/haskell-sphinx-client +Author: Chris Eidhof , Greg Weber , Aleksandar Dimitrov +Maintainer: haskelldevelopers@chordify.net +homepage: https://github.com/chordify/haskell-sphinx-client -cabal-version: >= 1.2 +cabal-version: >= 1.10 Build-Type: Simple extra-source-files: README.md @@ -20,6 +20,7 @@ Default: False library + default-language: Haskell2010 Exposed-Modules: Text.Search.Sphinx, Text.Search.Sphinx.Types, Text.Search.Sphinx.Configuration, Text.Search.Sphinx.ExcerptConfiguration, @@ -30,9 +31,9 @@ Build-Depends: base >= 4 && < 5, binary, data-binary-ieee754, - bytestring, network, - xml, - text < 1.3, text-icu < 0.8 + bytestring, network-simple, + xml, exceptions, + text, text-icu if flag(version-1-1-beta) cpp-options: -DONE_ONE_BETA