module Text.Search.Sphinx.ExcerptConfiguration where

-- import qualified Text.Search.Sphinx.Types as T

data ExcerptConfiguration = ExcerptConfiguration {
    -- | The hostname of the Sphinx daemon
    ExcerptConfiguration -> String
host :: String
    -- | The portnumber of the Sphinx daemon
  , ExcerptConfiguration -> Int
port :: Int
    -- | Encoding used to encode queries to the server, and decode server responses
  , ExcerptConfiguration -> String
encoding :: String
  , ExcerptConfiguration -> String
beforeMatch :: String
  , ExcerptConfiguration -> String
afterMatch :: String
  , ExcerptConfiguration -> String
chunkSeparator :: String
  , ExcerptConfiguration -> Int
limit  :: Int
  , ExcerptConfiguration -> Int
around :: Int
  , ExcerptConfiguration -> Bool
exactPhrase :: Bool
  , ExcerptConfiguration -> Bool
singlePassage :: Bool
  , ExcerptConfiguration -> Bool
useBoundaries :: Bool
  , ExcerptConfiguration -> Bool
weightOrder :: Bool
  -- | warning! broken on 1.10-beta (keep to default of false). Fixed on trunk
  , ExcerptConfiguration -> Bool
queryMode :: Bool
  , ExcerptConfiguration -> Bool
forceAllWords :: Bool
  , ExcerptConfiguration -> Int
limitPassages :: Int
  , ExcerptConfiguration -> Int
limitWords :: Int
  , ExcerptConfiguration -> Int
startPassageId :: Int
  , ExcerptConfiguration -> Bool
loadFiles :: Bool
  , ExcerptConfiguration -> String
htmlStripMode :: String
  , ExcerptConfiguration -> Bool
allowEmpty :: Bool
  , ExcerptConfiguration -> String
passageBoundary :: String
}
 deriving (Int -> ExcerptConfiguration -> ShowS
[ExcerptConfiguration] -> ShowS
ExcerptConfiguration -> String
(Int -> ExcerptConfiguration -> ShowS)
-> (ExcerptConfiguration -> String)
-> ([ExcerptConfiguration] -> ShowS)
-> Show ExcerptConfiguration
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ExcerptConfiguration -> ShowS
showsPrec :: Int -> ExcerptConfiguration -> ShowS
$cshow :: ExcerptConfiguration -> String
show :: ExcerptConfiguration -> String
$cshowList :: [ExcerptConfiguration] -> ShowS
showList :: [ExcerptConfiguration] -> ShowS
Show)

-- this is true to the API
defaultConfig :: ExcerptConfiguration
defaultConfig = ExcerptConfiguration {
    port :: Int
port          = Int
3312
  , host :: String
host          = String
"127.0.0.1"
  , encoding :: String
encoding      = String
"utf8"
  , beforeMatch :: String
beforeMatch = String
"<b>"
  , afterMatch :: String
afterMatch = String
"</b>"
  , chunkSeparator :: String
chunkSeparator = String
"..."
  , limit :: Int
limit  = Int
256
  , around :: Int
around = Int
5
  , exactPhrase :: Bool
exactPhrase = Bool
False
  , singlePassage :: Bool
singlePassage = Bool
False
  , weightOrder :: Bool
weightOrder = Bool
False
  , queryMode :: Bool
queryMode = Bool
False
  , forceAllWords :: Bool
forceAllWords = Bool
False
  , limitPassages :: Int
limitPassages = Int
0
  , limitWords :: Int
limitWords = Int
0
  , useBoundaries :: Bool
useBoundaries = Bool
False
  , startPassageId :: Int
startPassageId = Int
1
  , loadFiles :: Bool
loadFiles = Bool
False
  , htmlStripMode :: String
htmlStripMode = String
"index" -- "none", "strip", "index", and "retain". 
  , allowEmpty :: Bool
allowEmpty = Bool
False
  , passageBoundary :: String
passageBoundary = String
"none"
}

-- this seems better to me
altConfig :: ExcerptConfiguration
altConfig = ExcerptConfiguration
defaultConfig {
    beforeMatch = "<span class='match'>"
  , afterMatch = "</span>"
  , chunkSeparator = " &#8230; "
  -- , queryMode = True Buggy!
  , forceAllWords = True
}