packages feed

sphinx-cli-0.1: SphinxCLI.hs

module Main where

import Text.Search.Sphinx
import qualified Text.Search.Sphinx.Types as ST

import System.Console.GetOpt
import System.Environment

main :: IO ()
main = do
    args     <- getArgs
    case getOpt Permute options args of
       (_, [],  _) -> printUsage 
       (o, q,  []) -> printQuery (getConfig o) (getIndex o) (unwords q)
       (_, _, err) -> printUsageError err

printQuery :: Configuration -> String -> String -> IO ()
printQuery cfg idx q = do
    res <- query cfg idx q
    print res

printUsage :: IO ()
printUsage = printUsageError []

printUsageError :: [String] -> IO ()
printUsageError err = do
    progName <- getProgName
    putStrLn $ concat err ++ usageInfo (header progName) options
  where header p = "Usage: " ++ p ++ " [OPTIONS] query words"

-- Some options (such as the index) are not part of the configuration.
data Flag = Host      String
          | Port      Int
          | Index     String
          | SortBy    String
          | SortExpr  String
          | Any
          | Boolean
          | Extended
          | Extended2
          | Phrase
          | Filter    String
          | Value     String
          | GroupBy   String
          | GroupSort String
          | Distinct  String
          | Limit     Int
          | Rank      ST.Rank

options :: [OptDescr Flag]
options = 
    [ Option ['h'] ["host"]      (ReqArg Host "HOST")       "connect to searchd at host HOST"
    , Option ['p'] ["port"]      (ReqArg (Port . read) "PORT")    "connect to searchd at port PORT"
    , Option ['i'] ["index"]     (ReqArg Index "IDX")       "search through index(es) specified by IDX"
	, Option ['s'] ["sortby"]    (ReqArg SortBy "CLAUSE")   "sort matches by 'CLAUSE' in sort_extended mode"
	, Option ['S'] ["sortexpr"]  (ReqArg SortExpr "EXPR")   "sort matches by 'EXPR' DESC in sort_expr mode"
	, Option ['a'] ["any"]       (NoArg Any)                "use 'match any word' matching mode"
	, Option ['b'] ["boolean"]   (NoArg Boolean)            "use 'boolean query' matching mode"
	, Option ['e'] ["extended"]  (NoArg Extended)           "use 'extended query' matching mode"
    , Option ['E'] ["extended2"] (NoArg Extended2)          "use 'extended query' V2 matching mode"
	, Option ['P'] ["phrase"]    (NoArg Phrase)             "use 'exact phrase' matching mode"
	, Option ['f'] ["filter"]    (ReqArg Filter "ATTR")     "filter by attribute 'ATTR' (default is 'group_id') (NOT YET SUPPORTED)"
	, Option ['v'] ["value"]     (ReqArg Value "VAL")       "add VAL to allowed 'group_id' values list (NOT YET SUPPORTED)"
	, Option ['g'] ["groupby"]   (ReqArg GroupBy "EXPR")    "group matches by 'EXPR'"
	, Option ['G'] ["groupsort"] (ReqArg GroupSort "EXPR")  "sort groups by 'EXPR'"
	, Option ['d'] ["distinct"]  (ReqArg Distinct "ATTR")   "count distinct values of 'ATTR''"
	, Option ['l'] ["limit"]     (ReqArg (Limit . read) "COUNT")     "retrieve COUNT matches (default: 20)"
    , Option ['r'] ["rank"]      (ReqArg rank "RANK")       "ranking mode, only for extended V2!"
    ]

rank "bm25"      = Rank ST.Bm25
rank "none"      = Rank ST.None
rank "wordcount" = Rank ST.WordCount
rank _           = error "Unknown ranking algorithm.  Should be 'bm25', 'none' or 'wordcount'"

getConfig :: [Flag] -> Configuration
getConfig = foldl setConfig testConfig

setConfig :: Configuration -> Flag -> Configuration
setConfig c (Host  h)     = c { host = h }
setConfig c (Port  p)     = c { port = p }
setConfig c (Index _)     = c -- Not part of the configuration
setConfig c (SortBy s)    = c { sort = ST.SortExtended, sortBy = s } 
setConfig c (SortExpr e)  = c { sort = ST.Expr,     sortBy = e } 
setConfig c (Any)         = c { mode = ST.Any }
setConfig c (Boolean)     = c { mode = ST.Boolean }
setConfig c (Extended)    = c { mode = ST.Extended }
setConfig c (Extended2)   = c { mode = ST.Extended2 }
setConfig c (Phrase)      = c { mode = ST.Phrase }
setConfig c (Filter f)    = c -- Not yet supported! TODO
setConfig c (Value v)     = c -- Not yet supported! TODO
setConfig c (GroupBy g)   = c { groupBy       = g }
setConfig c (GroupSort g) = c { groupSort     = g }
setConfig c (Distinct d)  = c { groupDistinct = d }
setConfig c (Limit x)     = c { limit  = x, maxMatches = max 1000 x }
setConfig c (Rank r)      = c { ranker = r }

getIndex :: [Flag] -> String
getIndex []             = "*"
getIndex (Index i:rest) = i
getIndex (_      :rest) = getIndex rest

testConfig = defaultConfig { weights = [100, 1] }