packages feed

clickhouse-haskell 0.1.2.2 → 0.1.2.3

raw patch · 9 files changed

+308/−252 lines, 9 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

- Database.ClickHouseDriver.Column: CKArray :: Vector ClickhouseType -> ClickhouseType
- Database.ClickHouseDriver.Column: CKDate :: !Integer -> !Int -> !Int -> ClickhouseType
- Database.ClickHouseDriver.Column: CKDecimal :: Float -> ClickhouseType
- Database.ClickHouseDriver.Column: CKDecimal128 :: Double -> ClickhouseType
- Database.ClickHouseDriver.Column: CKDecimal32 :: Float -> ClickhouseType
- Database.ClickHouseDriver.Column: CKDecimal64 :: Double -> ClickhouseType
- Database.ClickHouseDriver.Column: CKIPv4 :: (Word8, Word8, Word8, Word8) -> ClickhouseType
- Database.ClickHouseDriver.Column: CKIPv6 :: (Word16, Word16, Word16, Word16, Word16, Word16, Word16, Word16) -> ClickhouseType
- Database.ClickHouseDriver.Column: CKInt128 :: Int64 -> Int64 -> ClickhouseType
- Database.ClickHouseDriver.Column: CKInt16 :: Int16 -> ClickhouseType
- Database.ClickHouseDriver.Column: CKInt32 :: Int32 -> ClickhouseType
- Database.ClickHouseDriver.Column: CKInt64 :: Int64 -> ClickhouseType
- Database.ClickHouseDriver.Column: CKInt8 :: Int8 -> ClickhouseType
- Database.ClickHouseDriver.Column: CKNull :: ClickhouseType
- Database.ClickHouseDriver.Column: CKString :: ByteString -> ClickhouseType
- Database.ClickHouseDriver.Column: CKTuple :: Vector ClickhouseType -> ClickhouseType
- Database.ClickHouseDriver.Column: CKUInt128 :: Word64 -> Word64 -> ClickhouseType
- Database.ClickHouseDriver.Column: CKUInt16 :: Word16 -> ClickhouseType
- Database.ClickHouseDriver.Column: CKUInt32 :: Word32 -> ClickhouseType
- Database.ClickHouseDriver.Column: CKUInt64 :: Word64 -> ClickhouseType
- Database.ClickHouseDriver.Column: CKUInt8 :: Word8 -> ClickhouseType
- Database.ClickHouseDriver.Column: [day] :: ClickhouseType -> !Int
- Database.ClickHouseDriver.Column: [month] :: ClickhouseType -> !Int
- Database.ClickHouseDriver.Column: [year] :: ClickhouseType -> !Integer
- Database.ClickHouseDriver.Column: data ClickhouseType
+ Database.ClickHouseDriver.Column: c_convert_time :: Int64 -> CString -> Int -> IO CString
+ Database.ClickHouseDriver.Column: c_convert_time64 :: Float -> CString -> Int -> IO CString
+ Database.ClickHouseDriver.Column: c_write_time :: CString -> CString -> Int -> Int -> IO Int32
+ Database.ClickHouseDriver.Column: convert_time_from_int32 :: Int32 -> IO Int32
+ Database.ClickHouseDriver.Column: genSpecs :: ByteString -> [Vector Word64] -> Reader (ByteString, [Vector Word64])
+ Database.ClickHouseDriver.Column: getSpecs :: ByteString -> [ByteString]
+ Database.ClickHouseDriver.Column: hi_bits_128 :: Double -> Int -> Word64
+ Database.ClickHouseDriver.Column: hi_bits_negative_128 :: Double -> Int -> Word64
+ Database.ClickHouseDriver.Column: low_bits_128 :: Double -> Int -> Word64
+ Database.ClickHouseDriver.Column: low_bits_negative_128 :: Double -> Int -> Word64
+ Database.ClickHouseDriver.Column: readArray :: ServerInfo -> Int -> ByteString -> Reader (Vector ClickhouseType)
+ Database.ClickHouseDriver.Column: readArraySpec :: Vector Word64 -> Reader (Vector Word64)
+ Database.ClickHouseDriver.Column: readDate :: Int -> Reader (Vector ClickhouseType)
+ Database.ClickHouseDriver.Column: readDateTime :: ServerInfo -> Int -> ByteString -> Reader (Vector ClickhouseType)
+ Database.ClickHouseDriver.Column: readDateTimeWithSpec :: ServerInfo -> Int -> Maybe Int -> ByteString -> Reader (Vector ClickhouseType)
+ Database.ClickHouseDriver.Column: readDecimal :: Int -> ByteString -> Reader (Vector ClickhouseType)
+ Database.ClickHouseDriver.Column: readEnum :: Int -> ByteString -> Reader (Vector ClickhouseType)
+ Database.ClickHouseDriver.Column: readFixed :: Int -> ByteString -> Reader (Vector ClickhouseType)
+ Database.ClickHouseDriver.Column: readFixedLengthString :: Int -> Reader ClickhouseType
+ Database.ClickHouseDriver.Column: readIPv4 :: Int -> Reader (Vector ClickhouseType)
+ Database.ClickHouseDriver.Column: readIPv6 :: Int -> Reader (Vector ClickhouseType)
+ Database.ClickHouseDriver.Column: readIntColumn :: Int -> ByteString -> Reader (Vector ClickhouseType)
+ Database.ClickHouseDriver.Column: readLowCardinality :: ServerInfo -> Int -> ByteString -> Reader (Vector ClickhouseType)
+ Database.ClickHouseDriver.Column: readNullable :: ServerInfo -> Int -> ByteString -> Reader (Vector ClickhouseType)
+ Database.ClickHouseDriver.Column: readSimpleAggregateFunction :: ServerInfo -> Int -> ByteString -> Reader (Vector ClickhouseType)
+ Database.ClickHouseDriver.Column: readTimeSpec :: ByteString -> (Maybe Int, Maybe ByteString)
+ Database.ClickHouseDriver.Column: readTuple :: ServerInfo -> Int -> ByteString -> Reader (Vector ClickhouseType)
+ Database.ClickHouseDriver.Column: readUUID :: Int -> Reader (Vector ClickhouseType)
+ Database.ClickHouseDriver.Column: typeMismatchError :: ByteString -> String
+ Database.ClickHouseDriver.Column: word128_division :: Word64 -> Word64 -> Int -> Double
+ Database.ClickHouseDriver.Column: writeArray :: Context -> ByteString -> ByteString -> Vector ClickhouseType -> Writer Builder
+ Database.ClickHouseDriver.Column: writeDate :: ByteString -> Vector ClickhouseType -> Writer Builder
+ Database.ClickHouseDriver.Column: writeDateTime :: ByteString -> ByteString -> Vector ClickhouseType -> Writer Builder
+ Database.ClickHouseDriver.Column: writeDecimal :: ByteString -> ByteString -> Vector ClickhouseType -> Writer Builder
+ Database.ClickHouseDriver.Column: writeEnum :: ByteString -> ByteString -> Vector ClickhouseType -> Writer Builder
+ Database.ClickHouseDriver.Column: writeFixedLengthString :: ByteString -> ByteString -> Vector ClickhouseType -> Writer Builder
+ Database.ClickHouseDriver.Column: writeIPv4 :: ByteString -> Vector ClickhouseType -> Writer Builder
+ Database.ClickHouseDriver.Column: writeIPv6 :: ByteString -> Vector ClickhouseType -> Writer Builder
+ Database.ClickHouseDriver.Column: writeIntColumn :: ByteString -> ByteString -> Vector ClickhouseType -> Writer Builder
+ Database.ClickHouseDriver.Column: writeLowCardinality :: Context -> ByteString -> ByteString -> Vector ClickhouseType -> Writer Builder
+ Database.ClickHouseDriver.Column: writeNullable :: Context -> ByteString -> ByteString -> Vector ClickhouseType -> Writer Builder
+ Database.ClickHouseDriver.Column: writeStringColumn :: ByteString -> Vector ClickhouseType -> Writer Builder
+ Database.ClickHouseDriver.Column: writeTuple :: Context -> ByteString -> ByteString -> Vector ClickhouseType -> Writer Builder
+ Database.ClickHouseDriver.Column: writeUIntColumn :: ByteString -> ByteString -> Vector ClickhouseType -> Writer Builder
+ Database.ClickHouseDriver.Column: writeUUID :: ByteString -> Vector ClickhouseType -> Writer Builder

Files

clickhouse-haskell.cabal view
@@ -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,
src/Database/ClickHouseDriver/Block.hs view
@@ -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,
src/Database/ClickHouseDriver/Client.hs view
@@ -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 )
src/Database/ClickHouseDriver/Column.hs view
@@ -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) 
src/Database/ClickHouseDriver/Connection.hs view
@@ -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),
src/Database/ClickHouseDriver/HTTP/Client.hs view
@@ -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
src/Database/ClickHouseDriver/HTTP/Connection.hs view
@@ -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+      }
src/Database/ClickHouseDriver/HTTP/Helpers.hs view
@@ -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=" ++)
src/Database/ClickHouseDriver/HTTP/Types.hs view
@@ -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+  }