{-# LANGUAGE CPP #-}
module Text.Search.Sphinx.Types (
    module Text.Search.Sphinx.Types
  , ByteString ) where

import Data.ByteString.Lazy (ByteString)
import Data.Int (Int64)
import Data.Maybe (Maybe, isJust)
import Data.Text (Text,empty)

-- | Data structure representing one query. It can be sent with 'runQueries'
-- or 'runQueries'' to the server in batch mode.
data Query = Query { Query -> Text
queryString :: Text -- ^ The actual query string
                   , Query -> Text
queryIndexes :: Text -- ^ The indexes, \"*\" means every index
                   , Query -> Text
queryComment :: Text  -- ^ A comment string.
                   } deriving (Int -> Query -> ShowS
[Query] -> ShowS
Query -> String
(Int -> Query -> ShowS)
-> (Query -> String) -> ([Query] -> ShowS) -> Show Query
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Query -> ShowS
showsPrec :: Int -> Query -> ShowS
$cshow :: Query -> String
show :: Query -> String
$cshowList :: [Query] -> ShowS
showList :: [Query] -> ShowS
Show)

-- | Search commands
data SearchdCommand = ScSearch
                    | ScExcerpt
                    | ScUpdate
                    | ScKeywords
                    deriving (Int -> SearchdCommand -> ShowS
[SearchdCommand] -> ShowS
SearchdCommand -> String
(Int -> SearchdCommand -> ShowS)
-> (SearchdCommand -> String)
-> ([SearchdCommand] -> ShowS)
-> Show SearchdCommand
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SearchdCommand -> ShowS
showsPrec :: Int -> SearchdCommand -> ShowS
$cshow :: SearchdCommand -> String
show :: SearchdCommand -> String
$cshowList :: [SearchdCommand] -> ShowS
showList :: [SearchdCommand] -> ShowS
Show, Int -> SearchdCommand
SearchdCommand -> Int
SearchdCommand -> [SearchdCommand]
SearchdCommand -> SearchdCommand
SearchdCommand -> SearchdCommand -> [SearchdCommand]
SearchdCommand
-> SearchdCommand -> SearchdCommand -> [SearchdCommand]
(SearchdCommand -> SearchdCommand)
-> (SearchdCommand -> SearchdCommand)
-> (Int -> SearchdCommand)
-> (SearchdCommand -> Int)
-> (SearchdCommand -> [SearchdCommand])
-> (SearchdCommand -> SearchdCommand -> [SearchdCommand])
-> (SearchdCommand -> SearchdCommand -> [SearchdCommand])
-> (SearchdCommand
    -> SearchdCommand -> SearchdCommand -> [SearchdCommand])
-> Enum SearchdCommand
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: SearchdCommand -> SearchdCommand
succ :: SearchdCommand -> SearchdCommand
$cpred :: SearchdCommand -> SearchdCommand
pred :: SearchdCommand -> SearchdCommand
$ctoEnum :: Int -> SearchdCommand
toEnum :: Int -> SearchdCommand
$cfromEnum :: SearchdCommand -> Int
fromEnum :: SearchdCommand -> Int
$cenumFrom :: SearchdCommand -> [SearchdCommand]
enumFrom :: SearchdCommand -> [SearchdCommand]
$cenumFromThen :: SearchdCommand -> SearchdCommand -> [SearchdCommand]
enumFromThen :: SearchdCommand -> SearchdCommand -> [SearchdCommand]
$cenumFromTo :: SearchdCommand -> SearchdCommand -> [SearchdCommand]
enumFromTo :: SearchdCommand -> SearchdCommand -> [SearchdCommand]
$cenumFromThenTo :: SearchdCommand
-> SearchdCommand -> SearchdCommand -> [SearchdCommand]
enumFromThenTo :: SearchdCommand
-> SearchdCommand -> SearchdCommand -> [SearchdCommand]
Enum)

searchdCommand :: SearchdCommand -> Int
searchdCommand :: SearchdCommand -> Int
searchdCommand = SearchdCommand -> Int
forall a. Enum a => a -> Int
fromEnum

-- | Current client-side command implementation versions
data VerCommand = VcSearch
                | VcExcerpt
                | VcUpdate
                | VcKeywords
                deriving (Int -> VerCommand -> ShowS
[VerCommand] -> ShowS
VerCommand -> String
(Int -> VerCommand -> ShowS)
-> (VerCommand -> String)
-> ([VerCommand] -> ShowS)
-> Show VerCommand
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> VerCommand -> ShowS
showsPrec :: Int -> VerCommand -> ShowS
$cshow :: VerCommand -> String
show :: VerCommand -> String
$cshowList :: [VerCommand] -> ShowS
showList :: [VerCommand] -> ShowS
Show)

#ifdef ONE_ONE_BETA
-- | Important! only 1.1 compatible, not 9.9.x
verCommand VcSearch   = 0x117
verCommand VcExcerpt  = 0x102
#else
-- | Important! 2.0 compatible
verCommand :: VerCommand -> a
verCommand VerCommand
VcSearch   = a
0x118
verCommand VerCommand
VcExcerpt  = a
0x103
#endif
verCommand VerCommand
VcUpdate   = a
0x101
verCommand VerCommand
VcKeywords = a
0x100

-- | Searchd status codes
data Status = OK
            | RETRY
            | WARNING
            | ERROR Int
            deriving (Int -> Status -> ShowS
[Status] -> ShowS
Status -> String
(Int -> Status -> ShowS)
-> (Status -> String) -> ([Status] -> ShowS) -> Show Status
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Status -> ShowS
showsPrec :: Int -> Status -> ShowS
$cshow :: Status -> String
show :: Status -> String
$cshowList :: [Status] -> ShowS
showList :: [Status] -> ShowS
Show)

-- | status from an individual query
data QueryStatus = QueryOK
                 | QueryWARNING
                 | QueryERROR Int
                 deriving (Int -> QueryStatus -> ShowS
[QueryStatus] -> ShowS
QueryStatus -> String
(Int -> QueryStatus -> ShowS)
-> (QueryStatus -> String)
-> ([QueryStatus] -> ShowS)
-> Show QueryStatus
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> QueryStatus -> ShowS
showsPrec :: Int -> QueryStatus -> ShowS
$cshow :: QueryStatus -> String
show :: QueryStatus -> String
$cshowList :: [QueryStatus] -> ShowS
showList :: [QueryStatus] -> ShowS
Show)

toQueryStatus :: Int -> QueryStatus
toQueryStatus Int
0 = QueryStatus
QueryOK
toQueryStatus Int
3 = QueryStatus
QueryWARNING
toQueryStatus Int
2 = String -> QueryStatus
forall a. HasCallStack => String -> a
error String
"Didn't think retry was possible"
toQueryStatus Int
n = Int -> QueryStatus
QueryERROR Int
n

toStatus :: Int -> Status
toStatus Int
0 = Status
OK
toStatus Int
2 = Status
RETRY
toStatus Int
3 = Status
WARNING
toStatus Int
n = Int -> Status
ERROR Int
n

-- | Match modes
data MatchMode = All
               | Any
               | Phrase
               | Boolean
               | Extended
               | Fullscan
               | Extended2  -- extended engine V2 (TEMPORARY, WILL BE REMOVED)
               deriving (Int -> MatchMode -> ShowS
[MatchMode] -> ShowS
MatchMode -> String
(Int -> MatchMode -> ShowS)
-> (MatchMode -> String)
-> ([MatchMode] -> ShowS)
-> Show MatchMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MatchMode -> ShowS
showsPrec :: Int -> MatchMode -> ShowS
$cshow :: MatchMode -> String
show :: MatchMode -> String
$cshowList :: [MatchMode] -> ShowS
showList :: [MatchMode] -> ShowS
Show, Int -> MatchMode
MatchMode -> Int
MatchMode -> [MatchMode]
MatchMode -> MatchMode
MatchMode -> MatchMode -> [MatchMode]
MatchMode -> MatchMode -> MatchMode -> [MatchMode]
(MatchMode -> MatchMode)
-> (MatchMode -> MatchMode)
-> (Int -> MatchMode)
-> (MatchMode -> Int)
-> (MatchMode -> [MatchMode])
-> (MatchMode -> MatchMode -> [MatchMode])
-> (MatchMode -> MatchMode -> [MatchMode])
-> (MatchMode -> MatchMode -> MatchMode -> [MatchMode])
-> Enum MatchMode
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: MatchMode -> MatchMode
succ :: MatchMode -> MatchMode
$cpred :: MatchMode -> MatchMode
pred :: MatchMode -> MatchMode
$ctoEnum :: Int -> MatchMode
toEnum :: Int -> MatchMode
$cfromEnum :: MatchMode -> Int
fromEnum :: MatchMode -> Int
$cenumFrom :: MatchMode -> [MatchMode]
enumFrom :: MatchMode -> [MatchMode]
$cenumFromThen :: MatchMode -> MatchMode -> [MatchMode]
enumFromThen :: MatchMode -> MatchMode -> [MatchMode]
$cenumFromTo :: MatchMode -> MatchMode -> [MatchMode]
enumFromTo :: MatchMode -> MatchMode -> [MatchMode]
$cenumFromThenTo :: MatchMode -> MatchMode -> MatchMode -> [MatchMode]
enumFromThenTo :: MatchMode -> MatchMode -> MatchMode -> [MatchMode]
Enum)

-- | Ranking modes (ext2 only)
data Rank = ProximityBm25  -- default mode, phrase proximity major factor and BM25 minor one
          | Bm25           -- statistical mode, BM25 ranking only (faster but worse quality)
          | None           -- no ranking, all matches get a weight of 1
          | WordCount      -- simple word-count weighting, rank is a weighted sum of per-field keyword occurence counts
          | Proximity      -- internally used to emulate SPH_MATCH_ALL queries
          | MatchAny       -- internaly used to emulate SPHINX_MATCH_ANY searching mode
          | Fieldmask      -- ?
          | Sph04          -- like ProximityBm25, but more weight given to matches at beginning or end of field
          | RankExpr       -- Custom expression, set with rankExpr
          | Total
          deriving (Int -> Rank -> ShowS
[Rank] -> ShowS
Rank -> String
(Int -> Rank -> ShowS)
-> (Rank -> String) -> ([Rank] -> ShowS) -> Show Rank
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Rank -> ShowS
showsPrec :: Int -> Rank -> ShowS
$cshow :: Rank -> String
show :: Rank -> String
$cshowList :: [Rank] -> ShowS
showList :: [Rank] -> ShowS
Show, Int -> Rank
Rank -> Int
Rank -> [Rank]
Rank -> Rank
Rank -> Rank -> [Rank]
Rank -> Rank -> Rank -> [Rank]
(Rank -> Rank)
-> (Rank -> Rank)
-> (Int -> Rank)
-> (Rank -> Int)
-> (Rank -> [Rank])
-> (Rank -> Rank -> [Rank])
-> (Rank -> Rank -> [Rank])
-> (Rank -> Rank -> Rank -> [Rank])
-> Enum Rank
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Rank -> Rank
succ :: Rank -> Rank
$cpred :: Rank -> Rank
pred :: Rank -> Rank
$ctoEnum :: Int -> Rank
toEnum :: Int -> Rank
$cfromEnum :: Rank -> Int
fromEnum :: Rank -> Int
$cenumFrom :: Rank -> [Rank]
enumFrom :: Rank -> [Rank]
$cenumFromThen :: Rank -> Rank -> [Rank]
enumFromThen :: Rank -> Rank -> [Rank]
$cenumFromTo :: Rank -> Rank -> [Rank]
enumFromTo :: Rank -> Rank -> [Rank]
$cenumFromThenTo :: Rank -> Rank -> Rank -> [Rank]
enumFromThenTo :: Rank -> Rank -> Rank -> [Rank]
Enum)

-- | Sort modes
data Sort = Relevance
          | AttrDesc
          | AttrAsc
          | TimeSegments
          | SortExtended -- constructor already existed
          | Expr
          deriving (Int -> Sort -> ShowS
[Sort] -> ShowS
Sort -> String
(Int -> Sort -> ShowS)
-> (Sort -> String) -> ([Sort] -> ShowS) -> Show Sort
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Sort -> ShowS
showsPrec :: Int -> Sort -> ShowS
$cshow :: Sort -> String
show :: Sort -> String
$cshowList :: [Sort] -> ShowS
showList :: [Sort] -> ShowS
Show, Int -> Sort
Sort -> Int
Sort -> [Sort]
Sort -> Sort
Sort -> Sort -> [Sort]
Sort -> Sort -> Sort -> [Sort]
(Sort -> Sort)
-> (Sort -> Sort)
-> (Int -> Sort)
-> (Sort -> Int)
-> (Sort -> [Sort])
-> (Sort -> Sort -> [Sort])
-> (Sort -> Sort -> [Sort])
-> (Sort -> Sort -> Sort -> [Sort])
-> Enum Sort
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Sort -> Sort
succ :: Sort -> Sort
$cpred :: Sort -> Sort
pred :: Sort -> Sort
$ctoEnum :: Int -> Sort
toEnum :: Int -> Sort
$cfromEnum :: Sort -> Int
fromEnum :: Sort -> Int
$cenumFrom :: Sort -> [Sort]
enumFrom :: Sort -> [Sort]
$cenumFromThen :: Sort -> Sort -> [Sort]
enumFromThen :: Sort -> Sort -> [Sort]
$cenumFromTo :: Sort -> Sort -> [Sort]
enumFromTo :: Sort -> Sort -> [Sort]
$cenumFromThenTo :: Sort -> Sort -> Sort -> [Sort]
enumFromThenTo :: Sort -> Sort -> Sort -> [Sort]
Enum)

-- | Filter types
data Filter = ExclusionFilter Filter
            | FilterValues String [Int64]
            | FilterRange  String Int64 Int64
            | FilterFloatRange String Float Float
            deriving (Int -> Filter -> ShowS
[Filter] -> ShowS
Filter -> String
(Int -> Filter -> ShowS)
-> (Filter -> String) -> ([Filter] -> ShowS) -> Show Filter
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Filter -> ShowS
showsPrec :: Int -> Filter -> ShowS
$cshow :: Filter -> String
show :: Filter -> String
$cshowList :: [Filter] -> ShowS
showList :: [Filter] -> ShowS
Show)

-- | shortcut for creating an exclusion filter
exclude :: Filter -> Filter
exclude Filter
filter = Filter -> Filter
ExclusionFilter Filter
filter

fromEnumFilter :: Filter -> a
fromEnumFilter (FilterValues String
_ [Int64]
_)  = a
0
fromEnumFilter (FilterRange String
_ Int64
_ Int64
_) = a
1
fromEnumFilter (FilterFloatRange String
_ Float
_ Float
_) = a
2

-- | Attribute types
data AttrT = AttrTUInt          -- unsigned 32-bit integer
           | AttrTTimestamp     -- timestamp
           | AttrTStr2Ordinal   -- ordinal string number (integer at search time, specially handled at indexing time)
           | AttrTBool          -- boolean bit field
           | AttrTFloat         -- floating point number (IEEE 32-bit)
           | AttrTBigInt        -- signed 64-bit integer
           | AttrTString        -- string (binary; in-memory)
           | AttrTWordCount     -- string word count (integer at search time,tokenized and counted at indexing time)
           | AttrTMulti AttrT   -- multiple values (0 or more) 
           deriving (Int -> AttrT -> ShowS
[AttrT] -> ShowS
AttrT -> String
(Int -> AttrT -> ShowS)
-> (AttrT -> String) -> ([AttrT] -> ShowS) -> Show AttrT
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AttrT -> ShowS
showsPrec :: Int -> AttrT -> ShowS
$cshow :: AttrT -> String
show :: AttrT -> String
$cshowList :: [AttrT] -> ShowS
showList :: [AttrT] -> ShowS
Show)

instance Enum AttrT where
    toEnum :: Int -> AttrT
toEnum = Int -> AttrT
forall {a}. (Eq a, Num a) => a -> AttrT
toAttrT
    fromEnum :: AttrT -> Int
fromEnum = AttrT -> Int
forall {a}. Num a => AttrT -> a
attrT

toAttrT :: a -> AttrT
toAttrT a
1          = AttrT
AttrTUInt
toAttrT a
2          = AttrT
AttrTTimestamp
toAttrT a
3          = AttrT
AttrTStr2Ordinal
toAttrT a
4          = AttrT
AttrTBool
toAttrT a
5          = AttrT
AttrTFloat
toAttrT a
6          = AttrT
AttrTBigInt
toAttrT a
7          = AttrT
AttrTString
toAttrT a
8          = AttrT
AttrTWordCount
toAttrT a
0x40000001 = AttrT -> AttrT
AttrTMulti AttrT
AttrTUInt

attrMultiMask :: Integer
attrMultiMask = Integer
0x40000000

attrT :: AttrT -> a
attrT AttrT
AttrTUInt        = a
1
attrT AttrT
AttrTTimestamp   = a
2
attrT AttrT
AttrTStr2Ordinal = a
3
attrT AttrT
AttrTBool        = a
4
attrT AttrT
AttrTFloat       = a
5
attrT AttrT
AttrTBigInt      = a
6
attrT AttrT
AttrTString      = a
7
attrT AttrT
AttrTWordCount   = a
8
attrT (AttrTMulti AttrT
AttrTUInt) = a
0x40000001

-- | Grouping functions
data GroupByFunction = Day
                     | Week
                     | Month
                     | Year
                     | Attr
                     | AttrPair
                     deriving (Int -> GroupByFunction -> ShowS
[GroupByFunction] -> ShowS
GroupByFunction -> String
(Int -> GroupByFunction -> ShowS)
-> (GroupByFunction -> String)
-> ([GroupByFunction] -> ShowS)
-> Show GroupByFunction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GroupByFunction -> ShowS
showsPrec :: Int -> GroupByFunction -> ShowS
$cshow :: GroupByFunction -> String
show :: GroupByFunction -> String
$cshowList :: [GroupByFunction] -> ShowS
showList :: [GroupByFunction] -> ShowS
Show, Int -> GroupByFunction
GroupByFunction -> Int
GroupByFunction -> [GroupByFunction]
GroupByFunction -> GroupByFunction
GroupByFunction -> GroupByFunction -> [GroupByFunction]
GroupByFunction
-> GroupByFunction -> GroupByFunction -> [GroupByFunction]
(GroupByFunction -> GroupByFunction)
-> (GroupByFunction -> GroupByFunction)
-> (Int -> GroupByFunction)
-> (GroupByFunction -> Int)
-> (GroupByFunction -> [GroupByFunction])
-> (GroupByFunction -> GroupByFunction -> [GroupByFunction])
-> (GroupByFunction -> GroupByFunction -> [GroupByFunction])
-> (GroupByFunction
    -> GroupByFunction -> GroupByFunction -> [GroupByFunction])
-> Enum GroupByFunction
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: GroupByFunction -> GroupByFunction
succ :: GroupByFunction -> GroupByFunction
$cpred :: GroupByFunction -> GroupByFunction
pred :: GroupByFunction -> GroupByFunction
$ctoEnum :: Int -> GroupByFunction
toEnum :: Int -> GroupByFunction
$cfromEnum :: GroupByFunction -> Int
fromEnum :: GroupByFunction -> Int
$cenumFrom :: GroupByFunction -> [GroupByFunction]
enumFrom :: GroupByFunction -> [GroupByFunction]
$cenumFromThen :: GroupByFunction -> GroupByFunction -> [GroupByFunction]
enumFromThen :: GroupByFunction -> GroupByFunction -> [GroupByFunction]
$cenumFromTo :: GroupByFunction -> GroupByFunction -> [GroupByFunction]
enumFromTo :: GroupByFunction -> GroupByFunction -> [GroupByFunction]
$cenumFromThenTo :: GroupByFunction
-> GroupByFunction -> GroupByFunction -> [GroupByFunction]
enumFromThenTo :: GroupByFunction
-> GroupByFunction -> GroupByFunction -> [GroupByFunction]
Enum)

-- | The result of a query
data QueryResult = QueryResult {
      -- | The matches
      QueryResult -> [Match]
matches :: [Match]
      -- | Total amount of matches retrieved on server by this query.
    , QueryResult -> Int
total   :: Int
      -- | Total amount of matching documents in index.
    , QueryResult -> Int
totalFound :: Int
      -- | processed words with the number of docs and the number of hits.
    , QueryResult -> [(Text, Int, Int)]
words :: [(Text, Int, Int)]
      -- | List of attribute names returned in the result.
      -- | The Match will contain just the attribute values in the same order.
    , QueryResult -> [ByteString]
attributeNames :: [ByteString]
}
 deriving Int -> QueryResult -> ShowS
[QueryResult] -> ShowS
QueryResult -> String
(Int -> QueryResult -> ShowS)
-> (QueryResult -> String)
-> ([QueryResult] -> ShowS)
-> Show QueryResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> QueryResult -> ShowS
showsPrec :: Int -> QueryResult -> ShowS
$cshow :: QueryResult -> String
show :: QueryResult -> String
$cshowList :: [QueryResult] -> ShowS
showList :: [QueryResult] -> ShowS
Show

-- | a single query result, runQueries returns a list of these
data SingleResult = QueryOk QueryResult
                  | QueryWarning Text QueryResult
                  | QueryError Int Text
                  deriving (Int -> SingleResult -> ShowS
[SingleResult] -> ShowS
SingleResult -> String
(Int -> SingleResult -> ShowS)
-> (SingleResult -> String)
-> ([SingleResult] -> ShowS)
-> Show SingleResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SingleResult -> ShowS
showsPrec :: Int -> SingleResult -> ShowS
$cshow :: SingleResult -> String
show :: SingleResult -> String
$cshowList :: [SingleResult] -> ShowS
showList :: [SingleResult] -> ShowS
Show)

-- | a result returned from searchd
data Result a = Ok a
              | Warning Text a
              | Error Int Text
              | Retry Text
              deriving (Int -> Result a -> ShowS
[Result a] -> ShowS
Result a -> String
(Int -> Result a -> ShowS)
-> (Result a -> String) -> ([Result a] -> ShowS) -> Show (Result a)
forall a. Show a => Int -> Result a -> ShowS
forall a. Show a => [Result a] -> ShowS
forall a. Show a => Result a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Result a -> ShowS
showsPrec :: Int -> Result a -> ShowS
$cshow :: forall a. Show a => Result a -> String
show :: Result a -> String
$cshowList :: forall a. Show a => [Result a] -> ShowS
showList :: [Result a] -> ShowS
Show)

data Match = Match {
             -- Document ID
               Match -> Int64
documentId :: Int64
             -- Document weight
             , Match -> Int
documentWeight :: Int
             -- Attribute values
             , Match -> [Attr]
attributeValues :: [Attr]
             }
 deriving Int -> Match -> ShowS
[Match] -> ShowS
Match -> String
(Int -> Match -> ShowS)
-> (Match -> String) -> ([Match] -> ShowS) -> Show Match
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Match -> ShowS
showsPrec :: Int -> Match -> ShowS
$cshow :: Match -> String
show :: Match -> String
$cshowList :: [Match] -> ShowS
showList :: [Match] -> ShowS
Show

instance Eq Match where
  Match
d1 == :: Match -> Match -> Bool
== Match
d2 = Match -> Int64
documentId Match
d1 Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== Match -> Int64
documentId Match
d2

data Attr = AttrMulti [Attr]
          | AttrUInt  Int
          | AttrBigInt Int64
          | AttrString Text
          | AttrFloat Float
          deriving (Int -> Attr -> ShowS
[Attr] -> ShowS
Attr -> String
(Int -> Attr -> ShowS)
-> (Attr -> String) -> ([Attr] -> ShowS) -> Show Attr
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Attr -> ShowS
showsPrec :: Int -> Attr -> ShowS
$cshow :: Attr -> String
show :: Attr -> String
$cshowList :: [Attr] -> ShowS
showList :: [Attr] -> ShowS
Show)