pgsql-simple (empty) → 0.1.1
raw patch · 12 files changed
+2152/−0 lines, 12 filesdep +MonadCatchIO-transformersdep +attoparsecdep +basesetup-changed
Dependencies added: MonadCatchIO-transformers, attoparsec, base, base16-bytestring, binary, blaze-builder, blaze-textual, bytestring, containers, mtl, network, old-locale, pcre-light, text, time, utf8-string
Files
- Database/PostgreSQL/Base.hs +580/−0
- Database/PostgreSQL/Base/Types.hs +135/−0
- Database/PostgreSQL/Simple.hs +530/−0
- Database/PostgreSQL/Simple/Param.hs +199/−0
- Database/PostgreSQL/Simple/QueryParams.hs +84/−0
- Database/PostgreSQL/Simple/QueryResults.hs +168/−0
- Database/PostgreSQL/Simple/Result.hs +241/−0
- Database/PostgreSQL/Simple/Types.hs +105/−0
- LICENSE +30/−0
- README.markdown +22/−0
- Setup.lhs +3/−0
- pgsql-simple.cabal +55/−0
+ Database/PostgreSQL/Base.hs view
@@ -0,0 +1,580 @@+{-# OPTIONS_GHC -Wall -fno-warn-name-shadowing #-}+{-# LANGUAGE RecordWildCards, OverloadedStrings, ScopedTypeVariables #-}+{-# LANGUAGE FlexibleContexts, ViewPatterns, NamedFieldPuns, TupleSections #-}++-- | A front-end implementation for the PostgreSQL database protocol+-- version 3.0 (implemented in PostgreSQL 7.4 and later).++module Database.PostgreSQL.Base+ (begin+ ,rollback+ ,commit+ ,query+ ,exec+ ,escapeBS+ ,connect+ ,defaultConnectInfo+ ,close+ ,withDB+ ,withTransaction+ ,newPool+ ,pconnect+ ,withPoolConnection)+ where++import Database.PostgreSQL.Base.Types++import Control.Concurrent+import Control.Monad+import Control.Monad.CatchIO (MonadCatchIO)+import qualified Control.Monad.CatchIO as E+import Control.Monad.Fix+import Control.Monad.State (MonadState,execStateT,modify)+import Control.Monad.Trans+import Data.Binary+import Data.Binary.Get+import Data.Binary.Put+import Data.ByteString (ByteString)+import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as L+import qualified Data.ByteString.Lazy.UTF8 as L (toString,fromString)+import Data.ByteString.UTF8 (toString,fromString)+import Data.Int+import Data.List+import Data.IntMap.Strict (IntMap)+import qualified Data.IntMap.Strict as IntMap+import Data.Maybe+import Data.Monoid+import Network+import Prelude+import System.IO hiding (hPutStr)++--------------------------------------------------------------------------------+-- Exported values++-- | Default information for setting up a connection.+--+-- Defaults are as follows:+--+-- * Server on @localhost@+--+-- * User @postgres@+--+-- * No password+--+-- * Database @test@+--+-- * Character set @utf8@+--+-- Use as in the following example:+--+-- > connect defaultConnectInfo { connectHost = "db.example.com" }+defaultConnectInfo :: ConnectInfo+defaultConnectInfo = ConnectInfo {+ connectHost = "127.0.0.1"+ , connectPort = 5432+ , connectUser = "postgres"+ , connectPassword = ""+ , connectDatabase = ""+ }++-- | Create a new connection pool.+newPool :: MonadIO m+ => ConnectInfo -- ^ Connect info.+ -> m Pool+newPool info = liftIO $ do+ var <- newMVar $ PoolState {+ poolConnections = []+ , poolConnectInfo = info+ }+ return $ Pool var++-- | Connect using the connection pool.+pconnect :: MonadIO m => Pool -> m Connection+pconnect (Pool var) = liftIO $ do+ modifyMVar var $ \state@PoolState{..} -> do+ case poolConnections of+ [] -> do conn <- connect poolConnectInfo+ return (state,conn)+ (conn:conns) -> return (state { poolConnections = conns },conn)++-- | Restore a connection to the pool.+restore :: MonadIO m => Pool -> Connection -> m ()+restore (Pool var) conn = liftIO $ do+ handle <- readMVar $ connectionHandle conn+ modifyMVar_ var $ \state -> do+ case handle of+ Nothing -> return state+ Just h -> do+ eof <- hIsOpen h+ if eof+ then return state { poolConnections = conn : poolConnections state }+ else return state++-- | Use the connection pool.+withPoolConnection+ :: (MonadCatchIO m,MonadIO m)+ => Pool -- ^ The connection pool.+ -> (Connection -> m a) -- ^ Use the connection.+ -> m ()+withPoolConnection pool m = do+ _ <- E.bracket (pconnect pool) (restore pool) m+ return ()++-- | Connect with the given username to the given database. Will throw+-- an exception if it cannot connect.+connect :: MonadIO m => ConnectInfo -> m Connection -- ^ The datase connection.+connect connectInfo@ConnectInfo{..} = liftIO $ withSocketsDo $ do+ var <- newEmptyMVar+ h <- connectTo connectHost (PortNumber $ fromIntegral connectPort)+ hSetBuffering h NoBuffering+ putMVar var $ Just h+ types <- newMVar IntMap.empty+ let conn = Connection var types+ authenticate conn connectInfo+ return conn++-- | Run a an action with a connection and close the connection+-- afterwards (protects against exceptions).+withDB :: (MonadCatchIO m,MonadIO m) => ConnectInfo -> (Connection -> m a) -> m a+withDB connectInfo m = E.bracket (liftIO $ connect connectInfo) (liftIO . close) m++-- | With a transaction, do some action (protects against exceptions).+withTransaction :: (MonadCatchIO m,MonadIO m) => Connection -> m a -> m a+withTransaction conn act = do+ begin conn+ r <- act `E.onException` rollback conn+ commit conn+ return r++-- | Rollback a transaction.+rollback :: (MonadCatchIO m,MonadIO m) => Connection -> m ()+rollback conn = do+ _ <- exec conn (fromString ("ABORT;" :: String))+ return ()++-- | Commit a transaction.+commit :: (MonadCatchIO m,MonadIO m) => Connection -> m ()+commit conn = do+ _ <- exec conn (fromString ("COMMIT;" :: String))+ return ()++-- | Begin a transaction.+begin :: (MonadCatchIO m,MonadIO m) => Connection -> m ()+begin conn = do+ _ <- exec conn (fromString ("BEGIN;" :: String))+ return ()++-- | Close a connection. Can safely be called any number of times.+close :: MonadIO m => Connection -- ^ The connection.+ -> m ()+close Connection{connectionHandle} = liftIO$ do+ modifyMVar_ connectionHandle $ \h -> do+ case h of+ Just h -> hClose h+ Nothing -> return ()+ return Nothing++-- | Run a simple query on a connection.+query :: (MonadCatchIO m)+ => Connection -- ^ The connection.+ -> ByteString -- ^ The query.+ -> m ([Field],[[Maybe ByteString]])+query conn sql = do+ result <- execQuery conn sql+ case result of+ (_,Just ok) -> return ok+ _ -> return ([],[])++-- | Run a simple query on a connection.+execQuery :: (MonadCatchIO m)+ => Connection -- ^ The connection.+ -> ByteString -- ^ The query.+ -> m (Integer,Maybe ([Field],[[Maybe ByteString]]))+execQuery conn sql = liftIO $ do+ withConnection conn $ \h -> do+ types <- readMVar $ connectionObjects conn+ Result{..} <- sendQuery types h sql+ case resultType of+ ErrorResponse -> E.throw $ QueryError (fmap L.toString resultError)+ EmptyQueryResponse -> E.throw QueryEmpty+ _ ->+ let tagCount = fromMaybe 0 resultTagRows+ in case resultDesc of+ Just fields -> return $ (tagCount,Just (fields,resultRows))+ Nothing -> return $ (tagCount,Nothing)++-- | Exec a command.+exec :: (MonadCatchIO m)+ => Connection+ -> ByteString+ -> m Integer+exec conn sql = do+ result <- execQuery conn sql+ case result of+ (ok,_) -> return ok++-- | PostgreSQL protocol version supported by this library. +protocolVersion :: Int32+protocolVersion = 196608++-- | Escape a string for PostgreSQL.+escape :: String -> String+escape ('\\':cs) = '\\' : '\\' : escape cs+escape ('\'':cs) = '\'' : '\'' : escape cs+escape (c:cs) = c : escape cs+escape [] = []++-- | Escape a string for PostgreSQL.+escapeBS :: ByteString -> ByteString+escapeBS = fromString . escape . toString++--------------------------------------------------------------------------------+-- Authentication++-- | Run the connectInfoentication procedure.+authenticate :: Connection -> ConnectInfo -> IO ()+authenticate conn@Connection{..} connectInfo = do+ withConnection conn $ \h -> do+ sendStartUp h connectInfo+ getConnectInfoResponse h connectInfo+ objects <- objectIds h+ modifyMVar_ connectionObjects (\_ -> return objects)++-- | Send the start-up message.+sendStartUp :: Handle -> ConnectInfo -> IO ()+sendStartUp h ConnectInfo{..} = do+ sendBlock h Nothing $ do+ int32 protocolVersion+ string (fromString "user") ; string (fromString connectUser)+ string (fromString "database") ; string (fromString connectDatabase)+ zero++-- | Wait for and process the connectInfoentication response from the server.+getConnectInfoResponse :: Handle -> ConnectInfo -> IO ()+getConnectInfoResponse h conninfo = do+ (typ,block) <- getMessage h+ -- TODO: Handle connectInfo failure. Handle information messages that are+ -- sent, maybe store in the connection value for later+ -- inspection.+ case typ of+ AuthenticationOk+ | param == 0 -> waitForReady h+ | param == 3 -> sendPassClearText h conninfo+-- | param == 5 -> sendPassMd5 h conninfo salt+ | otherwise -> E.throw $ UnsupportedAuthenticationMethod param (show block)+ where param = decode block :: Int32+ _salt = flip runGet block $ do+ _ <- getInt32+ getWord8+ + els -> E.throw $ AuthenticationFailed (show (els,block))++-- | Send the pass as clear text and wait for connect response.+sendPassClearText :: Handle -> ConnectInfo -> IO ()+sendPassClearText h conninfo@ConnectInfo{..} = do+ sendMessage h PasswordMessage $+ string (fromString connectPassword)+ getConnectInfoResponse h conninfo++-- -- | Send the pass as salted MD5 and wait for connect response.+-- sendPassMd5 :: Handle -> ConnectInfo -> Word8 -> IO ()+-- sendPassMd5 h conninfo@ConnectInfo{..} salt = do+-- -- TODO: Need md5 library with salt support.+-- sendMessage h PasswordMessage $+-- string (fromString connectPassword)+-- getConnectInfoResponse h conninfo++--------------------------------------------------------------------------------+-- Initialization++objectIds :: Handle -> IO (IntMap Type)+objectIds h = do+ Result{..} <- sendQuery IntMap.empty h q+ case resultType of+ ErrorResponse -> E.throw $ InitializationError "Couldn't get types."+ _ -> return $ IntMap.fromList $ catMaybes $ flip map resultRows $ \row ->+ case map toString $ catMaybes row of+ [typeName,readMay -> Just objId] -> do+ typ <- typeFromName typeName+ return (fromIntegral objId,typ)+ _ -> Nothing++ where q = fromString ("SELECT typname, oid FROM pg_type" :: String)++--------------------------------------------------------------------------------+-- Queries and commands++-- | Send a simple query.+sendQuery :: IntMap Type -> Handle -> ByteString -> IO Result+sendQuery types h sql = do+ sendMessage h Query $ string sql+ listener $ \continue -> do+ (typ,block) <- liftIO $ getMessage h+ let setStatus = modify $ \r -> r { resultType = typ }+ case typ of+ ReadyForQuery ->+ modify $ \r -> r { resultRows = reverse (resultRows r) }++ listenPassively -> do+ case listenPassively of+ EmptyQueryResponse -> setStatus+ CommandComplete -> do setStatus+ setCommandTag block+ ErrorResponse -> do+ modify $ \r -> r { resultError = Just block }+ setStatus+ RowDescription -> getRowDesc types block+ DataRow -> getDataRow block+ _ -> return ()++ continue++ where emptyResponse = Result [] Nothing Nothing [] UnknownMessageType Nothing+ listener m = execStateT (fix m) emptyResponse++-- | CommandComplete returns a ‘tag’ which indicates how many rows were+-- affected, or returned, as a result of the command.+-- See http://developer.postgresql.org/pgdocs/postgres/protocol-message-formats.html+setCommandTag :: MonadState Result m => L.ByteString -> m ()+setCommandTag block = do+ modify $ \r -> r { resultTagRows = rows }+ where rows =+ case tag block of+ ["INSERT",_oid,readMay -> Just rows] -> return rows+ [cmd,readMay -> Just rows] | cmd `elem` cmds -> return rows+ _ -> Nothing+ tag = words . concat . map toString . L.toChunks . runGet getString+ cmds = ["DELETE","UPDATE","SELECT","MOVE","FETCH"]++-- | Update the row description of the result.+getRowDesc :: MonadState Result m => IntMap Type -> L.ByteString -> m ()+getRowDesc types block =+ modify $ \r -> r {+ resultDesc = Just (parseFields types (runGet parseMsg block))+ }+ where parseMsg = do+ fieldCount :: Int16 <- getInt16+ forM [1..fieldCount] $ \_ -> do+ name <- getString+ objid <- getInt32+ colid <- getInt16+ dtype <- getInt32+ size <- getInt16+ modifier <- getInt32+ code <- getInt16+ return (name,objid,colid,dtype,size,modifier,code)++-- | Parse a row description.+--+-- Parts of the row description are:+--+-- String: The field name.+--+-- Int32: If the field can be identified as a column of a specific+-- table, the object ID of the table; otherwise zero.+--+-- Int16: If the field can be identified as a column of a specific+-- table, the attribute number of the column; otherwise zero.+----+-- Int32: The object ID of the field's data type.+----+-- Int16: The data type size (see pg_type.typlen). Note that negative+-- values denote variable-width types.+----+-- Int32: The type modifier (see pg_attribute.atttypmod). The meaning+-- of the modifier is type-specific.+--+-- Int16: The format code being used for the field. Currently will be+-- zero (text) or one (binary). In a RowDescription returned from the+-- statement variant of Describe, the format code is not yet known and+-- will always be zero.+--+parseFields :: IntMap Type+ -> [(L.ByteString,Int32,Int16,Int32,Int16,Int32,Int16)]+ -> [Field]+parseFields types = mapMaybe parse where+ parse (_fieldName+ ,_ -- parseObjId -> _objectId+ ,_ -- parseAttrId -> _attrId+ ,parseType types -> typ+ ,_ -- parseSize -> _typeSize+ ,_ -- parseModifier typ -> _typeModifier+ ,parseFormatCode -> formatCode)+ = Just $ Field {+ fieldType = typ+ , fieldFormatCode = formatCode+ }++-- These aren't used (yet).++-- -- | Parse an object ID. 0 means no object.+-- parseObjId :: Int32 -> Maybe ObjectId+-- parseObjId 0 = Nothing+-- parseObjId n = Just (ObjectId n)++-- -- | Parse an attribute ID. 0 means no object.+-- parseAttrId :: Int16 -> Maybe ObjectId+-- parseAttrId 0 = Nothing+-- parseAttrId n = Just (ObjectId $ fromIntegral n)++-- | Parse a number into a type.+parseType :: IntMap Type -> Int32 -> Type+parseType types objId =+ case IntMap.lookup (fromIntegral objId) types of+ Just typ -> typ+ _ -> error $ "parseType: Unknown type given by object-id: " ++ show objId++typeFromName :: String -> Maybe Type+typeFromName = flip lookup fieldTypes++fieldTypes :: [(String, Type)]+fieldTypes =+ [("bool",Boolean)+ ,("int2",Short)+ ,("integer",Long)+ ,("int",Long)+ ,("int4",Long)+ ,("int8",LongLong)+ ,("timestamptz",TimestampWithZone)+ ,("varchar",CharVarying)+ ,("text",Text)]++-- This isn't used yet.+-- | Parse a type's size.+-- parseSize :: Int16 -> Size+-- parseSize (-1) = Varying+-- parseSize n = Size n++-- This isn't used yet.+-- -- | Parse a type-specific modifier.+-- parseModifier :: Type -> Int32 -> Maybe Modifier+-- parseModifier _typ _modifier = Nothing++-- | Parse a format code (text or binary).+parseFormatCode :: Int16 -> FormatCode+parseFormatCode 1 = BinaryCode+parseFormatCode _ = TextCode++-- | Add a data row to the response.+getDataRow :: MonadState Result m => L.ByteString -> m ()+getDataRow block =+ modify $ \r -> r { resultRows = runGet parseMsg block : resultRows r }+ where parseMsg = do+ values :: Int16 <- getInt16+ forM [1..values] $ \_ -> do+ size <- getInt32+ if size == -1+ then return Nothing+ else do v <- getByteString (fromIntegral size)+ return (Just v)++-- TODO:+-- getNotice :: MonadState Result m => L.ByteString -> m ()+-- getNotice block =+-- return ()+-- modify $ \r -> r { responseNotices = runGet parseMsg block : responseNotices r }+-- where parseMsg = return ""++typeFromChar :: Char -> Maybe MessageType+typeFromChar c = lookup c types++charFromType :: MessageType -> Maybe Char+charFromType typ = fmap fst $ find ((==typ).snd) types++types :: [(Char, MessageType)]+types = [('C',CommandComplete)+ ,('T',RowDescription)+ ,('D',DataRow)+ ,('I',EmptyQueryResponse)+ ,('E',ErrorResponse)+ ,('Z',ReadyForQuery)+ ,('N',NoticeResponse)+ ,('R',AuthenticationOk)+ ,('Q',Query)+ ,('p',PasswordMessage)]++-- | Blocks until receives ReadyForQuery.+waitForReady :: Handle -> IO ()+waitForReady h = loop where+ loop = do+ (typ,block) <- getMessage h+ case typ of+ ErrorResponse -> E.throw $ GeneralError $ show block+ ReadyForQuery | decode block == 'I' -> return ()+ _ -> loop++--------------------------------------------------------------------------------+-- Connections++-- | Atomically perform an action with the database handle, if there is one.+withConnection :: Connection -> (Handle -> IO a) -> IO a+withConnection Connection{..} m = do+ withMVar connectionHandle $ \h -> do+ case h of+ Just h -> m h+ -- TODO: Use extensible exceptions.+ Nothing -> E.throw ConnectionLost++-- | Send a block of bytes on a handle, prepending the message type+-- and complete length.+sendMessage :: Handle -> MessageType -> Put -> IO ()+sendMessage h typ output =+ case charFromType typ of+ Just char -> sendBlock h (Just char) output+ Nothing -> error $ "sendMessage: Bad message type " ++ show typ++-- | Send a block of bytes on a handle, prepending the complete length.+sendBlock :: Handle -> Maybe Char -> Put -> IO ()+sendBlock h typ output = do+ L.hPutStr h bytes+ where bytes = start `mappend` out+ start = runPut $ do+ maybe (return ()) (put . toByte) typ+ int32 $ fromIntegral int32Size ++ fromIntegral (L.length out)+ out = runPut output+ toByte c = fromIntegral (fromEnum c) :: Word8++-- | Get a message (block) from the stream.+getMessage :: Handle -> IO (MessageType,L.ByteString)+getMessage h = do+ messageType <- L.hGet h 1+ blockLength <- L.hGet h int32Size+ let typ = decode messageType+ rest = fromIntegral (decode blockLength :: Int32) - int32Size+ block <- L.hGet h rest+ return (maybe UnknownMessageType id $ typeFromChar typ,block)++--------------------------------------------------------------------------------+-- Binary input/output++-- | Put a Haskell string, encoding it to UTF-8, and null-terminating it.+string :: B.ByteString -> Put+string s = do putByteString s; zero++-- | Put a Haskell 32-bit integer.+int32 :: Int32 -> Put+int32 = put++-- | Put zero-byte terminator.+zero :: Put+zero = put (0 :: Word8)++-- | To avoid magic numbers, size of a 32-bit integer in bytes.+int32Size :: Int+int32Size = 4++getInt16 :: Get Int16+getInt16 = get++getInt32 :: Get Int32+getInt32 = get++getString :: Get L.ByteString+getString = getLazyByteStringNul++readMay :: Read a => String -> Maybe a+readMay x = case reads x of+ [(v,"")] -> return v+ _ -> Nothing
+ Database/PostgreSQL/Base/Types.hs view
@@ -0,0 +1,135 @@+{-# OPTIONS -Wall #-}+{-# LANGUAGE DeriveDataTypeable #-}+module Database.PostgreSQL.Base.Types+ (ConnectInfo(..)+ ,Connection(..)+ ,Field(..)+ ,Result(..)+ ,Type(..)+ ,MessageType(..)+ ,Size(..)+ ,FormatCode(..)+ ,Modifier(..)+ ,ObjectId+ ,Pool(..)+ ,PoolState(..)+ ,ConnectionError(..))+ where++import Control.Concurrent.MVar (MVar)+import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as L+import Data.Int+import Data.Typeable+import Data.Word+import System.IO (Handle)+import Data.IntMap.Strict (IntMap)+import Control.Exception (Exception)++data ConnectionError =+ QueryError (Maybe String) -- ^ Query returned an error.+ | QueryEmpty -- ^ The query was empty.+ | AuthenticationFailed String -- ^ Connecting failed due to authentication problem.+ | InitializationError String -- ^ Initialization (e.g. getting data types) failed.+ | ConnectionLost -- ^ Connection was lost when using withConnection.+ | UnsupportedAuthenticationMethod Int32 String -- ^ Unsupported method of authentication (e.g. md5).+ | GeneralError String+ deriving (Typeable,Show)++instance Exception ConnectionError where++-- | Connection configuration.+data ConnectInfo = ConnectInfo {+ connectHost :: String+ , connectPort :: Word16+ , connectUser :: String+ , connectPassword :: String+ , connectDatabase :: String+ } deriving (Eq,Read,Show,Typeable)++-- | A database connection.+data Connection = Connection {+ connectionHandle :: MVar (Maybe Handle)+ , connectionObjects :: MVar (IntMap Type)+ }++-- | Result of a database query.+data Result =+ Result {+ resultRows :: [[Maybe B.ByteString]]+ ,resultDesc :: Maybe [Field]+ ,resultError :: Maybe L.ByteString+ ,resultNotices :: [String]+ ,resultType :: MessageType+ ,resultTagRows :: Maybe Integer+ } deriving Show++-- | An internal message type.+data MessageType =+ CommandComplete+ | RowDescription+ | DataRow+ | EmptyQueryResponse+ | ErrorResponse+ | ReadyForQuery+ | NoticeResponse+ | AuthenticationOk+ | Query+ | PasswordMessage+ | UnknownMessageType+ deriving (Show,Eq)++-- | A field description.+data Field = Field {+ fieldType :: Type+ ,fieldFormatCode :: FormatCode+ } deriving Show++data Type = + Short -- ^ 2 bytes, small-range integer+ | Long -- ^ 4 bytes, usual choice for integer+ | LongLong -- ^ 8 bytes large-range integer+ | Decimal -- ^ variable, user-specified precision, exact, no limit+ | Numeric -- ^ variable, user-specified precision, exact, no limit+ | Real -- ^ 4 bytes, variable-precision, inexact+ | DoublePrecision -- ^ 8 bytes, variable-precision, inexact++ | CharVarying -- ^ character varying(n), varchar(n), variable-length+ | Characters -- ^ character(n), char(n), fixed-length+ | Text -- ^ text, variable unlimited length+ -- + -- Lazy. Decoded from UTF-8 into Haskell native encoding.++ | Boolean -- ^ boolean, 1 byte, state of true or false++ | Timestamp -- ^ timestamp /without/ time zone+ -- + -- More information about PostgreSQL’s dates here:+ -- <http://www.postgresql.org/docs/current/static/datatype-datetime.html>+ | TimestampWithZone -- ^ timestamp /with/ time zone+ | Date -- ^ date, 4 bytes julian day+ | Time -- ^ 8 bytes, time of day (no date)++ deriving (Eq,Enum,Show)++-- | A field size.+data Size = Varying | Size Int16+ deriving (Eq,Ord,Show)++-- | A text format code. Will always be TextCode for DESCRIBE queries.+data FormatCode = TextCode | BinaryCode+ deriving (Eq,Ord,Show)++-- | A type-specific modifier.+data Modifier = Modifier++-- | A PostgreSQL object ID.+type ObjectId = Int++-- | A connection pool.+data PoolState = PoolState {+ poolConnections :: [Connection]+ , poolConnectInfo :: ConnectInfo+ }++newtype Pool = Pool { unPool :: MVar PoolState }
+ Database/PostgreSQL/Simple.hs view
@@ -0,0 +1,530 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE BangPatterns, DeriveDataTypeable, OverloadedStrings, DisambiguateRecordFields #-}++-- |+-- Module: Database.PostgreSQL.Simple+-- Copyright: (c) 2011 Chris Done, 2011 MailRank, Inc.+-- License: BSD3+-- Maintainer: Chris Done <chrisdone@gmail.com>+-- Stability: experimental+-- Portability: portable+--+-- A mid-level client library for the MySQL database, aimed at ease of+-- use and high performance.++module Database.PostgreSQL.Simple+ (+ -- * Writing queries+ -- $use++ -- ** The Query type+ -- $querytype++ -- ** Parameter substitution+ -- $subst++ -- *** Type inference+ -- $inference++ -- ** Substituting a single parameter+ -- $only_param++ -- ** Representing a list of values+ -- $in++ -- ** Modifying multiple rows at once+ -- $many++ -- * Extracting results+ -- $result++ -- ** Handling null values+ -- $null++ -- ** Type conversions+ -- $types++ -- * Types+ ConnectInfo(..)+ , Connection+ , Query+ , In(..)+ , Binary(..)+ , Only(..)+ , ProcessedQuery+ , Pool+ -- ** Exceptions+ , FormatError(fmtMessage, fmtQuery, fmtParams)+ , QueryError(qeMessage, qeQuery)+ , ResultError(errSQLType, errHaskellType, errMessage)+ -- * Connection management+ , Base.connect+ , Base.defaultConnectInfo+ , Base.close+ -- * Queries that return results+ , query+ , query_+ , processQuery+ , queryProcessed+ -- * Queries that stream results+ -- , fold+ -- , fold_+ -- , forEach+ -- , forEach_+ -- * Statements that do not return results+ , execute+ , execute_+ , executeMany+ -- * Transaction handling+ , withTransaction+ , Base.commit+ , Base.rollback+ -- * Helper functions+ , formatMany+ , formatQuery+ , withPoolConnection+ , newPool+ ) where++import Blaze.ByteString.Builder (Builder, fromByteString, toByteString)+import Blaze.ByteString.Builder.Char8 (fromChar)+import Control.Applicative ((<$>), pure)+import Control.Exception (Exception, throw)+import Control.Monad (forM)+import Data.ByteString (ByteString)+import Data.List (intersperse)+import Data.Monoid (mappend, mconcat)+import Data.Typeable (Typeable)+import Database.PostgreSQL.Base.Types (ConnectInfo(..),Connection(..),Pool)+import Database.PostgreSQL.Base (withPoolConnection, newPool)+import Database.PostgreSQL.Simple.Param (Action(..), inQuotes)+import Database.PostgreSQL.Simple.QueryParams (QueryParams(..))+import Database.PostgreSQL.Simple.QueryResults (QueryResults(..))+import Database.PostgreSQL.Simple.Result (ResultError(..))+import Database.PostgreSQL.Simple.Types (Binary(..), In(..), Only(..), Query(..))+import Text.Regex.PCRE.Light (compile, caseless, match)+import qualified Data.ByteString.Char8 as B+import qualified Database.PostgreSQL.Base as Base+import Data.Monoid++-- | Exception thrown if a 'Query' could not be formatted correctly.+-- This may occur if the number of \'@?@\' characters in the query+-- string does not match the number of parameters provided.+data FormatError = FormatError {+ fmtMessage :: String+ , fmtQuery :: Query+ , fmtParams :: [ByteString]+ } deriving (Eq, Show, Typeable)++instance Exception FormatError++-- | Exception thrown if 'query' is used to perform an @INSERT@-like+-- operation, or 'execute' is used to perform a @SELECT@-like operation.+data QueryError = QueryError {+ qeMessage :: String+ , qeQuery :: Query+ } deriving (Eq, Show, Typeable)++instance Exception QueryError++-- | Format a query string.++-- This function is exposed to help with debugging and logging. Do not+-- use it to prepare queries for execution.+--+-- String parameters are escaped according to the character set in use+-- on the 'Connection'.+--+-- Throws 'FormatError' if the query string could not be formatted+-- correctly.+formatQuery :: QueryParams q => Query -> q -> IO ByteString+formatQuery q@(Query template) qs+ | null xs && '?' `B.notElem` template = return template+ | otherwise = toByteString <$> buildQuery q template xs+ where xs = renderParams qs++-- | Format a query string with a variable number of rows.+--+-- This function is exposed to help with debugging and logging. Do not+-- use it to prepare queries for execution.+--+-- The query string must contain exactly one substitution group,+-- identified by the SQL keyword \"@VALUES@\" (case insensitive)+-- followed by an \"@(@\" character, a series of one or more \"@?@\"+-- characters separated by commas, and a \"@)@\" character. White+-- space in a substitution group is permitted.+--+-- Throws 'FormatError' if the query string could not be formatted+-- correctly.+formatMany :: (QueryParams q) => Query -> [q] -> IO ByteString+formatMany q [] = fmtError "no rows supplied" q []+formatMany q@(Query template) qs = do+ case match re template [] of+ Just [_,before,qbits,after] -> do+ bs <- mapM (buildQuery q qbits . renderParams) qs+ return . toByteString . mconcat $ fromByteString before :+ intersperse (fromChar ',') bs +++ [fromByteString after]+ _ -> error "formatMany: The query did not match the documented format."+ where+ re = compile "^([^?]+\\bvalues\\s*)\+ \(\\(\\s*[?](?:\\s*,\\s*[?])*\\s*\\))\+ \([^?]*)$"+ [caseless]++buildQuery :: Query -> ByteString -> [Action] -> IO Builder+buildQuery q template xs = zipParams (split template) <$> mapM sub xs+ where sub (Plain b) = pure b+ sub (Escape s) = pure $ (inQuotes . fromByteString . Base.escapeBS) s+ sub (Many ys) = mconcat <$> mapM sub ys+ split s = fromByteString h : if B.null t then [] else split (B.tail t)+ where (h,t) = B.break (=='?') s+ zipParams (t:ts) (p:ps) = t `mappend` p `mappend` zipParams ts ps+ zipParams [t] [] = t+ zipParams _ _ = fmtError (show (B.count '?' template) +++ " '?' characters, but " +++ show (length xs) ++ " parameters") q xs++-- | Execute an @INSERT@, @UPDATE@, or other SQL query that is not+-- expected to return results.+--+-- Returns the number of rows affected.+--+-- Throws 'FormatError' if the query could not be formatted correctly.+execute :: (QueryParams q) => Connection -> Query -> q -> IO Integer+execute conn template qs = do+ Base.exec conn =<< formatQuery template qs++-- | A version of 'execute' that does not perform query substitution.+execute_ :: Connection -> Query -> IO Integer+execute_ conn (Query stmt) = do+ Base.exec conn stmt++-- | Execute a multi-row @INSERT@, @UPDATE@, or other SQL query that is not+-- expected to return results.+--+-- Returns the number of rows affected.+--+-- Throws 'FormatError' if the query could not be formatted correctly.+executeMany :: (QueryParams q) => Connection -> Query -> [q] -> IO Integer+executeMany _ _ [] = return 0+executeMany conn q qs = do+ Base.exec conn =<< formatMany q qs++-- | Perform a @SELECT@ or other SQL query that is expected to return+-- results. All results are retrieved and converted before this+-- function returns.+--+-- When processing large results, this function will consume a lot of+-- client-side memory. Consider using 'fold' instead.+--+-- Exceptions that may be thrown:+--+-- * 'FormatError': the query string could not be formatted correctly.+--+-- * 'QueryError': the result contains no columns (i.e. you should be+-- using 'execute' instead of 'query').+--+-- * 'ResultError': result conversion failed.+query :: (QueryParams q, QueryResults r)+ => Connection -> Query -> q -> IO [r]+query conn template qs = do+ q <- formatQuery template qs+ (fields,rows) <- Base.query conn q+ forM rows $ \row -> let !c = convertResults fields row+ in return c++-- | A version of 'query' that does not perform query substitution.+query_ :: (QueryResults r) => Connection -> Query -> IO [r]+query_ conn (Query q) = do+ (fields,rows) <- Base.query conn q+ forM rows $ \row -> let !c = convertResults fields row+ in return c++-- | A processed, appendable. query+newtype ProcessedQuery r = ProcessedQuery ByteString+ deriving (Monoid,Show)++-- | Process a query for later use.+processQuery :: (QueryParams q,QueryResults r) => Query -> q -> IO (ProcessedQuery r)+processQuery template qs = fmap ProcessedQuery $ formatQuery template qs++-- | A version of 'query' that does not perform query substitution.+queryProcessed :: (QueryResults r) => Connection -> ProcessedQuery r -> IO [r]+queryProcessed conn (ProcessedQuery q) = do+ (fields,rows) <- Base.query conn q+ forM rows $ \row -> let !c = convertResults fields row+ in return c++-- | Execute an action inside a SQL transaction.+--+-- This function initiates a transaction with a \"@begin+-- transaction@\" statement, then executes the supplied action. If+-- the action succeeds, the transaction will be completed with+-- 'Base.commit' before this function returns.+--+-- If the action throws /any/ kind of exception (not just a+-- MySQL-related exception), the transaction will be rolled back using+-- 'Base.rollback', then the exception will be rethrown.+withTransaction :: Connection -> IO a -> IO a+withTransaction = Base.withTransaction++fmtError :: String -> Query -> [Action] -> a+fmtError msg q xs = throw FormatError {+ fmtMessage = msg+ , fmtQuery = q+ , fmtParams = map twiddle xs+ }+ where twiddle (Plain b) = toByteString b+ twiddle (Escape s) = s+ twiddle (Many ys) = B.concat (map twiddle ys)++-- $use+--+-- SQL-based applications are somewhat notorious for their+-- susceptibility to attacks through the injection of maliciously+-- crafted data. The primary reason for widespread vulnerability to+-- SQL injections is that many applications are sloppy in handling+-- user data when constructing SQL queries.+--+-- This library provides a 'Query' type and a parameter substitution+-- facility to address both ease of use and security.++-- $querytype+-- +-- A 'Query' is a @newtype@-wrapped 'ByteString'. It intentionally+-- exposes a tiny API that is not compatible with the 'ByteString'+-- API; this makes it difficult to construct queries from fragments of+-- strings. The 'query' and 'execute' functions require queries to be+-- of type 'Query'.+--+-- To most easily construct a query, enable GHC's @OverloadedStrings@+-- language extension and write your query as a normal literal string.+--+-- > {-# LANGUAGE OverloadedStrings #-}+-- >+-- > import Database.MySQL.Simple+-- >+-- > hello = do+-- > conn <- connect defaultConnectInfo+-- > query conn "select 2 + 2"+--+-- A 'Query' value does not represent the actual query that will be+-- executed, but is a template for constructing the final query.++-- $subst+--+-- Since applications need to be able to construct queries with+-- parameters that change, this library provides a query substitution+-- capability.+--+-- The 'Query' template accepted by 'query' and 'execute' can contain+-- any number of \"@?@\" characters. Both 'query' and 'execute'+-- accept a third argument, typically a tuple. When constructing the+-- real query to execute, these functions replace the first \"@?@\" in+-- the template with the first element of the tuple, the second+-- \"@?@\" with the second element, and so on. If necessary, each+-- tuple element will be quoted and escaped prior to substitution;+-- this defeats the single most common injection vector for malicious+-- data.+--+-- For example, given the following 'Query' template:+--+-- > select * from user where first_name = ? and age > ?+--+-- And a tuple of this form:+--+-- > ("Boris" :: String, 37 :: Int)+--+-- The query to be executed will look like this after substitution:+--+-- > select * from user where first_name = 'Boris' and age > 37+--+-- If there is a mismatch between the number of \"@?@\" characters in+-- your template and the number of elements in your tuple, a+-- 'FormatError' will be thrown.+--+-- Note that the substitution functions do not attempt to parse or+-- validate your query. It's up to you to write syntactically valid+-- SQL, and to ensure that each \"@?@\" in your query template is+-- matched with the right tuple element.++-- $inference+--+-- Automated type inference means that you will often be able to avoid+-- supplying explicit type signatures for the elements of a tuple.+-- However, sometimes the compiler will not be able to infer your+-- types. Consider a care where you write a numeric literal in a+-- parameter tuple:+--+-- > query conn "select ? + ?" (40,2)+--+-- The above query will be rejected by the compiler, because it does+-- not know the specific numeric types of the literals @40@ and @2@.+-- This is easily fixed:+--+-- > query conn "select ? + ?" (40 :: Double, 2 :: Double)+--+-- The same kind of problem can arise with string literals if you have+-- the @OverloadedStrings@ language extension enabled. Again, just+-- use an explicit type signature if this happens.++-- $only_param+--+-- Haskell lacks a single-element tuple type, so if you have just one+-- value you want substituted into a query, what should you do?+--+-- The obvious approach would appear to be something like this:+--+-- > instance (Param a) => QueryParam a where+-- > ...+--+-- Unfortunately, this wreaks havoc with type inference, so we take a+-- different tack. To represent a single value @val@ as a parameter, write+-- a singleton list @[val]@, use 'Just' @val@, or use 'Only' @val@.+--+-- Here's an example using a singleton list:+--+-- > execute conn "insert into users (first_name) values (?)"+-- > ["Nuala"]++-- $in+--+-- Suppose you want to write a query using an @IN@ clause:+--+-- > select * from users where first_name in ('Anna', 'Boris', 'Carla')+--+-- In such cases, it's common for both the elements and length of the+-- list after the @IN@ keyword to vary from query to query.+--+-- To address this case, use the 'In' type wrapper, and use a single+-- \"@?@\" character to represent the list. Omit the parentheses+-- around the list; these will be added for you.+--+-- Here's an example:+--+-- > query conn "select * from users where first_name in ?" $+-- > In ["Anna", "Boris", "Carla"]+--+-- If your 'In'-wrapped list is empty, the string @\"(null)\"@ will be+-- substituted instead, to ensure that your clause remains+-- syntactically valid.++-- $many+--+-- If you know that you have many rows of data to insert into a table,+-- it is much more efficient to perform all the insertions in a single+-- multi-row @INSERT@ statement than individually.+--+-- The 'executeMany' function is intended specifically for helping+-- with multi-row @INSERT@ and @UPDATE@ statements. Its rules for+-- query substitution are different than those for 'execute'.+--+-- What 'executeMany' searches for in your 'Query' template is a+-- single substring of the form:+--+-- > values (?,?,?)+--+-- The rules are as follows:+--+-- * The keyword @VALUES@ is matched case insensitively.+--+-- * There must be no other \"@?@\" characters anywhere in your+-- template.+--+-- * There must one or more \"@?@\" in the parentheses.+--+-- * Extra white space is fine.+--+-- The last argument to 'executeMany' is a list of parameter+-- tuples. These will be substituted into the query where the @(?,?)@+-- string appears, in a form suitable for use in a multi-row @INSERT@+-- or @UPDATE@.+--+-- Here is an example:+--+-- > executeMany conn+-- > "insert into users (first_name,last_name) values (?,?)"+-- > [("Boris","Karloff"),("Ed","Wood")]+--+-- The query that will be executed here will look like this+-- (reformatted for tidiness):+--+-- > insert into users (first_name,last_name) values+-- > ('Boris','Karloff'),('Ed','Wood')++-- $result+--+-- The 'query' and 'query_' functions return a list of values in the+-- 'QueryResults' typeclass. This class performs automatic extraction+-- and type conversion of rows from a query result.+--+-- Here is a simple example of how to extract results:+--+-- > import qualified Data.Text as Text+-- >+-- > xs <- query_ conn "select name,age from users"+-- > forM_ xs $ \(name,age) ->+-- > putStrLn $ Text.unpack name ++ " is " ++ show (age :: Int)+--+-- Notice two important details about this code:+--+-- * The number of columns we ask for in the query template must+-- exactly match the number of elements we specify in a row of the+-- result tuple. If they do not match, a 'ResultError' exception+-- will be thrown.+--+-- * Sometimes, the compiler needs our help in specifying types. It+-- can infer that @name@ must be a 'Text', due to our use of the+-- @unpack@ function. However, we have to tell it the type of @age@,+-- as it has no other information to determine the exact type.++-- $null+--+-- The type of a result tuple will look something like this:+--+-- > (Text, Int, Int)+--+-- Although SQL can accommodate @NULL@ as a value for any of these+-- types, Haskell cannot. If your result contains columns that may be+-- @NULL@, be sure that you use 'Maybe' in those positions of of your+-- tuple.+--+-- > (Text, Maybe Int, Int)+--+-- If 'query' encounters a @NULL@ in a row where the corresponding+-- Haskell type is not 'Maybe', it will throw a 'ResultError'+-- exception.++-- $only_result+--+-- To specify that a query returns a single-column result, use the+-- 'Only' type.+--+-- > xs <- query_ conn "select id from users"+-- > forM_ xs $ \(Only dbid) -> {- ... -}++-- $types+--+-- Conversion of SQL values to Haskell values is somewhat+-- permissive. Here are the rules.+--+-- * For numeric types, any Haskell type that can accurately represent+-- all values of the given MySQL type is considered \"compatible\".+-- For instance, you can always extract a MySQL @TINYINT@ column to+-- a Haskell 'Int'. The Haskell 'Float' type can accurately+-- represent MySQL integer types of size up to @INT24@, so it is+-- considered compatble with those types.+--+-- * A numeric compatibility check is based only on the type of a+-- column, /not/ on its values. For instance, a MySQL @LONG_LONG@+-- column will be considered incompatible with a Haskell 'Int8',+-- even if it contains the value @1@.+--+-- * If a numeric incompatibility is found, 'query' will throw a+-- 'ResultError'.+--+-- * The 'String' and 'Text' types are assumed to be encoded as+-- UTF-8. If you use some other encoding, decoding may fail or give+-- wrong results. In such cases, write a @newtype@ wrapper and a+-- custom 'Result' instance to handle your encoding.
+ Database/PostgreSQL/Simple/Param.hs view
@@ -0,0 +1,199 @@+{-# LANGUAGE DeriveDataTypeable, DeriveFunctor, FlexibleInstances,+ OverloadedStrings #-}++-- |+-- Module: Database.PostgreSQL.Simple.Param+-- Copyright: (c) 2011 Chris Done, 2011 MailRank, Inc.+-- License: BSD3+-- Maintainer: Chris Done <chrisdone@gmail.com>+-- Stability: experimental+-- Portability: portable+--+-- The 'Param' typeclass, for rendering a parameter to a SQL query.++module Database.PostgreSQL.Simple.Param+ (+ Action(..)+ , Param(..)+ , inQuotes+ ) where++import Blaze.ByteString.Builder (Builder, fromByteString, fromLazyByteString,+ toByteString)+import Blaze.ByteString.Builder.Char8 (fromChar)+import Blaze.Text (integral, double, float)+import Data.ByteString (ByteString)+import qualified Data.ByteString.Base16 as B16+import qualified Data.ByteString.Base16.Lazy as L16+import Data.Int (Int8, Int16, Int32, Int64)+import Data.List (intersperse)+import Data.Monoid (mappend)+import Data.Time.Calendar (Day, showGregorian)+import Data.Time.Clock (UTCTime)+import Data.Time.Format (formatTime)+import Data.Time.LocalTime (TimeOfDay)+import Data.Typeable (Typeable)+import Data.Word (Word, Word8, Word16, Word32, Word64)+import Database.PostgreSQL.Simple.Types (Binary(..), In(..), Null)+import System.Locale (defaultTimeLocale)+import qualified Blaze.ByteString.Builder.Char.Utf8 as Utf8+import qualified Data.ByteString as SB+import qualified Data.ByteString.Lazy as LB+import qualified Data.Text as ST+import qualified Data.Text.Encoding as ST+import qualified Data.Text.Lazy as LT++-- | How to render an element when substituting it into a query.+data Action =+ Plain Builder+ -- ^ Render without escaping or quoting. Use for non-text types+ -- such as numbers, when you are /certain/ that they will not+ -- introduce formatting vulnerabilities via use of characters such+ -- as spaces or \"@'@\".+ | Escape ByteString+ -- ^ Escape and enclose in quotes before substituting. Use for all+ -- text-like types, and anything else that may contain unsafe+ -- characters when rendered.+ | Many [Action]+ -- ^ Concatenate a series of rendering actions.+ deriving (Typeable)++instance Show Action where+ show (Plain b) = "Plain " ++ show (toByteString b)+ show (Escape b) = "Escape " ++ show b+ show (Many b) = "Many " ++ show b++-- | A type that may be used as a single parameter to a SQL query.+class Param a where+ render :: a -> Action+ -- ^ Prepare a value for substitution into a query string.++instance Param Action where+ render a = a+ {-# INLINE render #-}++instance (Param a) => Param (Maybe a) where+ render Nothing = renderNull+ render (Just a) = render a+ {-# INLINE render #-}++instance (Param a) => Param (In [a]) where+ render (In []) = Plain $ fromByteString "(null)"+ render (In xs) = Many $+ Plain (fromChar '(') :+ (intersperse (Plain (fromChar ',')) . map render $ xs) +++ [Plain (fromChar ')')]++instance Param (Binary SB.ByteString) where+ render (Binary bs) = Plain $ fromByteString "x'" `mappend`+ fromByteString (B16.encode bs) `mappend`+ fromChar '\''++instance Param (Binary LB.ByteString) where+ render (Binary bs) = Plain $ fromByteString "x'" `mappend`+ fromLazyByteString (L16.encode bs) `mappend`+ fromChar '\''++renderNull :: Action+renderNull = Plain (fromByteString "null")++instance Param Null where+ render _ = renderNull+ {-# INLINE render #-}++instance Param Bool where+ render = Plain . integral . fromEnum+ {-# INLINE render #-}++instance Param Int8 where+ render = Plain . integral+ {-# INLINE render #-}++instance Param Int16 where+ render = Plain . integral+ {-# INLINE render #-}++instance Param Int32 where+ render = Plain . integral+ {-# INLINE render #-}++instance Param Int where+ render = Plain . integral+ {-# INLINE render #-}++instance Param Int64 where+ render = Plain . integral+ {-# INLINE render #-}++instance Param Integer where+ render = Plain . integral+ {-# INLINE render #-}++instance Param Word8 where+ render = Plain . integral+ {-# INLINE render #-}++instance Param Word16 where+ render = Plain . integral+ {-# INLINE render #-}++instance Param Word32 where+ render = Plain . integral+ {-# INLINE render #-}++instance Param Word where+ render = Plain . integral+ {-# INLINE render #-}++instance Param Word64 where+ render = Plain . integral+ {-# INLINE render #-}++instance Param Float where+ render v | isNaN v || isInfinite v = renderNull+ | otherwise = Plain (float v)+ {-# INLINE render #-}++instance Param Double where+ render v | isNaN v || isInfinite v = renderNull+ | otherwise = Plain (double v)+ {-# INLINE render #-}++instance Param SB.ByteString where+ render = Escape+ {-# INLINE render #-}++instance Param LB.ByteString where+ render = render . SB.concat . LB.toChunks+ {-# INLINE render #-}++instance Param ST.Text where+ render = Escape . ST.encodeUtf8+ {-# INLINE render #-}++instance Param [Char] where+ render = Escape . toByteString . Utf8.fromString+ {-# INLINE render #-}++instance Param LT.Text where+ render = render . LT.toStrict+ {-# INLINE render #-}++instance Param UTCTime where+ render = Plain . Utf8.fromString . formatTime defaultTimeLocale "'%F %T'"+ {-# INLINE render #-}++instance Param Day where+ render = Plain . inQuotes . Utf8.fromString . showGregorian+ {-# INLINE render #-}++instance Param TimeOfDay where+ render = Plain . inQuotes . Utf8.fromString . show+ {-# INLINE render #-}++-- | Surround a string with single-quote characters: \"@'@\"+--+-- This function /does not/ perform any other escaping.+inQuotes :: Builder -> Builder+inQuotes b = quote `mappend` b `mappend` quote+ where quote = Utf8.fromChar '\''
+ Database/PostgreSQL/Simple/QueryParams.hs view
@@ -0,0 +1,84 @@+-- |+-- Module: Database.PostgreSQL.Simple.QueryParams+-- Copyright: (c) 2011 Chris Done, 2011 MailRank, Inc.+-- License: BSD3+-- Maintainer: Chris Done <chrisdone@gmail.com>+-- Stability: experimental+-- Portability: portable+--+-- The 'QueryParams' typeclass, for rendering a collection of+-- parameters to a SQL query.+--+-- Predefined instances are provided for tuples containing up to ten+-- elements.++module Database.PostgreSQL.Simple.QueryParams+ (+ QueryParams(..)+ ) where++import Database.PostgreSQL.Simple.Param (Action(..), Param(..))+import Database.PostgreSQL.Simple.Types (Only(..))++-- | A collection type that can be turned into a list of rendering+-- 'Action's.+--+-- Instances should use the 'render' method of the 'Param' class+-- to perform conversion of each element of the collection.+class QueryParams a where+ renderParams :: a -> [Action]+ -- ^ Render a collection of values.++instance QueryParams () where+ renderParams _ = []++instance (Param a) => QueryParams (Only a) where+ renderParams (Only v) = [render v]++instance (Param a, Param b) => QueryParams (a,b) where+ renderParams (a,b) = [render a, render b]++instance (Param a, Param b, Param c) => QueryParams (a,b,c) where+ renderParams (a,b,c) = [render a, render b, render c]++instance (Param a, Param b, Param c, Param d) => QueryParams (a,b,c,d) where+ renderParams (a,b,c,d) = [render a, render b, render c, render d]++instance (Param a, Param b, Param c, Param d, Param e)+ => QueryParams (a,b,c,d,e) where+ renderParams (a,b,c,d,e) =+ [render a, render b, render c, render d, render e]++instance (Param a, Param b, Param c, Param d, Param e, Param f)+ => QueryParams (a,b,c,d,e,f) where+ renderParams (a,b,c,d,e,f) =+ [render a, render b, render c, render d, render e, render f]++instance (Param a, Param b, Param c, Param d, Param e, Param f, Param g)+ => QueryParams (a,b,c,d,e,f,g) where+ renderParams (a,b,c,d,e,f,g) =+ [render a, render b, render c, render d, render e, render f, render g]++instance (Param a, Param b, Param c, Param d, Param e, Param f, Param g,+ Param h)+ => QueryParams (a,b,c,d,e,f,g,h) where+ renderParams (a,b,c,d,e,f,g,h) =+ [render a, render b, render c, render d, render e, render f, render g,+ render h]++instance (Param a, Param b, Param c, Param d, Param e, Param f, Param g,+ Param h, Param i)+ => QueryParams (a,b,c,d,e,f,g,h,i) where+ renderParams (a,b,c,d,e,f,g,h,i) =+ [render a, render b, render c, render d, render e, render f, render g,+ render h, render i]++instance (Param a, Param b, Param c, Param d, Param e, Param f, Param g,+ Param h, Param i, Param j)+ => QueryParams (a,b,c,d,e,f,g,h,i,j) where+ renderParams (a,b,c,d,e,f,g,h,i,j) =+ [render a, render b, render c, render d, render e, render f, render g,+ render h, render i, render j]++instance (Param a) => QueryParams [a] where+ renderParams = map render
+ Database/PostgreSQL/Simple/QueryResults.hs view
@@ -0,0 +1,168 @@+{-# LANGUAGE BangPatterns, OverloadedStrings #-}++-- |+-- Module: Database.PostgreSQL.Simple.QueryResults+-- Copyright: (c) 2011 Chris Done, 2011 MailRank, Inc.+-- License: BSD3+-- Maintainer: Chris Done <chrisdone@gmail.com>+-- Stability: experimental+-- Portability: portable+--+-- The 'QueryResults' typeclass, for converting a row of results+-- returned by a SQL query into a more useful Haskell representation.+--+-- Predefined instances are provided for tuples containing up to ten+-- elements.++module Database.PostgreSQL.Simple.QueryResults+ ( QueryResults(..)+ , convertError+ ) where++import Control.Exception (throw)+import Data.ByteString (ByteString)+import qualified Data.ByteString.Char8 as B+import Database.PostgreSQL.Base.Types (Field(fieldType))+import Database.PostgreSQL.Simple.Result (ResultError(..), Result(..))+import Database.PostgreSQL.Simple.Types (Only(..))++-- | A collection type that can be converted from a list of strings.+--+-- Instances should use the 'convert' method of the 'Result' class+-- to perform conversion of each element of the collection.+--+-- This example instance demonstrates how to convert a two-column row+-- into a Haskell pair. Each field in the metadata is paired up with+-- each value from the row, and the two are passed to 'convert'.+--+-- @+-- instance ('Result' a, 'Result' b) => 'QueryResults' (a,b) where+-- 'convertResults' [fa,fb] [va,vb] = (a,b)+-- where !a = 'convert' fa va+-- !b = 'convert' fb vb+-- 'convertResults' fs vs = 'convertError' fs vs+-- @+--+-- Notice that this instance evaluates each element to WHNF before+-- constructing the pair. By doing this, we guarantee two important+-- properties:+--+-- * Keep resource usage under control by preventing the construction+-- of potentially long-lived thunks.+--+-- * Ensure that any 'ResultError' that might arise is thrown+-- immediately, rather than some place later in application code+-- that cannot handle it.+--+-- You can also declare Haskell types of your own to be instances of+-- 'QueryResults'.+--+-- @+-- data User { firstName :: String, lastName :: String }++-- instance 'QueryResults' User where+-- 'convertResults' [fa,fb] [va,vb] = User a b+-- where !a = 'convert' fa va+-- !b = 'convert' fb vb+-- 'convertResults' fs vs = 'convertError' fs vs+-- @++class QueryResults a where+ convertResults :: [Field] -> [Maybe ByteString] -> a+ -- ^ Convert values from a row into a Haskell collection.+ --+ -- This function will throw a 'ResultError' if conversion of the+ -- collection fails.++instance (Result a) => QueryResults (Only a) where+ convertResults [fa] [va] = Only a+ where !a = convert fa va+ convertResults fs vs = convertError fs vs 1++instance (Result a, Result b) => QueryResults (a,b) where+ convertResults [fa,fb] [va,vb] = (a,b)+ where !a = convert fa va; !b = convert fb vb+ convertResults fs vs = convertError fs vs 2++instance (Result a, Result b, Result c) => QueryResults (a,b,c) where+ convertResults [fa,fb,fc] [va,vb,vc] = (a,b,c)+ where !a = convert fa va; !b = convert fb vb; !c = convert fc vc+ convertResults fs vs = convertError fs vs 3++instance (Result a, Result b, Result c, Result d) =>+ QueryResults (a,b,c,d) where+ convertResults [fa,fb,fc,fd] [va,vb,vc,vd] = (a,b,c,d)+ where !a = convert fa va; !b = convert fb vb; !c = convert fc vc+ !d = convert fd vd+ convertResults fs vs = convertError fs vs 4++instance (Result a, Result b, Result c, Result d, Result e) =>+ QueryResults (a,b,c,d,e) where+ convertResults [fa,fb,fc,fd,fe] [va,vb,vc,vd,ve] = (a,b,c,d,e)+ where !a = convert fa va; !b = convert fb vb; !c = convert fc vc+ !d = convert fd vd; !e = convert fe ve+ convertResults fs vs = convertError fs vs 5++instance (Result a, Result b, Result c, Result d, Result e, Result f) =>+ QueryResults (a,b,c,d,e,f) where+ convertResults [fa,fb,fc,fd,fe,ff] [va,vb,vc,vd,ve,vf] = (a,b,c,d,e,f)+ where !a = convert fa va; !b = convert fb vb; !c = convert fc vc+ !d = convert fd vd; !e = convert fe ve; !f = convert ff vf+ convertResults fs vs = convertError fs vs 6++instance (Result a, Result b, Result c, Result d, Result e, Result f,+ Result g) =>+ QueryResults (a,b,c,d,e,f,g) where+ convertResults [fa,fb,fc,fd,fe,ff,fg] [va,vb,vc,vd,ve,vf,vg] =+ (a,b,c,d,e,f,g)+ where !a = convert fa va; !b = convert fb vb; !c = convert fc vc+ !d = convert fd vd; !e = convert fe ve; !f = convert ff vf+ !g = convert fg vg+ convertResults fs vs = convertError fs vs 7++instance (Result a, Result b, Result c, Result d, Result e, Result f,+ Result g, Result h) =>+ QueryResults (a,b,c,d,e,f,g,h) where+ convertResults [fa,fb,fc,fd,fe,ff,fg,fh] [va,vb,vc,vd,ve,vf,vg,vh] =+ (a,b,c,d,e,f,g,h)+ where !a = convert fa va; !b = convert fb vb; !c = convert fc vc+ !d = convert fd vd; !e = convert fe ve; !f = convert ff vf+ !g = convert fg vg; !h = convert fh vh+ convertResults fs vs = convertError fs vs 8++instance (Result a, Result b, Result c, Result d, Result e, Result f,+ Result g, Result h, Result i) =>+ QueryResults (a,b,c,d,e,f,g,h,i) where+ convertResults [fa,fb,fc,fd,fe,ff,fg,fh,fi] [va,vb,vc,vd,ve,vf,vg,vh,vi] =+ (a,b,c,d,e,f,g,h,i)+ where !a = convert fa va; !b = convert fb vb; !c = convert fc vc+ !d = convert fd vd; !e = convert fe ve; !f = convert ff vf+ !g = convert fg vg; !h = convert fh vh; !i = convert fi vi+ convertResults fs vs = convertError fs vs 9++instance (Result a, Result b, Result c, Result d, Result e, Result f,+ Result g, Result h, Result i, Result j) =>+ QueryResults (a,b,c,d,e,f,g,h,i,j) where+ convertResults [fa,fb,fc,fd,fe,ff,fg,fh,fi,fj]+ [va,vb,vc,vd,ve,vf,vg,vh,vi,vj] =+ (a,b,c,d,e,f,g,h,i,j)+ where !a = convert fa va; !b = convert fb vb; !c = convert fc vc+ !d = convert fd vd; !e = convert fe ve; !f = convert ff vf+ !g = convert fg vg; !h = convert fh vh; !i = convert fi vi+ !j = convert fj vj+ convertResults fs vs = convertError fs vs 10++-- | Throw a 'ConversionFailed' exception, indicating a mismatch+-- between the number of columns in the 'Field' and row, and the+-- number in the collection to be converted to.+convertError :: [Field] -> [Maybe ByteString] -> Int -> a+convertError fs vs n = throw $ ConversionFailed+ (show (length fs) ++ " values: " ++ show (zip (map fieldType fs)+ (map (fmap ellipsis) vs)))+ (show n ++ " slots in target type")+ "mismatch between number of columns to convert and number in target type"++ellipsis :: ByteString -> ByteString+ellipsis bs+ | B.length bs > 15 = B.take 10 bs `B.append` "[...]"+ | otherwise = bs
+ Database/PostgreSQL/Simple/Result.hs view
@@ -0,0 +1,241 @@+{-# LANGUAGE CPP, DeriveDataTypeable, FlexibleInstances #-}++-- |+-- Module: Database.PostgreSQL.Simpe.QueryResults+-- Copyright: (c) 2011 Chris Done, 2011 MailRank, Inc.+-- License: BSD3+-- Maintainer: Chris Done <chrisdone@gmail.com>+-- Stability: experimental+-- Portability: portable+--+-- The 'Result' typeclass, for converting a single value in a row+-- returned by a SQL query into a more useful Haskell representation.+--+-- A Haskell numeric type is considered to be compatible with all+-- MySQL numeric types that are less accurate than it. For instance,+-- the Haskell 'Double' type is compatible with the MySQL 'Long' type+-- because it can represent a 'Long' exactly. On the other hand, since+-- a 'Double' might lose precision if representing a 'LongLong', the+-- two are /not/ considered compatible.++module Database.PostgreSQL.Simple.Result+ ( Result(..)+ , ResultError(..)+ ) where++#include "MachDeps.h"++import Control.Applicative ((<$>), (<*>), (<*), (<|>))+import Control.Exception (Exception, throw)+import Data.Attoparsec.Char8 hiding (Result)+import Data.Bits ((.&.), (.|.), shiftL)+import Data.ByteString (ByteString)+import Data.Int (Int16, Int32, Int64)+import Data.List (foldl')+import Data.Ratio (Ratio)+import Data.Time.Calendar (Day, fromGregorian)+import Data.Time.Clock (UTCTime)+import Data.Time.Format (parseTime)+import Data.Time.LocalTime (TimeOfDay,LocalTime,ZonedTime,makeTimeOfDayValid)+import Data.Typeable (TypeRep, Typeable, typeOf)+import Data.Word (Word, Word16, Word32, Word64)+import Database.PostgreSQL.Base.Types (Field(..),Type(..),FormatCode(..))+import System.Locale (defaultTimeLocale)+import qualified Data.ByteString as SB+import qualified Data.ByteString.Char8 as B8+import qualified Data.ByteString.Lazy as LB+import qualified Data.Text as ST+import qualified Data.Text.Encoding as ST+import qualified Data.Text.Lazy as LT++-- | Exception thrown if conversion from a SQL value to a Haskell+-- value fails.+data ResultError = Incompatible { errSQLType :: String+ , errHaskellType :: String+ , errMessage :: String }+ -- ^ The SQL and Haskell types are not compatible.+ | UnexpectedNull { errSQLType :: String+ , errHaskellType :: String+ , errMessage :: String }+ -- ^ A SQL @NULL@ was encountered when the Haskell+ -- type did not permit it.+ | ConversionFailed { errSQLType :: String+ , errHaskellType :: String+ , errMessage :: String }+ -- ^ The SQL value could not be parsed, or could not+ -- be represented as a valid Haskell value, or an+ -- unexpected low-level error occurred (e.g. mismatch+ -- between metadata and actual data in a row).+ deriving (Eq, Show, Typeable)++instance Exception ResultError++-- | A type that may be converted from a SQL type.+class Result a where+ convert :: Field -> Maybe ByteString -> a+ -- ^ Convert a SQL value to a Haskell value.+ --+ -- Throws a 'ResultError' if conversion fails.++instance (Result a) => Result (Maybe a) where+ convert _ Nothing = Nothing+ convert f bs = Just (convert f bs)++instance Result Bool where+ convert _ (Just t)+ | str == "t" = True+ | str == "f" = False+ where str = B8.unpack t+ convert f _ = conversionFailed f "Bool" "could not parse"++instance Result Int16 where+ convert = atto ok16 $ signed decimal++instance Result Int32 where+ convert = atto ok32 $ signed decimal++instance Result Int where+ convert = atto okWord $ signed decimal++instance Result Int64 where+ convert = atto ok64 $ signed decimal++instance Result Integer where+ convert = atto ok64 $ signed decimal++instance Result Word16 where+ convert = atto ok16 decimal++instance Result Word32 where+ convert = atto ok32 decimal++instance Result Word where+ convert = atto okWord decimal++instance Result Word64 where+ convert = atto ok64 decimal++instance Result Float where+ convert = atto ok ((fromRational . toRational) <$> double)+ where ok = mkCompats [Real,Short,Long]++instance Result Double where+ convert = atto ok double+ where ok = mkCompats [Real,DoublePrecision,Short,Long]++instance Result (Ratio Integer) where+ convert = atto ok rational+ where ok = mkCompats [Decimal,Numeric,Real,DoublePrecision]++instance Result SB.ByteString where+ convert f = doConvert f okText $ id++instance Result LB.ByteString where+ convert f = LB.fromChunks . (:[]) . convert f++instance Result ST.Text where+ convert f | isText f = doConvert f okText $ ST.decodeUtf8+ | otherwise = incompatible f (typeOf ST.empty)+ "attempt to mix binary and text"++instance Result LT.Text where+ convert f = LT.fromStrict . convert f++instance Result [Char] where+ convert f = ST.unpack . convert f++instance Result LocalTime where+ convert f = doConvert f ok $ \bs ->+ case parseLocalTime (B8.unpack bs) of+ Just t -> t+ Nothing -> conversionFailed f "UTCTime" "could not parse"+ where ok = mkCompats [TimestampWithZone]++parseLocalTime :: String -> Maybe LocalTime+parseLocalTime s =+ parseTime defaultTimeLocale "%F %T%Q" s <|>+ parseTime defaultTimeLocale "%F %T%Q%z" (s ++ "00")++instance Result ZonedTime where+ convert f = doConvert f ok $ \bs ->+ case parseZonedTime (B8.unpack bs) of+ Just t -> t+ Nothing -> conversionFailed f "UTCTime" "could not parse"+ where ok = mkCompats [TimestampWithZone]++parseZonedTime :: String -> Maybe ZonedTime+parseZonedTime s =+ parseTime defaultTimeLocale "%F %T%Q%z" (s ++ "00")++instance Result UTCTime where+ convert f = doConvert f ok $ \bs ->+ case parseTime defaultTimeLocale "%F %T%Q" (B8.unpack bs) of+ Just t -> t+ Nothing -> conversionFailed f "UTCTime" "could not parse"+ where ok = mkCompats [Timestamp]++instance Result Day where+ convert f = flip (atto ok) f $ date+ where ok = mkCompats [Date]+ date = fromGregorian <$> (decimal <* char '-')+ <*> (decimal <* char '-')+ <*> decimal++instance Result TimeOfDay where+ convert f = flip (atto ok) f $ do+ hours <- decimal <* char ':'+ mins <- decimal <* char ':'+ secs <- decimal :: Parser Int+ case makeTimeOfDayValid hours mins (fromIntegral secs) of+ Just t -> return t+ _ -> conversionFailed f "TimeOfDay" "could not parse"+ where ok = mkCompats [Time]++isText :: Field -> Bool+isText f = fieldFormatCode f == TextCode++newtype Compat = Compat Word32++mkCompats :: [Type] -> Compat+mkCompats = foldl' f (Compat 0) . map mkCompat+ where f (Compat a) (Compat b) = Compat (a .|. b)++mkCompat :: Type -> Compat+mkCompat = Compat . shiftL 1 . fromEnum++compat :: Compat -> Compat -> Bool+compat (Compat a) (Compat b) = a .&. b /= 0++okText, ok16, ok32, ok64, okWord :: Compat+okText = mkCompats [CharVarying,Characters,Text]+ok16 = mkCompats [Short]+ok32 = mkCompats [Short,Long]+ok64 = mkCompats [Short,Long,LongLong]+#if WORD_SIZE_IN_BITS < 64+okWord = ok32+#else+okWord = ok64+#endif++doConvert :: (Typeable a) =>+ Field -> Compat -> (ByteString -> a) -> Maybe ByteString -> a+doConvert f types cvt (Just bs)+ | mkCompat (fieldType f) `compat` types = cvt bs+ | otherwise = incompatible f (typeOf (cvt undefined)) "types incompatible"+doConvert f _ cvt _ = throw $ UnexpectedNull (show (fieldType f))+ (show (typeOf (cvt undefined))) ""++incompatible :: Field -> TypeRep -> String -> a+incompatible f r = throw . Incompatible (show (fieldType f)) (show r)++conversionFailed :: Field -> String -> String -> a+conversionFailed f s = throw . ConversionFailed (show (fieldType f)) s++atto :: (Typeable a) => Compat -> Parser a -> Field -> Maybe ByteString -> a+atto types p0 f = doConvert f types $ go (error "atto") p0+ where+ go :: (Typeable a) => a -> Parser a -> ByteString -> a+ go dummy p s =+ case parseOnly p s of+ Left err -> conversionFailed f (show (typeOf dummy)) err+ Right v -> v
+ Database/PostgreSQL/Simple/Types.hs view
@@ -0,0 +1,105 @@+{-# LANGUAGE DeriveDataTypeable, DeriveFunctor, GeneralizedNewtypeDeriving #-}++-- |+-- Module: Database.PostgreSQL.Simple.Types+-- Copyright: (c) 2011 Chris Done, 2011 MailRank, Inc.+-- License: BSD3+-- Maintainer: Chris Done <chrisdone@gmail.com>+-- Stability: experimental+-- Portability: portable+--+-- Basic types.++module Database.PostgreSQL.Simple.Types+ (+ Null(..)+ , Only(..)+ , In(..)+ , Binary(..)+ , Query(..)+ ) where++import Blaze.ByteString.Builder (toByteString)+import Control.Arrow (first)+import Data.ByteString (ByteString)+import Data.Monoid (Monoid(..))+import Data.String (IsString(..))+import Data.Typeable (Typeable)+import qualified Blaze.ByteString.Builder.Char.Utf8 as Utf8+import qualified Data.ByteString as B++-- | A placeholder for the SQL @NULL@ value.+data Null = Null+ deriving (Read, Show, Typeable)++instance Eq Null where+ _ == _ = False+ _ /= _ = False++-- | A query string. This type is intended to make it difficult to+-- construct a SQL query by concatenating string fragments, as that is+-- an extremely common way to accidentally introduce SQL injection+-- vulnerabilities into an application.+--+-- This type is an instance of 'IsString', so the easiest way to+-- construct a query is to enable the @OverloadedStrings@ language+-- extension and then simply write the query in double quotes.+--+-- > {-# LANGUAGE OverloadedStrings #-}+-- >+-- > import Database.MySQL.Simple+-- >+-- > q :: Query+-- > q = "select ?"+--+-- The underlying type is a 'ByteString', and literal Haskell strings+-- that contain Unicode characters will be correctly transformed to+-- UTF-8.+newtype Query = Query {+ fromQuery :: ByteString+ } deriving (Eq, Ord, Typeable)++instance Show Query where+ show = show . fromQuery++instance Read Query where+ readsPrec i = fmap (first Query) . readsPrec i++instance IsString Query where+ fromString = Query . toByteString . Utf8.fromString++instance Monoid Query where+ mempty = Query B.empty+ mappend (Query a) (Query b) = Query (B.append a b)+ {-# INLINE mappend #-}++-- | A single-value \"collection\".+--+-- This is useful if you need to supply a single parameter to a SQL+-- query, or extract a single column from a SQL result.+--+-- Parameter example:+--+-- @query c \"select x from scores where x > ?\" ('Only' (42::Int))@+--+-- Result example:+--+-- @xs <- query_ c \"select id from users\"+--forM_ xs $ \\('Only' id) -> {- ... -}@+newtype Only a = Only {+ fromOnly :: a+ } deriving (Eq, Ord, Read, Show, Typeable, Functor)++-- | Wrap a list of values for use in an @IN@ clause. Replaces a+-- single \"@?@\" character with a parenthesized list of rendered+-- values.+--+-- Example:+--+-- > query c "select * from whatever where id in ?" (In [3,4,5])+newtype In a = In a+ deriving (Eq, Ord, Read, Show, Typeable, Functor)++-- | Wrap a mostly-binary string to be escaped in hexadecimal.+newtype Binary a = Binary a+ deriving (Eq, Ord, Read, Show, Typeable, Functor)
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2011, MailRank, Inc.++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:++1. Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++2. Redistributions in binary form must reproduce the above copyright+ notice, this list of conditions and the following disclaimer in the+ documentation and/or other materials provided with the distribution.++3. Neither the name of the author nor the names of his contributors+ may be used to endorse or promote products derived from this software+ without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS+OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR+ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS+OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)+HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,+STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN+ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE+POSSIBILITY OF SUCH DAMAGE.
+ README.markdown view
@@ -0,0 +1,22 @@+# Work in progress++I am currently porting the MySQL parts to PostgreSQL, hoping to+maintain the rest of the API verbatim.++# pgsql-simple: mid-level bindings to PostgreSQL servers++This library is a mid-level Haskell binding to PostgreSQL servers. It+is aimed at speed and ease of use.++# Licensing++This library is BSD-licensed.++# Authors++This library is written and maintained by Chris Done,+<chrisdone@gmail.com>.++This library is also directly forked from mysql-simple, written and+maintained by Bryan O'Sullivan, <bos@mailrank.com>, with the MySQL+parts changed to PostgreSQL, in order to have a consistent API.
+ Setup.lhs view
@@ -0,0 +1,3 @@+#!/usr/bin/env runhaskell+> import Distribution.Simple+> main = defaultMain
+ pgsql-simple.cabal view
@@ -0,0 +1,55 @@+name: pgsql-simple+version: 0.1.1+homepage: https://github.com/chrisdone/pgsql-simple+bug-reports: https://github.com/chrisdone/pgsql-simple/issues+synopsis: A mid-level PostgreSQL client library.+description: + A mid-level client library for the PostgreSQL database, intended to be+ fast and easy to use.+license: BSD3+license-file: LICENSE+author: Chris Done <chrisdone@gmail.com>, Bryan O'Sullivan <bos@mailrank.com>+maintainer: Chris Done <chrisdone@gmail.com>+copyright: 2011 Chris Done, 2011 MailRank, Inc.+category: Database+build-type: Simple+cabal-version: >= 1.6+extra-source-files:+ README.markdown++library+ exposed-modules:+ Database.PostgreSQL.Simple+ Database.PostgreSQL.Simple.Param+ Database.PostgreSQL.Simple.QueryParams+ Database.PostgreSQL.Simple.QueryResults+ Database.PostgreSQL.Simple.Result+ Database.PostgreSQL.Simple.Types+ Database.PostgreSQL.Base+ Database.PostgreSQL.Base.Types++ build-depends:+ attoparsec >= 0.8.5.3,+ base < 5,+ base16-bytestring,+ blaze-builder,+ blaze-textual,+ bytestring >= 0.9,+ pcre-light,+ old-locale,+ text >= 0.11.0.2,+ time,+ network >= 2.2,+ binary >= 0.5,+ mtl >= 2.0,+ MonadCatchIO-transformers,+ utf8-string,+ containers >= 0.5++ ghc-options: -Wall -O2+ if impl(ghc >= 6.8)+ ghc-options: -fwarn-tabs++source-repository head+ type: git+ location: http://github.com/chrisdone/pgsql-simple