{-# LANGUAGE FlexibleInstances #-}
module Database.ClickHouseDriver.HTTP.Helpers
( extract,
genURL,
toString
)
where
import Database.ClickHouseDriver.Column
( ClickhouseType(CKNull, CKTuple, CKArray, CKString, CKInt32) )
import Database.ClickHouseDriver.HTTP.Connection
( HttpConnection(HttpConnection, httpParams) )
import Database.ClickHouseDriver.HTTP.Types ( Cmd, JSONResult, HttpParams(..))
import Database.ClickHouseDriver.IO.BufferedWriter ( writeIn )
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.Text (pack)
import Data.Vector (toList)
import qualified Network.URI.Encode as NE
import Data.Maybe ( fromMaybe )
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]
++)