@@ -0,0 +1,65 @@
1+{-# LANGUAGE DeriveGeneric #-}
2+{-# LANGUAGE OverloadedStrings #-}
3+
4+module Database.Bloodhound.Client where
5+
6+import Control.Applicative
7+import Control.Monad (liftM)
8+import Data.Aeson
9+import Data.Aeson.TH (deriveJSON)
10+import qualified Data.ByteString.Lazy.Char8 as L
11+import qualified Data.Text as T
12+import Data.Time.Clock as DTC
13+import GHC.Generics (Generic)
14+import Network.HTTP.Conduit
15+
16+data Version = Version { number :: T.Text
17+ , build_hash :: T.Text
18+ , build_timestamp :: DTC.UTCTime
19+ , build_snapshot :: Bool
20+ , lucene_version :: T.Text } deriving (Show, Generic)
21+
22+data (FromJSON a, ToJSON a) => Status a =
23+ Status { ok :: Bool
24+ , status :: Int
25+ , name :: T.Text
26+ , version :: a
27+ , tagline :: T.Text } deriving (Show)
28+
29+instance ToJSON Version
30+instance FromJSON Version
31+
32+instance (FromJSON a, ToJSON a) => FromJSON (Status a) where
33+ parseJSON (Object v) = Status <$>
34+ v .: "ok" <*>
35+ v .: "status" <*>
36+ v .: "name" <*>
37+ v .: "version" <*>
38+ v .: "tagline"
39+ parseJSON _ = empty
40+
41+-- instance ToJSON (Status a)
42+-- instance FromJSON (Status a)
43+
44+muhServer = "http://localhost:9200"
45+
46+-- bloo <- (liftM responseBody $ parseUrl "http://localhost:9200/" >>= \r -> withManager (httpLbs r))
47+
48+rootPath :: String
49+rootPath = rollUp $ ["/"]
50+
51+-- Kinda hate this.
52+pathFromType :: String -> String -> String
53+pathFromType index docType = "/" ++ index ++ docType
54+
55+-- Kinda hate this too.
56+rollUp :: [String] -> String
57+rollUp = Prelude.concat
58+
59+getStatus :: String -> IO (Maybe (Status Version))
60+getStatus server = do
61+ request <- parseUrl $ server ++ rootPath
62+ response <- withManager $ httpLbs request
63+ return $ (decode $ responseBody response)
64+
65+main = simpleHttp "http://localhost:9200/events/event/_search?q=hostname:localhost&size=1" >>= L.putStrLn