git.iko.soy/typeable/bloodhound
on 53defce help sign in
typeable/bloodhound/examples/Tweet.hs
125 lines 4.7 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.V1.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 ]
34-------------------------------------------------------------------------------
35data Location = Location
36 { locLat :: Double
37 , locLon :: Double
38 } deriving (Eq, Generic, Show)
41-------------------------------------------------------------------------------
42data Tweet = Tweet
43 { user :: Text
44 , postDate :: UTCTime
45 , message :: Text
46 , age :: Int
47 , location :: Location
48 } deriving (Eq, Generic, Show)
51-------------------------------------------------------------------------------
52exampleTweet :: Tweet
53exampleTweet =
54 Tweet
55 { user = "bitemyapp"
56 , postDate = UTCTime (ModifiedJulianDay 55000) (secondsToDiffTime 10)
57 , message = "Use haskell!"
58 , age = 10000
59 , location = loc
60 }
61 where
62 loc = Location {locLat = 40.12, locLon = (-71.34)}
64instance ToJSON Tweet where
65 toJSON = genericToJSON defaultOptions
66instance FromJSON Tweet where
67 parseJSON = genericParseJSON defaultOptions
68instance ToJSON Location where
69 toJSON = genericToJSON defaultOptions
70instance FromJSON Location where
71 parseJSON = genericParseJSON defaultOptions
74-------------------------------------------------------------------------------
75main :: IO ()
76main = runBH' $ do
77 -- set up index
78 _ <- createIndex indexSettings testIndex
79 True <- indexExists testIndex
80 _ <- putMapping testIndex testMapping TweetMapping
82 -- create a tweet
83 resp <- indexDocument testIndex testMapping defaultIndexDocumentSettings exampleTweet (DocId "1")
84 liftIO (print resp)
85 -- 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}
87 -- bulk load
88 let stream = V.fromList [BulkIndex testIndex testMapping (DocId "2") (toJSON exampleTweet)]
89 _ <- bulk stream
90 -- Bulk loads require an index refresh before new data is loaded.
91 _ <- refreshIndex testIndex
93 -- set up some aliases
94 let aliasName = IndexName "twitter-alias"
95 let iAlias = IndexAlias testIndex (IndexAliasName aliasName)
96 let aliasRouting = Nothing
97 let aliasFiltering = Nothing
98 let aliasCreate = IndexAliasCreate aliasRouting aliasFiltering
99 _ <- updateIndexAliases (AddAlias iAlias aliasCreate :| [])
100 True <- indexExists aliasName
102 -- 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.
103 let idxTpl = IndexTemplate (TemplatePattern "tweet-*") (Just (IndexSettings (ShardCount 1) (ReplicaCount 1))) [toJSON TweetMapping]
104 let templateName = TemplateName "tweet-tpl"
105 _ <- putTemplate idxTpl templateName
106 True <- templateExists templateName
108 -- do a search
109 let boost = Nothing
110 let query = TermQuery (Term "user" "bitemyapp") boost
111 let search = mkSearch (Just query) boost
112 _ <- searchByType testIndex testMapping search
114 -- clean up
115 _ <- deleteTemplate templateName
116 _ <- deleteIndex testIndex
117 False <- indexExists testIndex
119 return ()
120 where
121 testServer = (Server "http://localhost:9200")
122 runBH' = withBH defaultManagerSettings testServer
123 testIndex = IndexName "twitter"
124 testMapping = MappingName "tweet"
125 indexSettings = IndexSettings (ShardCount 1) (ReplicaCount 0)