module Hunt.Query.Language.Builder
( qWord
, qWordNoCase
, qFullWord
, qFullWordNoCase
, qPhrase
, qPhraseNoCase
, qPrefixPhrase
, qPrefixPhraseNoCase
, qRange
, qAnd
, qAnds
, qOr
, qOrs
, qAndNot
, qAndNots
, qNext
, qNexts
, qFollow
, qFollows
, qNear
, qNears
, setNoCaseSearch
, setFuzzySearch
, setContext
, setContexts
, setBoost
, withinContexts
, withinContext
, withBoost
, qContext
)
where
import Hunt.Query.Language.Grammar
import Data.Text (Text)
import qualified Data.Text as T
import Hunt.Common.BasicTypes (Context, Weight)
qWord :: Text -> Query
qWord = QWord QCase
qWordNoCase :: Text -> Query
qWordNoCase = QWord QNoCase
qFullWord :: Text -> Query
qFullWord = QFullWord QCase
qFullWordNoCase :: Text -> Query
qFullWordNoCase = QFullWord QNoCase
qPhrase' :: (Text -> Query) -> Text -> Query
qPhrase' qf t
= case T.words t of
[w] -> qf w
ws -> qNexts $ map qf ws
qPhrase :: Text -> Query
qPhrase = qPhrase' qFullWord
qPhraseNoCase :: Text -> Query
qPhraseNoCase = qPhrase' qFullWordNoCase
qPrefixPhrase :: Text -> Query
qPrefixPhrase = qPhrase' qWordNoCase
qPrefixPhraseNoCase :: Text -> Query
qPrefixPhraseNoCase = qPhrase' qWordNoCase
qRange :: Text -> Text -> Query
qRange = QRange
qContext :: Context -> Text -> Query
qContext c w = QContext [c] $ QWord QCase w
qAnd :: Query -> Query -> Query
qAnd q1 q2 = qAnds [q1, q2]
qAnds :: [Query] -> Query
qAnds = mkAssocSeq And
qOr :: Query -> Query -> Query
qOr q1 q2 = qOrs [q1, q2]
qOrs :: [Query] -> Query
qOrs = mkAssocSeq Or
qAndNot :: Query -> Query -> Query
qAndNot q1 q2 = qAndNots [q1, q2]
qAndNots :: [Query] -> Query
qAndNots = mkLeftAssocSeq AndNot
qNext :: Query -> Query -> Query
qNext q1 q2 = qNexts [q1, q2]
qNexts :: [Query] -> Query
qNexts = mkAssocSeq Phrase
qFollow :: Int -> Query -> Query -> Query
qFollow d q1 q2 = qFollows d [q1, q2]
qFollows :: Int -> [Query] -> Query
qFollows d = mkAssocSeq (Follow d)
qNear :: Int -> Query -> Query -> Query
qNear d q1 q2 = qNears d [q1, q2]
qNears :: Int -> [Query] -> Query
qNears d = mkAssocSeq (Near d)
collectAssocs :: BinOp -> [Query] -> [Query]
collectAssocs op qs
= concatMap subqs qs
where
subqs (QSeq op' qs')
| op == op'
= qs'
subqs q'
= [q']
mkAssocSeq :: BinOp -> [Query] -> Query
mkAssocSeq op qs
= remSingle $ QSeq op (collectAssocs op qs)
mkLeftAssocSeq :: BinOp -> [Query] -> Query
mkLeftAssocSeq op qs
= remSingle $ QSeq op qs'
where
qs' = case qs of
(QSeq op' qs1 : qs2)
| op == op'
-> qs1 ++ qs2
_ -> qs
remSingle :: Query -> Query
remSingle (QSeq _ [q])
= q
remSingle q
= q
setNoCaseSearch :: Query -> Query
setNoCaseSearch (QWord _ w) = QWord QNoCase w
setNoCaseSearch (QFullWord _ w) = QFullWord QNoCase w
setNoCaseSearch (QPhrase _ w) = QPhrase QNoCase w
setNoCaseSearch q = q
setFuzzySearch :: Query -> Query
setFuzzySearch (QWord _ w) = QWord QFuzzy w
setFuzzySearch (QFullWord _ w) = QFullWord QFuzzy w
setFuzzySearch (QPhrase _ w) = QPhrase QFuzzy w
setFuzzySearch q = q
setContexts :: [Context] -> Query -> Query
setContexts = QContext
withinContexts :: [Context] -> Query -> Query
withinContexts = QContext
setContext :: Context -> Query -> Query
setContext cx = withinContexts [cx]
withinContext :: Context -> Query -> Query
withinContext cx = setContexts [cx]
setBoost :: Weight -> Query -> Query
setBoost = QBoost
withBoost :: Weight -> Query -> Query
withBoost = QBoost