module Hunt.ClientInterface
(
Command
, ApiDocument(..)
, Huntable(..)
, Content
, Context
, ContextSchema
, Description
, IndexMap
, RegEx
, StatusCmd
, URI
, Weight
, CmdError(..)
, CmdRes(..)
, CmdResult(..)
, LimitedResult(..)
, Score
, cmdSearch
, cmdCompletion
, cmdSelect
, cmdInsertDoc
, cmdUpdateDoc
, cmdDeleteDoc
, cmdDeleteDocsByQuery
, cmdLoadIndex
, cmdStoreIndex
, cmdInsertContext
, cmdDeleteContext
, cmdStatus
, cmdSequence
, cmdNOOP
, setSelectedFields
, setMaxResults
, setResultOffset
, setWeightIncluded
, createContextCommands
, mkApiDoc
, setDescription
, getDescription
, addDescription
, remDescription
, changeDescription
, lookupDescription
, lookupDescriptionText
, setIndex
, addToIndex
, getFromIndex
, changeIndex
, setDocWeight
, listToApiDoc
, insertCmdsToDocuments
, mkDescription
, mapToDescr
, insDescription
, emptyDescription
, fromDescription
, Query
, parseQuery
, module Hunt.Query.Language.Builder
, printQuery
, completeQueries
, mkSchema
, setCxNoDefault
, setCxWeight
, setCxRegEx
, setCxUpperCase
, setCxLowerCase
, setCxZeroFill
, setCxText
, setCxInt
, setCxDate
, setCxPosition
, noScore
, defScore
, mkScore
, getScore
, sendCmdToFile
)
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)
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)
cmdSearch :: Query -> Command
cmdSearch q
= Search { icQuery = q
, icOffsetSR = 0
, icMaxSR = (1)
, icWeight = False
, icFields = Nothing
}
cmdCompletion :: Query -> Command
cmdCompletion q
= Completion { icPrefixCR = q
, icMaxCR = (1)
}
cmdSelect :: Query -> Command
cmdSelect = Select
cmdInsertDoc :: ApiDocument -> Command
cmdInsertDoc = Insert
cmdUpdateDoc :: ApiDocument -> Command
cmdUpdateDoc = Update
cmdDeleteDoc :: URI -> Command
cmdDeleteDoc = Delete
cmdDeleteDocsByQuery :: Query -> Command
cmdDeleteDocsByQuery = DeleteByQuery
cmdInsertContext :: Context -> ContextSchema -> Command
cmdInsertContext cx sc
= InsertContext { icIContext = cx
, icSchema = sc
}
cmdDeleteContext :: Context -> Command
cmdDeleteContext cx
= DeleteContext { icDContext = cx }
cmdLoadIndex :: FilePath -> Command
cmdLoadIndex = LoadIx
cmdStoreIndex :: FilePath -> Command
cmdStoreIndex = StoreIx
cmdStatus :: StatusCmd -> Command
cmdStatus = Status
cmdSequence :: [Command] -> Command
cmdSequence [] = cmdNOOP
cmdSequence [c] = c
cmdSequence cs = Sequence cs
cmdNOOP :: Command
cmdNOOP = NOOP
setMaxResults :: Int -> Command -> Command
setMaxResults mx q@Search{}
= q { icMaxSR = mx }
setMaxResults mx q@Completion{}
= q { icMaxCR = mx }
setMaxResults _ q
= q
setResultOffset :: Int -> Command -> Command
setResultOffset off q@Search{}
= q { icOffsetSR = off }
setResultOffset _ q
= q
setSelectedFields :: [Text] -> Command -> Command
setSelectedFields fs q@Search{}
= q { icFields = Just fs }
setSelectedFields _ q
= q
setWeightIncluded :: Command -> Command
setWeightIncluded q@Search{}
= q { icWeight = True }
setWeightIncluded q
= q
createContextCommands :: [ApiDocument] -> Command
createContextCommands docs = cmdSequence cmds
where
names = nub $ docs >>= (LM.keys . adIndex)
cmds = (\name -> cmdInsertContext name mkSchema) <$> names
mkApiDoc :: URI -> ApiDocument
mkApiDoc u
= ApiDocument
{ adUri = u
, adIndex = emptyApiDocIndexMap
, adDescr = emptyApiDocDescr
, adWght = noScore
}
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 }
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 }
setDocWeight :: Score -> ApiDocument -> ApiDocument
setDocWeight w d
= d { adWght = w }
listToApiDoc
:: Text
-> [(Text, Text)]
-> [(Text, Text)]
-> ApiDocument
listToApiDoc uri k v = setDescription (mkDescription v) $ setIndex (LM.fromList k) $ mkApiDoc $ uri
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
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 _ = []
mkSchema :: ContextSchema
mkSchema = def
setCxNoDefault :: ContextSchema -> ContextSchema
setCxNoDefault sc
= sc { cxDefault = False }
setCxWeight :: Float -> ContextSchema -> ContextSchema
setCxWeight w sc
= sc { cxWeight = mkScore w }
setCxRegEx :: RegEx -> ContextSchema -> ContextSchema
setCxRegEx re sc
= sc { cxRegEx = Just re }
setCxUpperCase :: ContextSchema -> ContextSchema
setCxUpperCase sc
= sc { cxNormalizer = cnUpperCase : cxNormalizer sc }
setCxLowerCase :: ContextSchema -> ContextSchema
setCxLowerCase sc
= sc { cxNormalizer = cnLowerCase : cxNormalizer sc }
setCxZeroFill :: ContextSchema -> ContextSchema
setCxZeroFill sc
= sc { cxNormalizer = cnZeroFill : cxNormalizer sc }
setCxText :: ContextSchema -> ContextSchema
setCxText sc
= sc { cxType = ctText }
setCxInt :: ContextSchema -> ContextSchema
setCxInt sc
= sc { cxType = ctInt }
setCxDate :: ContextSchema -> ContextSchema
setCxDate sc
= sc { cxType = ctDate }
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]
sendCmdToFile :: String -> Command -> IO ()
sendCmdToFile fn cmd
= outputValue fn cmd