haskelldb-connect-hdbc (empty) → 0.1.0.0
raw patch · 6 files changed
+373/−0 lines, 6 filesdep +HDBCdep +basedep +containerssetup-changed
Dependencies added: HDBC, base, containers, haskelldb
Files
- LICENSE +30/−0
- Setup.hs +2/−0
- haskelldb-connect-hdbc.cabal +35/−0
- src/Database/HaskellDB/Connect/HDBC.hs +56/−0
- src/Database/HaskellDB/Connect/HDBC/Internal.hs +218/−0
- src/Database/HaskellDB/Connect/HDBC/Simple.hs +32/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2012, Kei Hibino++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 Kei Hibino 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
+ haskelldb-connect-hdbc.cabal view
@@ -0,0 +1,35 @@+name: haskelldb-connect-hdbc+version: 0.1.0.0+synopsis: Bracketed HDBC session for HaskellDB+description: This package includes module used from+ concrete HDBC session impelemntation+ with individual bracket implementation.+homepage: http://twitter.com/khibino+license: BSD3+license-file: LICENSE+author: Kei Hibino <ex8k.hibino@gmail.com>+maintainer: Kei Hibino <ex8k.hibino@gmail.com>+category: Database+build-type: Simple+cabal-version: >=1.8+++library+ exposed-modules: Database.HaskellDB.Connect.HDBC+ Database.HaskellDB.Connect.HDBC.Simple+ other-modules: Database.HaskellDB.Connect.HDBC.Internal++ build-depends: base < 5+ , containers+ , HDBC+ , haskelldb++ hs-source-dirs: src++source-repository head+ type: git+ location: git://github.com/khibino/haskelldb-connect-hdbc.git++source-repository head+ type: mercurial+ location: https://bitbucket.org/khibino/haskelldb-connect-hdbc
+ src/Database/HaskellDB/Connect/HDBC.hs view
@@ -0,0 +1,56 @@+{-# LANGUAGE Rank2Types #-}+-----------------------------------------------------------+-- |+-- Module : Database.HaskellDB.Connect.HDBC+-- Copyright : Kei Hibino 2012+-- License : BSD-style+--+-- Maintainer : ex8k.hibino@gmail.com+-- Stability : experimental+-- Portability : portable+--+-- Bracketed session for HaskellDB with HDBC+--+-----------------------------------------------------------++module Database.HaskellDB.Connect.HDBC (+ -- * Bracketed session+ -- $bracketedSession+ makeHDBCSession+ ) where++import Database.HDBC (IConnection, handleSqlError)+import qualified Database.HDBC as HDBC++import Database.HaskellDB.Database (Database (..))+import Database.HaskellDB.Sql.Generate (SqlGenerator)++import Database.HaskellDB.Connect.HDBC.Internal (mkDatabase)++{- $bracketedSession+This module provides a base function to call close correctly against opend DB connection.++Bracket function implementation is provided by several packages,+so this package provides base implementation which requires+bracket function and corresponding lift function.+-}++-- | Run an action on a HDBC IConnection and close the connection.+makeHDBCSession :: (Monad m, IConnection conn)+ => (m conn -> (conn -> m ()) -> (conn -> m a) -> m a) -- ^ bracket+ -> (forall b. IO b -> m b) -- ^ lift+ -> SqlGenerator+ -> IO conn -- ^ Connect action+ -> (conn -> Database -> m a) -- ^ Transaction body+ -> m a+makeHDBCSession bracket lift gen connect action =+ bracket+ (lift $ handleSqlError connect)+ (lift+ . handleSqlError+ . HDBC.disconnect)+ (\conn -> do+ x <- action conn (mkDatabase gen conn)+ -- Do rollback independent from driver default behavior when disconnect.+ lift $ HDBC.rollback conn+ return x)
+ src/Database/HaskellDB/Connect/HDBC/Internal.hs view
@@ -0,0 +1,218 @@+{-# LANGUAGE CPP #-}+-----------------------------------------------------------+-- |+-- Module : Database.HaskellDB.Connect.HDBC.Internal+-- Copyright : HWT Group 2003,+-- Bjorn Bringert 2005-2006,+-- Kei Hibino 2012+-- License : BSD-style+--+-- Maintainer : ex8k.hibino@gmail.com+-- Stability : experimental+-- Portability : portable+--+-- Connection management for HaskellDB with HDBC+--+-----------------------------------------------------------++module Database.HaskellDB.Connect.HDBC.Internal (+ mkDatabase+ ) where++import Data.Char (toLower)+import Data.Maybe (fromMaybe)+import Data.Map (Map)+import qualified Data.Map as Map++import Database.HDBC+ (IConnection, SqlColDesc (..), SqlTypeId (..),+ handleSqlError, getColumnNames, fetchAllRows)+import qualified Database.HDBC as HDBC++import Database.HaskellDB (Rel, Record)+import Database.HaskellDB.Database+ (Database (..), GetRec (getRec), GetInstances (..))+import Database.HaskellDB.Sql.Generate+ (SqlGenerator, sqlQuery, sqlInsert, sqlInsertQuery, sqlDelete, sqlUpdate,+ sqlCreateDB, sqlCreateTable, sqlDropDB, sqlDropTable)+import Database.HaskellDB.Sql.Print+ (ppSql, ppInsert, ppDelete, ppUpdate, ppCreate, ppDrop)+import Database.HaskellDB.PrimQuery+ (PrimQuery (..), PrimExpr, Scheme, attributes, TableName, Assoc, Attribute)+import Database.HaskellDB.FieldType (FieldDesc, FieldType (..))++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,+#if MIN_VERSION_haskelldb(2,1,1)+ dbCommit = HDBC.commit connection,+#endif+ 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+#if MIN_VERSION_haskelldb(2,2,1)+ SqlTimestampT -> LocalTimeT+#endif+ 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+#if MIN_VERSION_haskelldb(2,2,1)+ , getLocalTime = hdbcGetValue+#endif+ }++-- 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
+ src/Database/HaskellDB/Connect/HDBC/Simple.hs view
@@ -0,0 +1,32 @@+-----------------------------------------------------------+-- |+-- Module : Database.HaskellDB.Connect.HDBC.Simple+-- Copyright : Kei Hibino 2012+-- License : BSD-style+--+-- Maintainer : ex8k.hibino@gmail.com+-- Stability : experimental+-- Portability : portable+--+-- Bracketed HaskellDB session with 'IO'.+--+-----------------------------------------------------------+module Database.HaskellDB.Connect.HDBC.Simple (+ hdbcSession+ ) where++import Database.HDBC (IConnection)+import Database.HaskellDB.Database (Database)+import Database.HaskellDB.Sql.Generate (SqlGenerator)+import Database.HaskellDB.Connect.HDBC (makeHDBCSession)++import Control.Exception (bracket)++-- | Run an action on a HDBC 'IConnection' and close the connection.+-- Simple 'IO' version.+hdbcSession :: IConnection conn+ => SqlGenerator+ -> IO conn -- ^ Connect action+ -> (conn -> Database -> IO a) -- ^ Transaction body+ -> IO a+hdbcSession gen = makeHDBCSession bracket id gen