HDBC-session (empty) → 0.0.1.0

raw patch · 4 files changed

+150/−0 lines, 4 filesdep +HDBCdep +basesetup-changed

Dependencies added: HDBC, base

Files

• HDBC-session.cabal +33/−0
• LICENSE +30/−0
• Setup.hs +2/−0
• src/Database/HDBC/Session.hs +85/−0

@@ -0,0 +1,33 @@+name:                HDBC-session+version:             0.0.1.0+synopsis:            Bracketed connection for HDBC+description:         This package contains a base bracketed function+                     to call close correctly against opend DB connection.+homepage:            http://twitter.com/khibino+license:             BSD3+license-file:        LICENSE+author:              Kei Hibino+maintainer:          ex8k.hibino@gmail.com+copyright:           Copyright (c) 2013 Kei Hibino+category:            Database+build-type:          Simple+cabal-version:       >=1.10++library+  exposed-modules:     Database.HDBC.Session++  build-depends:         base <5+                       , HDBC+  hs-source-dirs:      src+  ghc-options:         -Wall++  default-language:     Haskell2010+++source-repository head+  type:       git+  location:   https://github.com/khibino/haskell-relational-record++source-repository head+  type:       mercurial+  location:   https://bitbucket.org/khibino/haskell-relational-record

@@ -0,0 +1,30 @@+Copyright (c) 2013, 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.

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,85 @@+{-# LANGUAGE Rank2Types #-}++-- |+-- Module      : Database.HDBC.Session+-- Copyright   : 2013 Kei Hibino+-- License     : BSD3+--+-- Maintainer  : ex8k.hibino@gmail.com+-- Stability   : experimental+-- Portability : unknown+--+-- This module provides a base bracketed function+-- to call close correctly against opend DB connection.+module Database.HDBC.Session (+  -- * Bracketed session+  -- $bracketedSession+  withConnection, withConnectionIO, withConnectionIO',++  -- * Show errors+  -- $showErrors+  showSqlError, handleSqlError'+  ) where++import Database.HDBC (IConnection, handleSql,+                      SqlError(seState, seNativeError, seErrorMsg))+import qualified Database.HDBC as HDBC+import Control.Exception (bracket)+++{- $bracketedSession+Bracket function implementation is provided by several packages,+so this package provides base implementation which requires+bracket function and corresponding lift function.+-}++{- $showErrors+Functions to show 'SqlError' type not to show 'String' fields.+-}++-- | show 'SqlError' not to show 'String' fields.+showSqlError :: SqlError -> String+showSqlError se = unlines+  ["seState: '" ++ seState se ++ "'",+   "seNativeError: " ++ show (seNativeError se),+   "seErrorMsg: '" ++ seErrorMsg se ++ "'"]++-- | Like 'handleSqlError', but not to show 'String' fields of SqlError.+handleSqlError' :: IO a -> IO a+handleSqlError' =  handleSql (fail . reformat . showSqlError)  where+  reformat = ("SQL error: \n" ++) . unlines . map ("  " ++) . lines++-- | Run a transaction on a HDBC IConnection and close the connection.+withConnection :: (Monad m, IConnection conn)+               => (forall c. m c -> (c -> m ()) -> (c -> m a) -> m a) -- ^ bracket+               -> (forall b. IO b -> m b)                             -- ^ lift+               -> IO conn                                             -- ^ Connect action+               -> (conn -> m a)                                       -- ^ Transaction body+               -> m a+withConnection bracket' lift connect tbody =+  bracket' (lift open') (lift . close') bodyWithRollback+  where+    open'  = handleSqlError' connect+    close' :: IConnection conn => conn -> IO ()+    close' =  handleSqlError' . HDBC.disconnect+    bodyWithRollback conn =+      bracket'+      (return ())+      -- Do rollback independent from driver default behavior when disconnect.+      (const . lift . handleSqlError' $ HDBC.rollback conn)+      (const $ tbody conn)++-- | Run a transaction on a HDBC 'IConnection' and close the connection.+--   Simple 'IO' version.+withConnectionIO :: IConnection conn+                 => IO conn        -- ^ Connect action+                 -> (conn -> IO a) -- ^ Transaction body+                 -> IO a           -- ^ Result transaction action+withConnectionIO =  withConnection bracket id++-- | Same as 'withConnectionIO' other than wrapping transaction body in 'handleSqlError''.+withConnectionIO' :: IConnection conn+                  => IO conn        -- ^ Connect action+                  -> (conn -> IO a) -- ^ Transaction body+                  -> IO a           -- ^ Result transaction action+withConnectionIO' connect body = withConnectionIO connect $ handleSqlError' . body