{- | Module : Hunt.ClientInterface License : MIT Maintainer : Uwe Schmidt Stability : experimental Portability: none portable Common data types and and smart constructors for calling a hunt server from a client. Values of the Command datatype and its component types, e.g Query, ApiDocument, and others can be constructed with the "smart" construtors defined in this module The module is intended to be imported qualified, eg like @import qualified Hunt.ClientInterface as HI@. -} -- ---------------------------------------------------------------------------- module Hunt.ClientInterface ( -- * types used in commands Command , ApiDocument(..) -- also used in results , Huntable(..) , Content , Context , ContextSchema , Description , IndexMap , RegEx , StatusCmd , URI , Weight -- * types used in results , CmdError(..) , CmdRes(..) , CmdResult(..) , LimitedResult(..) , Score -- * command construction , cmdSearch , cmdCompletion , cmdSelect , cmdInsertDoc , cmdUpdateDoc , cmdDeleteDoc , cmdDeleteDocsByQuery , cmdLoadIndex , cmdStoreIndex , cmdInsertContext , cmdDeleteContext , cmdStatus , cmdSequence , cmdNOOP -- ** configuration options for search and completion , setSelectedFields , setMaxResults , setResultOffset , setWeightIncluded -- ** Misc , createContextCommands -- * ApiDocument construction, configuration and access , mkApiDoc , setDescription , getDescription , addDescription , remDescription , changeDescription , lookupDescription , lookupDescriptionText , setIndex , addToIndex , getFromIndex , changeIndex , setDocWeight -- ** Misc , listToApiDoc , insertCmdsToDocuments -- ** description construction , mkDescription , mapToDescr , insDescription , emptyDescription , fromDescription -- * Queries , Query -- ** query parsing , parseQuery -- ** query construction , module Hunt.Query.Language.Builder -- ** pretty printing , printQuery -- ** query completion , completeQueries -- * schema definition , mkSchema , setCxNoDefault , setCxWeight , setCxRegEx , setCxUpperCase , setCxLowerCase , setCxZeroFill , setCxText , setCxInt , setCxDate , setCxPosition -- * Weights and Scores , noScore , defScore , mkScore , getScore -- -- * Output to server and file -- , sendCmdToServer , sendCmdToFile -- , defaultServer ) where import Control.Applicative ((<$>)) import Data.Aeson (FromJSON (..), ToJSON (..), Value(..)) import Data.Default import Data.List (nub) import qualified Data.Map.Strict as SM import qualified Data.Map.Lazy as LM import Data.Text (Text) import qualified Data.Text as T import Hunt.Common.ApiDocument (ApiDocument (..), IndexMap, LimitedResult (..), emptyApiDocDescr, emptyApiDocIndexMap) import Hunt.Common.BasicTypes (Content, Context, Description, RegEx, Score, URI, Weight, defScore, getScore, mkScore, noScore) import qualified Hunt.Common.DocDesc as DD import Hunt.Index.Schema import Hunt.Interpreter.Command import Hunt.Query.Language.Builder import Hunt.Query.Language.Grammar import Hunt.Query.Language.Parser (parseQuery) import Hunt.Utility.Output (outputValue) -- ------------------------------------------------------------ -- lookup commands class Huntable x where huntURI :: x -> URI huntIndexMap :: x -> IndexMap huntIndexMap _ = emptyApiDocIndexMap huntDescr :: x -> Description huntDescr _ = emptyApiDocDescr toApiDocument :: x -> ApiDocument toApiDocument x = setDescription (huntDescr x) $ setIndex (huntIndexMap x) $ mkApiDoc $ (huntURI x) -- | create simple search command cmdSearch :: Query -> Command cmdSearch q = Search { icQuery = q , icOffsetSR = 0 , icMaxSR = (-1) -- unlimited , icWeight = False , icFields = Nothing } -- | Create simple completion command cmdCompletion :: Query -> Command cmdCompletion q = Completion { icPrefixCR = q , icMaxCR = (-1) -- unlimited } cmdSelect :: Query -> Command cmdSelect = Select -- ------------------------------------------------------------ -- modifying commands -- | insert document cmdInsertDoc :: ApiDocument -> Command cmdInsertDoc = Insert -- | update document cmdUpdateDoc :: ApiDocument -> Command cmdUpdateDoc = Update -- | delete document identified by an URI cmdDeleteDoc :: URI -> Command cmdDeleteDoc = Delete -- | delete all documents idenitfied by a query cmdDeleteDocsByQuery :: Query -> Command cmdDeleteDocsByQuery = DeleteByQuery -- ------------------------------------------------------------ -- index schema manipulation cmdInsertContext :: Context -> ContextSchema -> Command cmdInsertContext cx sc = InsertContext { icIContext = cx , icSchema = sc } cmdDeleteContext :: Context -> Command cmdDeleteContext cx = DeleteContext { icDContext = cx } -- ------------------------------------------------------------ -- index persistance cmdLoadIndex :: FilePath -> Command cmdLoadIndex = LoadIx cmdStoreIndex :: FilePath -> Command cmdStoreIndex = StoreIx -- ------------------------------------------------------------ -- status and control commands cmdStatus :: StatusCmd -> Command cmdStatus = Status cmdSequence :: [Command] -> Command cmdSequence [] = cmdNOOP cmdSequence [c] = c cmdSequence cs = Sequence cs cmdNOOP :: Command cmdNOOP = NOOP -- ------------------------------------------------------------ -- | configure search and completion command: set the max # of results setMaxResults :: Int -> Command -> Command setMaxResults mx q@Search{} = q { icMaxSR = mx } setMaxResults mx q@Completion{} = q { icMaxCR = mx } setMaxResults _ q = q -- | configure search command: set the starting offset of the result list setResultOffset :: Int -> Command -> Command setResultOffset off q@Search{} = q { icOffsetSR = off } setResultOffset _ q = q -- | configure search command: set the list of attributes of the document decription -- to be included in the result list -- -- example: @setSelectedFields ["title", "date"]@ restricts the documents -- attributes to these to fields setSelectedFields :: [Text] -> Command -> Command setSelectedFields fs q@Search{} = q { icFields = Just fs } setSelectedFields _ q = q -- | configure search command: include document weight in result list setWeightIncluded :: Command -> Command setWeightIncluded q@Search{} = q { icWeight = True } setWeightIncluded q = q -- | create InsertContext Commands by a list of Insert Commands -- These contexts are not optimized and shoudn't be used in production code. createContextCommands :: [ApiDocument] -> Command createContextCommands docs = cmdSequence cmds where names = nub $ docs >>= (LM.keys . adIndex) cmds = (\name -> cmdInsertContext name mkSchema) <$> names -- ------------------------------------------------------------ -- | build an api document with an uri as key and a description -- map as contents mkApiDoc :: URI -> ApiDocument mkApiDoc u = ApiDocument { adUri = u , adIndex = emptyApiDocIndexMap , adDescr = emptyApiDocDescr , adWght = noScore } -- | add an index map containing the text parts to be indexed setDescription :: Description -> ApiDocument -> ApiDocument setDescription descr d = d { adDescr = descr } getDescription :: ApiDocument -> Description getDescription = adDescr lookupDescription :: FromJSON v => Text -> ApiDocument -> Maybe v lookupDescription k = DD.lookup k . adDescr lookupDescriptionText :: Text -> ApiDocument -> Text lookupDescriptionText k = DD.lookupText k . adDescr addDescription :: ToJSON v => Text -> v -> ApiDocument -> ApiDocument addDescription k v = changeDescription $ DD.insert k v remDescription :: Text -> ApiDocument -> ApiDocument remDescription k = changeDescription $ DD.delete k changeDescription :: (Description -> Description) -> ApiDocument -> ApiDocument changeDescription f a = a { adDescr = f . adDescr $ a } -- | add an index map containing the text parts to be indexed setIndex :: IndexMap -> ApiDocument -> ApiDocument setIndex im d = d { adIndex = im } addToIndex :: Context -> Content -> ApiDocument -> ApiDocument addToIndex cx ct d | T.null ct = d | otherwise = changeIndex (SM.insert cx ct) d getFromIndex :: Context -> ApiDocument -> Text getFromIndex cx d = maybe "" id . SM.lookup cx . adIndex $ d changeIndex :: (IndexMap -> IndexMap) -> ApiDocument -> ApiDocument changeIndex f a = a { adIndex = f $ adIndex a } -- | add a document weight setDocWeight :: Score -> ApiDocument -> ApiDocument setDocWeight w d = d { adWght = w } -- | wrapper for building an ApiDocument by lists listToApiDoc :: Text -- ^ The uri -> [(Text, Text)] -- ^ The index -> [(Text, Text)] -- ^ The description -> ApiDocument listToApiDoc uri k v = setDescription (mkDescription v) $ setIndex (LM.fromList k) $ mkApiDoc $ uri -- ------------------------------------------------------------ -- document description -- build a document description from a list of key-value pairs with -- simple text values mkDescription :: [(Text, Text)] -> Description mkDescription = DD.fromList . filter (not . T.null . snd) mapToDescr :: LM.Map Text Text -> DD.DocDesc mapToDescr src = mkDescription $ LM.toList src -- insert a key-value pair with an arbitrary value into -- a document description insDescription :: ToJSON v => Text -> v -> Description -> Description insDescription = DD.insert emptyDescription :: Description emptyDescription = DD.empty fromDescription :: Description -> [(Text, Value)] fromDescription = DD.toList insertCmdsToDocuments :: Command -> [ApiDocument] insertCmdsToDocuments (Insert d) = [d] insertCmdsToDocuments (Sequence cs) = cs >>= insertCmdsToDocuments insertCmdsToDocuments _ = [] -- ------------------------------------------------------------ -- ------------------------------------------------------------ -- context schema construction -- | the default schema: context type is text, no normalizers, -- weigth is 1.0, context is always searched by queries without context spec mkSchema :: ContextSchema mkSchema = def -- | prevent searching in context, when not explicitly set in query setCxNoDefault :: ContextSchema -> ContextSchema setCxNoDefault sc = sc { cxDefault = False } -- | set the regex for splitting a text into words setCxWeight :: Float -> ContextSchema -> ContextSchema setCxWeight w sc = sc { cxWeight = mkScore w } -- | set the regex for splitting a text into words setCxRegEx :: RegEx -> ContextSchema -> ContextSchema setCxRegEx re sc = sc { cxRegEx = Just re } -- | add a text normalizer for transformation into uppercase setCxUpperCase :: ContextSchema -> ContextSchema setCxUpperCase sc = sc { cxNormalizer = cnUpperCase : cxNormalizer sc } -- | add a text normalizer for transformation into lowercase setCxLowerCase :: ContextSchema -> ContextSchema setCxLowerCase sc = sc { cxNormalizer = cnLowerCase : cxNormalizer sc } -- | add a text normalizer for transformation into lowercase setCxZeroFill :: ContextSchema -> ContextSchema setCxZeroFill sc = sc { cxNormalizer = cnZeroFill : cxNormalizer sc } -- | set the type of a context to text setCxText :: ContextSchema -> ContextSchema setCxText sc = sc { cxType = ctText } -- | set the type of a context to Int setCxInt :: ContextSchema -> ContextSchema setCxInt sc = sc { cxType = ctInt } -- | set the type of a context to Date setCxDate :: ContextSchema -> ContextSchema setCxDate sc = sc { cxType = ctDate } -- | set the type of a context to Int setCxPosition :: ContextSchema -> ContextSchema setCxPosition sc = sc { cxType = ctPosition } -- ------------------------------------------------------------ completeQueries :: Query -> [Text] -> [Query] completeQueries (QWord t _) comps = (\c -> QWord t (c)) <$> comps completeQueries (QFullWord t _) comps = (\c -> QFullWord t (c))<$> comps completeQueries (QPhrase t _) comps = (\c -> QPhrase t (c)) <$> comps completeQueries (QContext cxs q) comps = (QContext cxs) <$> (completeQueries q comps) completeQueries (QBinary op q1 q2) comps = (QBinary op q1) <$> (completeQueries q2 comps) completeQueries (QSeq op qs) comps = (QSeq op) <$> (completeLast qs) where completeLast [] = [] completeLast [q] = sequence [completeQueries q comps] completeLast (q:qs') = (q :) <$> completeLast qs' completeQueries (QBoost w q) comps = (QBoost w) <$> (completeQueries q comps) completeQueries (QRange t1 t2) _ = [QRange t1 t2] -- TODO -- ------------------------------------------------------------ -- client output -- | send command as JSON into a file -- -- the JSON is pretty printed with aeson-pretty, -- @""@ and @"-"@ are used for output to stdout sendCmdToFile :: String -> Command -> IO () sendCmdToFile fn cmd = outputValue fn cmd -- ------------------------------------------------------------