diff --git a/clickhouse-haskell.cabal b/clickhouse-haskell.cabal --- a/clickhouse-haskell.cabal +++ b/clickhouse-haskell.cabal @@ -1,6 +1,6 @@ cabal-version: 1.12 name: clickhouse-haskell -version: 0.1.2.2 +version: 0.1.2.3 synopsis: A Haskell library as database client for Clickhouse homepage: https://github.com/2049foundation/clickhouse-haskell/ bug-reports: https://github.com/2049foundation/clickhouse-haskell/issues @@ -114,7 +114,11 @@ Paths_clickhouse_haskell hs-source-dirs: test - ghc-options: -threaded -rtsopts -with-rtsopts=-N + ghc-options: + -threaded + -rtsopts + -with-rtsopts=-N + -O2 build-depends: clickhouse-haskell, base >= 4.12 && <5, diff --git a/src/Database/ClickHouseDriver/Block.hs b/src/Database/ClickHouseDriver/Block.hs --- a/src/Database/ClickHouseDriver/Block.hs +++ b/src/Database/ClickHouseDriver/Block.hs @@ -26,7 +26,7 @@ where import Database.ClickHouseDriver.Column - ( ClickhouseType, readColumn, writeColumn ) + (readColumn, writeColumn ) import Database.ClickHouseDriver.Defines as Defines ( _DBMS_MIN_REVISION_WITH_BLOCK_INFO ) import Database.ClickHouseDriver.Types @@ -34,7 +34,8 @@ Block(..), BlockInfo(..), Context(Context), - ServerInfo(revision) ) + ServerInfo(revision), + ClickhouseType ) import Database.ClickHouseDriver.IO.BufferedReader ( readBinaryInt32, readBinaryStr, diff --git a/src/Database/ClickHouseDriver/Client.hs b/src/Database/ClickHouseDriver/Client.hs --- a/src/Database/ClickHouseDriver/Client.hs +++ b/src/Database/ClickHouseDriver/Client.hs @@ -47,7 +47,6 @@ ) where -import Database.ClickHouseDriver.Column ( ClickhouseType ) import Database.ClickHouseDriver.Connection ( ping', tcpConnect, @@ -63,7 +62,8 @@ CKResult(CKResult, query_result), TCPConnection(TCPConnection, tcpSocket), getServerInfo, - defaultQueryInfo ) + defaultQueryInfo, + ClickhouseType(..) ) import Database.ClickHouseDriver.IO.BufferedReader ( createBuffer ) import Control.Concurrent.Async ( mapConcurrently ) import Control.Exception ( SomeException, try ) diff --git a/src/Database/ClickHouseDriver/Column.hs b/src/Database/ClickHouseDriver/Column.hs --- a/src/Database/ClickHouseDriver/Column.hs +++ b/src/Database/ClickHouseDriver/Column.hs @@ -7,17 +7,7 @@ -- | This module contains the implementations of -- serialization and deserialization of Clickhouse data types. -module Database.ClickHouseDriver.Column - ( -- * Serialize and deserialize - ClickhouseType (..), - readColumn, - writeColumn, - - -- * Operations on ClickhouseType - transpose, - Database.ClickHouseDriver.Column.putStrLn, - ) -where +module Database.ClickHouseDriver.Column where import Database.ClickHouseDriver.Types (ClickhouseType (..), Context (..), ServerInfo (..)) import Database.ClickHouseDriver.IO.BufferedReader @@ -607,9 +597,11 @@ combine :: Vector ClickhouseType -> Vector Word64 -> Vector ClickhouseType combine elems config = let intervals = intervalize (fromIntegral <$> config) - cut (a, b) = CKArray $ V.take b (V.drop a elems) -- cut element array + cut :: (Int, Int)->ClickhouseType + cut (a, b) = CKArray $ V.take b (V.drop a elems) embed = (\(l, r) -> cut (l, r - l + 1)) <$> intervals - in embed + in embed + intervalize :: Vector Int -> Vector (Int, Int) intervalize vec = V.drop 1 $ V.scanl' (\(_, b) v -> (b + 1, v + b)) (-1, -1) vec -- drop the first tuple (-1,-1) diff --git a/src/Database/ClickHouseDriver/Connection.hs b/src/Database/ClickHouseDriver/Connection.hs --- a/src/Database/ClickHouseDriver/Connection.hs +++ b/src/Database/ClickHouseDriver/Connection.hs @@ -32,7 +32,7 @@ import qualified Database.ClickHouseDriver.Block as Block import qualified Database.ClickHouseDriver.ClientProtocol as Client -import Database.ClickHouseDriver.Column (ClickhouseType, transpose) +import Database.ClickHouseDriver.Column (transpose) import Database.ClickHouseDriver.Defines ( _BUFFER_SIZE, _CLIENT_NAME, @@ -83,6 +83,7 @@ readProgress, storeProfile, storeProgress, + ClickhouseType(..) ) import Database.ClickHouseDriver.IO.BufferedReader ( Buffer (socket), diff --git a/src/Database/ClickHouseDriver/HTTP/Client.hs b/src/Database/ClickHouseDriver/HTTP/Client.hs --- a/src/Database/ClickHouseDriver/HTTP/Client.hs +++ b/src/Database/ClickHouseDriver/HTTP/Client.hs @@ -3,8 +3,9 @@ -- -- This source code is distributed under the terms of a MIT license, -- found in the LICENSE file. - {-# LANGUAGE ApplicativeDo #-} +{-# LANGUAGE BlockArguments #-} +{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} @@ -12,16 +13,13 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE BlockArguments #-} -{-# LANGUAGE CPP #-} -- | This module provides implementation of user's API - module Database.ClickHouseDriver.HTTP.Client - ( - -- * Setting + ( -- * Setting setupEnv, runQuery, + -- * Query getByteString, getJSON, @@ -33,60 +31,75 @@ ping, exec, insertFromFile, + -- * Connection defaultHttpClient, httpClient, - defaultHttpPool + defaultHttpPool, ) where -import Database.ClickHouseDriver.Column ( ClickhouseType ) +import Control.Concurrent.Async (mapConcurrently) +import Control.Exception (SomeException, try) +import Control.Monad.State.Lazy (MonadIO (..)) +import qualified Data.ByteString as BS +import qualified Data.ByteString.Lazy as LBS +import Data.ByteString.Lazy.Builder + ( char8, + lazyByteString, + toLazyByteString, + ) +import qualified Data.ByteString.Lazy.Char8 as C8 +import Data.Default.Class (def) +import Data.Hashable (Hashable (hashWithSalt)) +import Data.Pool (Pool, withResource) +import qualified Data.Text as T +import Data.Text.Encoding (decodeUtf8) +import Data.Time.Clock (NominalDiffTime) +import Data.Typeable (Typeable) import Database.ClickHouseDriver.Defines as Defines - ( _DEFAULT_HTTP_PORT, _DEFAULT_HOST ) + ( _DEFAULT_HOST, + _DEFAULT_HTTP_PORT, + ) import Database.ClickHouseDriver.HTTP.Connection - ( defaultHttpConnection, - createHttpPool, httpConnectDb) + ( createHttpPool, + defaultHttpConnection, + httpConnectDb, + ) import Database.ClickHouseDriver.HTTP.Helpers - ( extract, genURL, toString ) -import Database.ClickHouseDriver.HTTP.Types ( Format(..), JSONResult, HttpConnection(..)) -import Control.Concurrent.Async ( mapConcurrently ) -import Control.Exception ( SomeException, try ) -import Control.Monad.State.Lazy ( MonadIO(..) ) -import qualified Data.ByteString as BS -import qualified Data.ByteString.Lazy as LBS -import Data.ByteString.Lazy.Builder (char8, lazyByteString, - toLazyByteString) -import qualified Data.ByteString.Lazy.Char8 as C8 -import Data.Hashable ( Hashable(hashWithSalt) ) -import qualified Data.Text as T -import Data.Text.Encoding ( decodeUtf8 ) -import Data.Typeable ( Typeable ) + ( extract, + genURL, + toString, + ) +import Database.ClickHouseDriver.HTTP.Types (Format (..), HttpConnection (..), JSONResult) +import Database.ClickHouseDriver.Types (ClickhouseType) import Haxl.Core - ( putFailure, - putSuccess, - dataFetch, - initEnv, - runHaxl, - stateEmpty, - stateSet, - BlockedFetch(..), - DataSource(fetch), - DataSourceName(..), - PerformFetch(SyncFetch), - Env(userEnv), - GenHaxl, - ShowP(..), - StateKey(State) ) -import Network.HTTP.Client (RequestBody (..), - httpLbs, method, - parseRequest, - requestBody, - responseBody, - streamFile) -import Text.Printf ( printf ) -import Data.Pool ( withResource, Pool ) -import Data.Time.Clock ( NominalDiffTime ) -import Data.Default.Class (def) + ( BlockedFetch (..), + DataSource (fetch), + DataSourceName (..), + Env (userEnv), + GenHaxl, + PerformFetch (SyncFetch), + ShowP (..), + StateKey (State), + dataFetch, + initEnv, + putFailure, + putSuccess, + runHaxl, + stateEmpty, + stateSet, + ) +import Network.HTTP.Client + ( RequestBody (..), + httpLbs, + method, + parseRequest, + requestBody, + responseBody, + streamFile, + ) +import Text.Printf (printf) {-Implementation in Haxl-} -- @@ -109,7 +122,7 @@ hashWithSalt salt (FetchByteString cmd) = hashWithSalt salt cmd hashWithSalt salt (FetchJSON cmd) = hashWithSalt salt cmd hashWithSalt salt (FetchCSV cmd) = hashWithSalt salt cmd - hashWithSalt salt Ping = hashWithSalt salt ("ok"::BS.ByteString) + hashWithSalt salt Ping = hashWithSalt salt ("ok" :: BS.ByteString) instance DataSourceName HttpClient where dataSourceName _ = "ClickhouseDataSource" @@ -122,12 +135,13 @@ [()] -> return () instance StateKey HttpClient where - data State HttpClient = SingleHttp HttpConnection - | HttpPool (Pool HttpConnection) + data State HttpClient + = SingleHttp HttpConnection + | HttpPool (Pool HttpConnection) class HttpEnvironment a where - toEnv :: a->State HttpClient - pick :: a-> IO HttpConnection + toEnv :: a -> State HttpClient + pick :: a -> IO HttpConnection instance HttpEnvironment HttpConnection where toEnv = SingleHttp @@ -155,8 +169,8 @@ req <- parseRequest url ans <- responseBody <$> httpLbs req mng return $ LBS.toStrict ans - HttpPool pool -> - withResource pool $ \conn@(HttpConnection _ mng)->do + HttpPool pool -> + withResource pool $ \conn@(HttpConnection _ mng) -> do url <- genURL conn queryWithType req <- parseRequest url ans <- responseBody <$> httpLbs req mng @@ -165,7 +179,7 @@ (putFailure var) (putSuccess var) (e :: Either SomeException (BS.ByteString)) - + -- | Fetch data from ClickHouse client in the text format. getByteString :: String -> GenHaxl u w BS.ByteString getByteString = dataFetch . FetchByteString @@ -181,77 +195,111 @@ getTextM :: (Monad m, Traversable m) => m String -> GenHaxl u w (m T.Text) getTextM = mapM getText --- | Fetch data from Clickhouse client in the format of JSON +-- | Fetch data from Clickhouse client in the format of JSON getJsonM :: (Monad m, Traversable m) => m String -> GenHaxl u w (m JSONResult) getJsonM = mapM getJSON -- | actual function used by user to perform fetching command -exec :: (HttpEnvironment a)=>String->Env a w->IO (Either C8.ByteString String) +exec :: (HttpEnvironment a) => String -> Env a w -> IO (Either C8.ByteString String) exec cmd' env = do let cmd = C8.pack cmd' - conn@HttpConnection{httpManager=mng} <- pick $ userEnv env + conn@HttpConnection {httpManager = mng} <- pick $ userEnv env url <- genURL conn "" req <- parseRequest url - ans <- responseBody <$> httpLbs req{ method = "POST" - , requestBody = RequestBodyLBS cmd} mng + ans <- + responseBody + <$> httpLbs + req + { method = "POST", + requestBody = RequestBodyLBS cmd + } + mng if ans /= "" then return $ Left ans -- error message else return $ Right "Created successfully" -- | insert one row -insertOneRow :: (HttpEnvironment a)=> String - -> [ClickhouseType] - -> Env a w - -> IO (Either C8.ByteString String) +insertOneRow :: + (HttpEnvironment a) => + String -> + [ClickhouseType] -> + Env a w -> + IO (Either C8.ByteString String) insertOneRow table_name arr environment = do let row = toString arr let cmd = C8.pack ("INSERT INTO " ++ table_name ++ " VALUES " ++ row) - settings@HttpConnection{httpManager=mng} <- pick $ userEnv environment + settings@HttpConnection {httpManager = mng} <- pick $ userEnv environment url <- genURL settings "" req <- parseRequest url - ans <- responseBody <$> httpLbs req{ method = "POST" - , requestBody = RequestBodyLBS cmd} mng + ans <- + responseBody + <$> httpLbs + req + { method = "POST", + requestBody = RequestBodyLBS cmd + } + mng if ans /= "" then return $ Left ans -- error messagethe hellenic republic else return $ Right "Inserted successfully" --- | insert one or more rows -insertMany :: (HttpEnvironment a)=> String - -> [[ClickhouseType]] - -> Env a w - -> IO(Either C8.ByteString String) +-- | insert one or more rows +insertMany :: + (HttpEnvironment a) => + String -> + [[ClickhouseType]] -> + Env a w -> + IO (Either C8.ByteString String) insertMany table_name rows environment = do let rowsString = map (lazyByteString . C8.pack . toString) rows - comma = char8 ',' + comma = char8 ',' preset = lazyByteString $ C8.pack $ "INSERT INTO " <> table_name <> " VALUES " - togo = preset <> (foldl1 (\x y-> x <> comma <> y) rowsString) - settings@HttpConnection{httpManager=mng} <- pick $ userEnv environment + togo = preset <> (foldl1 (\x y -> x <> comma <> y) rowsString) + settings@HttpConnection {httpManager = mng} <- pick $ userEnv environment url <- genURL settings "" req <- parseRequest url - ans <- responseBody <$> httpLbs req{method = "POST" - , requestBody = RequestBodyLBS $ toLazyByteString togo} mng + ans <- + responseBody + <$> httpLbs + req + { method = "POST", + requestBody = RequestBodyLBS $ toLazyByteString togo + } + mng print "inserted successfully" if ans /= "" then return $ Left ans else return $ Right "Successful insertion" --- | insert data from -insertFromFile :: (HttpEnvironment a)=> String - ->Format - ->FilePath - ->Env a w - ->IO(Either C8.ByteString String) +-- | insert data from +insertFromFile :: + (HttpEnvironment a) => + String -> + Format -> + FilePath -> + Env a w -> + IO (Either C8.ByteString String) insertFromFile table_name format file environment = do fileReqBody <- streamFile file - settings@HttpConnection{httpManager=mng} <- pick $ userEnv environment - url <- genURL settings ("INSERT INTO " <> table_name - <> case format of - CSV->" FORMAT CSV" - JSON->" FORMAT JSON" - TUPLE->" VALUES") + settings@HttpConnection {httpManager = mng} <- pick $ userEnv environment + url <- + genURL + settings + ( "INSERT INTO " <> table_name + <> case format of + CSV -> " FORMAT CSV" + JSON -> " FORMAT JSON" + TUPLE -> " VALUES" + ) req <- parseRequest url - ans <- responseBody <$> httpLbs req {method = "POST" - , requestBody = fileReqBody} mng + ans <- + responseBody + <$> httpLbs + req + { method = "POST", + requestBody = fileReqBody + } + mng if ans /= "" then return $ Left ans -- error message else return $ Right "Inserted successfully" @@ -260,20 +308,20 @@ ping = dataFetch $ Ping -- | Default environment -setupEnv :: (MonadIO m, HttpEnvironment a)=>a->m (Env a w) +setupEnv :: (MonadIO m, HttpEnvironment a) => a -> m (Env a w) setupEnv csetting = liftIO $ initEnv (stateSet (toEnv csetting) stateEmpty) csetting -defaultHttpClient :: (MonadIO m)=>m (Env HttpConnection w) +defaultHttpClient :: (MonadIO m) => m (Env HttpConnection w) defaultHttpClient = liftIO $ defaultHttpConnection >>= setupEnv -defaultHttpPool :: (MonadIO m)=>Int->NominalDiffTime->Int->m(Env (Pool HttpConnection) w) -defaultHttpPool numStripes idleTime maxResources - = liftIO $ createHttpPool def numStripes idleTime maxResources >>= setupEnv +defaultHttpPool :: (MonadIO m) => Int -> NominalDiffTime -> Int -> m (Env (Pool HttpConnection) w) +defaultHttpPool numStripes idleTime maxResources = + liftIO $ createHttpPool def numStripes idleTime maxResources >>= setupEnv -httpClient :: (MonadIO m)=> String->String-> m(Env HttpConnection w) +httpClient :: (MonadIO m) => String -> String -> m (Env HttpConnection w) httpClient user password = liftIO $ httpConnectDb user password Defines._DEFAULT_HTTP_PORT Defines._DEFAULT_HOST Nothing >>= setupEnv -- | rename runHaxl function. {-# INLINE runQuery #-} -runQuery :: (MonadIO m)=> Env u w -> GenHaxl u w a -> m a +runQuery :: (MonadIO m) => Env u w -> GenHaxl u w a -> m a runQuery env haxl = liftIO $ runHaxl env haxl diff --git a/src/Database/ClickHouseDriver/HTTP/Connection.hs b/src/Database/ClickHouseDriver/HTTP/Connection.hs --- a/src/Database/ClickHouseDriver/HTTP/Connection.hs +++ b/src/Database/ClickHouseDriver/HTTP/Connection.hs @@ -3,29 +3,37 @@ -- -- This source code is distributed under the terms of a MIT license, -- found in the LICENSE file. - -{-# LANGUAGE CPP #-} +{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} -- | Connection pool for HTTP connection. User should import Database.ClickHouseDriver.HTTP instead - -module Database.ClickHouseDriver.HTTP.Connection ( - httpConnect, +module Database.ClickHouseDriver.HTTP.Connection + ( httpConnect, httpConnectDb, defaultHttpConnection, - HttpConnection(..), - createHttpPool -) where - -import Network.HTTP.Client - ( defaultManagerSettings, newManager) + HttpConnection (..), + createHttpPool, + ) +where + +import Data.Default.Class (Default (..)) +import Data.Pool (Pool, createPool) +import Data.Time.Clock (NominalDiffTime) import Database.ClickHouseDriver.HTTP.Types - ( HttpConnection(..), - HttpParams(HttpParams, httpUsername, httpPort, httpPassword, - httpHost, httpDatabase) ) -import Data.Default.Class ( Default(..) ) -import Data.Pool ( createPool, Pool ) -import Data.Time.Clock ( NominalDiffTime ) + ( HttpConnection (..), + HttpParams + ( HttpParams, + httpDatabase, + httpHost, + httpPassword, + httpPort, + httpUsername + ), + ) +import Network.HTTP.Client + ( defaultManagerSettings, + newManager, + ) #define DEFAULT_USERNAME "default" #define DEFAULT_HOST_NAME "localhost" @@ -36,46 +44,51 @@ defaultHttpConnection = httpConnect DEFAULT_USERNAME DEFAULT_PASSWORD 8123 DEFAULT_HOST_NAME instance Default HttpParams where - def = HttpParams{ - httpHost = DEFAULT_HOST_NAME, - httpPassword = DEFAULT_PASSWORD, - httpPort = 8123, - httpUsername = DEFAULT_USERNAME, - httpDatabase = Nothing - } - -createHttpPool :: HttpParams - ->Int - ->NominalDiffTime - ->Int - ->IO(Pool HttpConnection) -createHttpPool HttpParams{ - httpHost=host, - httpPassword = password, - httpPort = port, - httpUsername = user, - httpDatabase = db - } - = createPool( - do - httpConnectDb user password port host db - )(\_->return ()) + def = + HttpParams + { httpHost = DEFAULT_HOST_NAME, + httpPassword = DEFAULT_PASSWORD, + httpPort = 8123, + httpUsername = DEFAULT_USERNAME, + httpDatabase = Nothing + } +createHttpPool :: + HttpParams -> + Int -> + NominalDiffTime -> + Int -> + IO (Pool HttpConnection) +createHttpPool + HttpParams + { httpHost = host, + httpPassword = password, + httpPort = port, + httpUsername = user, + httpDatabase = db + } = + createPool + ( do + httpConnectDb user password port host db + ) + (\_ -> return ()) -httpConnect :: String->String->Int->String->IO(HttpConnection) -httpConnect user password port host = +httpConnect :: String -> String -> Int -> String -> IO (HttpConnection) +httpConnect user password port host = httpConnectDb user password port host Nothing -httpConnectDb :: String->String->Int->String->Maybe String->IO(HttpConnection) +httpConnectDb :: String -> String -> Int -> String -> Maybe String -> IO (HttpConnection) httpConnectDb user password port host database = do mng <- newManager defaultManagerSettings - return HttpConnection { - httpParams = HttpParams { - httpHost = host, - httpPassword = password, - httpPort = port, - httpUsername = user, - httpDatabase = database - }, - httpManager = mng - } + return + HttpConnection + { httpParams = + HttpParams + { httpHost = host, + httpPassword = password, + httpPort = port, + httpUsername = user, + httpDatabase = database + }, + httpManager = mng + } diff --git a/src/Database/ClickHouseDriver/HTTP/Helpers.hs b/src/Database/ClickHouseDriver/HTTP/Helpers.hs --- a/src/Database/ClickHouseDriver/HTTP/Helpers.hs +++ b/src/Database/ClickHouseDriver/HTTP/Helpers.hs @@ -3,41 +3,41 @@ -- -- This source code is distributed under the terms of a MIT license, -- found in the LICENSE file. - {-# LANGUAGE FlexibleInstances #-} --- | Miscellaneous helper functions. User should not import it. - +-- | Miscellaneous helper functions. User should not import it. module Database.ClickHouseDriver.HTTP.Helpers ( extract, genURL, - toString + toString, ) where -import Database.ClickHouseDriver.Column - ( ClickhouseType(CKNull, CKTuple, CKArray, CKString, CKInt32) ) +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, 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 ) + ( 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 -- | Trim JSON data extract :: C8.ByteString -> JSONResult extract val = getData $ parse JP.json val where - getData (Fail e _ _) = Left e + getData (Fail e _ _) = Left e getData (Done _ (JP.Object x)) = Right $ getData' x - getData _ = Right [] + getData _ = Right [] getData' = map getObject . maybeArrToList . HM.lookup (pack "data") @@ -47,42 +47,44 @@ getArray (JP.Array arr) = arr getObject (JP.Object x) = x -genURL :: HttpConnection->Cmd->IO String -genURL HttpConnection { - httpParams = HttpParams{ - httpHost = host, - httpPassword = pw, - httpPort = port, +genURL :: HttpConnection -> Cmd -> IO String +genURL + HttpConnection + { httpParams = + HttpParams + { httpHost = host, + httpPassword = pw, + httpPort = port, httpUsername = usr, httpDatabase = db - } - } - cmd = do - (_,basicUrl) <- runWriterT $ do - writeIn "http://" - writeIn usr - writeIn ":" - writeIn pw - writeIn "@" - writeIn host - writeIn ":" - writeIn $ show port - writeIn "/" - if cmd == "ping" then return () else writeIn "?query=" - writeIn $ dbUrl db - let res = basicUrl ++ NE.encode cmd - return res + } + } + cmd = do + (_, basicUrl) <- runWriterT $ do + writeIn "http://" + writeIn usr + writeIn ":" + writeIn pw + writeIn "@" + writeIn host + writeIn ":" + writeIn $ show port + writeIn "/" + if cmd == "ping" then return () else writeIn "?query=" + writeIn $ dbUrl db + let res = basicUrl ++ NE.encode cmd + return res -- | serialize column type into sql string -toString :: [ClickhouseType]->String +toString :: [ClickhouseType] -> String toString ck = "(" ++ toStr ck ++ ")" -toStr :: [ClickhouseType]->String +toStr :: [ClickhouseType] -> String toStr [] = "" -toStr (x:[]) = toStr' x -toStr (x:xs) = toStr' x ++ "," ++ toStr xs +toStr (x : []) = toStr' x +toStr (x : xs) = toStr' x ++ "," ++ toStr xs -toStr' :: ClickhouseType->String +toStr' :: ClickhouseType -> String toStr' (CKInt32 n) = show n toStr' (CKString str) = "'" ++ C8.unpack str ++ "'" toStr' (CKArray arr) = "[" ++ (toStr $ toList arr) ++ "]" @@ -91,4 +93,4 @@ toStr' _ = error "unsupported writing type" dbUrl :: (Maybe String) -> String -dbUrl = fromMaybe "" . fmap ("?database=" ++) +dbUrl = fromMaybe "" . fmap ("?database=" ++) diff --git a/src/Database/ClickHouseDriver/HTTP/Types.hs b/src/Database/ClickHouseDriver/HTTP/Types.hs --- a/src/Database/ClickHouseDriver/HTTP/Types.hs +++ b/src/Database/ClickHouseDriver/HTTP/Types.hs @@ -1,22 +1,20 @@ -- | Definition of types - module Database.ClickHouseDriver.HTTP.Types ( JSONResult (..), Cmd, Haxl, - Format(..), - HttpConnection(..), - HttpParams(..) + Format (..), + HttpConnection (..), + HttpParams (..), ) where -import Data.Aeson (Value) -import Data.ByteString (ByteString) -import Data.HashMap.Strict (HashMap) -import Data.Text (Text) -import Haxl.Core (GenHaxl) -import Network.HTTP.Client ( Manager ) - +import Data.Aeson (Value) +import Data.ByteString (ByteString) +import Data.HashMap.Strict (HashMap) +import Data.Text (Text) +import Haxl.Core (GenHaxl) +import Network.HTTP.Client (Manager) type JSONResult = Either ByteString [HashMap Text Value] @@ -25,22 +23,19 @@ type Haxl a = GenHaxl () a data Format = CSV | JSON | TUPLE - deriving Eq + deriving (Eq) -data HttpParams - = HttpParams - { - httpHost :: !String, - httpPort :: {-# UNPACK #-} !Int, - httpUsername :: !String, - httpPassword :: !String, - httpDatabase :: Maybe String - } +data HttpParams = HttpParams + { httpHost :: !String, + httpPort :: {-# UNPACK #-} !Int, + httpUsername :: !String, + httpPassword :: !String, + httpDatabase :: Maybe String + } -data HttpConnection - = HttpConnection - { httpParams :: !HttpParams, - -- ^ basic parameters - httpManager :: !Manager - -- ^ http manager - } +data HttpConnection = HttpConnection + { -- | basic parameters + httpParams :: !HttpParams, + -- | http manager + httpManager :: !Manager + }