{-# LANGUAGE CPP #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralisedNewtypeDeriving #-}
module Database.Esqueleto.TextSearch.Language
( (@@.)
, prefixAndQuery
, prefixOrQuery
, prefixAndQueryLang
, prefixOrQueryLang
, toSearchTerm
, toSearchTermWeighted
, SearchTerm
, to_tsvector
, to_tsquery
, plainto_tsquery
, ts_rank
, ts_rank_cd
, setweight
, tsquery_or
, tsquery_and
) where
import Data.String (IsString)
import Data.Text (Text)
#if MIN_VERSION_esqueleto(3,5,0)
import Database.Esqueleto.Internal.Internal (unsafeSqlBinOp, unsafeSqlFunction)
import Database.Esqueleto.Experimental (SqlExpr, Value, val)
#else
import Database.Esqueleto (SqlExpr, Value, val)
import Database.Esqueleto.Internal.Sql (unsafeSqlBinOp, unsafeSqlFunction)
#endif
import Database.Esqueleto.TextSearch.Types
import qualified Data.Text as T
import Data.List.NonEmpty(nonEmpty, NonEmpty, toList)
(@@.)
:: SqlExpr (Value TsVector)
-> SqlExpr (Value (TsQuery Lexemes))
-> SqlExpr (Value Bool)
@@. :: SqlExpr (Value TsVector)
-> SqlExpr (Value (TsQuery Lexemes)) -> SqlExpr (Value Bool)
(@@.) = Builder
-> SqlExpr (Value TsVector)
-> SqlExpr (Value (TsQuery Lexemes))
-> SqlExpr (Value Bool)
forall a b c.
Builder
-> SqlExpr (Value a) -> SqlExpr (Value b) -> SqlExpr (Value c)
unsafeSqlBinOp Builder
"@@"
to_tsvector
:: IsString a
=> SqlExpr (Value RegConfig)
-> SqlExpr (Value a)
-> SqlExpr (Value TsVector)
to_tsvector :: forall a.
IsString a =>
SqlExpr (Value RegConfig)
-> SqlExpr (Value a) -> SqlExpr (Value TsVector)
to_tsvector SqlExpr (Value RegConfig)
a SqlExpr (Value a)
b = Builder
-> (SqlExpr (Value RegConfig), SqlExpr (Value a))
-> SqlExpr (Value TsVector)
forall a b.
UnsafeSqlFunctionArgument a =>
Builder -> a -> SqlExpr (Value b)
unsafeSqlFunction Builder
"to_tsvector" (SqlExpr (Value RegConfig)
a, SqlExpr (Value a)
b)
to_tsquery
:: SqlExpr (Value RegConfig)
-> SqlExpr (Value (TsQuery Words))
-> SqlExpr (Value (TsQuery Lexemes) )
to_tsquery :: SqlExpr (Value RegConfig)
-> SqlExpr (Value (TsQuery Words))
-> SqlExpr (Value (TsQuery Lexemes))
to_tsquery SqlExpr (Value RegConfig)
a SqlExpr (Value (TsQuery Words))
b = Builder
-> (SqlExpr (Value RegConfig), SqlExpr (Value (TsQuery Words)))
-> SqlExpr (Value (TsQuery Lexemes))
forall a b.
UnsafeSqlFunctionArgument a =>
Builder -> a -> SqlExpr (Value b)
unsafeSqlFunction Builder
"to_tsquery" (SqlExpr (Value RegConfig)
a, SqlExpr (Value (TsQuery Words))
b)
plainto_tsquery
:: SqlExpr (Value RegConfig)
-> SqlExpr (Value Text)
-> SqlExpr (Value (TsQuery Lexemes))
plainto_tsquery :: SqlExpr (Value RegConfig)
-> SqlExpr (Value Text) -> SqlExpr (Value (TsQuery Lexemes))
plainto_tsquery SqlExpr (Value RegConfig)
a SqlExpr (Value Text)
b = Builder
-> (SqlExpr (Value RegConfig), SqlExpr (Value Text))
-> SqlExpr (Value (TsQuery Lexemes))
forall a b.
UnsafeSqlFunctionArgument a =>
Builder -> a -> SqlExpr (Value b)
unsafeSqlFunction Builder
"plainto_tsquery" (SqlExpr (Value RegConfig)
a, SqlExpr (Value Text)
b)
ts_rank
:: SqlExpr (Value Weights)
-> SqlExpr (Value TsVector)
-> SqlExpr (Value (TsQuery Lexemes))
-> SqlExpr (Value [NormalizationOption])
-> SqlExpr (Value Double)
ts_rank :: SqlExpr (Value Weights)
-> SqlExpr (Value TsVector)
-> SqlExpr (Value (TsQuery Lexemes))
-> SqlExpr (Value [NormalizationOption])
-> SqlExpr (Value Double)
ts_rank SqlExpr (Value Weights)
a SqlExpr (Value TsVector)
b SqlExpr (Value (TsQuery Lexemes))
c SqlExpr (Value [NormalizationOption])
d = Builder
-> (SqlExpr (Value Weights), SqlExpr (Value TsVector),
SqlExpr (Value (TsQuery Lexemes)),
SqlExpr (Value [NormalizationOption]))
-> SqlExpr (Value Double)
forall a b.
UnsafeSqlFunctionArgument a =>
Builder -> a -> SqlExpr (Value b)
unsafeSqlFunction Builder
"ts_rank" (SqlExpr (Value Weights)
a, SqlExpr (Value TsVector)
b, SqlExpr (Value (TsQuery Lexemes))
c, SqlExpr (Value [NormalizationOption])
d)
ts_rank_cd
:: SqlExpr (Value Weights)
-> SqlExpr (Value TsVector)
-> SqlExpr (Value (TsQuery Lexemes))
-> SqlExpr (Value [NormalizationOption])
-> SqlExpr (Value Double)
ts_rank_cd :: SqlExpr (Value Weights)
-> SqlExpr (Value TsVector)
-> SqlExpr (Value (TsQuery Lexemes))
-> SqlExpr (Value [NormalizationOption])
-> SqlExpr (Value Double)
ts_rank_cd SqlExpr (Value Weights)
a SqlExpr (Value TsVector)
b SqlExpr (Value (TsQuery Lexemes))
c SqlExpr (Value [NormalizationOption])
d = Builder
-> (SqlExpr (Value Weights), SqlExpr (Value TsVector),
SqlExpr (Value (TsQuery Lexemes)),
SqlExpr (Value [NormalizationOption]))
-> SqlExpr (Value Double)
forall a b.
UnsafeSqlFunctionArgument a =>
Builder -> a -> SqlExpr (Value b)
unsafeSqlFunction Builder
"ts_rank_cd" (SqlExpr (Value Weights)
a, SqlExpr (Value TsVector)
b, SqlExpr (Value (TsQuery Lexemes))
c, SqlExpr (Value [NormalizationOption])
d)
setweight
:: SqlExpr (Value TsVector)
-> SqlExpr (Value Weight)
-> SqlExpr (Value TsVector)
setweight :: SqlExpr (Value TsVector)
-> SqlExpr (Value Weight) -> SqlExpr (Value TsVector)
setweight SqlExpr (Value TsVector)
a SqlExpr (Value Weight)
b = Builder
-> (SqlExpr (Value TsVector), SqlExpr (Value Weight))
-> SqlExpr (Value TsVector)
forall a b.
UnsafeSqlFunctionArgument a =>
Builder -> a -> SqlExpr (Value b)
unsafeSqlFunction Builder
"setweight" (SqlExpr (Value TsVector)
a, SqlExpr (Value Weight)
b)
tsquery_and :: SqlExpr (Value (TsQuery Lexemes))
-> SqlExpr (Value (TsQuery Lexemes))
-> SqlExpr (Value (TsQuery Lexemes))
tsquery_and :: SqlExpr (Value (TsQuery Lexemes))
-> SqlExpr (Value (TsQuery Lexemes))
-> SqlExpr (Value (TsQuery Lexemes))
tsquery_and = Builder
-> SqlExpr (Value (TsQuery Lexemes))
-> SqlExpr (Value (TsQuery Lexemes))
-> SqlExpr (Value (TsQuery Lexemes))
forall a b c.
Builder
-> SqlExpr (Value a) -> SqlExpr (Value b) -> SqlExpr (Value c)
unsafeSqlBinOp Builder
"&&"
tsquery_or :: SqlExpr (Value (TsQuery Lexemes))
-> SqlExpr (Value (TsQuery Lexemes))
-> SqlExpr (Value (TsQuery Lexemes))
tsquery_or :: SqlExpr (Value (TsQuery Lexemes))
-> SqlExpr (Value (TsQuery Lexemes))
-> SqlExpr (Value (TsQuery Lexemes))
tsquery_or = Builder
-> SqlExpr (Value (TsQuery Lexemes))
-> SqlExpr (Value (TsQuery Lexemes))
-> SqlExpr (Value (TsQuery Lexemes))
forall a b c.
Builder
-> SqlExpr (Value a) -> SqlExpr (Value b) -> SqlExpr (Value c)
unsafeSqlBinOp Builder
"||"
prefixAndQuery :: SearchTerm -> SqlExpr (Value (TsQuery Lexemes))
prefixAndQuery :: SearchTerm -> SqlExpr (Value (TsQuery Lexemes))
prefixAndQuery = RegConfig -> SearchTerm -> SqlExpr (Value (TsQuery Lexemes))
prefixAndQueryLang RegConfig
"english"
prefixAndQueryLang :: RegConfig -> SearchTerm -> SqlExpr (Value (TsQuery Lexemes))
prefixAndQueryLang :: RegConfig -> SearchTerm -> SqlExpr (Value (TsQuery Lexemes))
prefixAndQueryLang = (SqlExpr (Value (TsQuery Lexemes))
-> SqlExpr (Value (TsQuery Lexemes))
-> SqlExpr (Value (TsQuery Lexemes)))
-> RegConfig -> SearchTerm -> SqlExpr (Value (TsQuery Lexemes))
prefixAndQueryLangWith SqlExpr (Value (TsQuery Lexemes))
-> SqlExpr (Value (TsQuery Lexemes))
-> SqlExpr (Value (TsQuery Lexemes))
tsquery_and
prefixOrQuery :: SearchTerm -> SqlExpr (Value (TsQuery Lexemes))
prefixOrQuery :: SearchTerm -> SqlExpr (Value (TsQuery Lexemes))
prefixOrQuery = RegConfig -> SearchTerm -> SqlExpr (Value (TsQuery Lexemes))
prefixOrQueryLang RegConfig
"english"
prefixOrQueryLang :: RegConfig -> SearchTerm -> SqlExpr (Value (TsQuery Lexemes))
prefixOrQueryLang :: RegConfig -> SearchTerm -> SqlExpr (Value (TsQuery Lexemes))
prefixOrQueryLang = (SqlExpr (Value (TsQuery Lexemes))
-> SqlExpr (Value (TsQuery Lexemes))
-> SqlExpr (Value (TsQuery Lexemes)))
-> RegConfig -> SearchTerm -> SqlExpr (Value (TsQuery Lexemes))
prefixAndQueryLangWith SqlExpr (Value (TsQuery Lexemes))
-> SqlExpr (Value (TsQuery Lexemes))
-> SqlExpr (Value (TsQuery Lexemes))
tsquery_or
prefixAndQueryLangWith :: (SqlExpr (Value (TsQuery Lexemes))
-> SqlExpr (Value (TsQuery Lexemes))
-> SqlExpr (Value (TsQuery Lexemes))) -> RegConfig -> SearchTerm -> SqlExpr (Value (TsQuery Lexemes))
prefixAndQueryLangWith :: (SqlExpr (Value (TsQuery Lexemes))
-> SqlExpr (Value (TsQuery Lexemes))
-> SqlExpr (Value (TsQuery Lexemes)))
-> RegConfig -> SearchTerm -> SqlExpr (Value (TsQuery Lexemes))
prefixAndQueryLangWith SqlExpr (Value (TsQuery Lexemes))
-> SqlExpr (Value (TsQuery Lexemes))
-> SqlExpr (Value (TsQuery Lexemes))
binOp RegConfig
language (SearchTerm NonEmpty (TsQuery Words)
ts) =
(SqlExpr (Value (TsQuery Lexemes))
-> SqlExpr (Value (TsQuery Lexemes))
-> SqlExpr (Value (TsQuery Lexemes)))
-> [SqlExpr (Value (TsQuery Lexemes))]
-> SqlExpr (Value (TsQuery Lexemes))
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 SqlExpr (Value (TsQuery Lexemes))
-> SqlExpr (Value (TsQuery Lexemes))
-> SqlExpr (Value (TsQuery Lexemes))
binOp
([SqlExpr (Value (TsQuery Lexemes))]
-> SqlExpr (Value (TsQuery Lexemes)))
-> [SqlExpr (Value (TsQuery Lexemes))]
-> SqlExpr (Value (TsQuery Lexemes))
forall a b. (a -> b) -> a -> b
$ (TsQuery Words -> SqlExpr (Value (TsQuery Lexemes)))
-> [TsQuery Words] -> [SqlExpr (Value (TsQuery Lexemes))]
forall a b. (a -> b) -> [a] -> [b]
map (SqlExpr (Value RegConfig)
-> SqlExpr (Value (TsQuery Words))
-> SqlExpr (Value (TsQuery Lexemes))
to_tsquery (RegConfig -> SqlExpr (Value RegConfig)
forall typ. PersistField typ => typ -> SqlExpr (Value typ)
val RegConfig
language) (SqlExpr (Value (TsQuery Words))
-> SqlExpr (Value (TsQuery Lexemes)))
-> (TsQuery Words -> SqlExpr (Value (TsQuery Words)))
-> TsQuery Words
-> SqlExpr (Value (TsQuery Lexemes))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TsQuery Words -> SqlExpr (Value (TsQuery Words))
forall typ. PersistField typ => typ -> SqlExpr (Value typ)
val) ([TsQuery Words] -> [SqlExpr (Value (TsQuery Lexemes))])
-> [TsQuery Words] -> [SqlExpr (Value (TsQuery Lexemes))]
forall a b. (a -> b) -> a -> b
$ NonEmpty (TsQuery Words) -> [TsQuery Words]
forall a. NonEmpty a -> [a]
toList NonEmpty (TsQuery Words)
ts
newtype SearchTerm = SearchTerm { SearchTerm -> NonEmpty (TsQuery Words)
unQuery :: NonEmpty (TsQuery Words) }
deriving stock Int -> SearchTerm -> ShowS
[SearchTerm] -> ShowS
SearchTerm -> String
(Int -> SearchTerm -> ShowS)
-> (SearchTerm -> String)
-> ([SearchTerm] -> ShowS)
-> Show SearchTerm
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SearchTerm -> ShowS
showsPrec :: Int -> SearchTerm -> ShowS
$cshow :: SearchTerm -> String
show :: SearchTerm -> String
$cshowList :: [SearchTerm] -> ShowS
showList :: [SearchTerm] -> ShowS
Show
deriving newtype NonEmpty SearchTerm -> SearchTerm
SearchTerm -> SearchTerm -> SearchTerm
(SearchTerm -> SearchTerm -> SearchTerm)
-> (NonEmpty SearchTerm -> SearchTerm)
-> (forall b. Integral b => b -> SearchTerm -> SearchTerm)
-> Semigroup SearchTerm
forall b. Integral b => b -> SearchTerm -> SearchTerm
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: SearchTerm -> SearchTerm -> SearchTerm
<> :: SearchTerm -> SearchTerm -> SearchTerm
$csconcat :: NonEmpty SearchTerm -> SearchTerm
sconcat :: NonEmpty SearchTerm -> SearchTerm
$cstimes :: forall b. Integral b => b -> SearchTerm -> SearchTerm
stimes :: forall b. Integral b => b -> SearchTerm -> SearchTerm
Semigroup
toSearchTerm :: Text -> Maybe SearchTerm
toSearchTerm :: Text -> Maybe SearchTerm
toSearchTerm = [Weight] -> Text -> Maybe SearchTerm
toSearchTermWeighted []
toSearchTermWeighted :: [Weight] -> Text -> Maybe SearchTerm
toSearchTermWeighted :: [Weight] -> Text -> Maybe SearchTerm
toSearchTermWeighted [Weight]
weights Text
q = NonEmpty (TsQuery Words) -> SearchTerm
SearchTerm (NonEmpty (TsQuery Words) -> SearchTerm)
-> (NonEmpty Text -> NonEmpty (TsQuery Words))
-> NonEmpty Text
-> SearchTerm
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> TsQuery Words)
-> NonEmpty Text -> NonEmpty (TsQuery Words)
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Position -> [Weight] -> Text -> TsQuery Words
Word Position
Prefix [Weight]
weights) (NonEmpty Text -> SearchTerm)
-> Maybe (NonEmpty Text) -> Maybe SearchTerm
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text] -> Maybe (NonEmpty Text)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty [Text]
qs
where qs :: [Text]
qs = (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
T.null) ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
T.words
(Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> Text
T.filter (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Char
'\\', Char
'\'']) (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
T.strip Text
q