{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
module Text.Search.Sphinx
( escapeText
, query
, buildExcerpts
, runQueries
, runQueries'
, resultsToMatches
, maybeQueries
, T.Query(..), simpleQuery
, Configuration(..), defaultConfig
) where
import qualified Text.Search.Sphinx.Types as T (
Match,
Query(..),
VerCommand(VcSearch, VcExcerpt),
SearchdCommand(ScSearch, ScExcerpt),
Filter, Filter(..),
fromEnumFilter, Filter(..),
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)
import Text.Search.Sphinx.Put (num, num64, float, enum, list, numC, strC, foldPuts,
numC64, stringIntList, str, txt, cmd, verCmd)
import Data.Binary.Put (Put, runPut)
import Data.Binary.Get (runGet, getWord32be)
import qualified Data.ByteString.Lazy as BS
import qualified Data.ByteString.Lazy.Char8 as BS8
import Data.Int (Int64)
import qualified Network.Simple.TCP as TCP
import System.IO (Handle, hFlush)
import Data.Bits ((.|.))
import Prelude hiding (filter, tail)
import Data.List (nub)
import Data.Text (Text)
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 )
escapedChars :: String
escapedChars :: [Char]
escapedChars = Char
'"'Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:Char
'\\'Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:[Char]
"-!@~/()*[]="
escapeText :: Text -> Text
escapeText :: Text -> Text
escapeText = Text -> [Text] -> Text
X.intercalate Text
"\\" ([Text] -> Text) -> (Text -> [Text]) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> [Text]
breakBy (Char -> [Char] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char]
escapedChars)
where breakBy :: (Char -> Bool) -> Text -> [Text]
breakBy Char -> Bool
p Text
t | Text -> Bool
X.null Text
t = [Text
X.empty]
| Bool
otherwise = (if Char -> Bool
p (Char -> Bool) -> Char -> Bool
forall a b. (a -> b) -> a -> b
$ HasCallStack => Text -> Char
Text -> Char
X.head Text
t then (Text
""Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:) else [Text] -> [Text]
forall a. a -> a
id) ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ (Char -> Char -> Bool) -> Text -> [Text]
X.groupBy (\Char
_ Char
x -> Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Char -> Bool
p Char
x) Text
t
query :: Configuration
-> Text
-> Text
-> IO (T.Result T.QueryResult)
query :: Configuration -> Text -> Text -> IO (Result QueryResult)
query Configuration
config Text
indexes Text
search = do
let q :: Query
q = Text -> Text -> Text -> Query
T.Query Text
search Text
indexes Text
X.empty
Result [SingleResult]
results <- Configuration -> [Query] -> IO (Result [SingleResult])
runQueries' Configuration
config [Query
q]
Result QueryResult -> IO (Result QueryResult)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Result QueryResult -> IO (Result QueryResult))
-> Result QueryResult -> IO (Result QueryResult)
forall a b. (a -> b) -> a -> b
$ case Result [SingleResult]
results of
T.Ok [SingleResult]
rs -> case [SingleResult] -> SingleResult
forall a. HasCallStack => [a] -> a
head [SingleResult]
rs of
T.QueryOk QueryResult
result -> QueryResult -> Result QueryResult
forall a. a -> Result a
T.Ok QueryResult
result
T.QueryWarning Text
w QueryResult
result -> Text -> QueryResult -> Result QueryResult
forall a. Text -> a -> Result a
T.Warning Text
w QueryResult
result
T.QueryError Int
code Text
e -> Int -> Text -> Result QueryResult
forall a. Int -> Text -> Result a
T.Error Int
code Text
e
T.Error Int
code Text
error -> Int -> Text -> Result QueryResult
forall a. Int -> Text -> Result a
T.Error Int
code Text
error
T.Retry Text
retry -> Text -> Result QueryResult
forall a. Text -> Result a
T.Retry Text
retry
T.Warning Text
warning (SingleResult
result:[SingleResult]
results) -> case SingleResult
result of
T.QueryOk QueryResult
result -> Text -> QueryResult -> Result QueryResult
forall a. Text -> a -> Result a
T.Warning Text
warning QueryResult
result
T.QueryWarning Text
w QueryResult
result -> Text -> QueryResult -> Result QueryResult
forall a. Text -> a -> Result a
T.Warning (Text -> Text -> Text
X.append Text
warning Text
w) QueryResult
result
T.QueryError Int
code Text
e -> Int -> Text -> Result QueryResult
forall a. Int -> Text -> Result a
T.Error Int
code Text
e
simpleQuery :: Text
-> T.Query
simpleQuery :: Text -> Query
simpleQuery Text
q = Text -> Text -> Text -> Query
T.Query Text
q Text
"*" Text
X.empty
withConnection :: (MonadIO m, MonadMask m, MonadFail m) => String -> Int -> (TCP.Socket -> m r) -> m r
withConnection :: forall (m :: * -> *) r.
(MonadIO m, MonadMask m, MonadFail m) =>
[Char] -> Int -> (Socket -> m r) -> m r
withConnection [Char]
host Int
port Socket -> m r
cont = [Char] -> [Char] -> ((Socket, SockAddr) -> m r) -> m r
forall (m :: * -> *) r.
(MonadIO m, MonadMask m) =>
[Char] -> [Char] -> ((Socket, SockAddr) -> m r) -> m r
TCP.connect [Char]
host (Int -> [Char]
forall a. Show a => a -> [Char]
show Int
port) (((Socket, SockAddr) -> m r) -> m r)
-> ((Socket, SockAddr) -> m r) -> m r
forall a b. (a -> b) -> a -> b
$ \(Socket
socket,SockAddr
_) -> do
Just ByteString
bs <- Socket -> Int -> m (Maybe ByteString)
forall (m :: * -> *).
MonadIO m =>
Socket -> Int -> m (Maybe ByteString)
TCP.recv Socket
socket Int
4
let version :: Word32
version = Get Word32 -> ByteString -> Word32
forall a. Get a -> ByteString -> a
runGet Get Word32
getWord32be (ByteString -> Word32) -> ByteString -> Word32
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BS.fromStrict ByteString
bs
myVersion :: ByteString
myVersion = Put -> ByteString
runPut (Int -> Put
num Int
1)
Socket -> ByteString -> m ()
forall (m :: * -> *). MonadIO m => Socket -> ByteString -> m ()
TCP.send Socket
socket (ByteString -> m ()) -> ByteString -> m ()
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BS.toStrict ByteString
myVersion
Socket -> m r
cont Socket
socket
buildExcerpts :: ExConf.ExcerptConfiguration
-> [Text]
-> Text
-> Text
-> IO (T.Result [Text])
buildExcerpts :: ExcerptConfiguration
-> [Text] -> Text -> Text -> IO (Result [Text])
buildExcerpts ExcerptConfiguration
config [Text]
docs Text
indexes Text
words = [Char]
-> Int -> (Socket -> IO (Result [Text])) -> IO (Result [Text])
forall (m :: * -> *) r.
(MonadIO m, MonadMask m, MonadFail m) =>
[Char] -> Int -> (Socket -> m r) -> m r
withConnection (ExcerptConfiguration -> [Char]
ExConf.host ExcerptConfiguration
config) (ExcerptConfiguration -> Int
ExConf.port ExcerptConfiguration
config) ((Socket -> IO (Result [Text])) -> IO (Result [Text]))
-> (Socket -> IO (Result [Text])) -> IO (Result [Text])
forall a b. (a -> b) -> a -> b
$ \Socket
conn -> do
Converter
conv <- [Char] -> Maybe Bool -> IO Converter
ICU.open (ExcerptConfiguration -> [Char]
ExConf.encoding ExcerptConfiguration
config) Maybe Bool
forall a. Maybe a
Nothing
let req :: ByteString
req = Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ Put -> Put
makeBuildExcerpt (Converter -> Put
addExcerpt Converter
conv)
Socket -> ByteString -> IO ()
forall (m :: * -> *). MonadIO m => Socket -> ByteString -> m ()
TCP.send Socket
conn (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BS.toStrict ByteString
req
(Status
status, ByteString
response) <- Socket -> IO (Status, ByteString)
getResponse Socket
conn
case Status
status of
Status
T.OK -> Result [Text] -> IO (Result [Text])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Result [Text] -> IO (Result [Text]))
-> Result [Text] -> IO (Result [Text])
forall a b. (a -> b) -> a -> b
$ [Text] -> Result [Text]
forall a. a -> Result a
T.Ok (ByteString -> Converter -> [Text]
getResults ByteString
response Converter
conv)
Status
T.WARNING -> Result [Text] -> IO (Result [Text])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Result [Text] -> IO (Result [Text]))
-> Result [Text] -> IO (Result [Text])
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Result [Text]
forall a. Text -> a -> Result a
T.Warning (Get Text -> ByteString -> Text
forall a. Get a -> ByteString -> a
runGet (Converter -> Get Text
getTxt Converter
conv) ByteString
response) (ByteString -> Converter -> [Text]
getResults ByteString
response Converter
conv)
Status
T.RETRY -> Result [Text] -> IO (Result [Text])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Result [Text] -> IO (Result [Text]))
-> Result [Text] -> IO (Result [Text])
forall a b. (a -> b) -> a -> b
$ Text -> Result [Text]
forall a. Text -> Result a
T.Retry (Converter -> ByteString -> Text
errorMessage Converter
conv ByteString
response)
T.ERROR Int
n -> Result [Text] -> IO (Result [Text])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Result [Text] -> IO (Result [Text]))
-> Result [Text] -> IO (Result [Text])
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Result [Text]
forall a. Int -> Text -> Result a
T.Error Int
n (Converter -> ByteString -> Text
errorMessage Converter
conv ByteString
response)
where
getResults :: ByteString -> Converter -> [Text]
getResults ByteString
response Converter
conv = Get [Text] -> ByteString -> [Text]
forall a. Get a -> ByteString -> a
runGet (([Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
docs) Int -> Get Text -> Get [Text]
forall {a}. Int -> Get a -> Get [a]
`times` Converter -> Get Text
getTxt Converter
conv) ByteString
response
errorMessage :: Converter -> ByteString -> Text
errorMessage Converter
conv ByteString
response = Get Text -> ByteString -> Text
forall a. Get a -> ByteString -> a
runGet (Converter -> Get Text
getTxt Converter
conv) ByteString
response
makeBuildExcerpt :: Put -> Put
makeBuildExcerpt Put
putExcerpt = do
SearchdCommand -> Put
cmd SearchdCommand
T.ScExcerpt
VerCommand -> Put
verCmd VerCommand
T.VcExcerpt
Int -> Put
num (Int -> Put) -> Int -> Put
forall a b. (a -> b) -> a -> b
$ Int64 -> Int
forall a. Enum a => a -> Int
fromEnum (Int64 -> Int) -> Int64 -> Int
forall a b. (a -> b) -> a -> b
$ ByteString -> Int64
BS.length (Put -> ByteString
runPut Put
putExcerpt)
Put
putExcerpt
addExcerpt :: ICU.Converter -> Put
addExcerpt :: Converter -> Put
addExcerpt Converter
conv = do
Int -> Put
num Int
0
Int -> Put
num (Int -> Put) -> Int -> Put
forall a b. (a -> b) -> a -> b
$ ExcerptConfiguration -> Int
excerptFlags ExcerptConfiguration
config
Converter -> Text -> Put
txt Converter
conv Text
indexes
Converter -> Text -> Put
txt Converter
conv Text
words
ExcerptConfiguration -> [ExcerptConfiguration -> [Char]] -> Put
forall {t1 :: * -> *} {t2}.
Foldable t1 =>
t2 -> t1 (t2 -> [Char]) -> Put
strC ExcerptConfiguration
config [ExcerptConfiguration -> [Char]
ExConf.beforeMatch, ExcerptConfiguration -> [Char]
ExConf.afterMatch, ExcerptConfiguration -> [Char]
ExConf.chunkSeparator]
ExcerptConfiguration -> [ExcerptConfiguration -> Int] -> Put
forall {t1 :: * -> *} {t2}.
Foldable t1 =>
t2 -> t1 (t2 -> Int) -> Put
numC ExcerptConfiguration
config [ExcerptConfiguration -> Int
ExConf.limit, ExcerptConfiguration -> Int
ExConf.around, ExcerptConfiguration -> Int
ExConf.limitPassages, ExcerptConfiguration -> Int
ExConf.limitWords, ExcerptConfiguration -> Int
ExConf.startPassageId]
[Char] -> Put
str ([Char] -> Put) -> [Char] -> Put
forall a b. (a -> b) -> a -> b
$ ExcerptConfiguration -> [Char]
ExConf.htmlStripMode ExcerptConfiguration
config
#ifndef ONE_ONE_BETA
[Char] -> Put
str ([Char] -> Put) -> [Char] -> Put
forall a b. (a -> b) -> a -> b
$ ExcerptConfiguration -> [Char]
ExConf.passageBoundary ExcerptConfiguration
config
#endif
(Text -> Put) -> [Text] -> Put
forall {t :: * -> *} {a} {b}.
Foldable t =>
(a -> PutM b) -> t a -> Put
list (Converter -> Text -> Put
txt Converter
conv) [Text]
docs
modeFlag :: ExConf.ExcerptConfiguration -> (ExConf.ExcerptConfiguration -> Bool) -> Int -> Int
modeFlag :: ExcerptConfiguration
-> (ExcerptConfiguration -> Bool) -> Int -> Int
modeFlag ExcerptConfiguration
cfg ExcerptConfiguration -> Bool
setting Int
value = if ExcerptConfiguration -> Bool
setting ExcerptConfiguration
cfg then Int
value else Int
0
excerptFlags :: ExConf.ExcerptConfiguration -> Int
excerptFlags :: ExcerptConfiguration -> Int
excerptFlags ExcerptConfiguration
cfg = (Int -> Int -> Int) -> Int -> [Int] -> Int
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Int -> Int -> Int
forall a. Bits a => a -> a -> a
(.|.) Int
1 (((ExcerptConfiguration -> Bool, Int) -> Int)
-> [(ExcerptConfiguration -> Bool, Int)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (\(ExcerptConfiguration -> Bool
s,Int
v) -> ExcerptConfiguration
-> (ExcerptConfiguration -> Bool) -> Int -> Int
modeFlag ExcerptConfiguration
cfg ExcerptConfiguration -> Bool
s Int
v) [
(ExcerptConfiguration -> Bool
ExConf.exactPhrase, Int
2 )
, (ExcerptConfiguration -> Bool
ExConf.singlePassage, Int
4 )
, (ExcerptConfiguration -> Bool
ExConf.useBoundaries, Int
8 )
, (ExcerptConfiguration -> Bool
ExConf.weightOrder, Int
16 )
, (ExcerptConfiguration -> Bool
ExConf.queryMode, Int
32 )
, (ExcerptConfiguration -> Bool
ExConf.forceAllWords, Int
64 )
, (ExcerptConfiguration -> Bool
ExConf.loadFiles, Int
128 )
, (ExcerptConfiguration -> Bool
ExConf.allowEmpty, Int
256 )
])
runQueries :: Configuration -> [T.Query] -> IO (T.Result [T.QueryResult])
runQueries :: Configuration -> [Query] -> IO (Result [QueryResult])
runQueries Configuration
cfg [Query]
qs = Configuration -> [Query] -> IO (Result [SingleResult])
runQueries' Configuration
cfg [Query]
qs IO (Result [SingleResult])
-> (Result [SingleResult] -> IO (Result [QueryResult]))
-> IO (Result [QueryResult])
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Result [QueryResult] -> IO (Result [QueryResult])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Result [QueryResult] -> IO (Result [QueryResult]))
-> (Result [SingleResult] -> Result [QueryResult])
-> Result [SingleResult]
-> IO (Result [QueryResult])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Result [SingleResult] -> Result [QueryResult]
toSearchResult
where
toSearchResult :: T.Result [T.SingleResult] -> T.Result [T.QueryResult]
toSearchResult :: Result [SingleResult] -> Result [QueryResult]
toSearchResult Result [SingleResult]
results =
case Result [SingleResult]
results of
T.Ok [SingleResult]
rs -> [SingleResult] -> [QueryResult] -> Text -> Result [QueryResult]
fromOk [SingleResult]
rs [] Text
X.empty
T.Warning Text
warning [SingleResult]
rs -> Text -> [SingleResult] -> [QueryResult] -> Result [QueryResult]
fromWarn Text
warning [SingleResult]
rs []
T.Retry Text
retry -> Text -> Result [QueryResult]
forall a. Text -> Result a
T.Retry Text
retry
T.Error Int
code Text
error -> Int -> Text -> Result [QueryResult]
forall a. Int -> Text -> Result a
T.Error Int
code Text
error
where
fromOk :: [T.SingleResult] -> [T.QueryResult] -> Text -> T.Result [T.QueryResult]
fromOk :: [SingleResult] -> [QueryResult] -> Text -> Result [QueryResult]
fromOk [] [QueryResult]
acc Text
warn | Text -> Bool
X.null Text
warn = [QueryResult] -> Result [QueryResult]
forall a. a -> Result a
T.Ok [QueryResult]
acc
| Bool
otherwise = Text -> [QueryResult] -> Result [QueryResult]
forall a. Text -> a -> Result a
T.Warning Text
warn [QueryResult]
acc
fromOk (SingleResult
r:[SingleResult]
rs) [QueryResult]
acc Text
warn = case SingleResult
r of
T.QueryOk QueryResult
result -> [SingleResult] -> [QueryResult] -> Text -> Result [QueryResult]
fromOk [SingleResult]
rs ([QueryResult]
acc [QueryResult] -> [QueryResult] -> [QueryResult]
forall a. [a] -> [a] -> [a]
++ [QueryResult
result]) Text
warn
T.QueryWarning Text
w QueryResult
result -> [SingleResult] -> [QueryResult] -> Text -> Result [QueryResult]
fromOk [SingleResult]
rs ([QueryResult]
acc [QueryResult] -> [QueryResult] -> [QueryResult]
forall a. [a] -> [a] -> [a]
++ [QueryResult
result]) (Text -> Text -> Text
X.append Text
warn Text
w)
T.QueryError Int
code Text
e -> Int -> Text -> Result [QueryResult]
forall a. Int -> Text -> Result a
T.Error Int
code Text
e
fromWarn :: Text -> [T.SingleResult] -> [T.QueryResult] -> T.Result [T.QueryResult]
fromWarn :: Text -> [SingleResult] -> [QueryResult] -> Result [QueryResult]
fromWarn Text
warning [] [QueryResult]
acc = Text -> [QueryResult] -> Result [QueryResult]
forall a. Text -> a -> Result a
T.Warning Text
warning [QueryResult]
acc
fromWarn Text
warning (SingleResult
r:[SingleResult]
rs) [QueryResult]
acc = case SingleResult
r of
T.QueryOk QueryResult
result -> Text -> [SingleResult] -> [QueryResult] -> Result [QueryResult]
fromWarn Text
warning [SingleResult]
rs (QueryResult
resultQueryResult -> [QueryResult] -> [QueryResult]
forall a. a -> [a] -> [a]
:[QueryResult]
acc)
T.QueryWarning Text
w QueryResult
result -> Text -> [SingleResult] -> [QueryResult] -> Result [QueryResult]
fromWarn (Text -> Text -> Text
X.append Text
warning Text
w) [SingleResult]
rs (QueryResult
resultQueryResult -> [QueryResult] -> [QueryResult]
forall a. a -> [a] -> [a]
:[QueryResult]
acc)
T.QueryError Int
code Text
e -> Int -> Text -> Result [QueryResult]
forall a. Int -> Text -> Result a
T.Error Int
code Text
e
runQueries' :: Configuration -> [T.Query] -> IO (T.Result [T.SingleResult])
runQueries' :: Configuration -> [Query] -> IO (Result [SingleResult])
runQueries' Configuration
config [Query]
qs = [Char]
-> Int
-> (Socket -> IO (Result [SingleResult]))
-> IO (Result [SingleResult])
forall (m :: * -> *) r.
(MonadIO m, MonadMask m, MonadFail m) =>
[Char] -> Int -> (Socket -> m r) -> m r
withConnection (Configuration -> [Char]
host Configuration
config) (Configuration -> Int
port Configuration
config) ((Socket -> IO (Result [SingleResult]))
-> IO (Result [SingleResult]))
-> (Socket -> IO (Result [SingleResult]))
-> IO (Result [SingleResult])
forall a b. (a -> b) -> a -> b
$ \Socket
conn -> do
Converter
conv <- [Char] -> Maybe Bool -> IO Converter
ICU.open (Configuration -> [Char]
encoding Configuration
config) Maybe Bool
forall a. Maybe a
Nothing
let queryReq :: Put
queryReq = [Put] -> Put
foldPuts ([Put] -> Put) -> [Put] -> Put
forall a b. (a -> b) -> a -> b
$ (Query -> Put) -> [Query] -> [Put]
forall a b. (a -> b) -> [a] -> [b]
map (Configuration -> Converter -> Query -> Put
serializeQuery Configuration
config Converter
conv) [Query]
qs
Socket -> ByteString -> IO ()
forall (m :: * -> *). MonadIO m => Socket -> ByteString -> m ()
TCP.send Socket
conn (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BS.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Put -> ByteString
request Put
queryReq
Socket -> Converter -> IO (Result [SingleResult])
getSearchResult Socket
conn Converter
conv
where
numQueries :: Int
numQueries = [Query] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Query]
qs
request :: Put -> ByteString
request Put
qr = Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ do
SearchdCommand -> Put
cmd SearchdCommand
T.ScSearch
VerCommand -> Put
verCmd VerCommand
T.VcSearch
Int -> Put
num (Int -> Put) -> Int -> Put
forall a b. (a -> b) -> a -> b
$
#ifdef ONE_ONE_BETA
4
#else
Int
8
#endif
Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int64 -> Int
forall a. Enum a => a -> Int
fromEnum (Int64 -> Int) -> Int64 -> Int
forall a b. (a -> b) -> a -> b
$ ByteString -> Int64
BS.length (Put -> ByteString
runPut Put
qr))
#ifndef ONE_ONE_BETA
Int -> Put
num Int
0
#endif
Int -> Put
num Int
numQueries
Put
qr
getSearchResult :: TCP.Socket -> ICU.Converter -> IO (T.Result [T.SingleResult])
getSearchResult :: Socket -> Converter -> IO (Result [SingleResult])
getSearchResult Socket
conn Converter
conv = do
(Status
status, ByteString
response) <- Socket -> IO (Status, ByteString)
getResponse Socket
conn
case Status
status of
Status
T.OK -> Result [SingleResult] -> IO (Result [SingleResult])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Result [SingleResult] -> IO (Result [SingleResult]))
-> Result [SingleResult] -> IO (Result [SingleResult])
forall a b. (a -> b) -> a -> b
$ [SingleResult] -> Result [SingleResult]
forall a. a -> Result a
T.Ok (ByteString -> Converter -> [SingleResult]
getResults ByteString
response Converter
conv)
Status
T.WARNING -> Result [SingleResult] -> IO (Result [SingleResult])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Result [SingleResult] -> IO (Result [SingleResult]))
-> Result [SingleResult] -> IO (Result [SingleResult])
forall a b. (a -> b) -> a -> b
$ Text -> [SingleResult] -> Result [SingleResult]
forall a. Text -> a -> Result a
T.Warning (Get Text -> ByteString -> Text
forall a. Get a -> ByteString -> a
runGet (Converter -> Get Text
getTxt Converter
conv) ByteString
response) (ByteString -> Converter -> [SingleResult]
getResults ByteString
response Converter
conv)
Status
T.RETRY -> Result [SingleResult] -> IO (Result [SingleResult])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Result [SingleResult] -> IO (Result [SingleResult]))
-> Result [SingleResult] -> IO (Result [SingleResult])
forall a b. (a -> b) -> a -> b
$ Text -> Result [SingleResult]
forall a. Text -> Result a
T.Retry (Converter -> ByteString -> Text
errorMessage Converter
conv ByteString
response)
T.ERROR Int
n -> Result [SingleResult] -> IO (Result [SingleResult])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Result [SingleResult] -> IO (Result [SingleResult]))
-> Result [SingleResult] -> IO (Result [SingleResult])
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Result [SingleResult]
forall a. Int -> Text -> Result a
T.Error Int
n (Converter -> ByteString -> Text
errorMessage Converter
conv ByteString
response)
where
getResults :: ByteString -> Converter -> [SingleResult]
getResults ByteString
response Converter
conv = Get [SingleResult] -> ByteString -> [SingleResult]
forall a. Get a -> ByteString -> a
runGet (Int
numQueries Int -> Get SingleResult -> Get [SingleResult]
forall {a}. Int -> Get a -> Get [a]
`times` Converter -> Get SingleResult
getResult Converter
conv) ByteString
response
errorMessage :: Converter -> ByteString -> Text
errorMessage Converter
conv ByteString
response = Get Text -> ByteString -> Text
forall a. Get a -> ByteString -> a
runGet (Converter -> Get Text
getTxt Converter
conv) ByteString
response
resultsToMatches :: Int -> [T.QueryResult] -> [T.Match]
resultsToMatches :: Int -> [QueryResult] -> [Match]
resultsToMatches Int
maxResults = [QueryResult] -> [Match]
combine
where
combine :: [QueryResult] -> [Match]
combine [] = []
combine (QueryResult
r:[QueryResult]
rs)
| QueryResult -> Int
T.totalFound QueryResult
r Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
maxResults = QueryResult -> [Match]
T.matches QueryResult
r
| QueryResult -> Int
T.totalFound QueryResult
r Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = [QueryResult] -> [Match]
combine [QueryResult]
rs
| Bool
otherwise = [QueryResult] -> [Match]
takeResults (QueryResult
rQueryResult -> [QueryResult] -> [QueryResult]
forall a. a -> [a] -> [a]
:[QueryResult]
rs)
takeResults :: [T.QueryResult] -> [T.Match]
takeResults :: [QueryResult] -> [Match]
takeResults = Int -> [Match] -> [Match]
forall a. Int -> [a] -> [a]
take Int
maxResults ([Match] -> [Match])
-> ([QueryResult] -> [Match]) -> [QueryResult] -> [Match]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Match] -> [Match]
forall a. Eq a => [a] -> [a]
nub ([Match] -> [Match])
-> ([QueryResult] -> [Match]) -> [QueryResult] -> [Match]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Match] -> [Match] -> [Match]) -> [[Match]] -> [Match]
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 [Match] -> [Match] -> [Match]
forall a. [a] -> [a] -> [a]
(++) ([[Match]] -> [Match])
-> ([QueryResult] -> [[Match]]) -> [QueryResult] -> [Match]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (QueryResult -> [Match]) -> [QueryResult] -> [[Match]]
forall a b. (a -> b) -> [a] -> [b]
map QueryResult -> [Match]
T.matches
maybeQueries :: (Text -> IO ()) -> Configuration -> [T.Query] -> IO (Maybe [T.QueryResult])
maybeQueries :: (Text -> IO ())
-> Configuration -> [Query] -> IO (Maybe [QueryResult])
maybeQueries Text -> IO ()
logCallback Configuration
conf [Query]
queries = do
Result [QueryResult]
result <- Configuration -> [Query] -> IO (Result [QueryResult])
runQueries Configuration
conf [Query]
queries
case Result [QueryResult]
result of
T.Ok [QueryResult]
r -> Maybe [QueryResult] -> IO (Maybe [QueryResult])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([QueryResult] -> Maybe [QueryResult]
forall a. a -> Maybe a
Just [QueryResult]
r)
T.Retry Text
msg -> Text -> IO ()
logCallback Text
msg IO () -> IO (Maybe [QueryResult]) -> IO (Maybe [QueryResult])
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Text -> IO ())
-> Configuration -> [Query] -> IO (Maybe [QueryResult])
maybeQueries Text -> IO ()
logCallback Configuration
conf [Query]
queries
T.Warning Text
w [QueryResult]
r -> Text -> IO ()
logCallback Text
w IO () -> IO (Maybe [QueryResult]) -> IO (Maybe [QueryResult])
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe [QueryResult] -> IO (Maybe [QueryResult])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([QueryResult] -> Maybe [QueryResult]
forall a. a -> Maybe a
Just [QueryResult]
r)
T.Error Int
code Text
msg ->
Text -> IO ()
logCallback ([Text] -> Text
X.concat [Text
"Error code ",[Char] -> Text
X.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
code,Text
". ",Text
msg]) IO () -> IO (Maybe [QueryResult]) -> IO (Maybe [QueryResult])
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe [QueryResult] -> IO (Maybe [QueryResult])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [QueryResult]
forall a. Maybe a
Nothing
getResponse :: TCP.Socket -> IO (T.Status, BS.ByteString)
getResponse :: Socket -> IO (Status, ByteString)
getResponse Socket
conn = do
Just ByteString
header <- Socket -> Int -> IO (Maybe ByteString)
forall (m :: * -> *).
MonadIO m =>
Socket -> Int -> m (Maybe ByteString)
TCP.recv Socket
conn Int
8
let (Status
status, Word16
version, Word32
len) = ByteString -> (Status, Word16, Word32)
readHeader (ByteString -> (Status, Word16, Word32))
-> ByteString -> (Status, Word16, Word32)
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BS.fromStrict ByteString
header
if Word32
len Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
0
then [Char] -> IO ()
forall a. HasCallStack => [Char] -> a
error [Char]
"received zero-sized searchd response (bad query?)"
else () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just ByteString
response <- Socket -> Int -> IO (Maybe ByteString)
forall (m :: * -> *).
MonadIO m =>
Socket -> Int -> m (Maybe ByteString)
TCP.recv Socket
conn (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
len)
(Status, ByteString) -> IO (Status, ByteString)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Status
status, ByteString -> ByteString
BS.fromStrict ByteString
response)
serializeQuery :: Configuration -> ICU.Converter -> T.Query -> Put
serializeQuery :: Configuration -> Converter -> Query -> Put
serializeQuery Configuration
cfg Converter
conv (T.Query Text
qry Text
indexes Text
comment) = do
Configuration -> [Configuration -> Int] -> Put
forall {t1 :: * -> *} {t2}.
Foldable t1 =>
t2 -> t1 (t2 -> Int) -> Put
numC Configuration
cfg [ Configuration -> Int
offset
, Configuration -> Int
limit
, MatchMode -> Int
forall a. Enum a => a -> Int
fromEnum (MatchMode -> Int)
-> (Configuration -> MatchMode) -> Configuration -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Configuration -> MatchMode
mode
, Rank -> Int
forall a. Enum a => a -> Int
fromEnum (Rank -> Int) -> (Configuration -> Rank) -> Configuration -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Configuration -> Rank
ranker
]
case Configuration -> Rank
ranker Configuration
cfg of
Rank
RankExpr -> [Char] -> Put
str (Configuration -> [Char]
rankExpr Configuration
cfg)
Rank
_ -> () -> Put
forall a. a -> PutM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Int -> Put
num (Sort -> Int
forall a. Enum a => a -> Int
fromEnum (Configuration -> Sort
sort Configuration
cfg))
[Char] -> Put
str (Configuration -> [Char]
sortBy Configuration
cfg)
Converter -> Text -> Put
txt Converter
conv Text
qry
(Int -> Put) -> [Int] -> Put
forall {t :: * -> *} {a} {b}.
Foldable t =>
(a -> PutM b) -> t a -> Put
list Int -> Put
num (Configuration -> [Int]
weights Configuration
cfg)
Converter -> Text -> Put
txt Converter
conv Text
indexes
Int -> Put
num Int
1
Configuration -> [Configuration -> Int] -> Put
forall {t1 :: * -> *} {a} {t2}.
(Foldable t1, Integral a) =>
t2 -> t1 (t2 -> a) -> Put
numC64 Configuration
cfg [Configuration -> Int
minId, Configuration -> Int
maxId]
(Filter -> Put) -> [Filter] -> Put
forall {t :: * -> *} {a} {b}.
Foldable t =>
(a -> PutM b) -> t a -> Put
list Filter -> Put
putFilter (Configuration -> [Filter]
filters Configuration
cfg)
GroupByFunction -> Put
forall a. Enum a => a -> Put
enum (Configuration -> GroupByFunction
groupByFunc Configuration
cfg)
[Char] -> Put
str (Configuration -> [Char]
groupBy Configuration
cfg)
Int -> Put
num (Configuration -> Int
maxMatches Configuration
cfg)
[Char] -> Put
str (Configuration -> [Char]
groupSort Configuration
cfg)
Int -> Put
num (Configuration -> Int
cutoff Configuration
cfg)
Int -> Put
num (Configuration -> Int
retryCount Configuration
cfg)
Int -> Put
num (Configuration -> Int
retryDelay Configuration
cfg)
[Char] -> Put
str (Configuration -> [Char]
groupDistinct Configuration
cfg)
Int -> Put
num Int
0
[([Char], Int)] -> Put
stringIntList (Configuration -> [([Char], Int)]
indexWeights Configuration
cfg)
Int -> Put
num (Configuration -> Int
maxQueryTime Configuration
cfg)
[([Char], Int)] -> Put
stringIntList (Configuration -> [([Char], Int)]
fieldWeights Configuration
cfg)
Converter -> Text -> Put
txt Converter
conv Text
comment
Int -> Put
num Int
0
[Char] -> Put
str (Configuration -> [Char]
selectClause Configuration
cfg)
where
putFilter :: T.Filter -> Put
putFilter :: Filter -> Put
putFilter (T.ExclusionFilter Filter
filter) = Filter -> Bool -> Put
forall {a}. Enum a => Filter -> a -> Put
putFilter_ Filter
filter Bool
True
putFilter Filter
filter = Filter -> Bool -> Put
forall {a}. Enum a => Filter -> a -> Put
putFilter_ Filter
filter Bool
False
putFilter_ :: Filter -> a -> Put
putFilter_ f :: Filter
f@(T.FilterValues [Char]
attr [Int64]
values) a
ex = Filter -> [Char] -> ([Int64] -> Put) -> [[Int64]] -> a -> Put
forall {t :: * -> *} {a} {a} {b}.
(Foldable t, Enum a) =>
Filter -> [Char] -> (a -> PutM b) -> t a -> a -> Put
putFilter__ Filter
f [Char]
attr ((Int64 -> Put) -> [Int64] -> Put
forall {t :: * -> *} {a} {b}.
Foldable t =>
(a -> PutM b) -> t a -> Put
list Int64 -> Put
forall {a}. Integral a => a -> Put
num64) [[Int64]
values] a
ex
putFilter_ f :: Filter
f@(T.FilterRange [Char]
attr Int64
min Int64
max) a
ex = Filter -> [Char] -> (Int64 -> Put) -> [Int64] -> a -> Put
forall {t :: * -> *} {a} {a} {b}.
(Foldable t, Enum a) =>
Filter -> [Char] -> (a -> PutM b) -> t a -> a -> Put
putFilter__ Filter
f [Char]
attr Int64 -> Put
forall {a}. Integral a => a -> Put
num64 [Int64
min, Int64
max] a
ex
putFilter_ f :: Filter
f@(T.FilterFloatRange [Char]
attr Float
min Float
max) a
ex = Filter -> [Char] -> (Float -> Put) -> [Float] -> a -> Put
forall {t :: * -> *} {a} {a} {b}.
(Foldable t, Enum a) =>
Filter -> [Char] -> (a -> PutM b) -> t a -> a -> Put
putFilter__ Filter
f [Char]
attr Float -> Put
float [Float
min, Float
max] a
ex
putFilter__ :: Filter -> [Char] -> (a -> PutM b) -> t a -> a -> Put
putFilter__ Filter
filter [Char]
attr a -> PutM b
puter t a
values a
exclude = do
[Char] -> Put
str [Char]
attr
Int -> Put
num (Int -> Put) -> Int -> Put
forall a b. (a -> b) -> a -> b
$ Filter -> Int
forall {a}. Num a => Filter -> a
T.fromEnumFilter Filter
filter
(a -> PutM b) -> t a -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ a -> PutM b
puter t a
values
Int -> Put
num (Int -> Put) -> Int -> Put
forall a b. (a -> b) -> a -> b
$ a -> Int
forall a. Enum a => a -> Int
fromEnum a
exclude