Permalink
Browse files

Add types and appease hlint.

  • Loading branch information...
1 parent f6068b4 commit afbd0d1430ba5941b665dc9a8f27b95e2e77daf0 External Reality committed Nov 6, 2011
Showing with 29 additions and 6 deletions.
  1. +7 −6 src/Snap/Snaplet/Sedna.hs
  2. +22 −0 src/Snap/Snaplet/Sedna/Types.hs
View
@@ -32,8 +32,8 @@ instance MonadControlIO (Handler b v) where
-------------------------------------------------------------------------------
-sednaInit :: ConnSrc s => (s SednaConnection) -> SnapletInit b (SednaSnaplet s)
-sednaInit src = makeSnaplet "sedna" "Sedna Database Connectivity" Nothing $ do
+sednaInit :: ConnSrc s => s SednaConnection -> SnapletInit b (SednaSnaplet s)
+sednaInit src = makeSnaplet "sedna" "Sedna Database Connectivity" Nothing $
return $ SednaSnaplet src
@@ -53,10 +53,11 @@ withSedna' f = do
-------------------------------------------------------------------------------
query :: HasSedna m s => Query -> m QueryResult
-query xQuery = do
- withSedna $ (\conn -> withTransaction conn (\conn' -> do
- sednaExecute conn' xQuery
- sednaGetResultString conn'))
+query xQuery =
+ withSedna (\conn -> withTransaction conn
+ (\conn' -> do
+ sednaExecute conn' xQuery
+ sednaGetResultString conn'))
-------------------------------------------------------------------------------
@@ -0,0 +1,22 @@
+module Snap.Snaplet.Sedna.Types where
+
+import Prelude hiding (catch)
+import Control.Monad.IO.Control
+import Control.Monad.State
+import Database.SednaTypes
+import Database.SednaBindings
+import Data.Pool
+
+class ConnSrc s where
+ withConn :: (MonadControlIO m) => s SednaConnection -> (SednaConnection -> m b) -> m b
+ closeConn :: (MonadControlIO m) => s SednaConnection -> SednaConnection -> m ()
+
+instance ConnSrc Pool where
+ withConn = withResource
+ closeConn _ _ = return ()
+
+instance ConnSrc IO where
+ withConn conn fn = do
+ conn' <- liftIO conn
+ fn conn'
+ closeConn _ = liftIO . sednaCloseConnection

0 comments on commit afbd0d1

Please sign in to comment.