snaplet-hasql (empty) → 0.0.1

raw patch · 4 files changed

+102/−0 lines, 4 filesdep +basedep +hasqldep +hasql-backendsetup-changed

Dependencies added: base, hasql, hasql-backend, lens, mtl, snap

Files

• LICENSE +20/−0
• Setup.hs +2/−0
• snaplet-hasql.cabal +21/−0
• src/Snap/Snaplet/Hasql.hs +59/−0

@@ -0,0 +1,20 @@+Copyright (c) 2015 Mike Ledger++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

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

@@ -0,0 +1,21 @@+name:                snaplet-hasql+version:             0.0.1+synopsis:            A Hasql snaplet+license:             MIT+license-file:        LICENSE+author:              Mike Ledger+maintainer:          eleventynine@gmail.com+category:            Web+build-type:          Simple+cabal-version:       >=1.10++library+  exposed-modules:     Snap.Snaplet.Hasql+  build-depends:       base >=4.7 && <4.8, +                       lens >=4.7 && <5.0, +                       mtl >=2.2 && <2.3, +                       hasql >=0.7 && <0.8, +                       hasql-backend >=0.4 && <0.5, +                       snap >=0.13 && <0.15+  hs-source-dirs:      src+  default-language:    Haskell2010

@@ -0,0 +1,59 @@+{-# LANGUAGE ExplicitNamespaces     #-}+{-# LANGUAGE FlexibleContexts       #-}+{-# LANGUAGE FlexibleInstances      #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE MultiParamTypeClasses  #-}+{-# LANGUAGE OverloadedStrings      #-}+module Snap.Snaplet.Hasql+  ( HasPool(..)+  , hasqlInit+  , session+  , session'+  , module H+  ) where+import           Control.Lens+import           Control.Monad.Reader+import           Hasql                as H hiding (session)+import qualified Hasql+import           Hasql.Backend        hiding (Tx)+import           Snap++class (Show (CxError db), Show (TxError db), CxTx db, Cx db) =>+      HasPool s db | s -> db where+  poolLens :: Lens' s (Pool db)++instance (Cx db, CxTx db, Show (CxError db), Show (TxError db)) =>+         HasPool (Pool db) db where+  poolLens = id++hasqlInit+  :: HasPool c db+  => CxSettings db+  -> PoolSettings+  -> SnapletInit c (Pool db)+hasqlInit cx p =+  makeSnaplet "hasql" "" Nothing $ do+    pool <- liftIO (acquirePool cx p)+    onUnload (releasePool pool)+    return pool++{-# INLINE session #-}+-- | Wrapper around 'session' that just calls 'fail' on failure, and+-- uses the available 'poolLens'. Most useful inside 'Handler`s.+session :: (HasPool v db, MonadReader v m) => Session db m r -> m r+session f = do+  db <- view poolLens+  r  <- Hasql.session db f+  case r of+    Right a -> return a+    Left er -> fail (show er)++{-# INLINE session' #-}+-- | Wrapper around 'session'.+session' :: (HasPool v db, MonadReader v m)+         => Session db m r+         -> m (Either (SessionError db) r)+session' f = do+  db <- view poolLens+  Hasql.session db f+