packages feed

snaplet-postgresql-simple 1.0.2.0 → 1.1.0.0

raw patch · 6 files changed

+283/−134 lines, 6 filesdep +aesondep +heistdep +snap-coredep ~basedep ~bytestringdep ~lensnew-component:exe:Example

Dependencies added: aeson, heist, snap-core, snaplet-postgresql-simple, time, xmlhtml

Dependency ranges changed: base, bytestring, lens, mtl, postgresql-simple, snap, text

Files

+ example/Site.hs view
@@ -0,0 +1,88 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE LambdaCase        #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards   #-}+{-# LANGUAGE TemplateHaskell   #-}++module Main where++------------------------------------------------------------------------------+import           Control.Applicative+import           Control.Monad.Trans+import           Control.Monad.Reader+import           Control.Monad.State+import           Data.ByteString (ByteString)+import           Control.Lens+import           Data.Maybe+import qualified Data.Text as T+import qualified Data.Text.Encoding as T+import           Data.Time.Clock+import qualified Database.PostgreSQL.Simple as P+import           Snap+import           Snap.Snaplet.Auth+import           Snap.Snaplet.Auth.Backends.PostgresqlSimple+import           Snap.Snaplet.Heist+import           Snap.Snaplet.PostgresqlSimple+import           Snap.Snaplet.Session+import           Snap.Snaplet.Session.Backends.CookieSession+import           Snap.Util.FileServe+import           Heist+import           Text.XmlHtml hiding (render)+++------------------------------------------------------------------------------+data App = App+    { _sess :: Snaplet SessionManager+    , _db :: Snaplet Postgres+    , _auth :: Snaplet (AuthManager App)+    }++makeLenses ''App++instance HasPostgres (Handler b App) where+    getPostgresState = with db get+    setLocalPostgresState s = local (set (db . snapletValue) s)++------------------------------------------------------------------------------+-- | The application's routes.+routes :: [(ByteString, Handler App App ())]+routes = [ ("/",            writeText "hello")+         , ("foo", fooHandler)+         , ("add/:uname", addHandler)+         , ("find/:email", findHandler)+         ]++fooHandler = do+    results <- query_ "select * from snap_auth_user"+    liftIO $ print (results :: [AuthUser])++addHandler = do+    mname <- getParam "uname"+    email <- getParam "email"+    let name = maybe "guest" T.decodeUtf8 mname+    u <- with auth $ do+        createUser name "" >>= \u -> case u of+            Left _   -> return u+            Right u' -> saveUser (u' {userEmail = T.decodeUtf8 <$> email})+    liftIO $ print u++findHandler = do+    email <- getParam "email"+    env <- with auth get+    liftIO $ lookupByEmail env (maybe "" T.decodeUtf8 email) >>= print++------------------------------------------------------------------------------+-- | The application initializer.+app :: SnapletInit App App+app = makeSnaplet "app" "An snaplet example application." Nothing $ do+    s <- nestSnaplet "" sess $+         initCookieSessionManager "site_key.txt" "_cookie" Nothing Nothing+    d <- nestSnaplet "db" db pgsInit+    a <- nestSnaplet "auth" auth $ initPostgresAuth sess d+    addRoutes routes+    return $ App s d a+++main :: IO ()+main = serveSnaplet defaultConfig app+
resources/db/devel.cfg view
@@ -4,7 +4,7 @@ pass = "" db = "testdb" -# Nmuber of distinct connection pools to maintain.  The smallest acceptable+# Number of distinct connection pools to maintain.  The smallest acceptable # value is 1. numStripes = 1 
snaplet-postgresql-simple.cabal view
@@ -1,5 +1,5 @@ name:           snaplet-postgresql-simple-version:        1.0.2.0+version:        1.1.0.0 synopsis:       postgresql-simple snaplet for the Snap Framework description:    This snaplet contains support for using the Postgresql                 database with a Snap Framework application via the@@ -10,11 +10,17 @@ author:         Doug Beardsley maintainer:     mightybyte@gmail.com build-type:     Simple-tested-with:    GHC == 7.4.2, GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.1, GHC == 7.10.2-cabal-version:  >= 1.6+cabal-version:  >= 1.10 homepage:       https://github.com/mightybyte/snaplet-postgresql-simple category:       Web, Snap +tested-with:+  GHC == 7.8.4,+  GHC == 7.10.3,+  GHC == 8.0.1,+  GHC == 8.2.1,+  GHC == 8.4.1+ extra-source-files:   LICENSE   README.md@@ -27,6 +33,11 @@   type:     git   location: https://github.com/mightybyte/snaplet-postgresql-simple.git ++flag Example+  description: Enable example+  default: False+ Library   hs-source-dirs: src @@ -39,17 +50,17 @@     Paths_snaplet_postgresql_simple    build-depends:-    base                       >= 4       && < 4.10,+    base                       >= 4       && < 4.12,     bytestring                 >= 0.9.1   && < 0.11,     clientsession              >= 0.7.2   && < 0.10,     configurator               >= 0.2     && < 0.4,-    lens                       >= 3.7.6   && < 4.16,+    lens                       >= 3.7.6   && < 4.17,     lifted-base                >= 0.2     && < 0.3,     monad-control              >= 1.0     && < 1.1,     mtl                        >= 2       && < 2.3,     postgresql-simple          >= 0.3     && < 0.6,     resource-pool              >= 0.2     && < 0.3,-    snap                       >= 1.0     && < 1.1,+    snap                       >= 1.0     && < 1.2,     text                       >= 0.11    && < 1.3,     transformers               >= 0.2     && < 0.6,     transformers-base          >= 0.4     && < 0.5,@@ -58,3 +69,27 @@    ghc-options: -Wall -fwarn-tabs -funbox-strict-fields                -fno-warn-orphans -fno-warn-unused-do-bind++  default-language: Haskell2010++executable Example+  if flag(Example)+    buildable: True+  else+    buildable: False+  build-depends: base,+                 aeson,+                 bytestring,+                 heist,+                 lens,+                 postgresql-simple,+                 mtl,+                 snap,+                 snap-core,+                 snaplet-postgresql-simple,+                 text,+                 time,+                 xmlhtml+  default-language:    Haskell2010+  hs-source-dirs: example+  main-is: Site.hs
src/Snap/Snaplet/Auth/Backends/PostgresqlSimple.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE BangPatterns      #-}+{-# LANGUAGE CPP               #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards   #-} @@ -17,7 +18,7 @@ >     { ... -- your own application state here >     , _sess :: Snaplet SessionManager >     , _db   :: Snaplet Postgres->     , _auth :: Snaplet (AuthManager App)+>     , _auth :: Snaplet (A.AuthManager App) >     }  Then in your initializer you'll have something like this:@@ -35,36 +36,41 @@   ) where  -------------------------------------------------------------------------------import           Prelude import           Control.Applicative-import qualified Control.Exception as E-import           Control.Lens-import           Control.Monad-import           Control.Monad.Trans-import qualified Data.Configurator as C-import qualified Data.HashMap.Lazy as HM-import           Data.Maybe-import qualified Data.Text as T-import           Data.Text (Text)-import qualified Data.Text.Encoding as T-import qualified Database.PostgreSQL.Simple as P-import qualified Database.PostgreSQL.Simple.ToField as P-import           Database.PostgreSQL.Simple.FromField-import           Database.PostgreSQL.Simple.FromRow-import           Database.PostgreSQL.Simple.Types-import           Snap-import           Snap.Snaplet.Auth-import           Snap.Snaplet.PostgresqlSimple-import           Snap.Snaplet.PostgresqlSimple.Internal-import           Snap.Snaplet.Session-import           Web.ClientSession+import qualified Control.Exception                      as E+import           Control.Lens                           ((^#))+import           Control.Monad                          (liftM, void, when)+import           Control.Monad.Trans                    (liftIO)+import qualified Data.Configurator                      as C+import qualified Data.HashMap.Lazy                      as HM+import           Data.Maybe                             (fromMaybe, listToMaybe)+import           Data.Text                              (Text)+import qualified Data.Text                              as T+import qualified Data.Text.Encoding                     as T+import qualified Database.PostgreSQL.Simple             as P+import           Database.PostgreSQL.Simple.FromField   (FromField, fromField)+import qualified Database.PostgreSQL.Simple.ToField     as P+import           Database.PostgreSQL.Simple.Types       (Query (Query)) import           Paths_snaplet_postgresql_simple+import           Prelude+import           Snap                                   (Snaplet, SnapletInit,+                                                         SnapletLens,+                                                         getSnapletUserConfig,+                                                         makeSnaplet,+                                                         snapletValue)+import qualified Snap.Snaplet.Auth                      as A+import           Snap.Snaplet.PostgresqlSimple          (FromRow, Only, ToRow,+                                                         field, fromRow)+import           Snap.Snaplet.PostgresqlSimple.Internal (Postgres,+                                                         withConnection)+import           Snap.Snaplet.Session                   (SessionManager, mkRNG)+import           Web.ClientSession                      (getKey) ------------------------------------------------------------------------------   data PostgresAuthManager = PostgresAuthManager-    { pamTable    :: AuthTable-    , pamConn     :: Postgres+    { pamTable :: AuthTable+    , pamConn  :: Postgres     }  @@ -74,26 +80,26 @@ initPostgresAuth   :: SnapletLens b SessionManager  -- ^ Lens to the session snaplet   -> Snaplet Postgres  -- ^ The postgres snaplet-  -> SnapletInit b (AuthManager b)+  -> SnapletInit b (A.AuthManager b) initPostgresAuth sess db = makeSnaplet "postgresql-auth" desc datadir $ do     config <- getSnapletUserConfig     authTable <- liftIO $ C.lookupDefault "snap_auth_user" config "authTable"-    authSettings <- authSettingsFromConfig-    key <- liftIO $ getKey (asSiteKey authSettings)+    authSettings <- A.authSettingsFromConfig+    key <- liftIO $ getKey (A.asSiteKey authSettings)     let tableDesc = defAuthTable { tblName = authTable }     let manager = PostgresAuthManager tableDesc $ db ^# snapletValue     liftIO $ createTableIfMissing manager     rng <- liftIO mkRNG-    return AuthManager+    return A.AuthManager       { backend = manager       , session = sess       , activeUser = Nothing-      , minPasswdLen = asMinPasswdLen authSettings-      , rememberCookieName = asRememberCookieName authSettings+      , minPasswdLen = A.asMinPasswdLen authSettings+      , rememberCookieName = A.asRememberCookieName authSettings       , rememberCookieDomain = Nothing-      , rememberPeriod = asRememberPeriod authSettings+      , rememberPeriod = A.asRememberPeriod authSettings       , siteKey = key-      , lockout = asLockout authSettings+      , lockout = A.asLockout authSettings       , randomNumberGenerator = rng       }   where@@ -119,22 +125,25 @@           , tblName pamTable           , "\" ("           , T.intercalate "," (map (fDesc . ($pamTable) . fst) colDef)-          , ")"+          , "); "+          , "CREATE INDEX email_idx ON \""+          , tblName pamTable+          , "\" (email);"           ] -buildUid :: Int -> UserId-buildUid = UserId . T.pack . show+buildUid :: Int -> A.UserId+buildUid = A.UserId . T.pack . show  -instance FromField UserId where+instance FromField A.UserId where     fromField f v = buildUid <$> fromField f v -instance FromField Password where-    fromField f v = Encrypted <$> fromField f v+instance FromField A.Password where+    fromField f v = A.Encrypted <$> fromField f v -instance FromRow AuthUser where+instance FromRow A.AuthUser where     fromRow =-        AuthUser+        A.AuthUser         <$> _userId         <*> _userLogin         <*> _userEmail@@ -189,9 +198,9 @@     withConnection pc $ \conn -> P.execute conn q ps     return () -instance P.ToField Password where-    toField (ClearText bs) = P.toField bs-    toField (Encrypted bs) = P.toField bs+instance P.ToField A.Password where+    toField (A.ClearText bs) = P.toField bs+    toField (A.Encrypted bs) = P.toField bs   -- | Datatype containing the names of the columns for the authentication table.@@ -250,30 +259,30 @@  -- | List of deconstructors so it's easier to extract column names from an -- 'AuthTable'.-colDef :: [(AuthTable -> (Text, Text), AuthUser -> P.Action)]+colDef :: [(AuthTable -> (Text, Text), A.AuthUser -> P.Action)] colDef =-  [ (colId              , P.toField . fmap unUid . userId)-  , (colLogin           , P.toField . userLogin)-  , (colEmail           , P.toField . userEmail)-  , (colPassword        , P.toField . userPassword)-  , (colActivatedAt     , P.toField . userActivatedAt)-  , (colSuspendedAt     , P.toField . userSuspendedAt)-  , (colRememberToken   , P.toField . userRememberToken)-  , (colLoginCount      , P.toField . userLoginCount)-  , (colFailedLoginCount, P.toField . userFailedLoginCount)-  , (colLockedOutUntil  , P.toField . userLockedOutUntil)-  , (colCurrentLoginAt  , P.toField . userCurrentLoginAt)-  , (colLastLoginAt     , P.toField . userLastLoginAt)-  , (colCurrentLoginIp  , P.toField . userCurrentLoginIp)-  , (colLastLoginIp     , P.toField . userLastLoginIp)-  , (colCreatedAt       , P.toField . userCreatedAt)-  , (colUpdatedAt       , P.toField . userUpdatedAt)-  , (colResetToken      , P.toField . userResetToken)-  , (colResetRequestedAt, P.toField . userResetRequestedAt)+  [ (colId              , P.toField . fmap A.unUid . A.userId)+  , (colLogin           , P.toField . A.userLogin)+  , (colEmail           , P.toField . A.userEmail)+  , (colPassword        , P.toField . A.userPassword)+  , (colActivatedAt     , P.toField . A.userActivatedAt)+  , (colSuspendedAt     , P.toField . A.userSuspendedAt)+  , (colRememberToken   , P.toField . A.userRememberToken)+  , (colLoginCount      , P.toField . A.userLoginCount)+  , (colFailedLoginCount, P.toField . A.userFailedLoginCount)+  , (colLockedOutUntil  , P.toField . A.userLockedOutUntil)+  , (colCurrentLoginAt  , P.toField . A.userCurrentLoginAt)+  , (colLastLoginAt     , P.toField . A.userLastLoginAt)+  , (colCurrentLoginIp  , P.toField . A.userCurrentLoginIp)+  , (colLastLoginIp     , P.toField . A.userLastLoginIp)+  , (colCreatedAt       , P.toField . A.userCreatedAt)+  , (colUpdatedAt       , P.toField . A.userUpdatedAt)+  , (colResetToken      , P.toField . A.userResetToken)+  , (colResetRequestedAt, P.toField . A.userResetRequestedAt)   ] -saveQuery :: AuthTable -> AuthUser -> (Text, [P.Action])-saveQuery atable u@AuthUser{..} = maybe insertQuery updateQuery userId+saveQuery :: AuthTable -> A.AuthUser -> (Text, [P.Action])+saveQuery atable u@A.AuthUser{..} = maybe insertQuery updateQuery userId   where     insertQuery =  (T.concat [ "INSERT INTO "                              , tblName atable@@ -296,19 +305,19 @@                   , " = ? RETURNING "                   , T.intercalate "," (map (fst . ($atable) . fst) colDef)                   ]-        , params ++ [P.toField $ unUid uid])+        , params ++ [P.toField $ A.unUid uid])     cols = map (fst . ($atable) . fst) $ tail colDef     vals = map (const "?") cols     params = map (($u) . snd) $ tail colDef  -onFailure :: Monad m => E.SomeException -> m (Either AuthFailure a)-onFailure e = return $ Left $ AuthError $ show e+onFailure :: Monad m => E.SomeException -> m (Either A.AuthFailure a)+onFailure e = return $ Left $ A.AuthError $ show e  ------------------------------------------------------------------------------ -- |-instance IAuthBackend PostgresAuthManager where-    save PostgresAuthManager{..} u@AuthUser{..} = do+instance A.IAuthBackend PostgresAuthManager where+    save PostgresAuthManager{..} u@A.AuthUser{..} = do         let (qstr, params) = saveQuery pamTable u         let q = Query $ T.encodeUtf8 qstr         let action = withConnection pamConn $ \conn -> do@@ -325,7 +334,7 @@                 , fst (colId pamTable)                 , " = ?"                 ]-        querySingle pamConn q [unUid uid]+        querySingle pamConn q [A.unUid uid]       where cols = map (fst . ($pamTable) . fst) colDef      lookupByLogin PostgresAuthManager{..} login = do@@ -339,6 +348,19 @@         querySingle pamConn q [login]       where cols = map (fst . ($pamTable) . fst) colDef +#if MIN_VERSION_snap(1,1,0)+    lookupByEmail PostgresAuthManager{..} email = do+        let q = Query $ T.encodeUtf8 $ T.concat+                [ "select ", T.intercalate "," cols, " from "+                , tblName pamTable+                , " where "+                , fst (colEmail pamTable)+                , " = ?"+                ]+        querySingle pamConn q [email]+      where cols = map (fst . ($pamTable) . fst) colDef+#endif+     lookupByRememberToken PostgresAuthManager{..} token = do         let q = Query $ T.encodeUtf8 $ T.concat                 [ "select ", T.intercalate "," cols, " from "@@ -350,7 +372,7 @@         querySingle pamConn q [token]       where cols = map (fst . ($pamTable) . fst) colDef -    destroy PostgresAuthManager{..} AuthUser{..} = do+    destroy PostgresAuthManager{..} A.AuthUser{..} = do         let q = Query $ T.encodeUtf8 $ T.concat                 [ "delete from "                 , tblName pamTable
src/Snap/Snaplet/PostgresqlSimple.hs view
@@ -1,6 +1,6 @@-{-# LANGUAGE OverloadedStrings   #-} {-# LANGUAGE FlexibleContexts    #-} {-# LANGUAGE FlexibleInstances   #-}+{-# LANGUAGE OverloadedStrings   #-} {-# LANGUAGE RecordWildCards     #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ViewPatterns        #-}@@ -130,38 +130,41 @@    ) where -import           Prelude hiding ((++)) import           Control.Applicative-import qualified Control.Exception as E-import           Control.Lens-import           Control.Monad.IO.Class-import           Control.Monad.State-import           Control.Monad.Reader-import           Control.Monad.Trans.Control (MonadBaseControl(..))-import           Data.ByteString (ByteString)-import           Data.Monoid(Monoid(..), (<>))-import qualified Data.Configurator as C-import qualified Data.Configurator.Types as C-import qualified Data.Text as T-import qualified Data.Text.Encoding as T-import qualified Data.Text.Lazy as TL-import qualified Data.Text.Lazy.Builder as TB-import qualified Data.Text.Lazy.Builder.Int as TB-import qualified Data.Text.Lazy.Builder.RealFloat as TB-import           Data.Int-import           Data.Ratio-import           Data.Pool-import           Database.PostgreSQL.Simple.ToRow+import qualified Control.Exception                      as E+import           Control.Lens                           (set, (^#))+import           Control.Monad                          (liftM)+import           Control.Monad.IO.Class                 (MonadIO, liftIO)+import           Control.Monad.Reader                   (ReaderT, ask, asks,+                                                         local)+import           Control.Monad.State                    (get)+import           Control.Monad.Trans.Control            (MonadBaseControl,+                                                         liftBaseWith, restoreM)+import           Data.ByteString                        (ByteString)+import qualified Data.Configurator                      as C+import qualified Data.Configurator.Types                as C+import           Data.Int                               (Int64)+import           Data.Monoid                            (Monoid (..), (<>))+import           Data.Pool                              (createPool)+import           Data.Ratio                             (denominator, numerator)+import qualified Data.Text                              as T+import qualified Data.Text.Encoding                     as T+import qualified Data.Text.Lazy                         as TL+import qualified Data.Text.Lazy.Builder                 as TB+import qualified Data.Text.Lazy.Builder.Int             as TB+import qualified Data.Text.Lazy.Builder.RealFloat       as TB+import qualified Database.PostgreSQL.Simple             as P import           Database.PostgreSQL.Simple.FromRow-import qualified Database.PostgreSQL.Simple as P+import           Database.PostgreSQL.Simple.ToRow import qualified Database.PostgreSQL.Simple.Transaction as P-import           Snap-import           Snap.Snaplet.PostgresqlSimple.Internal import           Paths_snaplet_postgresql_simple+import           Prelude                                hiding ((++))+import qualified Snap                                   as Snap+import           Snap.Snaplet.PostgresqlSimple.Internal  ------------------------------------------------------------------------------ -- | Default instance-instance HasPostgres (Handler b Postgres) where+instance HasPostgres (Snap.Handler b Postgres) where     getPostgresState = get     setLocalPostgresState s = local (const s) @@ -173,9 +176,9 @@ -- > d <- nestSnaplet "db" db pgsInit -- > count <- liftIO $ runReaderT (execute "INSERT ..." params) d instance {-# OVERLAPPING #-} (MonadIO m, MonadBaseControl IO m)-  => HasPostgres (ReaderT (Snaplet Postgres) m) where-    getPostgresState = asks (^# snapletValue)-    setLocalPostgresState s = local (set snapletValue s)+  => HasPostgres (ReaderT (Snap.Snaplet Postgres) m) where+    getPostgresState = asks (^# Snap.snapletValue)+    setLocalPostgresState s = local (set Snap.snapletValue s)  ------------------------------------------------------------------------------ -- | A convenience instance to make it easier to use functions written for@@ -258,8 +261,8 @@         loop (T.break escapeNeeded -> (a,b))           = TB.fromText a <>               case T.uncons b of-                Nothing      ->  qt-                Just (c,b')  ->  escapeChar c <> loop b'+                Nothing     ->  qt+                Just (c,b') ->  escapeChar c <> loop b'      escapeNeeded c = c == '\'' || c == '\\' @@ -279,16 +282,16 @@  ------------------------------------------------------------------------------ -- | Initialize the snaplet-pgsInit :: SnapletInit b Postgres-pgsInit = makeSnaplet "postgresql-simple" description datadir $ do-    config <- mkPGSConfig =<< getSnapletUserConfig+pgsInit :: Snap.SnapletInit b Postgres+pgsInit = Snap.makeSnaplet "postgresql-simple" description datadir $ do+    config <- mkPGSConfig =<< Snap.getSnapletUserConfig     initHelper config   ------------------------------------------------------------------------------ -- | Initialize the snaplet using a specific configuration.-pgsInit' :: PGSConfig -> SnapletInit b Postgres-pgsInit' config = makeSnaplet "postgresql-simple" description Nothing $+pgsInit' :: PGSConfig -> Snap.SnapletInit b Postgres+pgsInit' config = Snap.makeSnaplet "postgresql-simple" description Nothing $     initHelper config  
src/Snap/Snaplet/PostgresqlSimple/Internal.hs view
@@ -1,27 +1,28 @@-{-# LANGUAGE OverloadedStrings   #-} {-# LANGUAGE FlexibleContexts    #-} {-# LANGUAGE FlexibleInstances   #-}+{-# LANGUAGE OverloadedStrings   #-} {-# LANGUAGE ScopedTypeVariables #-}  module Snap.Snaplet.PostgresqlSimple.Internal where -import           Control.Monad.IO.Class-import           Control.Monad.Trans-import           Control.Monad.Trans.Control (MonadBaseControl(..), control)-import           Control.Monad.Trans.Identity-import           Control.Monad.Trans.List-import           Control.Monad.Trans.Maybe-import           Control.Monad.Trans.Reader-import qualified Control.Monad.Trans.RWS.Lazy as LRWS-import qualified Control.Monad.Trans.RWS.Strict as SRWS-import qualified Control.Monad.Trans.State.Lazy as LS-import qualified Control.Monad.Trans.State.Strict as SS-import qualified Control.Monad.Trans.Writer.Lazy as LW+import           Control.Monad.IO.Class            (MonadIO, liftIO)+import           Control.Monad.Trans               (lift)+import           Control.Monad.Trans.Control       (MonadBaseControl (..),+                                                    control)+import           Control.Monad.Trans.Identity      (IdentityT (IdentityT))+import           Control.Monad.Trans.List          (ListT (ListT))+import           Control.Monad.Trans.Maybe         (MaybeT (MaybeT))+import           Control.Monad.Trans.Reader        (ReaderT (ReaderT))+import qualified Control.Monad.Trans.RWS.Lazy      as LRWS+import qualified Control.Monad.Trans.RWS.Strict    as SRWS+import qualified Control.Monad.Trans.State.Lazy    as LS+import qualified Control.Monad.Trans.State.Strict  as SS+import qualified Control.Monad.Trans.Writer.Lazy   as LW import qualified Control.Monad.Trans.Writer.Strict as SW-import           Data.ByteString (ByteString)-import           Data.Monoid-import           Data.Pool-import qualified Database.PostgreSQL.Simple as P+import           Data.ByteString                   (ByteString)+import           Data.Monoid                       (Monoid)+import           Data.Pool                         (Pool, withResource)+import qualified Database.PostgreSQL.Simple        as P  ------------------------------------------------------------------------------ -- | The state for the postgresql-simple snaplet. To use it in your app@@ -134,7 +135,7 @@ -- action. Nested calls to withPG will only reserve one connection. For example, -- the following code calls withPG twice in a nested way yet only results in a single -- connection being reserved:--- +-- -- > myHandler = withPG $ do -- >    queryTheDatabase -- >    commonDatabaseMethod@@ -144,7 +145,7 @@ -- >    evenMoreDatabaseActions -- -- This is useful in a practical setting because you may often find yourself in a situation--- where you have common code (that requires a database connection) that you wish to call from +-- where you have common code (that requires a database connection) that you wish to call from -- other blocks of code that may require a database connection and you still want to make sure -- that you are only using one connection through all of your nested methods. withPG :: (HasPostgres m)