Skip to content

Commit 0c73361

Browse files
norm2782norm2782
committed
Initial import
0 parents  commit 0c73361

File tree

6 files changed

+193
-0
lines changed

6 files changed

+193
-0
lines changed

‎.gitignore

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,2 @@
1+
.DS_Store
2+
dist/

‎LICENSE

Lines changed: 27 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,27 @@
1+
Copyright (c) 2009, Snap Framework authors (see CONTRIBUTORS)
2+
All rights reserved.
3+
4+
Redistribution and use in source and binary forms, with or without
5+
modification, are permitted provided that the following conditions are met:
6+
7+
Redistributions of source code must retain the above copyright notice, this
8+
list of conditions and the following disclaimer.
9+
10+
Redistributions in binary form must reproduce the above copyright notice, this
11+
list of conditions and the following disclaimer in the documentation and/or
12+
other materials provided with the distribution.
13+
14+
Neither the name of the Snap Framework authors nor the names of its
15+
contributors may be used to endorse or promote products derived from this
16+
software without specific prior written permission.
17+
18+
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
19+
ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
20+
WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
21+
DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
22+
FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
23+
DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
24+
SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
25+
CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
26+
OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
27+
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

‎README

Whitespace-only changes.

‎Setup.hs

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,3 @@
1+
import Distribution.Simple
2+
3+
main = defaultMain

‎snaplet-hdbc.cabal

Lines changed: 37 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,37 @@
1+
name: snaplet-hdbc
2+
version: 0.1.0
3+
synopsis: HDBC snaplet
4+
description: HDBC snaplet
5+
license: BSD3
6+
license-file: LICENSE
7+
author: Jurriën Stutterheim
8+
maintainer: [email protected]
9+
build-type: Simple
10+
cabal-version: >= 1.6
11+
homepage: http://norm2782.com/
12+
category: Web
13+
14+
extra-source-files: LICENSE
15+
16+
Library
17+
hs-source-dirs: src
18+
19+
exposed-modules:
20+
Snap.Snaplet.Hdbc
21+
22+
build-depends:
23+
base >= 4 && < 5,
24+
clientsession >= 0.4,
25+
containers >= 0.3,
26+
haskell98,
27+
HDBC >= 2.2,
28+
mtl > 2.0 && < 2.1,
29+
snap >= 0.6 && < 0.7,
30+
text >= 0.11
31+
32+
if impl(ghc >= 6.12.0)
33+
ghc-options: -Wall -fwarn-tabs -funbox-strict-fields -O2
34+
-fno-warn-orphans -fno-warn-unused-do-bind
35+
else
36+
ghc-options: -Wall -fwarn-tabs -funbox-strict-fields -O2
37+
-fno-warn-orphans

‎src/Snap/Snaplet/Hdbc.hs

