snaplet-hdbc 0.7.1.1 → 0.7.2

raw patch · 3 files changed

+37/−83 lines, 3 filesdep +MonadCatchIO-transformersdep +resource-pool-catchiodep −lifted-basedep −monad-controldep −resource-poolPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: MonadCatchIO-transformers, resource-pool-catchio

Dependencies removed: lifted-base, monad-control, resource-pool, transformers-base

API changes (from Hackage documentation)

Files

• snaplet-hdbc.cabal +17/−19
• src/Snap/Snaplet/Hdbc.hs +12/−41
• src/Snap/Snaplet/Hdbc/Types.hs +8/−23

@@ -1,5 +1,5 @@ name:           snaplet-hdbc-version:        0.7.1.1+version:        0.7.2 synopsis:       HDBC snaplet for Snap Framework description:    This snaplet consists of two parts: an HDBC abstraction snaplet                 and an HDBC authentication backend for Snap's authentication@@ -28,24 +28,22 @@     Snap.Snaplet.Hdbc.Types    build-depends:-    base                      >= 4       && < 5,-    bytestring                >= 0.9.1   && < 0.10,-    clientsession             >= 0.7.2   && < 0.8,-    containers                >= 0.3     && < 0.5,-    convertible               >= 1.0     && < 1.1,-    data-lens                 >= 2.0.1   && < 2.1,-    data-lens-template        >= 2.1     && < 2.2,-    HDBC                      >= 2.2     && < 2.4,-    lifted-base               >= 0.1     && < 0.2,-    mtl                       >  2.0     && < 2.1,-    monad-control             >= 0.2     && < 0.4,-    resource-pool             >= 0.2     && < 0.3,-    snap                      >= 0.6     && < 0.8,-    text                      >= 0.11    && < 0.12,-    time                      >= 1.1     && < 1.5,-    transformers              >= 0.2     && < 0.3,-    transformers-base         >= 0.2     && < 0.5,-    unordered-containers      >= 0.1.4   && < 0.2+    base                       >= 4       && < 5,+    bytestring                 >= 0.9.1   && < 0.10,+    clientsession              >= 0.7.2   && < 0.8,+    containers                 >= 0.3     && < 0.5,+    convertible                >= 1.0     && < 1.1,+    data-lens                  >= 2.0.1   && < 2.1,+    data-lens-template         >= 2.1     && < 2.2,+    HDBC                       >= 2.2     && < 2.4,+    MonadCatchIO-transformers  >= 0.2.1   && < 0.3,+    mtl                        >  2.0     && < 2.1,+    resource-pool-catchio      >= 0.2     && < 0.3,+    snap                       >= 0.6     && < 0.8,+    text                       >= 0.11    && < 0.12,+    time                       >= 1.1     && < 1.5,+    transformers               >= 0.2     && < 0.3,+    unordered-containers       >= 0.1.4   && < 0.2    ghc-options: -Wall -fwarn-tabs -funbox-strict-fields                -fno-warn-orphans -fno-warn-unused-do-bind

