module Text.Search.Sphinx.Configuration where

import qualified Text.Search.Sphinx.Types as T

-- | The configuration for a query
--
-- A note about encodings: The encoding specified here is used to encode
-- every @Text@ value that is sent to the server, and it used to decode all
-- of the server's answers, including error messages.
--
-- If the specified encoding doesn't support characters sent to the server,
-- they will silently be substituted with the byte value of @\'\\SUB\' ::
-- 'Char'@ before transmission.
--
-- If the server sends a byte value back that the encoding doesn't understand,
-- the affected bytes will be converted into special values as
-- specified by that encoding. For example, when decoding invalid UTF-8,
-- all invalid bytes are going to be substituted with @\'\\65533\' ::
-- 'Char'@.
--
data Configuration = Configuration {
    -- | The hostname of the Sphinx daemon
    Configuration -> String
host :: String
    -- | The portnumber of the Sphinx daemon
  , Configuration -> Int
port :: Int
    -- | Encoding used to encode queries to the server, and decode server responses
  , Configuration -> String
encoding :: String
    -- | Per-field weights
  , Configuration -> [Int]
weights :: [Int]
    -- | How many records to seek from result-set start (default is 0)
  , Configuration -> Int
offset :: Int
    -- | How many records to return from result-set starting at offset (default is 20)
  , Configuration -> Int
limit :: Int
    -- | Query matching mode
  , Configuration -> MatchMode
mode :: T.MatchMode
    -- | Ranking mode
  , Configuration -> Rank
ranker :: T.Rank
    -- | Ranking expression, used when ranker = RankExpr
  , Configuration -> String
rankExpr :: String
    -- | Match sorting mode
  , Configuration -> Sort
sort :: T.Sort
    -- | Attribute to sort by
  , Configuration -> String
sortBy :: String
    -- | Minimum ID to match, 0 means no limit
  , Configuration -> Int
minId :: Int
    -- | Maximum ID to match, 0 means no limit
  , Configuration -> Int
maxId :: Int
    -- | attribute filters
  , Configuration -> [Filter]
filters :: [T.Filter]
    -- | Group-by sorting clause (to sort groups in result set with)
  , Configuration -> String
groupBy :: String
    -- | Group-by count-distinct attribute
  , Configuration -> String
groupSort :: String
    -- | Group-by function (to pre-process group-by attribute value with)
  , Configuration -> GroupByFunction
groupByFunc :: T.GroupByFunction
    -- | Group-by attribute name 
  , Configuration -> String
groupDistinct :: String
    -- | Maximum number of matches to retrieve
  , Configuration -> Int
maxMatches :: Int
    -- | Cutoff to stop searching at
  , Configuration -> Int
cutoff :: Int
    -- | Distributed retries count
  , Configuration -> Int
retryCount :: Int
    -- | Distributed retries delay
  , Configuration -> Int
retryDelay :: Int
    -- | Per-index weights
  , Configuration -> [(String, Int)]
indexWeights :: [(String, Int)]
    -- | Maximum query time in milliseconds, 0 means no limit
  , Configuration -> Int
maxQueryTime :: Int
    -- | Per-field-name weights
  , Configuration -> [(String, Int)]
fieldWeights :: [(String, Int)]
    -- | attributes to select, defaults to \"*\"
  , Configuration -> String
selectClause :: String -- setSelect in regular API
}
 deriving (Int -> Configuration -> ShowS
[Configuration] -> ShowS
Configuration -> String
(Int -> Configuration -> ShowS)
-> (Configuration -> String)
-> ([Configuration] -> ShowS)
-> Show Configuration
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Configuration -> ShowS
showsPrec :: Int -> Configuration -> ShowS
$cshow :: Configuration -> String
show :: Configuration -> String
$cshowList :: [Configuration] -> ShowS
showList :: [Configuration] -> ShowS
Show)

-- | A basic, default configuration.
defaultConfig :: Configuration
defaultConfig = Configuration {
                  port :: Int
port          = Int
3312
                , host :: String
host          = String
"127.0.0.1"
                , encoding :: String
encoding      = String
"UTF-8"
                , weights :: [Int]
weights       = []
                , offset :: Int
offset        = Int
0
                , limit :: Int
limit         = Int
20
                , mode :: MatchMode
mode          = MatchMode
T.All
                , ranker :: Rank
ranker        = Rank
T.ProximityBm25
                , rankExpr :: String
rankExpr      = String
""
                , sort :: Sort
sort          = Sort
T.Relevance
                , sortBy :: String
sortBy        = String
""
                , minId :: Int
minId         = Int
0
                , maxId :: Int
maxId         = Int
0
                , filters :: [Filter]
filters       = []
                , groupSort :: String
groupSort     = String
"@group desc"
                , groupBy :: String
groupBy       = String
""
                , groupByFunc :: GroupByFunction
groupByFunc   = GroupByFunction
T.Day
                , groupDistinct :: String
groupDistinct = String
""
                , maxMatches :: Int
maxMatches    = Int
1000
                , cutoff :: Int
cutoff        = Int
0
                , retryCount :: Int
retryCount    = Int
0
                , retryDelay :: Int
retryDelay    = Int
0
                , indexWeights :: [(String, Int)]
indexWeights  = []
                , maxQueryTime :: Int
maxQueryTime  = Int
0
                , fieldWeights :: [(String, Int)]
fieldWeights  = []
                , selectClause :: String
selectClause  = String
"*"
              }