-- | module:    Network.Riak.Search
--   copyright: (c) 2016 Sentenai
--   author:    Antonio Nikishaev <me@lelf.lu>
--   license:   Apache
--
-- Solr search
--
-- http://docs.basho.com/riak/2.1.3/dev/using/search/
{-# LANGUAGE CPP #-}
module Network.Riak.Search
  ( IndexInfo
  , SearchResult(..)
  , Score
  , indexInfo
  , getIndex
  , putIndex
  , deleteIndex
  , searchRaw
  ) where

#if __GLASGOW_HASKELL__ <= 708
import           Control.Applicative
#endif
import qualified Data.Riak.Proto as Proto
import           Network.Riak.Connection.Internal
import           Network.Riak.Lens
import qualified Network.Riak.Request as Req
import qualified Network.Riak.Response as Resp
import           Network.Riak.Types.Internal

-- | 'IndexInfo' smart constructor.
--
-- If 'Nothing', @schema@ defaults to @"_yz_default"@.
--
-- If 'Nothing', @n@ defaults to the default @n@ value for buckets that have not
-- explicitly set the property. In the default installation of @riak@, this is
-- 3 (see https://github.com/basho/riak_core/blob/develop/priv/riak_core.schema).
indexInfo :: Index -> Maybe Schema -> Maybe N -> IndexInfo
indexInfo :: Index -> Maybe Index -> Maybe N -> IndexInfo
indexInfo Index
ix Maybe Index
schema Maybe N
nval = IndexInfo
forall msg. Message msg => msg
Proto.defMessage IndexInfo -> (IndexInfo -> IndexInfo) -> IndexInfo
forall a b. a -> (a -> b) -> b
& LensLike' Identity IndexInfo Index
forall (f :: * -> *) s a.
(Functor f, HasField s "name" a) =>
LensLike' f s a
Proto.name LensLike' Identity IndexInfo Index
-> Index -> IndexInfo -> IndexInfo
forall s a. Setter s a -> a -> s -> s
.~ Index
ix
                                            IndexInfo -> (IndexInfo -> IndexInfo) -> IndexInfo
forall a b. a -> (a -> b) -> b
& LensLike' Identity IndexInfo (Maybe Index)
forall (f :: * -> *) s a.
(Functor f, HasField s "maybe'schema" a) =>
LensLike' f s a
Proto.maybe'schema LensLike' Identity IndexInfo (Maybe Index)
-> Maybe Index -> IndexInfo -> IndexInfo
forall s a. Setter s a -> a -> s -> s
.~ Maybe Index
schema
                                            IndexInfo -> (IndexInfo -> IndexInfo) -> IndexInfo
forall a b. a -> (a -> b) -> b
& LensLike' Identity IndexInfo (Maybe N)
forall (f :: * -> *) s a.
(Functor f, HasField s "maybe'nVal" a) =>
LensLike' f s a
Proto.maybe'nVal LensLike' Identity IndexInfo (Maybe N)
-> Maybe N -> IndexInfo -> IndexInfo
forall s a. Setter s a -> a -> s -> s
.~ Maybe N
nval

-- | Get an index info for @Just index@, or get all indexes for @Nothing@.
--
-- https://docs.basho.com/riak/kv/2.1.4/developing/api/protocol-buffers/yz-index-get/
getIndex :: Connection -> Maybe Index -> IO [IndexInfo]
getIndex :: Connection -> Maybe Index -> IO [IndexInfo]
getIndex Connection
conn Maybe Index
ix = RpbYokozunaIndexGetResp -> [IndexInfo]
Resp.getIndex (RpbYokozunaIndexGetResp -> [IndexInfo])
-> IO RpbYokozunaIndexGetResp -> IO [IndexInfo]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection -> RpbYokozunaIndexGetReq -> IO RpbYokozunaIndexGetResp
forall req resp. Exchange req resp => Connection -> req -> IO resp
exchange Connection
conn (Maybe Index -> RpbYokozunaIndexGetReq
Req.getIndex Maybe Index
ix)

-- | Create a new index or modify an existing index.
--
-- https://docs.basho.com/riak/kv/2.1.4/developing/api/protocol-buffers/yz-index-put/
putIndex :: Connection -> IndexInfo -> Maybe Timeout -> IO ([Proto.RpbContent], VClock)
putIndex :: Connection -> IndexInfo -> Maybe N -> IO ([RpbContent], VClock)
putIndex Connection
conn IndexInfo
info Maybe N
timeout = RpbPutResp -> ([RpbContent], VClock)
Resp.put (RpbPutResp -> ([RpbContent], VClock))
-> IO RpbPutResp -> IO ([RpbContent], VClock)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection -> RpbYokozunaIndexPutReq -> IO RpbPutResp
forall req resp. Exchange req resp => Connection -> req -> IO resp
exchange Connection
conn (IndexInfo -> Maybe N -> RpbYokozunaIndexPutReq
Req.putIndex IndexInfo
info Maybe N
timeout)

-- | Delete an index.
--
-- https://docs.basho.com/riak/kv/2.1.4/developing/api/protocol-buffers/yz-index-delete/
deleteIndex :: Connection -> Index -> IO ()
deleteIndex :: Connection -> Index -> IO ()
deleteIndex Connection
conn Index
ix = Connection -> RpbYokozunaIndexDeleteReq -> IO ()
forall req. Request req => Connection -> req -> IO ()
exchange_ Connection
conn (Index -> RpbYokozunaIndexDeleteReq
Req.deleteIndex Index
ix)

-- | Search by raw 'SearchQuery' request (a 'Data.ByteString.Lazy.Bytestring')
-- using an 'Index'.
searchRaw :: Connection -> SearchQuery -> Index -> IO SearchResult
searchRaw :: Connection -> Index -> Index -> IO SearchResult
searchRaw Connection
conn Index
q Index
ix = RpbSearchQueryResp -> SearchResult
Resp.search (RpbSearchQueryResp -> SearchResult)
-> IO RpbSearchQueryResp -> IO SearchResult
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection -> RpbSearchQueryReq -> IO RpbSearchQueryResp
forall req resp. Exchange req resp => Connection -> req -> IO resp
exchange Connection
conn (Index -> Index -> RpbSearchQueryReq
Req.search Index
q Index
ix)