snaplet-postgresql-simple 0.6 → 0.6.0.1
raw patch · 4 files changed
+24/−21 lines, 4 filesdep ~basedep ~lensdep ~snap
Dependency ranges changed: base, lens, snap
Files
- snaplet-postgresql-simple.cabal +3/−3
- src/Snap/Snaplet/Auth/Backends/PostgresqlSimple.hs +15/−11
- src/Snap/Snaplet/PostgresqlSimple.hs +6/−5
- src/Snap/Snaplet/PostgresqlSimple/Internal.hs +0/−2
snaplet-postgresql-simple.cabal view
@@ -1,5 +1,5 @@ name: snaplet-postgresql-simple-version: 0.6+version: 0.6.0.1 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@@ -41,12 +41,12 @@ clientsession >= 0.7.2 && < 0.10, configurator >= 0.2 && < 0.4, errors >= 1.4 && < 1.5,- lens,+ lens < 4.9, MonadCatchIO-transformers >= 0.3 && < 0.4, mtl >= 2 && < 2.3, postgresql-simple >= 0.3 && < 0.5, resource-pool-catchio >= 0.2 && < 0.3,- snap >= 0.10 && < 0.14,+ snap >= 0.10 && < 0.15, text >= 0.11 && < 1.3, transformers >= 0.2 && < 0.5, unordered-containers >= 0.2 && < 0.3
src/Snap/Snaplet/Auth/Backends/PostgresqlSimple.hs view
@@ -36,8 +36,12 @@ ------------------------------------------------------------------------------ import Prelude+import Control.Applicative import Control.Error 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 qualified Data.Text as T@@ -80,7 +84,7 @@ let manager = PostgresAuthManager tableDesc $ db ^# snapletValue liftIO $ createTableIfMissing manager rng <- liftIO mkRNG- return $ AuthManager+ return AuthManager { backend = manager , session = sess , activeUser = Nothing@@ -105,7 +109,7 @@ "select relname from pg_class where relname='" `T.append` schemaless (tblName pamTable) `T.append` "'" when (null (res :: [Only T.Text])) $- P.execute_ conn (Query $ T.encodeUtf8 q) >> return ()+ void (P.execute_ conn (Query $ T.encodeUtf8 q)) return () where schemaless = T.reverse . T.takeWhile (/='.') . T.reverse@@ -113,7 +117,7 @@ [ "CREATE TABLE \"" , tblName pamTable , "\" ("- , T.intercalate "," (map (fDesc . ($pamTable) . (fst)) colDef)+ , T.intercalate "," (map (fDesc . ($pamTable) . fst) colDef) , ")" ] @@ -268,31 +272,31 @@ ] saveQuery :: AuthTable -> AuthUser -> (Text, [P.Action])-saveQuery at u@AuthUser{..} = maybe insertQuery updateQuery userId+saveQuery atable u@AuthUser{..} = maybe insertQuery updateQuery userId where insertQuery = (T.concat [ "INSERT INTO "- , tblName at+ , tblName atable , " (" , T.intercalate "," cols , ") VALUES (" , T.intercalate "," vals , ") RETURNING "- , T.intercalate "," (map (fst . ($at) . fst) colDef)+ , T.intercalate "," (map (fst . ($atable) . fst) colDef) ] , params)- qval f = fst (f at) `T.append` " = ?"+ qval f = fst (f atable) `T.append` " = ?" updateQuery uid = (T.concat [ "UPDATE "- , tblName at+ , tblName atable , " SET " , T.intercalate "," (map (qval . fst) $ tail colDef) , " WHERE "- , fst (colId at)+ , fst (colId atable) , " = ? RETURNING "- , T.intercalate "," (map (fst . ($at) . fst) colDef)+ , T.intercalate "," (map (fst . ($atable) . fst) colDef) ] , params ++ [P.toField $ unUid uid])- cols = map (fst . ($at) . fst) $ tail colDef+ cols = map (fst . ($atable) . fst) $ tail colDef vals = map (const "?") cols params = map (($u) . snd) $ tail colDef
src/Snap/Snaplet/PostgresqlSimple.hs view
@@ -39,6 +39,7 @@ > instance HasPostgres (Handler b App) where > getPostgresState = with db get+> setLocalPostgresState s = local (set (db . snapletValue) s) With this code, our postHandler example no longer requires the 'with' function: @@ -121,7 +122,7 @@ import Prelude hiding ((++)) import Control.Applicative-import Control.Lens (set)+import Control.Lens import Control.Monad.CatchIO (MonadCatchIO) import qualified Control.Monad.CatchIO as CIO import Control.Monad.IO.Class@@ -280,7 +281,7 @@ ------------------------------------------------------------------------------ -- | Initialize the snaplet using a specific configuration. pgsInit' :: PGSConfig -> SnapletInit b Postgres-pgsInit' config = makeSnaplet "postgresql-simple" description datadir $ do+pgsInit' config = makeSnaplet "postgresql-simple" description datadir $ initHelper config @@ -316,7 +317,7 @@ ------------------------------------------------------------------------------ -- | See 'P.query_' query_ :: (HasPostgres m, FromRow r) => P.Query -> m [r]-query_ q = liftPG (\c -> P.query_ c q)+query_ q = liftPG (`P.query_` q) ------------------------------------------------------------------------------@@ -401,7 +402,7 @@ -- | execute_ :: (HasPostgres m) => P.Query -> m Int64-execute_ template = liftPG (\c -> P.execute_ c template)+execute_ template = liftPG (`P.execute_` template) ------------------------------------------------------------------------------@@ -427,7 +428,7 @@ withTransactionMode mode act = withPG $ CIO.block $ do liftPG $ P.beginMode mode r <- CIO.unblock act `CIO.onException` liftPG P.rollback- liftPG $ P.commit+ liftPG P.commit return r formatMany :: (ToRow q, HasPostgres m)
src/Snap/Snaplet/PostgresqlSimple/Internal.hs view
@@ -1,9 +1,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE ViewPatterns #-} module Snap.Snaplet.PostgresqlSimple.Internal where