bloodhound 0.7.0.1 → 0.8.0.0

raw patch · 8 files changed

+433/−193 lines, 8 filesdep +mtl-compatdep ~doctestdep ~semigroupsdep ~unordered-containerssetup-changedPVP ok

version bump matches the API change (PVP)

Dependencies added: mtl-compat

Dependency ranges changed: doctest, semigroups, unordered-containers

API changes (from Hackage documentation)

Files

• Setup.hs +4/−48
• bloodhound.cabal +12/−5
• src/Database/Bloodhound/Client.hs +107/−17
• src/Database/Bloodhound/Types.hs +186/−34
• src/Database/Bloodhound/Types/Class.hs +3/−0
• tests/doctests.hs +4/−0
• tests/doctests.hsc +0/−74
• tests/tests.hs +117/−15

@@ -1,51 +1,7 @@-{-# OPTIONS_GHC -Wall #-}-module Main (main) where+#!/usr/bin/env runhaskell -import Data.List ( nub )-import Data.Version ( showVersion )-import Distribution.Package ( PackageName(PackageName), Package, PackageId, InstalledPackageId, packageVersion, packageName )-import Distribution.PackageDescription ( PackageDescription(), TestSuite(..) )-import Distribution.Simple ( defaultMainWithHooks, UserHooks(..), simpleUserHooks )-import Distribution.Simple.Utils ( rewriteFile, createDirectoryIfMissingVerbose, copyFiles )-import Distribution.Simple.BuildPaths ( autogenModulesDir )-import Distribution.Simple.Setup ( BuildFlags(buildVerbosity), Flag(..), fromFlag, HaddockFlags(haddockDistPref))-import Distribution.Simple.LocalBuildInfo ( withLibLBI, withTestLBI, LocalBuildInfo(), ComponentLocalBuildInfo(componentPackageDeps) )-import Distribution.Text ( display )-import Distribution.Verbosity ( Verbosity, normal )-import System.FilePath ( (</>) )+module Main where+import Distribution.Simple  main :: IO ()-main = defaultMainWithHooks simpleUserHooks-  { buildHook = \pkg lbi hooks flags -> do-     generateBuildModule (fromFlag (buildVerbosity flags)) pkg lbi-     buildHook simpleUserHooks pkg lbi hooks flags-  , postHaddock = \args flags pkg lbi -> do-     -- copyFiles normal (haddockOutputDir flags pkg) [("images","Hierarchy.png")]-     postHaddock simpleUserHooks args flags pkg lbi-  }--haddockOutputDir :: Package p => HaddockFlags -> p -> FilePath-haddockOutputDir flags pkg = destDir where-  baseDir = case haddockDistPref flags of-    NoFlag -> "."-    Flag x -> x-  destDir = baseDir </> "doc" </> "html" </> display (packageName pkg)--generateBuildModule :: Verbosity -> PackageDescription -> LocalBuildInfo -> IO ()-generateBuildModule verbosity pkg lbi = do-  let dir = autogenModulesDir lbi-  createDirectoryIfMissingVerbose verbosity True dir-  withLibLBI pkg lbi $ \_ libcfg -> do-    withTestLBI pkg lbi $ \suite suitecfg -> do-      rewriteFile (dir </> "Build_" ++ testName suite ++ ".hs") $ unlines-        [ "module Build_" ++ testName suite ++ " where"-        , "deps :: [String]"-        , "deps = " ++ (show $ formatdeps (testDeps libcfg suitecfg))-        ]-  where-    formatdeps = map (formatone . snd)-    formatone p = case packageName p of-      PackageName n -> n ++ "-" ++ showVersion (packageVersion p)--testDeps :: ComponentLocalBuildInfo -> ComponentLocalBuildInfo -> [(InstalledPackageId, PackageId)]-testDeps xs ys = nub $ componentPackageDeps xs ++ componentPackageDeps ys+main = defaultMain

@@ -1,5 +1,5 @@ name:                bloodhound-version:             0.7.0.1+version:             0.8.0.0 synopsis:            ElasticSearch client library for Haskell description:         ElasticSearch made awesome for Haskell hackers homepage:            https://github.com/bitemyapp/bloodhound@@ -28,7 +28,7 @@                        containers       >= 0.5.0.0 && <0.6,                        aeson            >= 0.7     && <0.10,                        http-client      >= 0.3     && <0.5,-                       semigroups       >= 0.15    && <0.17,+                       semigroups       >= 0.15    && <0.18,                        time             >= 1.4     && <1.6,                        text             >= 0.11    && <1.3,                        mtl              >= 1.0     && <2.3,@@ -38,7 +38,9 @@                        uri-bytestring   >= 0.1     && <0.2,                        exceptions,                        data-default-class,-                       blaze-builder+                       blaze-builder,+                       unordered-containers,+                       mtl-compat   default-language:    Haskell2010  test-suite tests@@ -65,15 +67,20 @@   default-language:    Haskell2010  test-suite doctests+  ghc-options:      -threaded -Wall   default-language: Haskell2010   type:             exitcode-stdio-1.0   main-is:          doctests.hs-  hs-source-dirs:   tests+  hs-source-dirs:   tests, src   if impl(ghc >= 7.8)     build-depends:    base,                       directory,-                      doctest,+                      doctest >= 0.10.1,                       doctest-prop,                       filepath   else     buildable: False++Source-Repository head+  Type:     git+  Location: git://github.com/bitemyapp/bloodhound.git

@@ -1,5 +1,5 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RecordWildCards   #-}+{-# LANGUAGE OverloadedStrings   #-}+{-# LANGUAGE RecordWildCards     #-}  ------------------------------------------------------------------------------- -- |@@ -27,6 +27,9 @@        , indexExists        , openIndex        , closeIndex+       , putTemplate+       , templateExists+       , deleteTemplate        , putMapping        , deleteMapping        , indexDocument@@ -36,6 +39,7 @@        , searchAll        , searchByIndex        , searchByType+       , scanSearch        , refreshIndex        , mkSearch        , mkAggregateSearch@@ -88,7 +92,7 @@ -- >>> let runBH' = withBH defaultManagerSettings testServer -- >>> let testIndex = IndexName "twitter" -- >>> let testMapping = MappingName "tweet"--- >>> let defaultIndexSettings = IndexSettings (ShardCount 3) (ReplicaCount 2)+-- >>> let defaultIndexSettings = IndexSettings (ShardCount 1) (ReplicaCount 0) -- >>> data TweetMapping = TweetMapping deriving (Eq, Show) -- >>> _ <- runBH' $ deleteIndex testIndex >> deleteMapping testIndex testMapping -- >>> import GHC.Generics@@ -168,6 +172,18 @@   Server s <- bhServer <$> getBHEnv   return $ joinPath' (s:ps) +appendSearchTypeParam :: Text -> SearchType -> Text+appendSearchTypeParam originalUrl st = addQuery params originalUrl+  where stText = "search_type"+        params+          | st == SearchTypeDfsQueryThenFetch = [(stText, Just "dfs_query_then_fetch")]+          | st == SearchTypeCount             = [(stText, Just "count")]+          | st == SearchTypeScan              = [(stText, Just "scan"), ("scroll", Just "1m")]+          | st == SearchTypeQueryAndFetch     = [(stText, Just "query_and_fetch")]+          | st == SearchTypeDfsQueryAndFetch  = [(stText, Just "dfs_query_and_fetch")]+        -- used to catch 'SearchTypeQueryThenFetch', which is also the default+          | otherwise                         = [(stText, Just "query_then_fetch")]+ -- | Severely dumbed down query renderer. Assumes your data doesn't -- need any encoding addQuery :: [(Text, Maybe Text)] -> Text -> Text@@ -177,17 +193,17 @@       T.decodeUtf8 $ BB.toByteString $ NHTU.renderQueryText prependQuestionMark q     prependQuestionMark = True - bindM2 :: (Applicative m, Monad m) => (a -> b -> m c) -> m a -> m b -> m c bindM2 f ma mb = join (f <$> ma <*> mb) --- | Convenience function that sets up a mananager and BHEnv and runs+-- | Convenience function that sets up a manager and BHEnv and runs -- the given set of bloodhound operations. Connections will be -- pipelined automatically in accordance with the given manager -- settings in IO. If you've got your own monad transformer stack, you -- should use 'runBH' directly. withBH :: ManagerSettings -> Server -> BH IO a -> IO a-withBH ms s f = withManager ms $ \mgr -> do+withBH ms s f = do+  mgr <- newManager ms   let env = BHEnv { bhServer  = s                   , bhManager = mgr }   runBH env f@@ -200,7 +216,7 @@ head   :: MonadBH m => Text -> m Reply head   = flip (dispatch NHTM.methodHead) Nothing put    :: MonadBH m => Text -> Maybe L.ByteString -> m Reply-put    = dispatch NHTM.methodPost+put    = dispatch NHTM.methodPut post   :: MonadBH m => Text -> Maybe L.ByteString -> m Reply post   = dispatch NHTM.methodPost @@ -301,6 +317,35 @@ closeIndex :: MonadBH m => IndexName -> m Reply closeIndex = openOrCloseIndexes CloseIndex +-- | 'putTemplate' creates a template given an 'IndexTemplate' and a 'TemplateName'.+--   Explained in further detail at+--   <https://www.elastic.co/guide/en/elasticsearch/reference/1.7/indices-templates.html>+--+--   >>> let idxTpl = IndexTemplate (TemplatePattern "tweet-*") (Just (IndexSettings (ShardCount 1) (ReplicaCount 1))) [toJSON TweetMapping]+--   >>> resp <- runBH' $ putTemplate idxTpl (TemplateName "tweet-tpl")+putTemplate :: MonadBH m => IndexTemplate -> TemplateName -> m Reply+putTemplate indexTemplate (TemplateName templateName) =+  bindM2 put url (return body)+  where url = joinPath ["_template", templateName]+        body = Just $ encode indexTemplate++-- | 'templateExists' checks to see if a template exists.+--+--   >>> exists <- runBH' $ templateExists (TemplateName "tweet-tpl")+templateExists :: MonadBH m => TemplateName -> m Bool+templateExists (TemplateName templateName) = do+  (_, exists) <- existentialQuery =<< joinPath ["_template", templateName]+  return exists++-- | 'deleteTemplate' is an HTTP DELETE and deletes a template.+--+--   >>> let idxTpl = IndexTemplate (TemplatePattern "tweet-*") (Just (IndexSettings (ShardCount 1) (ReplicaCount 1))) [toJSON TweetMapping]+--   >>> _ <- runBH' $ putTemplate idxTpl (TemplateName "tweet-tpl")+--   >>> resp <- runBH' $ deleteTemplate (TemplateName "tweet-tpl")+deleteTemplate :: MonadBH m => TemplateName -> m Reply+deleteTemplate (TemplateName templateName) =+  delete =<< joinPath ["_template", templateName]+ -- | 'putMapping' is an HTTP PUT and has upsert semantics. Mappings are schemas -- for documents in indexes. --@@ -312,7 +357,9 @@                  -> MappingName -> a -> m Reply putMapping (IndexName indexName) (MappingName mappingName) mapping =   bindM2 put url (return body)-  where url = joinPath [indexName, mappingName, "_mapping"]+  where url = joinPath [indexName, "_mapping", mappingName]+        -- "_mapping" and mappingName above were originally transposed+        -- erroneously. The correct API call is: "/INDEX/_mapping/MAPPING_NAME"         body = Just $ encode mapping  -- | 'deleteMapping' is an HTTP DELETE and deletes a mapping for a given index.@@ -326,7 +373,9 @@ deleteMapping :: MonadBH m => IndexName -> MappingName -> m Reply deleteMapping (IndexName indexName)   (MappingName mappingName) =-  delete =<< joinPath [indexName, mappingName, "_mapping"]+  -- "_mapping" and mappingName below were originally transposed+  -- erroneously. The correct API call is: "/INDEX/_mapping/MAPPING_NAME"+  delete =<< joinPath [indexName, "_mapping", mappingName]  -- | 'indexDocument' is the primary way to save a single document in --   Elasticsearch. The document itself is simply something we can@@ -342,7 +391,7 @@   (MappingName mappingName) cfg document (DocId docId) =   bindM2 put url (return body)   where url = addQuery params <$> joinPath [indexName, mappingName, docId]-        params = case idsVersionControl cfg of+        versionCtlParams = case idsVersionControl cfg of           NoVersionControl -> []           InternalVersion v -> versionParams v "internal"           ExternalGT (ExternalDocVersion v) -> versionParams v "external_gt"@@ -352,6 +401,10 @@         versionParams v t = [ ("version", Just $ vt v)                             , ("version_type", Just t)                             ]+        parentParams = case idsParent cfg of+          Nothing -> []+          Just (DocumentParent (DocId p)) -> [ ("parent", Just p) ]+        params = versionCtlParams ++ parentParams         body = Just (encode document)  -- | 'deleteDocument' is the primary way to delete a single document.@@ -456,7 +509,8 @@   where url = joinPath [indexName, mappingName, docId]  dispatchSearch :: MonadBH m => Text -> Search -> m Reply-dispatchSearch url search = post url (Just (encode search))+dispatchSearch url search = post url' (Just (encode search))+  where url' = appendSearchTypeParam url (searchType search)  -- | 'searchAll', given a 'Search', will perform that search against all indexes --   on an Elasticsearch server. Try to avoid doing this if it can be helped.@@ -490,6 +544,42 @@   (MappingName mappingName) = bindM2 dispatchSearch url . return   where url = joinPath [indexName, mappingName, "_search"] +scanSearch' :: MonadBH m => IndexName -> MappingName -> Search -> m (Maybe ScrollId)+scanSearch' (IndexName indexName) (MappingName mappingName) search = do+    let url = joinPath [indexName, mappingName, "_search"]+        search' = search { searchType = SearchTypeScan }+    resp' <- bindM2 dispatchSearch url (return search')+    let msr = decode' $ responseBody resp' :: Maybe (SearchResult ())+        msid = maybe Nothing scrollId msr+    return msid++scroll' :: (FromJSON a, MonadBH m) => Maybe ScrollId -> m ([Hit a], Maybe ScrollId)+scroll' Nothing = return ([], Nothing)+scroll' (Just sid) = do+    url <- joinPath ["_search/scroll?scroll=1m"]+    resp' <- post url (Just . L.fromStrict $ T.encodeUtf8 sid)+    let msr = decode' $ responseBody resp' :: FromJSON a => Maybe (SearchResult a)+        resp = case msr of+            Just sr -> (hits $ searchHits sr, scrollId sr)+            _       -> ([], Nothing)+    return resp++simpleAccumilator :: (FromJSON a, MonadBH m) => [Hit a] -> ([Hit a], Maybe ScrollId) -> m ([Hit a], Maybe ScrollId)+simpleAccumilator oldHits (newHits, Nothing) = return (oldHits ++ newHits, Nothing)+simpleAccumilator oldHits ([], _) = return (oldHits, Nothing)+simpleAccumilator oldHits (newHits, msid) = do+    (newHits', msid') <- scroll' msid+    simpleAccumilator (oldHits ++ newHits) (newHits', msid')++-- | 'scanSearch' uses the 'scan&scroll' API of elastic,+-- for a given 'IndexName' and 'MappingName',+scanSearch :: (FromJSON a, MonadBH m) => IndexName -> MappingName -> Search -> m [Hit a]+scanSearch indexName mappingName search = do+    msid <- scanSearch' indexName mappingName search+    (hits, msid') <- scroll' msid+    (totalHits, _) <- simpleAccumilator [] (hits, msid')+    return totalHits+ -- | 'mkSearch' is a helper function for defaulting additional fields of a 'Search' --   to Nothing in case you only care about your 'Query' and 'Filter'. Use record update --   syntax if you want to add things like aggregations or highlights while still using@@ -497,9 +587,9 @@ -- -- >>> let query = TermQuery (Term "user" "bitemyapp") Nothing -- >>> mkSearch (Just query) Nothing--- Search {queryBody = Just (TermQuery (Term {termField = "user", termValue = "bitemyapp"}) Nothing), filterBody = Nothing, sortBody = Nothing, aggBody = Nothing, highlight = Nothing, trackSortScores = False, from = From 0, size = Size 10}+-- Search {queryBody = Just (TermQuery (Term {termField = "user", termValue = "bitemyapp"}) Nothing), filterBody = Nothing, sortBody = Nothing, aggBody = Nothing, highlight = Nothing, trackSortScores = False, from = From 0, size = Size 10, searchType = SearchTypeQueryThenFetch, fields = Nothing, source = Nothing} mkSearch :: Maybe Query -> Maybe Filter -> Search-mkSearch query filter = Search query filter Nothing Nothing Nothing False (From 0) (Size 10)+mkSearch query filter = Search query filter Nothing Nothing Nothing False (From 0) (Size 10) SearchTypeQueryThenFetch Nothing Nothing  -- | 'mkAggregateSearch' is a helper function that defaults everything in a 'Search' except for --   the 'Query' and the 'Aggregation'.@@ -509,7 +599,7 @@ -- TermsAgg (TermsAggregation {term = Left "user", termInclude = Nothing, termExclude = Nothing, termOrder = Nothing, termMinDocCount = Nothing, termSize = Nothing, termShardSize = Nothing, termCollectMode = Just BreadthFirst, termExecutionHint = Nothing, termAggs = Nothing}) -- >>> let myAggregation = mkAggregateSearch Nothing $ mkAggregations "users" terms mkAggregateSearch :: Maybe Query -> Aggregations -> Search-mkAggregateSearch query mkSearchAggs = Search query Nothing Nothing (Just mkSearchAggs) Nothing False (From 0) (Size 0)+mkAggregateSearch query mkSearchAggs = Search query Nothing Nothing (Just mkSearchAggs) Nothing False (From 0) (Size 0) SearchTypeQueryThenFetch Nothing Nothing  -- | 'mkHighlightSearch' is a helper function that defaults everything in a 'Search' except for --   the 'Query' and the 'Aggregation'.@@ -518,7 +608,7 @@ -- >>> let testHighlight = Highlights Nothing [FieldHighlight (FieldName "message") Nothing] -- >>> let search = mkHighlightSearch (Just query) testHighlight mkHighlightSearch :: Maybe Query -> Highlights -> Search-mkHighlightSearch query searchHighlights = Search query Nothing Nothing Nothing (Just searchHighlights) False (From 0) (Size 10)+mkHighlightSearch query searchHighlights = Search query Nothing Nothing Nothing (Just searchHighlights) False (From 0) (Size 10) SearchTypeQueryThenFetch Nothing Nothing  -- | 'pageSearch' is a helper function that takes a search and assigns the from --    and size fields for the search. The from parameter defines the offset@@ -528,9 +618,9 @@ -- >>> let query = QueryMatchQuery $ mkMatchQuery (FieldName "_all") (QueryString "haskell") -- >>> let search = mkSearch (Just query) Nothing -- >>> search--- Search {queryBody = Just (QueryMatchQuery (MatchQuery {matchQueryField = FieldName "_all", matchQueryQueryString = QueryString "haskell", matchQueryOperator = Or, matchQueryZeroTerms = ZeroTermsNone, matchQueryCutoffFrequency = Nothing, matchQueryMatchType = Nothing, matchQueryAnalyzer = Nothing, matchQueryMaxExpansions = Nothing, matchQueryLenient = Nothing})), filterBody = Nothing, sortBody = Nothing, aggBody = Nothing, highlight = Nothing, trackSortScores = False, from = From 0, size = Size 10}+-- Search {queryBody = Just (QueryMatchQuery (MatchQuery {matchQueryField = FieldName "_all", matchQueryQueryString = QueryString "haskell", matchQueryOperator = Or, matchQueryZeroTerms = ZeroTermsNone, matchQueryCutoffFrequency = Nothing, matchQueryMatchType = Nothing, matchQueryAnalyzer = Nothing, matchQueryMaxExpansions = Nothing, matchQueryLenient = Nothing, matchQueryBoost = Nothing})), filterBody = Nothing, sortBody = Nothing, aggBody = Nothing, highlight = Nothing, trackSortScores = False, from = From 0, size = Size 10, searchType = SearchTypeQueryThenFetch, fields = Nothing, source = Nothing} -- >>> pageSearch (From 10) (Size 100) search--- Search {queryBody = Just (QueryMatchQuery (MatchQuery {matchQueryField = FieldName "_all", matchQueryQueryString = QueryString "haskell", matchQueryOperator = Or, matchQueryZeroTerms = ZeroTermsNone, matchQueryCutoffFrequency = Nothing, matchQueryMatchType = Nothing, matchQueryAnalyzer = Nothing, matchQueryMaxExpansions = Nothing, matchQueryLenient = Nothing})), filterBody = Nothing, sortBody = Nothing, aggBody = Nothing, highlight = Nothing, trackSortScores = False, from = From 10, size = Size 100}+-- Search {queryBody = Just (QueryMatchQuery (MatchQuery {matchQueryField = FieldName "_all", matchQueryQueryString = QueryString "haskell", matchQueryOperator = Or, matchQueryZeroTerms = ZeroTermsNone, matchQueryCutoffFrequency = Nothing, matchQueryMatchType = Nothing, matchQueryAnalyzer = Nothing, matchQueryMaxExpansions = Nothing, matchQueryLenient = Nothing, matchQueryBoost = Nothing})), filterBody = Nothing, sortBody = Nothing, aggBody = Nothing, highlight = Nothing, trackSortScores = False, from = From 10, size = Size 100, searchType = SearchTypeQueryThenFetch, fields = Nothing, source = Nothing} pageSearch :: From     -- ^ The result offset            -> Size     -- ^ The number of results to return            -> Search  -- ^ The current seach

@@ -47,7 +47,7 @@        , toTerms        , toDateHistogram        , omitNulls-       , BH+       , BH(..)        , runBH        , BHEnv(..)        , MonadBH(..)@@ -56,20 +56,30 @@        , Existence(..)        , NullValue(..)        , IndexSettings(..)+       , IndexTemplate(..)        , Server(..)        , Reply        , EsResult(..)+       , EsResultFound(..)        , DocVersion        , ExternalDocVersion(..)        , VersionControl(..)+       , DocumentParent(..)        , IndexDocumentSettings(..)        , Query(..)        , Search(..)+       , SearchType(..)        , SearchResult(..)+       , ScrollId        , SearchHits(..)        , TrackSortScores        , From(..)        , Size(..)+       , Source(..)+       , PatternOrPatterns(..)+       , Include(..)+       , Exclude(..)+       , Pattern(..)        , ShardResult(..)        , Hit(..)        , Filter(..)@@ -100,7 +110,10 @@        , RegexpFlags(..)        , RegexpFlag(..)        , FieldName(..)+       , Script(..)        , IndexName(..)+       , TemplateName(..)+       , TemplatePattern(..)        , MappingName(..)        , DocId(..)        , CacheName(..)@@ -196,6 +209,8 @@        , Bucket(..)        , BucketAggregation(..)        , TermsAggregation(..)+       , ValueCountAggregation(..)+       , FilterAggregation(..)        , DateHistogramAggregation(..)         , Highlights(..)@@ -215,14 +230,16 @@          ) where  import           Control.Applicative-import           Control.Monad.Error+import           Control.Monad.Catch+import           Control.Monad.Except import           Control.Monad.Reader import           Control.Monad.State import           Control.Monad.Writer import           Data.Aeson import           Data.Aeson.Types                (Pair, emptyObject, parseMaybe) import qualified Data.ByteString.Lazy.Char8      as L-import           Data.List                       (nub)+import qualified Data.HashMap.Strict             as HM (union)+import           Data.List                       (foldl', nub) import           Data.List.NonEmpty              (NonEmpty (..), toList) import qualified Data.Map.Strict                 as M import           Data.Maybe@@ -274,7 +291,10 @@                , MonadError e                , Alternative                , MonadPlus-               , MonadFix)+               , MonadFix+               , MonadThrow+               , MonadCatch+               , MonadMask)  instance MonadTrans BH where   lift = BH . lift@@ -348,6 +368,20 @@ data FieldDefinition =   FieldDefinition { fieldType :: FieldType } deriving (Eq, Show) +{-| An 'IndexTemplate' defines a template that will automatically be+    applied to new indices created. The templates include both+    'IndexSettings' and mappings, and a simple 'TemplatePattern' that+    controls if the template will be applied to the index created.+    Specify mappings as follows: @[toJSON TweetMapping, ...]@++    https://www.elastic.co/guide/en/elasticsearch/reference/1.7/indices-templates.html+-}+data IndexTemplate =+  IndexTemplate { templatePattern  :: TemplatePattern+                , templateSettings :: Maybe IndexSettings+                , templateMappings :: [Value]+                }+ data MappingField =   MappingField   { mappingFieldName :: FieldName                  , fieldDefinition  :: FieldDefinition } deriving (Eq, Show)@@ -375,15 +409,22 @@   | BulkUpdate IndexName MappingName DocId Value deriving (Eq, Show)  {-| 'EsResult' describes the standard wrapper JSON document that you see in-    successful Elasticsearch responses.+    successful Elasticsearch lookups or lookups that couldn't find the document. -}-data EsResult a = EsResult { _index   :: Text-                           , _type    :: Text-                           , _id      :: Text-                           , _version :: DocVersion-                           , found    :: Maybe Bool-                           , _source  :: a } deriving (Eq, Show)+data EsResult a = EsResult { _index      :: Text+                           , _type       :: Text+                           , _id         :: Text+                           , foundResult :: Maybe (EsResultFound a)} deriving (Eq, Show) ++{-| 'EsResultFound' contains the document and its metadata inside of an+    'EsResult' when the document was successfully found.+-}+data EsResultFound a = EsResultFound {  _version :: DocVersion+                                     , _source   :: a } deriving (Eq, Show)+++ {-| 'DocVersion' is an integer version number for a document between 1 and 9.2e+18 used for <<https://www.elastic.co/guide/en/elasticsearch/guide/current/optimistic-concurrency-control.html optimistic concurrency control>>. -}@@ -439,18 +480,24 @@                     -- care, as this could result in data loss.                     deriving (Show, Eq, Ord) +{-| 'DocumentParent' is used to specify a parent document.+-}+newtype DocumentParent = DocumentParent DocId+  deriving (Eq, Show)+ {-| 'IndexDocumentSettings' are special settings supplied when indexing a document. For the best backwards compatiblity when new fields are added, you should probably prefer to start with 'defaultIndexDocumentSettings' -}-data IndexDocumentSettings = IndexDocumentSettings {-      idsVersionControl :: VersionControl-    }+data IndexDocumentSettings =+  IndexDocumentSettings { idsVersionControl :: VersionControl+                        , idsParent         :: Maybe DocumentParent+                        } deriving (Eq, Show) -{-| Reasonable default settings. Chooses no version control.+{-| Reasonable default settings. Chooses no version control and no parent. -} defaultIndexDocumentSettings :: IndexDocumentSettings-defaultIndexDocumentSettings = IndexDocumentSettings NoVersionControl+defaultIndexDocumentSettings = IndexDocumentSettings NoVersionControl Nothing  {-| 'Sort' is a synonym for a list of 'SortSpec's. Sort behavior is order     dependent with later sorts acting as tie-breakers for earlier sorts.@@ -546,6 +593,14 @@ -} newtype IndexName = IndexName Text deriving (Eq, Generic, Show) +{-| 'TemplateName' is used to describe which template to query/create/delete+-}+newtype TemplateName = TemplateName Text deriving (Eq, Show, Generic)++{-| 'TemplatePattern' represents a pattern which is matched against index names+-}+newtype TemplatePattern = TemplatePattern Text deriving (Eq, Show, Generic)+ {-| 'MappingName' is part of mappings which are how ES describes and schematizes     the data in the indices. -}@@ -566,6 +621,12 @@ -} newtype FieldName = FieldName Text deriving (Eq, Show) ++{-| 'Script' is often used in place of 'FieldName' to specify more+complex ways of extracting a value from a document.+-}+newtype Script = Script { scriptText :: Text } deriving (Eq, Show)+ {-| 'CacheName' is used in 'RegexpFilter' for describing the     'CacheKey' keyed caching behavior. -}@@ -681,8 +742,33 @@                        -- default False                      , trackSortScores :: TrackSortScores                      , from            :: From-                     , size            :: Size } deriving (Eq, Show)+                     , size            :: Size+                     , searchType      :: SearchType+                     , fields          :: Maybe [FieldName]+                     , source          :: Maybe Source } deriving (Eq, Show) +data SearchType = SearchTypeQueryThenFetch+                | SearchTypeDfsQueryThenFetch+                | SearchTypeCount+                | SearchTypeScan+                | SearchTypeQueryAndFetch+                | SearchTypeDfsQueryAndFetch+  deriving (Eq, Show)++data Source =+  NoSource+  | SourcePatterns PatternOrPatterns+  | SourceIncludeExclude Include Exclude+    deriving (Show, Eq)++data PatternOrPatterns = PopPattern   Pattern+                       | PopPatterns [Pattern] deriving (Eq, Show)++data Include = Include [Pattern] deriving (Eq, Show)+data Exclude = Exclude [Pattern] deriving (Eq, Show)++newtype Pattern = Pattern Text deriving (Eq, Show)+ data Highlights = Highlights { globalsettings  :: Maybe HighlightSettings                              , highlightFields :: [FieldHighlight]                              } deriving (Show, Eq)@@ -969,13 +1055,14 @@              , matchQueryMatchType       :: Maybe MatchQueryType              , matchQueryAnalyzer        :: Maybe Analyzer              , matchQueryMaxExpansions   :: Maybe MaxExpansions-             , matchQueryLenient         :: Maybe Lenient } deriving (Eq, Show)+             , matchQueryLenient         :: Maybe Lenient+             , matchQueryBoost           :: Maybe Boost } deriving (Eq, Show)  {-| 'mkMatchQuery' is a convenience function that defaults the less common parameters,     enabling you to provide only the 'FieldName' and 'QueryString' to make a 'MatchQuery' -} mkMatchQuery :: FieldName -> QueryString -> MatchQuery-mkMatchQuery field query = MatchQuery field query Or ZeroTermsNone Nothing Nothing Nothing Nothing Nothing+mkMatchQuery field query = MatchQuery field query Or ZeroTermsNone Nothing Nothing Nothing Nothing Nothing Nothing  data MatchQueryType =   MatchPhrase@@ -1194,8 +1281,11 @@                , timedOut     :: Bool                , shards       :: ShardResult                , searchHits   :: SearchHits a-               , aggregations :: Maybe AggregationResults } deriving (Eq, Show)+               , aggregations :: Maybe AggregationResults+               , scrollId     :: Maybe ScrollId } deriving (Eq, Show) +type ScrollId = Text  -- Fixme: Newtype+ type Score = Maybe Double  data SearchHits a =@@ -1268,7 +1358,9 @@               | FractionalInterval Float TimeInterval deriving (Eq, Show)  data Aggregation = TermsAgg TermsAggregation-                 | DateHistogramAgg DateHistogramAggregation deriving (Eq, Show)+                 | DateHistogramAgg DateHistogramAggregation+                 | ValueCountAgg ValueCountAggregation+                 | FilterAgg FilterAggregation deriving (Eq, Show)   data TermsAggregation = TermsAggregation { term              :: Either Text Text@@ -1294,7 +1386,14 @@                                                          , dateAggs       :: Maybe Aggregations                                                          } deriving (Eq, Show) +-- | See <https://www.elastic.co/guide/en/elasticsearch/reference/current/search-aggregations-metrics-valuecount-aggregation.html> for more information.+data ValueCountAggregation = FieldValueCount FieldName+                           | ScriptValueCount Script deriving (Eq, Show) +-- | Single-bucket filter aggregations. See <https://www.elastic.co/guide/en/elasticsearch/reference/current/search-aggregations-bucket-filter-aggregation.html#search-aggregations-bucket-filter-aggregation> for more information.+data FilterAggregation = FilterAggregation { faFilter :: Filter+                                           , faAggs   :: Maybe Aggregations} deriving (Eq, Show)+ mkTermsAggregation :: Text -> TermsAggregation mkTermsAggregation t = TermsAggregation (Left t) Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing @@ -1367,6 +1466,13 @@                                                "post_offset" .= postOffset                                              ],                "aggs"           .= dateHistoAggs ]+  toJSON (ValueCountAgg a) = object ["value_count" .= v]+    where v = case a of+                (FieldValueCount (FieldName n)) -> object ["field" .= n]+                (ScriptValueCount (Script s))   -> object ["script" .= s]+  toJSON (FilterAgg (FilterAggregation filt ags)) =+    omitNulls [ "filter" .= filt+              , "aggs" .= ags]  type AggregationResults = M.Map Text Value @@ -1886,7 +1992,7 @@   toJSON (MatchQuery (FieldName fieldName)           (QueryString mqQueryString) booleanOperator           zeroTermsQuery cutoffFrequency matchQueryType-          analyzer maxExpansions lenient) =+          analyzer maxExpansions lenient boost) =     object [ fieldName .= omitNulls base ]     where base = [ "query" .= mqQueryString                  , "operator" .= booleanOperator@@ -1895,7 +2001,8 @@                  , "type" .= matchQueryType                  , "analyzer" .= analyzer                  , "max_expansions" .= maxExpansions-                 , "lenient" .= lenient ]+                 , "lenient" .= lenient+                 , "boost" .= boost ]   instance ToJSON MultiMatchQuery where@@ -1953,6 +2060,8 @@ instance ToJSON MaxQueryTerms instance ToJSON TypeName instance ToJSON IndexName+instance ToJSON TemplateName+instance ToJSON TemplatePattern instance ToJSON BoostTerms instance ToJSON MaxWordLength instance ToJSON MinWordLength@@ -1989,22 +2098,43 @@   instance ToJSON IndexSettings where-  toJSON (IndexSettings s r) = object ["settings" .= object ["shards" .= s, "replicas" .= r]]+  toJSON (IndexSettings s r) = object ["settings" .=+                                 object ["index" .=+                                   object ["number_of_shards" .= s, "number_of_replicas" .= r]+                                 ]+                               ] +instance ToJSON IndexTemplate where+  toJSON (IndexTemplate p s m) = merge+    (object [ "template" .= p+            , "mappings" .= foldl' merge (object []) m+            ])+    (toJSON s)+   where+     merge (Object o1) (Object o2) = toJSON $ HM.union o1 o2+     merge o           Null        = o+     merge _           _           = undefined  instance (FromJSON a) => FromJSON (EsResult a) where-  parseJSON (Object v) = EsResult <$>-                         v .:  "_index"   <*>-                         v .:  "_type"    <*>-                         v .:  "_id"      <*>-                         v .:  "_version" <*>-                         v .:? "found"    <*>-                         v .:  "_source"+  parseJSON jsonVal@(Object v) = do+    found <- v .:? "found" .!= False+    fr <- if found+             then parseJSON jsonVal+             else return Nothing+    EsResult <$> v .:  "_index"   <*>+                 v .:  "_type"    <*>+                 v .:  "_id"      <*>+                 pure fr   parseJSON _          = empty +instance (FromJSON a) => FromJSON (EsResultFound a) where+  parseJSON (Object v) = EsResultFound <$>+                         v .: "_version" <*>+                         v .: "_source"+  parseJSON _          = empty  instance ToJSON Search where-  toJSON (Search query sFilter sort searchAggs highlight sTrackSortScores sFrom sSize) =+  toJSON (Search query sFilter sort searchAggs highlight sTrackSortScores sFrom sSize _ sFields sSource) =     omitNulls [ "query"        .= query               , "filter"       .= sFilter               , "sort"         .= sort@@ -2012,9 +2142,30 @@               , "highlight"    .= highlight               , "from"         .= sFrom               , "size"         .= sSize-              , "track_scores" .= sTrackSortScores]+              , "track_scores" .= sTrackSortScores+              , "fields"       .= sFields+              , "_source"      .= sSource]  +instance ToJSON Source where+    toJSON NoSource                         = toJSON False+    toJSON (SourcePatterns patterns)        = toJSON patterns+    toJSON (SourceIncludeExclude incl excl) = object [ "include" .= incl, "exclude" .= excl ]++instance ToJSON PatternOrPatterns where+  toJSON (PopPattern pattern)   = toJSON pattern+  toJSON (PopPatterns patterns) = toJSON patterns++instance ToJSON Include where+  toJSON (Include patterns) = toJSON patterns++instance ToJSON Exclude where+  toJSON (Exclude patterns) = toJSON patterns++instance ToJSON Pattern where+  toJSON (Pattern pattern) = toJSON pattern++ instance ToJSON FieldHighlight where     toJSON (FieldHighlight (FieldName fName) (Just fSettings)) =         object [ fName .= fSettings ]@@ -2232,7 +2383,8 @@                          v .:  "timed_out"    <*>                          v .:  "_shards"      <*>                          v .:  "hits"         <*>-                         v .:? "aggregations"+                         v .:? "aggregations" <*>+                         v .:? "_scroll_id"   parseJSON _          = empty  instance (FromJSON a) => FromJSON (SearchHits a) where

@@ -1,8 +1,11 @@+{-# LANGUAGE CPP #-} module Database.Bloodhound.Types.Class        ( Seminearring(..) )        where +#if !MIN_VERSION_base(4,8,0) import Data.Monoid+#endif  class Monoid a => Seminearring a where   -- 0, +, *

@@ -0,0 +1,4 @@+import Test.DocTest++main :: IO ()+main = doctest ["-i src", "Database.Bloodhound"]

@@ -1,74 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE ForeignFunctionInterface #-}--------------------------------------------------------------------------------- |--- Module      :  Main (doctests)--- Copyright   :  (C) 2014 Chris Allen--- License     :  BSD-style (see the file LICENSE)--- Maintainer  :  Chris Allen <cma@bitemyapp.com>--- Stability   :  provisional--- Portability :  portable------ This module provides doctests for a project based on the actual versions--- of the packages it was built with. It requires a corresponding Setup.lhs--- to be added to the project--------------------------------------------------------------------------------module Main where--import Build_doctests (deps)-import Control.Applicative-import Control.Monad-import Data.List-import System.Directory-import System.FilePath-import Test.DocTest--##if defined(mingw32_HOST_OS)-##if defined(i386_HOST_ARCH)-##define USE_CP-import Control.Applicative-import Control.Exception-import Foreign.C.Types-foreign import stdcall "windows.h SetConsoleCP" c_SetConsoleCP :: CUInt -> IO Bool-foreign import stdcall "windows.h GetConsoleCP" c_GetConsoleCP :: IO CUInt-##elif defined(x86_64_HOST_ARCH)-##define USE_CP-import Control.Applicative-import Control.Exception-import Foreign.C.Types-foreign import ccall "windows.h SetConsoleCP" c_SetConsoleCP :: CUInt -> IO Bool-foreign import ccall "windows.h GetConsoleCP" c_GetConsoleCP :: IO CUInt-##endif-##endif---- | Run in a modified codepage where we can print UTF-8 values on Windows.-withUnicode :: IO a -> IO a-##ifdef USE_CP-withUnicode m = do-  cp <- c_GetConsoleCP-  (c_SetConsoleCP 65001 >> m) `finally` c_SetConsoleCP cp-##else-withUnicode m = m-##endif--main :: IO ()-main = withUnicode $ getSources >>= \sources -> doctest $-    "-isrc"-  : "-idist/build/autogen"-  : "-optP-include"-  : "-optPdist/build/autogen/cabal_macros.h"-  : "-hide-all-packages"-  : map ("-package="++) deps ++ sources--getSources :: IO [FilePath]-getSources = filter (isSuffixOf ".hs") <$> go "src"-  where-    go dir = do-      (dirs, files) <- getFilesAndDirectories dir-      (files ++) . concat <$> mapM go dirs--getFilesAndDirectories :: FilePath -> IO ([FilePath], [FilePath])-getFilesAndDirectories dir = do-  c <- map (dir </>) . filter (`notElem` ["..", "."]) <$> getDirectoryContents dir-  (,) <$> filterM doesDirectoryExist c <*> filterM doesFileExist c

@@ -14,6 +14,7 @@ import           Data.List.NonEmpty              (NonEmpty (..)) import qualified Data.List.NonEmpty              as NE import qualified Data.Map.Strict                 as M+import           Data.Monoid import           Data.Text                       (Text) import qualified Data.Text                       as T import           Data.Time.Calendar              (Day (..))@@ -47,7 +48,7 @@   `shouldBe` (expected :: Int)  createExampleIndex :: BH IO Reply-createExampleIndex = createIndex defaultIndexSettings testIndex+createExampleIndex = createIndex (IndexSettings (ShardCount 1) (ReplicaCount 0)) testIndex deleteExampleIndex :: BH IO Reply deleteExampleIndex = deleteIndex testIndex @@ -174,15 +175,16 @@  searchTweet :: Search -> BH IO (Either String Tweet) searchTweet search = do-  reply <- searchByIndex testIndex search-  let result = eitherDecode (responseBody reply) :: Either String (SearchResult Tweet)+  result <- searchTweets search   let myTweet = fmap (hitSource . head . hits . searchHits) result   return myTweet +searchTweets :: Search -> BH IO (Either String (SearchResult Tweet))+searchTweets search = eitherDecode . responseBody <$> searchByIndex testIndex search+ searchExpectNoResults :: Search -> BH IO () searchExpectNoResults search = do-  reply <- searchByIndex testIndex search-  let result = eitherDecode (responseBody reply) :: Either String (SearchResult Tweet)+  result <- searchTweets search   let emptyHits = fmap (hits . searchHits) result   liftIO $     emptyHits `shouldBe` Right []@@ -214,11 +216,21 @@  searchTweetHighlight :: Search -> BH IO (Either String (Maybe HitHighlight)) searchTweetHighlight search = do-  reply <- searchByIndex testIndex search-  let result = eitherDecode (responseBody reply) :: Either String (SearchResult Tweet)+  result <- searchTweets search   let myHighlight = fmap (hitHighlight . head . hits . searchHits) result   return myHighlight +searchExpectSource :: Source -> Either String Value -> BH IO ()+searchExpectSource src expected = do+  _ <- insertData+  let query = QueryMatchQuery $ mkMatchQuery (FieldName "_all") (QueryString "haskell")+  let search = (mkSearch (Just query) Nothing) { source = Just src }+  reply <- searchAll search+  let result = eitherDecode (responseBody reply) :: Either String (SearchResult Value)+  let value = fmap (hitSource . head . hits . searchHits) result+  liftIO $+    value `shouldBe` expected+ data BulkTest = BulkTest { name :: Text } deriving (Eq, Generic, Show) instance FromJSON BulkTest instance ToJSON BulkTest@@ -278,6 +290,9 @@     hs <- arbitrary     return $ SearchHits tot score hs +getSource :: EsResult a -> Maybe a+getSource = fmap _source . foundResult+ main :: IO () main = hspec $ do @@ -298,8 +313,14 @@       docInserted <- getDocument testIndex testMapping (DocId "1")       let newTweet = eitherDecode                      (responseBody docInserted) :: Either String (EsResult Tweet)-      liftIO $ (fmap _source newTweet `shouldBe` Right exampleTweet)+      liftIO $ (fmap getSource newTweet `shouldBe` Right (Just exampleTweet)) +    it "produces a parseable result when looking up a bogus document" $ withTestEnv $ do+      doc <- getDocument testIndex testMapping  (DocId "bogus")+      let noTweet = eitherDecode+                    (responseBody doc) :: Either String (EsResult Tweet)+      liftIO $ fmap foundResult noTweet `shouldBe` Right Nothing+     it "can use optimistic concurrency control" $ withTestEnv $ do       let ev = ExternalDocVersion minBound       let cfg = defaultIndexDocumentSettings { idsVersionControl = ExternalGT ev }@@ -309,6 +330,24 @@       res' <- insertData' cfg       liftIO $ isVersionConflict res' `shouldBe` True +  describe "template API" $ do+    it "can create a template" $ withTestEnv $ do+      let idxTpl = IndexTemplate (TemplatePattern "tweet-*") (Just (IndexSettings (ShardCount 1) (ReplicaCount 1))) [toJSON TweetMapping]+      resp <- putTemplate idxTpl (TemplateName "tweet-tpl")+      liftIO $ validateStatus resp 200++    it "can detect if a template exists" $ withTestEnv $ do+      exists <- templateExists (TemplateName "tweet-tpl")+      liftIO $ exists `shouldBe` True++    it "can delete a template" $ withTestEnv $ do+      resp <- deleteTemplate (TemplateName "tweet-tpl")+      liftIO $ validateStatus resp 200++    it "can detect if a template doesn't exist" $ withTestEnv $ do+      exists <- templateExists (TemplateName "tweet-tpl")+      liftIO $ exists `shouldBe` False+   describe "bulk API" $ do     it "inserts all documents we request" $ withTestEnv $ do       _ <- insertData@@ -326,8 +365,8 @@       let maybeFirst  = eitherDecode $ responseBody fDoc :: Either String (EsResult BulkTest)       let maybeSecond = eitherDecode $ responseBody sDoc :: Either String (EsResult BulkTest)       liftIO $ do-        fmap _source maybeFirst `shouldBe` Right firstTest-        fmap _source maybeSecond `shouldBe` Right secondTest+        fmap getSource maybeFirst `shouldBe` Right (Just firstTest)+        fmap getSource maybeSecond `shouldBe` Right (Just secondTest)     describe "query API" $ do@@ -359,8 +398,8 @@      it "returns document for multi-match query" $ withTestEnv $ do       _ <- insertData-      let fields = [FieldName "user", FieldName "message"]-      let query = QueryMultiMatchQuery $ mkMultiMatchQuery fields (QueryString "bitemyapp")+      let flds = [FieldName "user", FieldName "message"]+      let query = QueryMultiMatchQuery $ mkMultiMatchQuery flds (QueryString "bitemyapp")       let search = mkSearch (Just query) Nothing       myTweet <- searchTweet search       liftIO $@@ -407,9 +446,8 @@       let sortSpec = DefaultSortSpec $ mkSort (FieldName "age") Ascending       let search = Search Nothing                    (Just IdentityFilter) (Just [sortSpec]) Nothing Nothing-                   False (From 0) (Size 10)-      reply <- searchByIndex testIndex search-      let result = eitherDecode (responseBody reply) :: Either String (SearchResult Tweet)+                   False (From 0) (Size 10) SearchTypeQueryThenFetch Nothing Nothing+      result <- searchTweets search       let myTweet = fmap (hitSource . head . hits . searchHits) result       liftIO $         myTweet `shouldBe` Right otherTweet@@ -601,6 +639,32 @@       _ <- insertData       searchTermsAggHint [GlobalOrdinals, GlobalOrdinalsHash, GlobalOrdinalsLowCardinality, Map] ++    it "can execute value_count aggregations" $ withTestEnv $ do+      _ <- insertData+      _ <- insertOther+      let ags = mkAggregations "user_count" (ValueCountAgg (FieldValueCount (FieldName "user"))) <>+                mkAggregations "bogus_count" (ValueCountAgg (FieldValueCount (FieldName "bogus")))+      let search = mkAggregateSearch Nothing ags+      let docCountPair k n = (k, object ["value" .= Number n])+      res <- searchTweets search+      liftIO $+        fmap aggregations res `shouldBe` Right (Just (M.fromList [ docCountPair "user_count" 2+                                                                 , docCountPair "bogus_count" 0+                                                                 ]))++    it "can execute filter aggregations" $ withTestEnv $ do+      _ <- insertData+      _ <- insertOther+      let ags = mkAggregations "bitemyapps" (FilterAgg (FilterAggregation (TermFilter (Term "user" "bitemyapp") defaultCache) Nothing)) <>+                mkAggregations "notmyapps" (FilterAgg (FilterAggregation (TermFilter (Term "user" "notmyapp") defaultCache) Nothing))+      let search = mkAggregateSearch Nothing ags+      let docCountPair k n = (k, object ["doc_count" .= Number n])+      res <- searchTweets search+      liftIO $+        fmap aggregations res `shouldBe` Right (Just (M.fromList [ docCountPair "bitemyapps" 1+                                                                 , docCountPair "notmyapps" 1+                                                                 ]))     -- Interaction of date serialization and date histogram aggregation is broken.     -- it "returns date histogram aggregation results" $ withTestEnv $ do     --   _ <- insertData@@ -645,8 +709,33 @@       liftIO $         myHighlight `shouldBe` Right Nothing +  describe "Source filtering" $ do +    it "doesn't include source when sources are disabled" $ withTestEnv $ do+      searchExpectSource+        NoSource+        (Left "key \"_source\" not present") +    it "includes a source" $ withTestEnv $ do+      searchExpectSource+        (SourcePatterns (PopPattern (Pattern "message")))+        (Right (Object (HM.fromList [("message", String "Use haskell!")])))++    it "includes sources" $ withTestEnv $ do+      searchExpectSource+        (SourcePatterns (PopPatterns [Pattern "user", Pattern "message"]))+        (Right (Object (HM.fromList [("user",String "bitemyapp"),("message", String "Use haskell!")])))++    it "includes source patterns" $ withTestEnv $ do+      searchExpectSource+        (SourcePatterns (PopPattern (Pattern "*ge")))+        (Right (Object (HM.fromList [("age", Number 10000),("message", String "Use haskell!")])))++    it "excludes source patterns" $ withTestEnv $ do+      searchExpectSource+        (SourceIncludeExclude (Include []) (Exclude [Pattern "l*", Pattern "*ge", Pattern "postDate"]))+        (Right (Object (HM.fromList [("user",String "bitemyapp")])))+   describe "ToJSON RegexpFlags" $ do     it "generates the correct JSON for AllRegexpFlags" $       toJSON AllRegexpFlags `shouldBe` String "ALL"@@ -709,3 +798,16 @@       enumFrom (pred maxBound :: DocVersion) `shouldBe` [pred maxBound, maxBound]       enumFrom (pred maxBound :: DocVersion) `shouldBe` [pred maxBound, maxBound]       enumFromThen minBound (pred maxBound :: DocVersion) `shouldBe` [minBound, pred maxBound]++  describe "scan&scroll API" $ do+    it "returns documents using the scan&scroll API" $ withTestEnv $ do+      _ <- insertData+      _ <- insertOther+      let search = (mkSearch (Just $ MatchAllQuery Nothing) Nothing) { size = (Size 1) }+      regular_search <- searchTweet search+      scan_search' <- scanSearch testIndex testMapping search :: BH IO [Hit Tweet]+      let scan_search = map hitSource scan_search'+      liftIO $+        regular_search `shouldBe` Right exampleTweet -- Check that the size restrtiction is being honored +      liftIO $+        scan_search `shouldMatchList` [exampleTweet, otherTweet]