git.iko.soy/typeable/bloodhound
on c20f303 help sign in
typeable/bloodhound/examples/Tweet.hs
108 lines 4.0 kB history raw
1{-# LANGUAGE DeriveGeneric #-}
2{-# LANGUAGE OverloadedStrings #-}
3module Main
4 ( main
5 ) where
8import Control.Monad.IO.Class (liftIO)
9import Data.Aeson (FromJSON (..), defaultOptions,
10 genericParseJSON, genericToJSON,
11 object, (.=))
12import Data.List.NonEmpty (NonEmpty (..))
13import Data.Text (Text)
14import Data.Time.Calendar (Day (..))
15import Data.Time.Clock (UTCTime (..), secondsToDiffTime)
16import qualified Data.Vector as V
17import Database.V5.Bloodhound
18import GHC.Generics (Generic)
19import Network.HTTP.Client (defaultManagerSettings)
22data TweetMapping = TweetMapping deriving (Eq, Show)
24instance ToJSON TweetMapping where
25 toJSON TweetMapping =
26 object
27 [ "properties" .=
28 object ["location" .= object ["type" .= ("geo_point" :: Text)]]
29 ]
31data Tweet = Tweet
32 { user :: Text
33 , postDate :: UTCTime
34 , message :: Text
35 , age :: Int
36 , location :: LatLon
37 } deriving (Eq, Generic, Show)
40exampleTweet :: Tweet
41exampleTweet =
42 Tweet
43 { user = "bitemyapp"
44 , postDate = UTCTime (ModifiedJulianDay 55000) (secondsToDiffTime 10)
45 , message = "Use haskell!"
46 , age = 10000
47 , location = loc
48 }
49 where
50 loc = LatLon {lat = 40.12, lon = -71.3}
52instance ToJSON Tweet where
53 toJSON = genericToJSON defaultOptions
54instance FromJSON Tweet where
55 parseJSON = genericParseJSON defaultOptions
58main :: IO ()
59main = runBH' $ do
60 -- set up index
61 _ <- createIndex indexSettings testIndex
62 True <- indexExists testIndex
63 _ <- putMapping testIndex testMapping TweetMapping
65 -- create a tweet
66 resp <- indexDocument testIndex testMapping defaultIndexDocumentSettings exampleTweet (DocId "1")
67 liftIO (print resp)
68 -- 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}
70 -- bulk load
71 let stream = V.fromList [BulkIndex testIndex testMapping (DocId "2") (toJSON exampleTweet)]
72 _ <- bulk stream
73 -- Bulk loads require an index refresh before new data is loaded.
74 _ <- refreshIndex testIndex
76 -- set up some aliases
77 let aliasName = IndexName "twitter-alias"
78 let iAlias = IndexAlias testIndex (IndexAliasName aliasName)
79 let aliasRouting = Nothing
80 let aliasFiltering = Nothing
81 let aliasCreate = IndexAliasCreate aliasRouting aliasFiltering
82 _ <- updateIndexAliases (AddAlias iAlias aliasCreate :| [])
83 True <- indexExists aliasName
85 -- 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.
86 let idxTpl = IndexTemplate (TemplatePattern "tweet-*") (Just (IndexSettings (ShardCount 1) (ReplicaCount 1))) [toJSON TweetMapping]
87 let templateName = TemplateName "tweet-tpl"
88 _ <- putTemplate idxTpl templateName
89 True <- templateExists templateName
91 -- do a search
92 let boost = Nothing
93 let query = TermQuery (Term "user" "bitemyapp") boost
94 let search = mkSearch (Just query) boost
95 _ <- searchByType testIndex testMapping search
97 -- clean up
98 _ <- deleteTemplate templateName
99 _ <- deleteIndex testIndex
100 False <- indexExists testIndex
102 return ()
103 where
104 testServer = Server "http://localhost:9200"
105 runBH' = withBH defaultManagerSettings testServer
106 testIndex = IndexName "twitter"
107 testMapping = MappingName "tweet"
108 indexSettings = IndexSettings (ShardCount 1) (ReplicaCount 0)