[Pkg-haskell-commits] r799 - in /packages/haskelldb-hdbc: ./ branches/ branches/upstream/ branches/upstream/current/ branches/upstream/current/Database/ branches/upstream/current/Database/HaskellDB/ tags/
arjan at users.alioth.debian.org
arjan at users.alioth.debian.org
Sun Nov 11 17:00:27 UTC 2007
Author: arjan
Date: Sun Nov 11 17:00:27 2007
New Revision: 799
URL: http://svn.debian.org/wsvn/pkg-haskell/?sc=1&rev=799
Log:
[svn-inject] Installing original source of haskelldb-hdbc
Added:
packages/haskelldb-hdbc/
packages/haskelldb-hdbc/branches/
packages/haskelldb-hdbc/branches/upstream/
packages/haskelldb-hdbc/branches/upstream/current/
packages/haskelldb-hdbc/branches/upstream/current/Database/
packages/haskelldb-hdbc/branches/upstream/current/Database/HaskellDB/
packages/haskelldb-hdbc/branches/upstream/current/Database/HaskellDB/HDBC.hs
packages/haskelldb-hdbc/branches/upstream/current/Setup.hs
packages/haskelldb-hdbc/branches/upstream/current/haskelldb-hdbc.cabal
packages/haskelldb-hdbc/tags/
Added: packages/haskelldb-hdbc/branches/upstream/current/Database/HaskellDB/HDBC.hs
URL: http://svn.debian.org/wsvn/pkg-haskell/packages/haskelldb-hdbc/branches/upstream/current/Database/HaskellDB/HDBC.hs?rev=799&op=file
==============================================================================
--- packages/haskelldb-hdbc/branches/upstream/current/Database/HaskellDB/HDBC.hs (added)
+++ packages/haskelldb-hdbc/branches/upstream/current/Database/HaskellDB/HDBC.hs Sun Nov 11 17:00:27 2007
@@ -1,0 +1,203 @@
+-----------------------------------------------------------
+-- |
+-- Module : Database.HaskellDB.HDBC
+-- Copyright : HWT Group 2003,
+-- Bjorn Bringert 2005-2006
+-- License : BSD-style
+--
+-- Maintainer : haskelldb-users at 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
Added: packages/haskelldb-hdbc/branches/upstream/current/Setup.hs
URL: http://svn.debian.org/wsvn/pkg-haskell/packages/haskelldb-hdbc/branches/upstream/current/Setup.hs?rev=799&op=file
==============================================================================
--- packages/haskelldb-hdbc/branches/upstream/current/Setup.hs (added)
+++ packages/haskelldb-hdbc/branches/upstream/current/Setup.hs Sun Nov 11 17:00:27 2007
@@ -1,0 +1,4 @@
+#!/usr/bin/env runghc
+
+import Distribution.Simple
+main = defaultMain
Added: packages/haskelldb-hdbc/branches/upstream/current/haskelldb-hdbc.cabal
URL: http://svn.debian.org/wsvn/pkg-haskell/packages/haskelldb-hdbc/branches/upstream/current/haskelldb-hdbc.cabal?rev=799&op=file
==============================================================================
--- packages/haskelldb-hdbc/branches/upstream/current/haskelldb-hdbc.cabal (added)
+++ packages/haskelldb-hdbc/branches/upstream/current/haskelldb-hdbc.cabal Sun Nov 11 17:00:27 2007
@@ -1,0 +1,21 @@
+Name: haskelldb-hdbc
+Version: 0.10
+Copyright: The authors
+Maintainer: haskelldb-users at 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
More information about the Pkg-haskell-commits
mailing list