monetdb-mapi (empty) → 0.1.0.0
raw patch · 5 files changed
+264/−0 lines, 5 filesdep +basedep +bindings-monetdb-mapisetup-changed
Dependencies added: base, bindings-monetdb-mapi
Files
- ChangeLog.md +5/−0
- LICENSE +30/−0
- Setup.hs +2/−0
- monetdb-mapi.cabal +28/−0
- src/Database/MonetDB/Mapi.hs +199/−0
+ ChangeLog.md view
@@ -0,0 +1,5 @@+# Revision history for monetdb-mapi++## 0.1.0.0 -- YYYY-mm-dd++* First version. Released on an unsuspecting world.
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2016, Moritz Bruder++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Moritz Bruder nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ monetdb-mapi.cabal view
@@ -0,0 +1,28 @@+name: monetdb-mapi+version: 0.1.0.0+synopsis: Mid-level bindings for the MonetDB API (mapi)+-- description: +license: BSD3+license-file: LICENSE+author: Moritz Bruder+maintainer: muesli4@gmail.com+-- copyright: +category: Database+build-type: Simple+extra-source-files: ChangeLog.md+cabal-version: >=1.10++source-repository head+ type: git+ location: git://github.com/muesli4/monetdb-mapi.git++library+ exposed-modules: Database.MonetDB.Mapi+ -- other-modules: + -- other-extensions: + build-depends: base >=4.8 && <4.10,+ bindings-monetdb-mapi ==0.1.*++ hs-source-dirs: src+ default-language: Haskell2010+
+ src/Database/MonetDB/Mapi.hs view
@@ -0,0 +1,199 @@+module Database.MonetDB.Mapi+ (+ -- * Error handling+ MapiError+ , errorType+ , ErrorType(..)++ -- * Connection parameters+ , Lang(..)+ , ConInfo(..)+ , emptyConInfo+ , defConInfo++ -- * Connection handling+ , Connection(..)+ , connect+ , disconnect+ , withConnection++ -- * Queries+ , quickQuery+ , quickQuery_+ ) where++import Control.Monad+import Data.Typeable+import Foreign.C.String+import Foreign.C.Types+import Foreign.Concurrent as C+import Foreign.ForeignPtr+import Foreign.Ptr+import qualified Bindings.MonetDB.Mapi as B+import qualified Control.Exception as E++-- | Some IO actions might throw 'MapiError'.+data MapiError = MapiError+ { errorType :: ErrorType+ }+ deriving Show++instance E.Exception MapiError where+ toException = E.SomeException+ fromException (E.SomeException e) = cast e++data ErrorType = Default String+ | Timeout+ | Server String+ deriving Show++-- | The language to be used for a connection.+data Lang = Sql+ | Mil+ | Mal+ | XQuery++fromLang :: Lang -> String+fromLang l = case l of+ Sql -> "sql"+ Mil -> "mil"+ Mal -> "mal"+ XQuery -> "xquery"++newtype Connection = Connection B.Mapi++optCString :: Maybe String -> IO CString+optCString = maybe (return nullPtr) newCString++throwOnMapiError :: B.Mapi -> IO ()+throwOnMapiError mapi = do+ e <- B.mapi_error mapi+ -- Encountered MERROR+ if e == B.cMERROR+ then do+ cstr <- B.mapi_error_str mapi+ print cstr+ s <- peekCString cstr+ E.throwIO $ MapiError $ Default s+ else when (e == B.cMTIMEOUT) $ E.throwIO $ MapiError Timeout++throwOnMapiHdlError :: B.Mapi -> B.MapiHdl -> IO ()+throwOnMapiHdlError mapi hdl = do+ e <- B.mapi_error mapi+ when (e == B.cMSERVER) $+ getServerErrorMsg hdl >>= E.throwIO . MapiError . Server++getServerErrorMsg :: B.MapiHdl -> IO String+getServerErrorMsg hdl = do+ cstr <- B.mapi_result_error hdl+ peekCString cstr++throwOnError :: B.Mapi -> B.MapiHdl -> IO ()+throwOnError mapi hdl = do+ throwOnMapiError mapi+ throwOnMapiHdlError mapi hdl++type Database = String++data ConInfo = ConInfo+ { ciOptHost :: Maybe String+ , ciOptPort :: Maybe Int+ , ciUsername :: Maybe String+ , ciPassword :: Maybe String+ , ciDbName :: Database+ }++-- | It is strongly advised to use 'withConnection', which is exception-safe.+connect :: ConInfo -> Lang -> IO Connection+connect (ConInfo mHost mPort mUser mPass dbName) lang = do+ host <- optCString mHost+ let port = maybe 0 fromIntegral mPort+ user <- optCString mUser+ pass <- optCString mPass+ langStr <- newCString (fromLang lang)+ db <- newCString dbName+ mapi <- B.mapi_connect host port user pass langStr db+ throwOnMapiError mapi+ pure $ Connection mapi++disconnect :: Connection -> IO ()+disconnect (Connection mapi) = B.mapi_disconnect mapi++-- | A 'ConInfo' with all optional fields omitted.+emptyConInfo :: Database -> ConInfo+emptyConInfo = ConInfo Nothing Nothing Nothing Nothing++-- | A 'ConInfo' with common default settings, mostly for testing purposes.+defConInfo :: Database -> ConInfo+defConInfo = ConInfo Nothing Nothing (Just "monetdb") (Just "monetdb")++-- | Opens a connection, runs the action and closes the connection, even when+-- an exception has been thrown.+--+-- >>> withConnection (defConInfo "test") Mal $ \c -> quickQuery c "io.print(42, 23);"+-- [["42", "23"]]+--+withConnection :: ConInfo -> Lang -> (Connection -> IO a) -> IO a+withConnection ci l f = E.bracket (connect ci l) disconnect f+++-- TODO rework Result and Query, that mechanism is terrible++type QueryForeignPtr = ForeignPtr ()++newtype Query = Query QueryForeignPtr++query :: Connection -> String -> IO Query+query (Connection mapi) qStr = do+ qCStr <- newCString qStr+ mapiHdl <- B.mapi_query mapi qCStr+ throwOnError mapi mapiHdl+ q <- C.newForeignPtr mapiHdl (B.mapi_close_handle mapiHdl)+ pure $ Query q++newtype Result = Result QueryForeignPtr++execute :: Query -> IO Result+execute (Query fMapiHdl) = do+ withForeignPtr fMapiHdl $ \mapiHdl -> do+ B.mapi_execute mapiHdl+ -- TODO check for errors+ return $ Result fMapiHdl++fetchRow :: Result -> IO (Maybe [String])+fetchRow (Result fMapiHdl) = + withForeignPtr fMapiHdl $ \mapiHdl -> do+ nFields <- B.mapi_fetch_row mapiHdl+ if nFields == 0+ then return Nothing+ else do+ -- TODO mapi_fetch_field returns 0 on error+ let fetchField i = do+ pc <- B.mapi_fetch_field mapiHdl i+ sz <- B.mapi_fetch_field_len mapiHdl i+ peekCStringLen (pc, fromIntegral sz)+ Just <$> mapM fetchField [0 .. pred nFields]++fetchRows :: Result -> IO [[String]]+fetchRows res = go+ where+ go = do+ mRow <- fetchRow res+ maybe (return []) (\row -> (row :) <$> go) mRow++fieldNames :: Result -> IO [String]+fieldNames (Result fMapiHdl) = withForeignPtr fMapiHdl $ \mapiHdl -> do+ nFields <- B.mapi_get_field_count mapiHdl+ -- FIXME may return 0+ fieldCStrs <- mapM (B.mapi_get_name mapiHdl) [0 .. pred nFields]+ mapM peekCString fieldCStrs++-- | Run a query and fetch the result rows.+quickQuery :: Connection -> String -> IO [[String]]+quickQuery c s = do+ q <- query c s+ r <- execute q+ fetchRows r++quickQuery_ :: Connection -> String -> IO ()+quickQuery_ c s = query c s >>= void . execute