Switch back to the regular resource-pool.

Bump version number to 0.6 to match Snap's version numbering.
Add some documentation

snaplet-hdbc.cabal

@@ -1,5 +1,5 @@
 name:           snaplet-hdbc
-version:        0.2.0
+version:        0.6.0
 synopsis:       HDBC snaplet
 description:    HDBC snaplet
 license:        BSD3
@@ -30,16 +30,12 @@ Library
     data-lens-template        >= 2.1   && < 2.2,
     HDBC                      >= 2.2,
     mtl                       >  2.0   && < 2.1,
-    MonadCatchIO-transformers >= 0.2,
-    resource-pool-catchio     >= 0.2,
+    monad-control             >= 0.2,
+    resource-pool             >= 0.2,
     snap                      >= 0.6   && < 0.7,
     text                      >= 0.11,
     time                      >= 1.2,
     unordered-containers      >= 0.1.4
 
-  if impl(ghc >= 6.12.0)
-    ghc-options: -Wall -fwarn-tabs -funbox-strict-fields -O2
-                 -fno-warn-orphans -fno-warn-unused-do-bind
-  else
-    ghc-options: -Wall -fwarn-tabs -funbox-strict-fields -O2
-                 -fno-warn-orphans
+  ghc-options: -Wall -fwarn-tabs -funbox-strict-fields -O2
+               -fno-warn-orphans -fno-warn-unused-do-bind

src/Snap/Snaplet/Auth/Backends/Hdbc.hs

@@ -3,7 +3,7 @@
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE FlexibleContexts #-}
 
-
+-- | Authentication backend using HDBC
 module Snap.Snaplet.Auth.Backends.Hdbc where
 
 import            Control.Monad.State
@@ -19,50 +19,59 @@ import            Snap.Snaplet.Auth
 import            Snap.Snaplet.Session
 import            Web.ClientSession
 
+-- | Initialises this HDBC snaplet. It automatically configures a resource
+-- pool with commonly acceptable default settings. Use `initHdbcAuthManager'`
+-- to initialise with a custom resource pool.
 initHdbcAuthManager
   :: IConnection conn
-  => AuthSettings
-  -> Lens b (Snaplet SessionManager)
-  -> IO conn
-  -> AuthTable
-  -> Queries
+  => AuthSettings  -- ^ Auth settings
+  -> Lens b (Snaplet SessionManager)  -- ^ Lens to the session manager
+  -> IO conn       -- ^ Raw HDBC connection
+  -> AuthTable     -- ^ Authentication table configuration
+  -> Queries       -- ^ Queries to be used for authentication
   -> SnapletInit b (AuthManager b)
 initHdbcAuthManager s l conn tbl qs = initHdbcAuthManager' s l pool tbl qs
   where pool = createPool conn disconnect 1 300 1
 
+-- | Initialises this HDBC snaplet with a custom resource pool.
 initHdbcAuthManager'
   :: IConnection conn
-  => AuthSettings
-  -> Lens b (Snaplet SessionManager)
-  -> IO (Pool conn)
-  -> AuthTable
-  -> Queries
+  => AuthSettings    -- ^ Auth settings
+  -> Lens b (Snaplet SessionManager)  -- ^ Lens to the session manager
+  -> IO (Pool conn)  -- ^ A pre-configured resource pool which dispenses
+                     --   HDBC connections
+  -> AuthTable       -- ^ Authentication table configuration
+  -> Queries         -- ^ Queries to be used for authentication
   -> SnapletInit b (AuthManager b)
 initHdbcAuthManager' s l pool tbl qs =
   makeSnaplet  "HdbcAuthManager"
                "A snaplet providing user authentication using an HDBC backend"
                Nothing $ liftIO $ do
   key  <- getKey (asSiteKey s)
   pl   <- pool
