@@ -1,130 +0,0 @@
1−{-# LANGUAGE OverloadedStrings #-}
2−{-# LANGUAGE DeriveGeneric #-}
3−
4−module Test
5− where
6−
7−import Database.V5.Bloodhound
8−import Data.Aeson
9−import Data.Text (Text)
10−import Data.Time.Clock (NominalDiffTime, UTCTime (..),
11− secondsToDiffTime)
12−import GHC.Generics
13−import Data.Time.Calendar (Day (..), fromGregorian)
14−import Network.HTTP.Client hiding (Proxy)
15−import qualified Data.HashMap.Strict as HM
16−
17−testServer :: Server
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
30−insertData = do
31− resetIndex
32− insertData' defaultIndexDocumentSettings
33−
34−insertData' :: IndexDocumentSettings -> BH IO Reply
35−insertData' ids = do
36− r <- indexDocument testIndex testMapping ids exampleTweet (DocId "1")
37− _ <- refreshIndex testIndex
38− return r
39−
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
45− return myTweet
46−
47−searchTweets :: Search -> BH IO (Either EsError (SearchResult Tweet))
48−searchTweets search = parseEsResponse =<< searchByIndex testIndex search
49−
50−data Tweet = Tweet { user :: Text
51− , postDate :: UTCTime
52− , message :: Text
53− , age :: Int
54− , location :: Location
55− , extra :: Maybe Text }
56− deriving (Eq, Generic, Show)
57−
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
66−
67−data Location = Location { lat :: Double
68− , lon :: Double } deriving (Eq, Generic, Show)
69−
70−
71−grabFirst :: Either EsError (SearchResult a) -> Either EsError a
72−grabFirst r =
73− case fmap (hitSource . head . hits . searchHits) r of
74− (Left e) -> Left e
75− (Right Nothing) -> Left (EsError 500 "Source was missing")
76− (Right (Just x)) -> Right x
77−
78−resetIndex :: BH IO ()
79−resetIndex = do
80− _ <- deleteExampleIndex
81− _ <- createExampleIndex
82− _ <- putMapping testIndex testMapping TweetMapping
83− return ()
84−
85−data TweetMapping = TweetMapping deriving (Eq, Show)
86−
87−instance ToJSON TweetMapping where
88− toJSON TweetMapping =
89− object ["tweet" .=
90− object ["properties" .=
91− object [ "user" .= object [ "type" .= ("string" :: Text)
92− , "fielddata" .= True
93− ]
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)]
101− ]]]
102−
103−exampleTweet :: Tweet
104−exampleTweet = Tweet { user = "bitemyapp"
105− , postDate = UTCTime
106− (ModifiedJulianDay 55000)
107− (secondsToDiffTime 10)
108− , message = "Use haskell!"
109− , age = 10000
110− , location = Location 40.12 (-71.34)
111− , extra = Nothing }
112−
113−one :: IO ()
114−one = do
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
124− {- liftIO $
125− myTweet `shouldBe` Right exampleTweet -}
126− -- print myTweet
127− resp <- withTestEnv $ searchByIndex testIndex search
128− parsed <- parseEsResponse resp :: IO (Either EsError (SearchResult Tweet))
129− print parsed
130− return ()