Lines changed: 124 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,124 @@
1+
{-# LANGUAGE OverloadedStrings #-}
2+
{-# LANGUAGE FlexibleInstances #-}
3+
{-# LANGUAGE FlexibleContexts #-}
4+
{-# LANGUAGE ExistentialQuantification #-}
5+
6+
{-|
7+
8+
This module provides a very thin wrapper around HDBC
9+
-}
10+
module Snap.Snaplet.Hdbc where
11+
12+
import Database.HDBC (IConnection(), SqlValue, Statement, SqlColDesc)
13+
import qualified Database.HDBC as HDBC
14+
import Snap.Snaplet
15+
import Control.Monad.State
16+
17+
data HdbcSnaplet conn = IConnection conn => HdbcSnaplet {
18+
hdbcConn :: conn
19+
}
20+
21+
hdbcInit :: IConnection conn => conn -> SnapletInit b (HdbcSnaplet conn)
22+
hdbcInit conn = makeSnaplet "hdbc" "HDBC abstraction" Nothing $ do
23+
onUnload $ HDBC.disconnect conn
24+
return $ HdbcSnaplet conn
25+
26+
getConn :: IConnection conn => Handler b (HdbcSnaplet conn) conn
27+
getConn = gets hdbcConn
28+
29+
runUnit :: IConnection conn => (conn -> IO ())
30+
-> Handler b (HdbcSnaplet conn) ()
31+
runUnit f = do
32+
conn <- gets hdbcConn
33+
liftIO $ f conn
34+
35+
disconnect :: IConnection conn => Handler b (HdbcSnaplet conn) ()
36+
disconnect = runUnit HDBC.disconnect
37+
38+
commit :: IConnection conn => Handler b (HdbcSnaplet conn) ()
39+
commit = runUnit HDBC.commit
40+
41+
rollback :: IConnection conn => Handler b (HdbcSnaplet conn) ()
42+
rollback = runUnit HDBC.rollback
43+
44+
runRaw :: IConnection conn => String -> Handler b (HdbcSnaplet conn) ()
45+
runRaw str = do
46+
conn <- gets hdbcConn
47+
liftIO $ HDBC.runRaw conn str
48+
49+
run :: IConnection conn => String -> [SqlValue]
50+
-> Handler b (HdbcSnaplet conn) Integer
51+
run str vs = do
52+
conn <- gets hdbcConn
53+
liftIO $ HDBC.run conn str vs
54+
55+
prepare :: IConnection conn => String -> Handler b (HdbcSnaplet conn) Statement
56+
prepare str = do
57+
conn <- gets hdbcConn
58+
liftIO $ HDBC.prepare conn str
59+
60+
clone :: IConnection conn => Handler b (HdbcSnaplet conn) conn
61+
clone = do
62+
conn <- gets hdbcConn
63+
liftIO $ HDBC.clone conn
64+
65+
pureStr :: IConnection conn => (conn -> String)
66+
-> Handler b (HdbcSnaplet conn) String
67+
pureStr f = do
68+
conn <- gets hdbcConn
69+
return $ f conn
70+
71+
hdbcDriverName :: IConnection conn => Handler b (HdbcSnaplet conn) String
72+
hdbcDriverName = pureStr HDBC.hdbcDriverName
73+
74+
hdbcClientVer :: IConnection conn => Handler b (HdbcSnaplet conn) String
75+
hdbcClientVer = pureStr HDBC.hdbcClientVer
76+
77+
proxiedClientName :: IConnection conn => Handler b (HdbcSnaplet conn) String
78+
proxiedClientName = pureStr HDBC.proxiedClientName
79+
80+
proxiedClientVer :: IConnection conn => Handler b (HdbcSnaplet conn) String
81+
proxiedClientVer = pureStr HDBC.proxiedClientVer
82+
83+
dbServerVer :: IConnection conn => Handler b (HdbcSnaplet conn) String
84+
dbServerVer = pureStr HDBC.dbServerVer
85+
86+
dbTransactionSupport :: IConnection conn => Handler b (HdbcSnaplet conn) Bool
87+
dbTransactionSupport = do
88+
conn <- gets hdbcConn
89+
return $ HDBC.dbTransactionSupport conn
90+
91+
getTables :: IConnection conn => Handler b (HdbcSnaplet conn) [String]
92+
getTables = do
93+
conn <- gets hdbcConn
94+
liftIO $ HDBC.getTables conn
95+
96+
describeTable :: IConnection conn => String
97+
-> Handler b (HdbcSnaplet conn) [(String, SqlColDesc)]
98+
describeTable str = do
99+
conn <- gets hdbcConn
100+
liftIO $ HDBC.describeTable conn str
101+
102+
quickQuery' :: IConnection conn => String -> [SqlValue]
103+
-> Handler b (HdbcSnaplet conn) [[SqlValue]]
104+
quickQuery' str vs = do
105+
conn <- gets hdbcConn
106+
liftIO $ HDBC.quickQuery' conn str vs
107+
108+
quickQuery :: IConnection conn => String -> [SqlValue]
109+
-> Handler b (HdbcSnaplet conn) [[SqlValue]]
110+
quickQuery str vs = do
111+
conn <- gets hdbcConn
112+
liftIO $ HDBC.quickQuery conn str vs
113+
114+
sRun :: IConnection conn => String -> [Maybe String]
115+
-> Handler b (HdbcSnaplet conn) Integer
116+
sRun str mstrs = do
117+
conn <- gets hdbcConn
118+
liftIO $ HDBC.sRun conn str mstrs
119+
120+
withTransaction :: IConnection conn => (conn -> IO a) -> Handler b (HdbcSnaplet conn) a
121+
withTransaction f = do
122+
conn <- gets hdbcConn
123+
liftIO $ HDBC.withTransaction conn f
124+

0 commit comments

Comments
 (0)