-  return AuthManager {
-      backend = HdbcAuthManager pl tbl qs
-    , session = l
-    , activeUser = Nothing
-    , minPasswdLen = asMinPasswdLen s
-    , rememberCookieName = asRememberCookieName s
-    , rememberPeriod = asRememberPeriod s
-    , siteKey = key
-    , lockout = asLockout s
-  }
-
-data HdbcAuthManager = forall conn. IConnection conn => HdbcAuthManager {
-     authDBPool  :: Pool conn
-  ,  table       :: AuthTable
-  ,  qries       :: Queries
-}
-
-data AuthTable = AuthTable {
-     tblName :: String
+  return AuthManager
+    {  backend = HdbcAuthManager pl tbl qs
+    ,  session = l
+    ,  activeUser = Nothing
+    ,  minPasswdLen = asMinPasswdLen s
+    ,  rememberCookieName = asRememberCookieName s
+    ,  rememberPeriod = asRememberPeriod s
+    ,  siteKey = key
+    ,  lockout = asLockout s }
+
+-- | Authmanager state containing the resource pool and the table/query
+-- configuration.
+data HdbcAuthManager
+  =   forall conn. IConnection conn
+  =>  HdbcAuthManager
+  {   authDBPool :: Pool conn
+  ,   table  :: AuthTable
+  ,   qries  :: Queries }
+
+-- | Datatype containing the names of the columns for the authentication table.
+data AuthTable
+  =  AuthTable
+  {  tblName :: String
   ,  colId :: String
   ,  colLogin :: String
   ,  colPassword :: String
@@ -81,9 +90,11 @@ data AuthTable = AuthTable {
   ,  colRoles :: String
   ,  colMeta :: String }
 
+-- | Default authentication table layout
 defAuthTable :: AuthTable
-defAuthTable = AuthTable  {
-     tblName = "users"
+defAuthTable
+  =  AuthTable
+  {  tblName = "users"
   ,  colId = "uid"
   ,  colLogin = "email"
   ,  colPassword = "password"
@@ -102,35 +113,38 @@ defAuthTable = AuthTable  {
   ,  colRoles = "roles"
   ,  colMeta = "meta" }
 
+-- | List of deconstructors so it's easier to extract column names form an
+-- 'AuthTable'.
 colLst :: [AuthTable -> String]
-colLst =  [  colLogin
-          ,  colPassword
-          ,  colActivatedAt
-          ,  colSuspendedAt
-          ,  colRememberToken
-          ,  colLoginCount
-          ,  colFailedLoginCount
-          ,  colLockedOutUntil
-          ,  colCurrentLoginAt
-          ,  colLastLoginAt
-          ,  colCurrentLoginIp
-          ,  colLastLoginIp
-          ,  colCreatedAt
-          ,  colUpdatedAt
-          ,  colRoles
-          ,  colMeta ]
+colLst =
+  [  colLogin
+  ,  colPassword
+  ,  colActivatedAt
+  ,  colSuspendedAt
+  ,  colRememberToken
+  ,  colLoginCount
+  ,  colFailedLoginCount
+  ,  colLockedOutUntil
+  ,  colCurrentLoginAt
+  ,  colLastLoginAt
+  ,  colCurrentLoginIp
+  ,  colLastLoginIp
+  ,  colCreatedAt
+  ,  colUpdatedAt
+  ,  colRoles
+  ,  colMeta ]
 
 data LookupQuery = ByUserId | ByLogin | ByRememberToken
 
 type QueryAndVals = (String, [SqlValue])
 type SelectQuery = AuthTable -> LookupQuery -> [SqlValue] -> QueryAndVals
 type ModifyQuery = AuthTable -> AuthUser -> QueryAndVals
 
-data Queries = Queries {
-     selectQuery  :: SelectQuery
+data Queries
+  =  Queries
+  {  selectQuery  :: SelectQuery
   ,  saveQuery    :: ModifyQuery
-  ,  deleteQuery  :: ModifyQuery
-}
+  ,  deleteQuery  :: ModifyQuery }
 
 defQueries :: Queries
 defQueries = Queries {

src/Snap/Snaplet/Hdbc.hs

@@ -4,10 +4,9 @@
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE FunctionalDependencies #-}
 
-{-|
-
-  This module provides a very thin wrapper around HDBC
--}
+-- | 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
+-- HDBC functions.
 module Snap.Snaplet.Hdbc (
   -- Snaplet functions
      HdbcSnaplet(..)
@@ -74,8 +73,8 @@ module Snap.Snaplet.Hdbc (
 
 import            Prelude hiding (catch)
 
-import            Control.Exception (SomeException)
-import            Control.Monad.CatchIO
+import            Control.Exception.Control hiding (Handler)
+import            Control.Monad.IO.Control
 import            Control.Monad.State
 import            Data.Map (Map)
 import            Data.Pool
@@ -84,73 +83,123 @@ import            Database.HDBC (IConnection(), SqlValue, SqlError, Statement)
 import            Database.HDBC.ColTypes
 import            Snap.Snaplet
 
+-- | A map with the column name as key and the value from the database as value
 type Row = Map String SqlValue
 
-class  (IConnection c, MonadCatchIO m) => HasHdbc m c | m -> c where
+-- | Instantiate this typeclass on 'Handler b YourSnapletState' so this snaplet
+-- can find the resource pool. Typically you would instantiate it for Snap's
+-- Handler type and use your snaplet's lens to this snaplet to access this
+-- snaplet's state, which contains the pool. Suppose your snaplet state type is
+-- defined as follows, where 'Connection' is the connection type from the HDBC
+-- database adapter of your choosing:
+--
+-- > data App = App
+-- >  { _dbLens :: Snaplet (HdbcSnaplet Connection) }
+--
+-- Then a typical instance you will want to define in your own snaplet is the
+-- following:
+--
+-- > instance HasHdbc (Handler b App) Connection where
+-- >   getPool = with dbLens $ gets hdbcPool
+--
+class (IConnection c, MonadControlIO m) => HasHdbc m c | m -> c where
   getPool :: m (Pool c)
 
+-- | This is (hopefully) a temporary instance, which will disppear once the
+-- entire snap framework is switched to 'MonadControlIO'.
 instance MonadControlIO (Handler b v) where
   liftControlIO f = liftIO (f return)
 
-data HdbcSnaplet c = IConnection c => HdbcSnaplet {
-  hdbcPool :: Pool c }
-
+-- | The snaplet state type containing a resource pool, parameterised by a raw
+-- HDBC connection.
+data HdbcSnaplet c
+  =   IConnection c
+  =>  HdbcSnaplet
+  {   hdbcPool :: Pool c }
+
+-- | Initialise the snaplet by providing it with a raw HDBC connection. A
+-- resource pool is created with some default parameters that should be fine
+-- for most common usecases. If a custom resource pool configuration is
+-- desired, use the `hdbcInit'` initialiser instead. When the snaplet is
+-- unloaded, the 'disconnect' function is called to close any remaining
+-- connections.
 hdbcInit :: IConnection c => IO c -> SnapletInit b (HdbcSnaplet c)
 hdbcInit conn = hdbcInit' $ createPool conn HDBC.disconnect 1 300 1
 
+-- | Instead of a raw HDBC connection, this initialiser expects a
+-- pre-configured resource pool that dispenses HDBC connections. When the
+-- snaplet is unloaded, the 'disconnect' function is called to close any
+-- remaining connections.
 hdbcInit' :: IConnection c => IO (Pool c) -> SnapletInit b (HdbcSnaplet c)
 hdbcInit' pl = makeSnaplet "hdbc" "HDBC abstraction" Nothing $ do
   pl' <- liftIO pl
   onUnload $ withResource pl' HDBC.disconnect
   return $ HdbcSnaplet pl'
 
+-- | Get a new connection from the resource pool, apply the provided function
+-- to it and return the result in of the 'IO' compution in monad @m@.
 withHdbc :: HasHdbc m c => (c -> IO a) -> m a
 withHdbc f = do
   pl <- getPool
   withResource pl (\conn -> liftIO $ f conn)
 
+-- | 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'.
 withHdbc' :: HasHdbc m c => (c -> a) -> m a
 withHdbc' f = do
   pl <- getPool
   withResource pl (\conn -> return $ f conn)
 
-query :: HasHdbc m c
-      => String      {-^ The raw SQL to execute. Use @?@ to indicate
-                         placeholders. -}
-      -> [SqlValue]  {-^ Values for each placeholder according to its position
-                         in the SQL statement. -}
-      -> m [Row]     {-^ A 'Map' of attribute name to attribute value for each
-                         row. Can be the empty list. -}
+-- | Execute a @SELECT@ query on the database by passing the query as 'String',
+-- together with a list of values to bind to it. A list of 'Row's is returned.
+query
+  :: HasHdbc m c
+  => String      -- ^ The raw SQL to execute. Use @?@ to indicate placeholders.
+  -> [SqlValue]  -- ^ Values for each placeholder according to its position in
+                 --   the SQL statement.
+  -> m [Row]     -- ^ A 'Map' of attribute name to attribute value for each
+                 --   row. Can be the empty list.
 query sql bind = do
   stmt <- prepare sql
   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
+-- for @INSERT@, @UPDATE@ and @DELETE@ queries.
 query' :: HasHdbc m conn => String -> [SqlValue] -> m Integer
 query' sql bind = withTransaction' $ do
   stmt <- prepare sql
   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.
+--
+-- > withTransaction' $ \conn -> do ...
+--
 withTransaction :: HasHdbc m c => (c -> IO a) -> m a
 withTransaction f = withHdbc (`HDBC.withTransaction` f)
 
-{-| Run an action inside a transaction. If the action throws an exception, the
-transaction will be rolled back, and the exception rethrown.
-
-> withTransaction' $ do
->   query "INSERT INTO ..." []
->   query "DELETE FROM ..." []
-
--}
+-- | Run an action inside a transaction. If the action throws an exception, the
+-- transaction will be rolled back, and the exception rethrown.
+--
+-- > withTransaction' $ do
+-- >   query "INSERT INTO ..." []
+-- >   query "DELETE FROM ..." []
+--
 withTransaction' :: HasHdbc m c => m a -> m a
 withTransaction' action = do
   r <- onException action doRollback
   commit
   return r
   where doRollback = catch rollback doRollbackHandler
-        doRollbackHandler :: MonadCatchIO m => SomeException -> m ()
+        doRollbackHandler :: MonadControlIO m => SomeException -> m ()
         doRollbackHandler _ = return ()
 
+-- | The functions provided below are wrappers around the original HDBC
+-- functions. Please refer to the HDBC documentation to see what they do and
+-- how they work.
+
 disconnect :: HasHdbc m c => m ()
 disconnect = withHdbc HDBC.disconnect