git.iko.soy/typeable/bloodhound
on v0.15.0.0 help sign in
typeable/bloodhound/examples/Tweet.hs
111 lines 4.3 kB history raw
1{-# LANGUAGE DeriveGeneric #-}
2{-# LANGUAGE OverloadedStrings #-}
3module Main
4 ( main
5 ) where
8-------------------------------------------------------------------------------
9import Control.Monad.IO.Class (liftIO)
10import Data.Aeson (FromJSON (..), defaultOptions,
11 genericParseJSON, genericToJSON,
12 object, (.=))
13import Data.List.NonEmpty (NonEmpty (..))
14import Data.Text (Text)
15import Data.Time.Calendar (Day (..))
16import Data.Time.Clock (UTCTime (..), secondsToDiffTime)
17import qualified Data.Vector as V
18import Database.V5.Bloodhound
19import GHC.Generics (Generic)
20import Network.HTTP.Client (defaultManagerSettings)
21-------------------------------------------------------------------------------
24data TweetMapping = TweetMapping deriving (Eq, Show)
26instance ToJSON TweetMapping where
27 toJSON TweetMapping =
28 object
29 [ "properties" .=
30 object ["location" .= object ["type" .= ("geo_point" :: Text)]]
31 ]
32-------------------------------------------------------------------------------
33data Tweet = Tweet
34 { user :: Text
35 , postDate :: UTCTime
36 , message :: Text
37 , age :: Int
38 , location :: LatLon
39 } deriving (Eq, Generic, Show)
42-------------------------------------------------------------------------------
43exampleTweet :: Tweet
44exampleTweet =
45 Tweet
46 { user = "bitemyapp"
47 , postDate = UTCTime (ModifiedJulianDay 55000) (secondsToDiffTime 10)
48 , message = "Use haskell!"
49 , age = 10000
50 , location = loc
51 }
52 where
53 loc = LatLon {lat = 40.12, lon = -71.3}
55instance ToJSON Tweet where
56 toJSON = genericToJSON defaultOptions
57instance FromJSON Tweet where
58 parseJSON = genericParseJSON defaultOptions
61main :: IO ()
62main = runBH' $ do
63 -- set up index
64 _ <- createIndex indexSettings testIndex
65 True <- indexExists testIndex
66 _ <- putMapping testIndex testMapping TweetMapping
68 -- create a tweet
69 resp <- indexDocument testIndex testMapping defaultIndexDocumentSettings exampleTweet (DocId "1")
70 liftIO (print resp)
71 -- Response {responseStatus = Status {statusCode = 201, statusMessage = "Created"}, responseVersion = HTTP/1.1, responseHeaders = [("Content-Type","application/json; charset=UTF-8"),("Content-Length","74")], responseBody = "{\"_index\":\"twitter\",\"_type\":\"tweet\",\"_id\":\"1\",\"_version\":1,\"created\":true}", responseCookieJar = CJ {expose = []}, responseClose' = ResponseClose}
73 -- bulk load
74 let stream = V.fromList [BulkIndex testIndex testMapping (DocId "2") (toJSON exampleTweet)]
75 _ <- bulk stream
76 -- Bulk loads require an index refresh before new data is loaded.
77 _ <- refreshIndex testIndex
79 -- set up some aliases
80 let aliasName = IndexName "twitter-alias"
81 let iAlias = IndexAlias testIndex (IndexAliasName aliasName)
82 let aliasRouting = Nothing
83 let aliasFiltering = Nothing
84 let aliasCreate = IndexAliasCreate aliasRouting aliasFiltering
85 _ <- updateIndexAliases (AddAlias iAlias aliasCreate :| [])
86 True <- indexExists aliasName
88 -- create a template so that if we just write into an index named tweet-2017-01-02, for instance, the index will be automatically created with the given mapping. This is a great idea for any ongoing indices because it makes them much easier to manage and rotate.
89 let idxTpl = IndexTemplate (TemplatePattern "tweet-*") (Just (IndexSettings (ShardCount 1) (ReplicaCount 1))) [toJSON TweetMapping]
90 let templateName = TemplateName "tweet-tpl"
91 _ <- putTemplate idxTpl templateName
92 True <- templateExists templateName
94 -- do a search
95 let boost = Nothing
96 let query = TermQuery (Term "user" "bitemyapp") boost
97 let search = mkSearch (Just query) boost
98 _ <- searchByType testIndex testMapping search
100 -- clean up
101 _ <- deleteTemplate templateName
102 _ <- deleteIndex testIndex
103 False <- indexExists testIndex
105 return ()
106 where
107 testServer = Server "http://localhost:9200"
108 runBH' = withBH defaultManagerSettings testServer
109 testIndex = IndexName "twitter"
110 testMapping = MappingName "tweet"
111 indexSettings = IndexSettings (ShardCount 1) (ReplicaCount 0)