haskelldb-hdbc-2.2.4/0000755000000000000000000000000012564414143012540 5ustar0000000000000000haskelldb-hdbc-2.2.4/haskelldb-hdbc.cabal0000644000000000000000000000202512564414143016352 0ustar0000000000000000Name: haskelldb-hdbc Version: 2.2.4 Cabal-version: >= 1.6 Build-type: Simple Copyright: The authors Homepage: https://github.com/m4dc4p/haskelldb Maintainer: haskelldb-users@lists.sourceforge.net Author: Daan Leijen, Conny Andersson, Martin Andersson, Mary Bergman, Victor Blomqvist, Bjorn Bringert, Anders Hockersten, Torbjorn Martin, Jeremy Shaw License: BSD3 License-file: LICENSE Synopsis: HaskellDB support for HDBC. Description: HaskellDB requires this driver to work with any of HDBC's drivers. Category: Database Library Build-depends: mtl >= 1 && < 3, haskelldb >= 2.2 && < 3, HDBC >= 2 && < 3, convertible >= 1.0.1 && < 2 Build-depends: base >= 3 && < 5, containers >= 0.2 && < 1, old-time >= 1 && < 2 Extensions: ExistentialQuantification, OverlappingInstances, UndecidableInstances, MultiParamTypeClasses Exposed-Modules: Database.HaskellDB.HDBC ghc-options: -fwarn-incomplete-patterns Source-repository head Type: git Location: https://github.com/m4dc4p/haskelldb haskelldb-hdbc-2.2.4/LICENSE0000644000000000000000000000307512564414143013552 0ustar0000000000000000Copyright (c) 1999 Daan Leijen, daan@cs.uu.nl Copyright (c) 2003-2004 The HaskellDB development team 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 names of the copyright holders nor the names of the 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. haskelldb-hdbc-2.2.4/Setup.hs0000644000000000000000000000010512564414143014170 0ustar0000000000000000#!/usr/bin/env runghc import Distribution.Simple main = defaultMain haskelldb-hdbc-2.2.4/Database/0000755000000000000000000000000012564414143014244 5ustar0000000000000000haskelldb-hdbc-2.2.4/Database/HaskellDB/0000755000000000000000000000000012564414143016035 5ustar0000000000000000haskelldb-hdbc-2.2.4/Database/HaskellDB/HDBC.hs0000644000000000000000000001773212564414143017103 0ustar0000000000000000{-# LANGUAGE FlexibleContexts #-} ----------------------------------------------------------- -- | -- Module : Database.HaskellDB.HDBC -- Copyright : HWT Group 2003, -- Bjorn Bringert 2005-2006 -- License : BSD-style -- -- Maintainer : haskelldb-users@lists.sourceforge.net -- Stability : experimental -- Portability : portable -- -- HDBC interface for HaskellDB -- ----------------------------------------------------------- module Database.HaskellDB.HDBC (hdbcConnect) where import Database.HaskellDB import Database.HaskellDB.Database import Database.HaskellDB.Sql.Generate (SqlGenerator(..)) import Database.HaskellDB.Sql.Print import Database.HaskellDB.PrimQuery import Database.HaskellDB.Query import Database.HaskellDB.FieldType import Database.HDBC as HDBC hiding (toSql) import Control.Monad.Trans (MonadIO, liftIO) import Data.Char (toLower) import Data.Map (Map) import qualified Data.Map as Map import Data.Maybe (fromMaybe) -- | Run an action on a HDBC IConnection and close the connection. hdbcConnect :: (MonadIO m, IConnection conn) => SqlGenerator -> IO conn -- ^ connection function -> (Database -> m a) -> m a hdbcConnect gen connect action = do conn <- liftIO $ handleSqlError connect x <- action (mkDatabase gen conn) -- FIXME: should we really commit here? liftIO $ HDBC.commit conn liftIO $ handleSqlError (HDBC.disconnect conn) return x mkDatabase :: (IConnection conn) => SqlGenerator -> conn -> Database mkDatabase gen connection = Database { dbQuery = hdbcQuery gen connection, dbInsert = hdbcInsert gen connection, dbInsertQuery = hdbcInsertQuery gen connection, dbDelete = hdbcDelete gen connection, dbUpdate = hdbcUpdate gen connection, dbTables = hdbcTables connection, dbDescribe = hdbcDescribe connection, dbTransaction = hdbcTransaction connection, dbCommit = HDBC.commit connection, dbCreateDB = hdbcCreateDB gen connection, dbCreateTable = hdbcCreateTable gen connection, dbDropDB = hdbcDropDB gen connection, dbDropTable = hdbcDropTable gen connection } hdbcQuery :: (GetRec er vr, IConnection conn) => SqlGenerator -> conn -> PrimQuery -> Rel er -> IO [Record vr] hdbcQuery gen connection q rel = hdbcPrimQuery connection sql scheme rel where sql = show $ ppSql $ sqlQuery gen q scheme = attributes q hdbcInsert :: (IConnection conn) => SqlGenerator -> conn -> TableName -> Assoc -> IO () hdbcInsert gen conn table assoc = hdbcPrimExecute conn $ show $ ppInsert $ sqlInsert gen table assoc hdbcInsertQuery :: (IConnection conn) => SqlGenerator -> conn -> TableName -> PrimQuery -> IO () hdbcInsertQuery gen conn table assoc = hdbcPrimExecute conn $ show $ ppInsert $ sqlInsertQuery gen table assoc hdbcDelete :: (IConnection conn) => SqlGenerator -> conn -> TableName -> [PrimExpr] -> IO () hdbcDelete gen conn table exprs = hdbcPrimExecute conn $ show $ ppDelete $ sqlDelete gen table exprs hdbcUpdate :: (IConnection conn) => SqlGenerator -> conn -> TableName -> [PrimExpr] -> Assoc -> IO () hdbcUpdate gen conn table criteria assigns = hdbcPrimExecute conn $ show $ ppUpdate $ sqlUpdate gen table criteria assigns hdbcTables :: (IConnection conn) => conn -> IO [TableName] hdbcTables conn = handleSqlError $ HDBC.getTables conn hdbcDescribe :: (IConnection conn) => conn -> TableName -> IO [(Attribute,FieldDesc)] hdbcDescribe conn table = handleSqlError $ do cs <- HDBC.describeTable conn table return [(n,colDescToFieldDesc c) | (n,c) <- cs] colDescToFieldDesc :: SqlColDesc -> FieldDesc colDescToFieldDesc c = (t, nullable) where nullable = fromMaybe True (colNullable c) string = maybe StringT BStrT (colSize c) t = case colType c of SqlCharT -> string SqlVarCharT -> string SqlLongVarCharT -> string SqlWCharT -> string SqlWVarCharT -> string SqlWLongVarCharT -> string SqlDecimalT -> IntegerT SqlNumericT -> IntegerT SqlSmallIntT -> IntT SqlIntegerT -> IntT SqlRealT -> DoubleT SqlFloatT -> DoubleT SqlDoubleT -> DoubleT SqlBitT -> BoolT SqlTinyIntT -> IntT SqlBigIntT -> IntT SqlBinaryT -> string SqlVarBinaryT -> string SqlLongVarBinaryT -> string SqlDateT -> CalendarTimeT SqlTimeT -> CalendarTimeT SqlTimestampT -> LocalTimeT SqlUTCDateTimeT -> CalendarTimeT SqlUTCTimeT -> CalendarTimeT SqlTimeWithZoneT -> CalendarTimeT SqlTimestampWithZoneT -> CalendarTimeT SqlIntervalT _ -> string SqlGUIDT -> string SqlUnknownT _ -> string hdbcCreateDB :: (IConnection conn) => SqlGenerator -> conn -> String -> IO () hdbcCreateDB gen conn name = hdbcPrimExecute conn $ show $ ppCreate $ sqlCreateDB gen name hdbcCreateTable :: (IConnection conn) => SqlGenerator -> conn -> TableName -> [(Attribute,FieldDesc)] -> IO () hdbcCreateTable gen conn name attrs = hdbcPrimExecute conn $ show $ ppCreate $ sqlCreateTable gen name attrs hdbcDropDB :: (IConnection conn) => SqlGenerator -> conn -> String -> IO () hdbcDropDB gen conn name = hdbcPrimExecute conn $ show $ ppDrop $ sqlDropDB gen name hdbcDropTable :: (IConnection conn) => SqlGenerator -> conn -> TableName -> IO () hdbcDropTable gen conn name = hdbcPrimExecute conn $ show $ ppDrop $ sqlDropTable gen name -- | HDBC implementation of 'Database.dbTransaction'. hdbcTransaction :: (IConnection conn) => conn -> IO a -> IO a hdbcTransaction conn action = handleSqlError $ HDBC.withTransaction conn (\_ -> action) ----------------------------------------------------------- -- Primitive operations ----------------------------------------------------------- type HDBCRow = Map String HDBC.SqlValue normalizeField :: String -> String normalizeField = map toLower -- | Primitive query hdbcPrimQuery :: (GetRec er vr, IConnection conn) => conn -- ^ Database connection. -> String -- ^ SQL query -> Scheme -- ^ List of field names to retrieve -> Rel er -- ^ Phantom argument to get the return type right. -> IO [Record vr] -- ^ Query results hdbcPrimQuery conn sql scheme rel = do stmt <- handleSqlError $ HDBC.prepare conn sql handleSqlError $ HDBC.execute stmt [] rows <- fetchNormalizedAllRowsAL stmt mapM (getRec hdbcGetInstances rel scheme) $ map Map.fromList rows where fetchNormalizedAllRowsAL sth = do names <- map normalizeField `fmap` getColumnNames sth rows <- fetchAllRows sth return $ map (zip names) rows -- | Primitive execute hdbcPrimExecute :: (IConnection conn) => conn -- ^ Database connection. -> String -- ^ SQL query. -> IO () hdbcPrimExecute conn sql = do handleSqlError $ HDBC.run conn sql [] return () ----------------------------------------------------------- -- Getting data from a statement ----------------------------------------------------------- hdbcGetInstances :: GetInstances HDBCRow hdbcGetInstances = GetInstances { getString = hdbcGetValue , getInt = hdbcGetValue , getInteger = hdbcGetValue , getDouble = hdbcGetValue , getBool = hdbcGetValue , getCalendarTime = hdbcGetValue , getLocalTime = hdbcGetValue } -- hdbcGetValue :: Data.Convertible.Base.Convertible SqlValue a -- => HDBCRow -> String -> IO (Maybe a) hdbcGetValue m f = case Map.lookup (normalizeField f) m of Nothing -> fail $ "No such field " ++ f Just x -> return $ HDBC.fromSql x