haskelldb-hdbc (empty) → 0.10
raw patch · 3 files changed
+228/−0 lines, 3 filesdep +HDBCdep +basedep +haskell98build-type:Customsetup-changed
Dependencies added: HDBC, base, haskell98, haskelldb, mtl
Files
- Database/HaskellDB/HDBC.hs +203/−0
- Setup.hs +4/−0
- haskelldb-hdbc.cabal +21/−0
+ Database/HaskellDB/HDBC.hs view
@@ -0,0 +1,203 @@+-----------------------------------------------------------+-- |+-- 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 Connection and close the connection.+hdbcConnect :: MonadIO m => + SqlGenerator+ -> IO Connection -- ^ 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 :: SqlGenerator -> Connection -> 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,+ dbCreateDB = hdbcCreateDB gen connection,+ dbCreateTable = hdbcCreateTable gen connection,+ dbDropDB = hdbcDropDB gen connection,+ dbDropTable = hdbcDropTable gen connection+ }++hdbcQuery :: GetRec er vr => + SqlGenerator+ -> Connection + -> 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 :: SqlGenerator -> Connection -> TableName -> Assoc -> IO ()+hdbcInsert gen conn table assoc = + hdbcPrimExecute conn $ show $ ppInsert $ sqlInsert gen table assoc++hdbcInsertQuery :: SqlGenerator -> Connection -> TableName -> PrimQuery -> IO ()+hdbcInsertQuery gen conn table assoc = + hdbcPrimExecute conn $ show $ ppInsert $ sqlInsertQuery gen table assoc++hdbcDelete :: SqlGenerator -> Connection -> TableName -> [PrimExpr] -> IO ()+hdbcDelete gen conn table exprs = + hdbcPrimExecute conn $ show $ ppDelete $ sqlDelete gen table exprs++hdbcUpdate :: SqlGenerator -> Connection -> TableName -> [PrimExpr] -> Assoc -> IO ()+hdbcUpdate gen conn table criteria assigns = + hdbcPrimExecute conn $ show $ ppUpdate $ sqlUpdate gen table criteria assigns++hdbcTables :: Connection -> IO [TableName]+hdbcTables conn = handleSqlError $ HDBC.getTables conn++hdbcDescribe :: Connection -> 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 -> CalendarTimeT+ SqlUTCDateTimeT -> CalendarTimeT+ SqlUTCTimeT -> CalendarTimeT+ SqlIntervalT _ -> string+ SqlGUIDT -> string+ SqlUnknownT _ -> string++hdbcCreateDB :: SqlGenerator -> Connection -> String -> IO ()+hdbcCreateDB gen conn name + = hdbcPrimExecute conn $ show $ ppCreate $ sqlCreateDB gen name++hdbcCreateTable :: SqlGenerator -> Connection -> TableName -> [(Attribute,FieldDesc)] -> IO ()+hdbcCreateTable gen conn name attrs+ = hdbcPrimExecute conn $ show $ ppCreate $ sqlCreateTable gen name attrs++hdbcDropDB :: SqlGenerator -> Connection -> String -> IO ()+hdbcDropDB gen conn name + = hdbcPrimExecute conn $ show $ ppDrop $ sqlDropDB gen name++hdbcDropTable :: SqlGenerator -> Connection -> TableName -> IO ()+hdbcDropTable gen conn name+ = hdbcPrimExecute conn $ show $ ppDrop $ sqlDropTable gen name++-- | HDBC implementation of 'Database.dbTransaction'.+hdbcTransaction :: Connection -> IO a -> IO a+hdbcTransaction conn action = + handleSqlError $ HDBC.withTransaction conn (\_ -> action)+++-----------------------------------------------------------+-- Primitive operations+-----------------------------------------------------------++type HDBCRow = Map String HDBC.SqlValue++-- | Primitive query+hdbcPrimQuery :: GetRec er vr => + Connection -- ^ 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 <- HDBC.fetchAllRowsMap stmt+ mapM (getRec hdbcGetInstances rel scheme) rows++-- | Primitive execute+hdbcPrimExecute :: Connection -- ^ 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+ }++hdbcGetValue :: SqlType a => HDBCRow -> String -> IO (Maybe a)+hdbcGetValue m f = case Map.lookup (map toLower f) m of+ Nothing -> fail $ "No such field " ++ f+ Just x -> return $ HDBC.fromSql x
+ Setup.hs view
@@ -0,0 +1,4 @@+#!/usr/bin/env runghc++import Distribution.Simple+main = defaultMain
+ haskelldb-hdbc.cabal view
@@ -0,0 +1,21 @@+Name: haskelldb-hdbc+Version: 0.10+Copyright: The authors+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+build-depends: + haskell98,+ base,+ mtl,+ haskelldb==0.10,+ HDBC==1.0.1+Extensions: ExistentialQuantification,+ OverlappingInstances,+ UndecidableInstances,+ MultiParamTypeClasses+Synopsis: HaskellDB support for HDBC. You will also need one+ or more back-end specific packages.+Exposed-Modules:+ Database.HaskellDB.HDBC+ghc-options: -O2