@@ -1,10 +1,10 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeFamilies #-}  -- | This module provides a very thin wrapper around HDBC. It wraps some of the -- HDBC functions in more convenient functions and re-exports the rest of the@@ -79,6 +79,9 @@ import            Prelude hiding (catch)  import            Control.Concurrent.MVar+import            Control.Exception (SomeException)+import            Control.Monad.CatchIO+import            Control.Monad.IO.Class import            Data.Map (Map) import            Data.Pool import qualified  Database.HDBC as HDBC@@ -87,18 +90,6 @@ import            Snap.Snaplet import            Snap.Snaplet.Hdbc.Types -#if MIN_VERSION_monad_control(0,3,0)-import Control.Monad.Trans.Control (MonadBaseControl)-import Control.Monad.Base-import Control.Exception.Lifted-#else-import Control.Monad.IO.Control (MonadControlIO(..))-import Control.Monad.IO.Class (liftIO)-import Control.Exception.Control hiding (Handler)-#define control controlIO-#define liftBase liftIO-#endif- -- | A map with the column name as key and the value from the database as value type Row = Map String SqlValue @@ -107,24 +98,11 @@ -- can find the connection source. class  (  IConnection c        ,  ConnSrc s-#if MIN_VERSION_monad_control(0,3,0)-       ,  MonadBaseControl IO m-#else-       ,  MonadControlIO m-#endif+       ,  MonadCatchIO m        )   =>   HasHdbc m c s | m -> c s where   getHdbcState :: m (HdbcSnaplet c s) --- | This is (hopefully) a temporary instance, which will disppear once the--- entire snap framework is switched to monad-control.-#if MIN_VERSION_monad_control(0,3,0)--#else-instance MonadControlIO (Handler b v) where-  liftControlIO f = liftBase (f return)-#endif- type HdbcIO    c = HdbcSnaplet c IO type HdbcPool  c = HdbcSnaplet c Pool @@ -137,14 +115,11 @@ hdbcInit   ::  (  ConnSrc s       ,  IConnection c-#if MIN_VERSION_monad_control(0,3,0)-      ,  MonadBase IO (Initializer b (HdbcSnaplet c s))-#endif       )   =>  s c   ->  SnapletInit b (HdbcSnaplet c s) hdbcInit src = makeSnaplet "hdbc" "HDBC abstraction" Nothing $ do-  mv <- liftBase newEmptyMVar+  mv <- liftIO newEmptyMVar   return $ HdbcSnaplet src mv  @@ -153,7 +128,7 @@ withHdbc :: HasHdbc m c s => (c -> IO a) -> m a withHdbc f = do   st <- getHdbcState-  withConn st (liftBase . f)+  withConn st (liftIO . f)  -- | Get a new connection from the resource pool, apply the provided function -- to it and return the result in of the compution in monad 'm'.@@ -173,8 +148,8 @@                  --   row. Can be the empty list. query sql bind = do   stmt <- prepare sql-  liftBase $ HDBC.execute stmt bind-  liftBase $ HDBC.fetchAllRowsMap stmt+  liftIO $ HDBC.execute stmt bind+  liftIO $ HDBC.fetchAllRowsMap stmt  -- | Similar to 'query', but instead of returning a list of 'Row's, it returns -- an 'Integer' indicating the numbers of affected rows. This is typically used@@ -183,13 +158,13 @@ query' :: HasHdbc m c s => String -> [SqlValue] -> m Integer query' sql bind = withTransaction $ \conn -> do   stmt <- HDBC.prepare conn sql-  liftBase $ HDBC.execute stmt bind+  liftIO $ HDBC.execute stmt bind  -- query' below doesn't work that well, due to withTransaction' {- query' :: HasHdbc m c s => String -> [SqlValue] -> m Integer-} {- query' sql bind = withTransaction' $ do-}   {- stmt <- prepare sql-}-  {- liftBase $ HDBC.execute stmt bind-}+  {- liftIO $ HDBC.execute stmt bind-}  -- | Run an action inside a transaction. If the action throws an exception, the -- transaction will be rolled back, and the exception rethrown.@@ -212,11 +187,7 @@   commit   return r   where  doRollback = rollback `catch` doRollbackHandler-#if MIN_VERSION_monad_control(0,3,0)-         doRollbackHandler :: MonadBaseControl IO m => SomeException -> m ()-#else-         doRollbackHandler :: MonadControlIO m => SomeException -> m ()-#endif+         doRollbackHandler :: MonadCatchIO m => SomeException -> m ()          doRollbackHandler _ = return ()  -- | The functions provided below are wrappers around the original HDBC

@@ -1,24 +1,15 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE FlexibleContexts #-}  module Snap.Snaplet.Hdbc.Types where  import            Control.Concurrent.MVar+import            Control.Monad.CatchIO import            Control.Monad.State import            Database.HDBC (IConnection()) import qualified  Database.HDBC as HDBC import            Data.Pool -#if MIN_VERSION_monad_control(0,3,0)-import Control.Monad.Trans.Control (MonadBaseControl)-import Control.Monad.Base (liftBase)-#else-import Control.Monad.IO.Control (MonadControlIO)-#define control controlIO-#define liftBase liftIO-#endif- -- | The snaplet state type containing a resource pool, parameterised by a raw -- HDBC connection. data HdbcSnaplet c s@@ -27,15 +18,9 @@   {   connSrc  :: s c   ,   connVar  :: MVar c } -#if MIN_VERSION_monad_control(0,3,0) class ConnSrc s where-  withConn   :: (MonadBaseControl IO m, IConnection c) => HdbcSnaplet c s -> (c -> m b) -> m b-  closeConn  :: (MonadBaseControl IO m, IConnection c) => HdbcSnaplet c s -> c -> m ()-#else-class ConnSrc s where-  withConn   :: (MonadControlIO m, IConnection c) => HdbcSnaplet c s -> (c -> m b) -> m b-  closeConn  :: (MonadControlIO m, IConnection c) => HdbcSnaplet c s -> c -> m ()-#endif+  withConn   :: (MonadCatchIO m, IConnection c) => HdbcSnaplet c s -> (c -> m b) -> m b+  closeConn  :: (MonadCatchIO m, IConnection c) => HdbcSnaplet c s -> c -> m ()  instance ConnSrc Pool where   withConn       = withResource . connSrc@@ -44,12 +29,12 @@ instance ConnSrc IO where   withConn st fn = do     let cv = connVar st-    emp   <-  liftBase $ isEmptyMVar cv+    emp   <-  liftIO $ isEmptyMVar cv     conn  <-  if emp                 then do-                  conn <- liftBase $ connSrc st-                  liftBase $ putMVar cv conn+                  conn <- liftIO $ connSrc st+                  liftIO $ putMVar cv conn                   return conn-                else liftBase $ readMVar cv+                else liftIO $ readMVar cv     fn conn-  closeConn _  = liftBase . HDBC.disconnect+  closeConn _  = liftIO . HDBC.disconnect