@@ -21,6 +21,7 @@ import Data.Aeson.TH (deriveJSON)
2121import qualified Data.ByteString.Lazy.Char8 as L
2222import Data.List (intercalate)
2323import Data.Maybe (fromMaybe)
24+import Data.Monoid
2425import Data.Text (Text)
2526import Data.Time.Clock (UTCTime)
2627import GHC.Generics (Generic)
@@ -53,33 +54,8 @@ instance (FromJSON a, ToJSON a) => FromJSON (Status a) where
5354 v .: "tagline"
5455 parseJSON _ = empty
5556
56−-- instance ToJSON (Status a)
57−-- instance FromJSON (Status a)
58−
59−-- bloo <- (liftM responseBody $ parseUrl "http://localhost:9200/" >>= \r -> withManager (httpLbs r))
60−
61−-- rootPath :: String
62−-- rootPath = rollUp $ ["/"]
63−
64−-- -- Kinda hate this.
65−-- pathFromType :: String -> String -> String
66−-- pathFromType index docType = "/" ++ index ++ docType
67−
68−-- -- Kinda hate this too.
69−-- rollUp :: [String] -> String
70−-- rollUp = Prelude.concat
71−
7257main = simpleHttp "http://localhost:9200/events/event/_search?q=hostname:localhost&size=1" >>= L.putStrLn
7358
74−-- data Response = Response { blah :: Text } deriving (Show)
75−
76−-- indexDocument :: ToJSON a => a -> IO Response
77−-- indexDocument doc = ToJSON a
78−
79−-- nomenclature is because you're dropping the type baggage. All of this is compile-time erased.
80−-- newtype ShardCount = ShardCount { unShardCount :: Int } deriving (Show, Generic)
81−-- newtype ReplicaCount = ReplicaCount { unReplicaCount :: Int } deriving (Show, Generic)
82−
8359newtype ShardCount = ShardCount Int deriving (Show, Generic)
8460newtype ReplicaCount = ReplicaCount Int deriving (Show, Generic)
8561
@@ -95,8 +71,6 @@ mkReplicaCount n
9571 | n > 1000 = Nothing -- ...
9672 | otherwise = Just (ReplicaCount n)
9773
98−-- IndexSettings <$> mkShardCount 10 <*> mkReplicaCount 20
99−
10074data IndexSettings =
10175 IndexSettings { indexShards :: ShardCount
10276 , indexReplicas :: ReplicaCount } deriving (Show)
@@ -113,20 +87,6 @@ data Strategy = RoundRobinStrat | RandomStrat | HeadStrat deriving (Show)
11387
11488newtype Server = Server String deriving (Show)
11589
116−-- data Errors = IndexAlreadyExistsError | GenericError deriving (Show)
117−
118−-- data ElasticsearchError = ElasticsearchError
119−-- { status :: Int
120−-- , error :: Text } deriving (Show, Generic)
121−
122−-- instance FromJSON ElasticsearchError
123−
124−-- errorForResponse resp = do
125−-- let (sts, err) = decode (responseBody resp) :: ElasticsearchError
126−-- if T.isInfixOf "IndexAlreadyExistsException" error
127−-- then IndexAlreadyExistsError
128−-- else
129−
13090type Reply = Network.HTTP.Conduit.Response L.ByteString
13191type Method = NHTM.Method
13292
@@ -242,17 +202,17 @@ data EsResult a = EsResult { _index :: Text
242202 , _type :: Text
243203 , _id :: Text
244204 , _version :: Int
245− , found :: Bool
205+ , found :: Maybe Bool
246206 , _source :: a } deriving (Eq, Show)
247207
248208instance (FromJSON a, ToJSON a) => FromJSON (EsResult a) where
249209 parseJSON (Object v) = EsResult <$>
250− v .: "_index" <*>
251− v .: "_type" <*>
252− v .: "_id" <*>
253− v .: "_version" <*>
254− v .: "found" <*>
255− v .: "_source"
210+ v .: "_index" <*>
211+ v .: "_type" <*>
212+ v .: "_id" <*>
213+ v .: "_version" <*>
214+ v .:? "found" <*>
215+ v .: "_source"
256216 parseJSON _ = empty
257217
258218getDocument :: Server -> IndexName -> MappingName
@@ -270,25 +230,6 @@ documentExists (Server server) indexName mappingName docId = do
270230 return exists where
271231 url = joinPath [server, indexName, mappingName, docId]
272232
273−-- data Analyzer = AStandardAnalyzer StandardAnalyzer
274−-- | SimpleAnalyzer -- just "simple"
275−-- | WhitespaceAnalyzer
276−-- | StopAnalyzer
277−-- | KeywordAnalyzer
278−-- | PatternAnalyzer
279−-- | LanguageAnalyzer
280−-- | SnowballAnalyzer
281−-- | CustomAnalyzer
282−
283−-- data StandardAnalyzer =
284−-- StandardAnalyzer
285−-- { stopwords :: Maybe [Text] -- default []
286−-- , max_token_length :: Maybe Int -- default 255
287−-- }
288−
289−-- DefaultField -> "default_field": ""
290−-- Fields -> "fields": []
291−
292233type QueryString = Text
293234-- status:active
294235-- author:"John Smith"
@@ -345,14 +286,33 @@ queryStringQuery query = emptyQueryStringQuery { query = query }
345286type FieldName = Text
346287
347288type Cache = Bool -- caching on/off
289+defaultCache = False
290+
348291data Filter = AndFilter [Filter] Cache
349292 | OrFilter [Filter] Cache
293+ | IdentityFilter
350294 | BoolFilter BoolMatch Cache
351295 | ExistsFilter FieldName -- always cached
352296 | GeoBoundingBoxFilter GeoBoundingBoxConstraint GeoFilterType Cache
353297 | GeoDistanceFilter GeoConstraint Distance Cache
354298 deriving (Show)
355299
300+class Monoid a => Seminearring a where
301+ -- 0, +, *
302+ (<||>) :: a -> a -> a
303+ (<&&>) :: a -> a -> a
304+ (<&&>) = mappend
305+
306+infixr 5 <||>
307+infixr 5 <&&>
308+
309+instance Monoid Filter where
310+ mempty = IdentityFilter
311+ mappend a b = AndFilter [a, b] defaultCache
312+
313+instance Seminearring Filter where
314+ a <||> b = OrFilter [a, b] defaultCache
315+
356316instance ToJSON Filter where
357317 toJSON (AndFilter filters cache) =
358318 object ["and" .= fmap toJSON filters
@@ -360,6 +320,8 @@ instance ToJSON Filter where
360320 toJSON (OrFilter filters cache) =
361321 object ["or" .= fmap toJSON filters
362322 , "_cache" .= cache]
323+ toJSON (IdentityFilter) =
324+ object ["match_all" .= object []]
363325 toJSON (ExistsFilter fieldName) =
364326 object ["exists" .= object
365327 ["field" .= fieldName]]
@@ -367,7 +329,6 @@ instance ToJSON Filter where
367329 object ["bool" .= toJSON boolMatch
368330 , "_cache" .= cache]
369331
370−-- I dunno.
371332data Term = Term { termField :: Text
372333 , termValue :: Text } deriving (Show)
373334
@@ -446,25 +407,3 @@ data ShardResults =
446407 ShardResults { shardTotal :: Int
447408 , shardsSuccessful :: Int
448409 , shardsFailed :: Int } deriving (Show)
449−
450−-- This is turning into a fractal of horror
451−-- data Fuzziness = FDateFuzziness DateFuzziness |
452−
453−-- data Query = Query { query :: () } deriving (Show)
454−-- search :: Server -> IndexName -> Maybe MappingName
455−-- -> Query -> IO Reply
456−-- search = fuck
457−
458−-- getStatus :: String -> IO (Maybe (Status Version))
459−-- getStatus server = do
460−-- request <- parseUrl $ server ++ rootPath
461−-- response <- withManager $ httpLbs request
462−-- return $ (decode $ responseBody response)
463−
464−-- mkServer -- (Maybe Server) for URL parsing?
465−
466−-- data Cluster = Cluster { targets :: [Server]
467−-- , strategy :: Strategy } deriving (Show)
468−
469−-- target :: Cluster -> Server
470−-- target (Cluster targets HeadStrat) = head targets