@@ -1,130 +0,0 @@
1−{-# LANGUAGE OverloadedStrings #-}
2−{-# LANGUAGE DeriveGeneric #-}
7−import Database.V5.Bloodhound
9−import Data.Text (Text)
10−import Data.Time.Clock (NominalDiffTime, UTCTime (..),
13−import Data.Time.Calendar (Day (..), fromGregorian)
14−import Network.HTTP.Client hiding (Proxy)
15−import qualified Data.HashMap.Strict as HM
18−testServer = Server "http://localhost:9200"
19−testIndex :: IndexName
20−testIndex = IndexName "bloodhound-tests-twitter-1"
21−testMapping :: MappingName
22−testMapping = MappingName "tweet"
23−withTestEnv :: BH IO a -> IO a
24−withTestEnv = withBH defaultManagerSettings testServer
25−createExampleIndex :: (MonadBH m) => m Reply
26−createExampleIndex = createIndex (IndexSettings (ShardCount 1) (ReplicaCount 0)) testIndex
27−deleteExampleIndex :: (MonadBH m) => m Reply
28−deleteExampleIndex = deleteIndex testIndex
29−insertData :: BH IO Reply
32− insertData' defaultIndexDocumentSettings
34−insertData' :: IndexDocumentSettings -> BH IO Reply
36− r <- indexDocument testIndex testMapping ids exampleTweet (DocId "1")
37− _ <- refreshIndex testIndex
40−searchTweet :: Search -> BH IO (Either EsError Tweet)
41−searchTweet search = do
42− result <- searchTweets search
43− let myTweet :: Either EsError Tweet
44− myTweet = grabFirst result
47−searchTweets :: Search -> BH IO (Either EsError (SearchResult Tweet))
48−searchTweets search = parseEsResponse =<< searchByIndex testIndex search
50−data Tweet = Tweet { user :: Text
51− , postDate :: UTCTime
54− , location :: Location
55− , extra :: Maybe Text }
56− deriving (Eq, Generic, Show)
58−instance ToJSON Tweet where
59− toJSON = genericToJSON defaultOptions
60−instance FromJSON Tweet where
61− parseJSON = genericParseJSON defaultOptions
62−instance ToJSON Location where
63− toJSON = genericToJSON defaultOptions
64−instance FromJSON Location where
65− parseJSON = genericParseJSON defaultOptions
67−data Location = Location { lat :: Double
68− , lon :: Double } deriving (Eq, Generic, Show)
71−grabFirst :: Either EsError (SearchResult a) -> Either EsError a
73− case fmap (hitSource . head . hits . searchHits) r of
75− (Right Nothing) -> Left (EsError 500 "Source was missing")
76− (Right (Just x)) -> Right x
78−resetIndex :: BH IO ()
80− _ <- deleteExampleIndex
81− _ <- createExampleIndex
82− _ <- putMapping testIndex testMapping TweetMapping
85−data TweetMapping = TweetMapping deriving (Eq, Show)
87−instance ToJSON TweetMapping where
88− toJSON TweetMapping =
90− object ["properties" .=
91− object [ "user" .= object [ "type" .= ("string" :: Text)
92− , "fielddata" .= True
94− -- Serializing the date as a date is breaking other tests, mysteriously.
95− -- , "postDate" .= object [ "type" .= ("date" :: Text)
96− -- , "format" .= ("YYYY-MM-dd`T`HH:mm:ss.SSSZZ" :: Text)]
97− , "message" .= object ["type" .= ("string" :: Text)]
98− , "age" .= object ["type" .= ("integer" :: Text)]
99− , "location" .= object ["type" .= ("geo_point" :: Text)]
100− , "extra" .= object ["type" .= ("keyword" :: Text)]
103−exampleTweet :: Tweet
104−exampleTweet = Tweet { user = "bitemyapp"
105− , postDate = UTCTime
106− (ModifiedJulianDay 55000)
107− (secondsToDiffTime 10)
108− , message = "Use haskell!"
110− , location = Location 40.12 (-71.34)
115− _ <- withTestEnv $ insertData
116− let innerQuery = QueryMatchNoneQuery
117− -- let innerQuery = QueryMatchQuery $ mkMatchQuery (FieldName "message") (QueryString "Use haskel")
118− let phraseSuggester = mkPhraseSuggester (FieldName "message")
119− let namedSuggester = Suggest "Use haskel" "suggest_name" (SuggestTypePhraseSuggester phraseSuggester)
120− let search' = mkSearch (Just innerQuery) Nothing
121− let search = search' { suggestBody = Just namedSuggester }
122− print $ encode search
123− -- myTweet <- withTestEnv $ searchTweet search
125− myTweet `shouldBe` Right exampleTweet -}
127− resp <- withTestEnv $ searchByIndex testIndex search
128− parsed <- parseEsResponse resp :: IO (Either EsError (SearchResult Tweet))