[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