{-# LANGUAGE FlexibleInstances #-}
module Database.ClickHouseDriver.HTTP.Helpers
( extract,
genURL,
toString,
)
where
import Control.Monad.Writer (WriterT (runWriterT))
import qualified Data.Aeson as JP
import Data.Attoparsec.ByteString (IResult (Done, Fail), parse)
import qualified Data.ByteString.Char8 as C8
import qualified Data.HashMap.Strict as HM
import Data.Maybe (fromMaybe)
import Data.Text (pack)
import Data.Vector (toList)
import Database.ClickHouseDriver.HTTP.Connection
( HttpConnection (HttpConnection, httpParams),
)
import Database.ClickHouseDriver.HTTP.Types (Cmd, HttpParams (..), JSONResult)
import Database.ClickHouseDriver.IO.BufferedWriter (writeIn)
import Database.ClickHouseDriver.Types
( ClickhouseType (CKArray, CKInt32, CKNull, CKString, CKTuple),
)
import qualified Network.URI.Encode as NE
extract :: C8.ByteString -> JSONResult
ByteString
val = IResult ByteString Value -> JSONResult
forall a. IResult a Value -> Either a [Object]
getData (IResult ByteString Value -> JSONResult)
-> IResult ByteString Value -> JSONResult
forall a b. (a -> b) -> a -> b
$ Parser Value -> ByteString -> IResult ByteString Value
forall a. Parser a -> ByteString -> Result a
parse Parser Value
JP.json ByteString
val
where
getData :: IResult a Value -> Either a [Object]
getData (Fail a
e [String]
_ String
_) = a -> Either a [Object]
forall a b. a -> Either a b
Left a
e
getData (Done a
_ (JP.Object Object
x)) = [Object] -> Either a [Object]
forall a b. b -> Either a b
Right ([Object] -> Either a [Object]) -> [Object] -> Either a [Object]
forall a b. (a -> b) -> a -> b
$ Object -> [Object]
getData' Object
x
getData IResult a Value
_ = [Object] -> Either a [Object]
forall a b. b -> Either a b
Right []
getData' :: Object -> [Object]
getData' = (Value -> Object) -> [Value] -> [Object]
forall a b. (a -> b) -> [a] -> [b]
map Value -> Object
getObject ([Value] -> [Object]) -> (Object -> [Value]) -> Object -> [Object]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Value -> [Value]
maybeArrToList (Maybe Value -> [Value])
-> (Object -> Maybe Value) -> Object -> [Value]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Object -> Maybe Value
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup (String -> Text
pack String
"data")
maybeArrToList :: Maybe Value -> [Value]
maybeArrToList Maybe Value
Nothing = []
maybeArrToList (Just Value
x) = Vector Value -> [Value]
forall a. Vector a -> [a]
toList (Vector Value -> [Value])
-> (Value -> Vector Value) -> Value -> [Value]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Vector Value
getArray (Value -> [Value]) -> Value -> [Value]
forall a b. (a -> b) -> a -> b
$ Value
x
getArray :: Value -> Vector Value
getArray (JP.Array Vector Value
arr) = Vector Value
arr
getObject :: Value -> Object
getObject (JP.Object Object
x) = Object
x
genURL :: HttpConnection -> Cmd -> IO String
genURL :: HttpConnection -> String -> IO String
genURL
HttpConnection
{ httpParams :: HttpConnection -> HttpParams
httpParams =
HttpParams
{ httpHost :: HttpParams -> String
httpHost = String
host,
httpPassword :: HttpParams -> String
httpPassword = String
pw,
httpPort :: HttpParams -> Int
httpPort = Int
port,
httpUsername :: HttpParams -> String
httpUsername = String
usr,
httpDatabase :: HttpParams -> Maybe String
httpDatabase = Maybe String
db
}
}
String
cmd = do
(()
_, String
basicUrl) <- WriterT String IO () -> IO ((), String)
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT (WriterT String IO () -> IO ((), String))
-> WriterT String IO () -> IO ((), String)
forall a b. (a -> b) -> a -> b
$ do
String -> WriterT String IO ()
forall m w. MonoidMap m w => m -> Writer w
writeIn String
"http://"
String -> WriterT String IO ()
forall m w. MonoidMap m w => m -> Writer w
writeIn String
usr
String -> WriterT String IO ()
forall m w. MonoidMap m w => m -> Writer w
writeIn String
":"
String -> WriterT String IO ()
forall m w. MonoidMap m w => m -> Writer w
writeIn String
pw
String -> WriterT String IO ()
forall m w. MonoidMap m w => m -> Writer w
writeIn String
"@"
String -> WriterT String IO ()
forall m w. MonoidMap m w => m -> Writer w
writeIn String
host
String -> WriterT String IO ()
forall m w. MonoidMap m w => m -> Writer w
writeIn String
":"
String -> WriterT String IO ()
forall m w. MonoidMap m w => m -> Writer w
writeIn (String -> WriterT String IO ()) -> String -> WriterT String IO ()
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
port
String -> WriterT String IO ()
forall m w. MonoidMap m w => m -> Writer w
writeIn String
"/"
if String
cmd String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"ping" then () -> WriterT String IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return () else String -> WriterT String IO ()
forall m w. MonoidMap m w => m -> Writer w
writeIn String
"?query="
String -> WriterT String IO ()
forall m w. MonoidMap m w => m -> Writer w
writeIn (String -> WriterT String IO ()) -> String -> WriterT String IO ()
forall a b. (a -> b) -> a -> b
$ Maybe String -> String
dbUrl Maybe String
db
let res :: String
res = String
basicUrl String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
NE.encode String
cmd
String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
res
toString :: [ClickhouseType] -> String
toString :: [ClickhouseType] -> String
toString [ClickhouseType]
ck = String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [ClickhouseType] -> String
toStr [ClickhouseType]
ck String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
toStr :: [ClickhouseType] -> String
toStr :: [ClickhouseType] -> String
toStr [] = String
""
toStr (ClickhouseType
x : []) = ClickhouseType -> String
toStr' ClickhouseType
x
toStr (ClickhouseType
x : [ClickhouseType]
xs) = ClickhouseType -> String
toStr' ClickhouseType
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"," String -> String -> String
forall a. [a] -> [a] -> [a]
++ [ClickhouseType] -> String
toStr [ClickhouseType]
xs
toStr' :: ClickhouseType -> String
toStr' :: ClickhouseType -> String
toStr' (CKInt32 Int32
n) = Int32 -> String
forall a. Show a => a -> String
show Int32
n
toStr' (CKString ByteString
str) = String
"'" String -> String -> String
forall a. [a] -> [a] -> [a]
++ ByteString -> String
C8.unpack ByteString
str String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"'"
toStr' (CKArray Vector ClickhouseType
arr) = String
"[" String -> String -> String
forall a. [a] -> [a] -> [a]
++ ([ClickhouseType] -> String
toStr ([ClickhouseType] -> String) -> [ClickhouseType] -> String
forall a b. (a -> b) -> a -> b
$ Vector ClickhouseType -> [ClickhouseType]
forall a. Vector a -> [a]
toList Vector ClickhouseType
arr) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"]"
toStr' (CKTuple Vector ClickhouseType
arr) = String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ ([ClickhouseType] -> String
toStr ([ClickhouseType] -> String) -> [ClickhouseType] -> String
forall a b. (a -> b) -> a -> b
$ Vector ClickhouseType -> [ClickhouseType]
forall a. Vector a -> [a]
toList Vector ClickhouseType
arr) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
toStr' ClickhouseType
CKNull = String
"null"
toStr' ClickhouseType
_ = String -> String
forall a. HasCallStack => String -> a
error String
"unsupported writing type"
dbUrl :: (Maybe String) -> String
dbUrl :: Maybe String -> String
dbUrl = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"" (Maybe String -> String)
-> (Maybe String -> Maybe String) -> Maybe String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String) -> Maybe String -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String
"?database=" String -> String -> String
forall a. [a] -> [a] -> [a]
++)