servant-postgresql (empty) → 0.1
raw patch · 5 files changed
+296/−0 lines, 5 filesdep +basedep +bytestringdep +postgresql-simplesetup-changed
Dependencies added: base, bytestring, postgresql-simple, servant, servant-pool, servant-response
Files
- LICENSE +30/−0
- Setup.hs +2/−0
- servant-postgresql.cabal +26/−0
- src/Servant/Context/PostgreSQL.hs +129/−0
- src/Servant/PostgreSQL/Prelude.hs +109/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2014, Alp Mestanogullari++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * 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.++ * Neither the name of Alp Mestanogullari nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND 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 COPYRIGHT+OWNER 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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ servant-postgresql.cabal view
@@ -0,0 +1,26 @@+name: servant-postgresql+version: 0.1+synopsis: Useful functions and instances for using servant with a PostgreSQL context+description: Useful functions and instances for using servant with a PostgreSQL context+homepage: http://github.com/zalora/servant-postgresql+license: BSD3+license-file: LICENSE+author: Alp Mestanogullari+maintainer: alp@zalora.com+copyright: 2014 Zalora SEA+category: Web, Database+build-type: Simple+cabal-version: >=1.10++library+ exposed-modules: Servant.Context.PostgreSQL, Servant.PostgreSQL.Prelude+ build-depends: + base >=4 && <5+ , servant >= 0.1+ , servant-pool >= 0.1+ , servant-response >= 0.1+ , postgresql-simple >= 0.4+ , bytestring >= 0.7+ hs-source-dirs: src+ default-language: Haskell2010+ ghc-options: -Wall
+ src/Servant/Context/PostgreSQL.hs view
@@ -0,0 +1,129 @@+{- |+Module : Servant.Context.PostgreSQL+Copyright : (c) Zalora SEA 2014+License : BSD3+Maintainer : Alp Mestanogullari <alp@zalora.com>+Stability : experimental++Useful functions and instances for using servant with a PostgreSQL database.++* Use 'contextOfConnInfo' or 'contextOfConnStr' to create a PostgreSQL 'Context's.+* If you want connection-pooling, use 'pooledContextOfConnInfo' and+ 'pooledContextOfConnStr'.+-}+module Servant.Context.PostgreSQL+ ( -- * PostgreSQL 'Context'+ contextOfConnInfo+ , contextOfConnStr+ , -- * PostgreSQL 'Context' with connection pooling+ pooledContextOfConnInfo+ , pooledContextOfConnStr++ ) where++import Control.Exception+import Data.ByteString (ByteString)+import Database.PostgreSQL.Simple+import Servant.Context+import Servant.Context.Pool++-- | Create a @'Context' 'Connection'@ from the given+-- 'ConnectInfo'.+--+-- This means a new connection will be fired whenever you+-- perform a database operation. If you want to avoid that,+-- see the /pooledContextOfXXX/ functions.+contextOfConnInfo :: ConnectInfo -> Context Connection+contextOfConnInfo ci = mkContext f+ where f act = bracket (connect ci) close act++-- | Create a @'Context' 'Connection'@ from the given+-- connection string.+--+-- This means a new connection will be fired whenever you+-- perform a database operation. If you want to avoid that,+-- see the /pooledContextOfXXX/ functions.+contextOfConnStr :: ByteString -> Context Connection+contextOfConnStr str = mkContext f+ where f act = bracket (connectPostgreSQL str) close act++-- | Create a 'Context' that'll use a 'Pool' of+-- PostgreSQL 'Connection's internally, from+-- a 'ConnectInfo' value.+pooledContextOfConnInfo :: Int -- ^ Number of stripes (sub-pools). /Minimum: 1/+ -> NominalDiffTime -- ^ amount of time during which an unused+ -- 'Connection' is kept open+ -> Int -- ^ Maximum number of resources to keep open+ -- per stripe. /Minimum: 1/+ -> ConnectInfo -- ^ connection information+ -> IO (Context Connection)+pooledContextOfConnInfo nstripes idleDuration maxOpen ci =+ pooledContext (connect ci)+ close+ nstripes+ idleDuration+ maxOpen++-- | Create a 'Context' that'll use a 'Pool' of+-- PostgreSQL 'Connection's internally, from+-- a connection string (a 'ByteString').+pooledContextOfConnStr :: Int -- ^ Number of stripes (sub-pools). /Minimum: 1/+ -> NominalDiffTime -- ^ amount of time during which an unused+ -- 'Connection' is kept open+ -> Int -- ^ Maximum number of resources to keep open+ -- per stripe. /Minimum: 1/+ -> ByteString -- ^ connection string+ -> IO (Context Connection)+pooledContextOfConnStr nstripes idleDuration maxOpen connstr =+ pooledContext (connectPostgreSQL connstr)+ close+ nstripes+ idleDuration+ maxOpen++{-+-- | Simple wrapper around @postgresql-simple@'s @['Only' 'Int']@+newtype PGResult =+ PGResult { onlyInts :: [Only Int] }+ deriving (Eq, Show)++-- | Create a 'PGResult' by simply wrapping the argument in a /newtype/+resultOfInts :: [Only Int] -> PGResult+resultOfInts = PGResult++-- | Send status 201 if successful, 400 if not along with an error+instance Response (UpdateResponse Add) PGResult where+ toResponse result =+ (UpdateResponse successful m, responseStatus)++ where affected = getSum . foldMap (Sum . fromOnly) $ onlyInts result+ successful = affected > 0+ m = + if affected < 1 + then "Unknown error. please report this to maintainers" + else ""+ responseStatus =+ if successful then status201 else status400++-- | Send status 200 if successful, 404 if target not found along with "Not found"+instance Response (UpdateResponse Update) PGResult where+ toResponse result =+ (UpdateResponse successful m, responseStatus)++ where affected = getSum . foldMap (Sum . fromOnly) $ onlyInts result+ successful = affected > 0+ m = if affected < 1 then "Not found" else ""+ responseStatus =+ if successful then status200 else notFound404++-- | Send status 200 if successful, 404 if target not found along with "Not found"+instance Response (UpdateResponse Delete) PGResult where+ toResponse result =+ (UpdateResponse successful m, responseStatus)++ where affected = getSum . foldMap (Sum . fromOnly) $ onlyInts result+ successful = affected > 0+ m = if affected < 1 then "Not found" else ""+ responseStatus =+ if successful then status200 else notFound404+-}
+ src/Servant/PostgreSQL/Prelude.hs view
@@ -0,0 +1,109 @@+{-# LANGUAGE FlexibleInstances,+ GeneralizedNewtypeDeriving,+ MultiParamTypeClasses,+ OverloadedStrings #-}+{- |+Module : Servant.PostgreSQL.Prelude+Copyright : (c) Zalora SEA 2014+License : BSD3+Maintainer : Alp Mestanogullari <alp@zalora.com>+Stability : experimental++An helpful wrapper around 'Int64' that you can tie to+the standard response types in "Servant.Response.Prelude" with+the instances defined in this module.+-}+module Servant.PostgreSQL.Prelude+ ( PGResult+ , ToPGResult(..)+ , toPGResult+ , pgresultOfInts+ , pgresultOfInt64+ , module Servant.Context.PostgreSQL+ ) where++import Data.Foldable+import Data.Int+import Data.Monoid+import Database.PostgreSQL.Simple+import Servant.Context.PostgreSQL+import Servant.Prelude+import Servant.Response.Prelude++-- | A wrapper around 'Int64', which is what+-- PG hands us back when running +-- 'Database.PostgreSQL.Simple.execute'.+--+-- The @o@ type parameter lets us tag+-- the result with the operation that+-- we're running. This lets us turn+-- results into a proper response+-- (response body + status) differently+-- for 'Add' and 'Update' for example.+newtype PGResult o = PGResult { pgres :: Int64 }+ deriving (Eq, Ord, Num, Show)++-- | Run a database action and convert its+-- result to a 'PGResult'.+--+-- This will only typecheck on queries that+-- return 'Int64' or @['Only' 'Int']@, or a custom+-- type of yours for which you provide a 'ToPGResult'+-- instance.+toPGResult :: ToPGResult r => IO r -> IO (PGResult o)+toPGResult = fmap fromRes++-- | Run an 'IO' action that returns @['Only' 'Int']@+-- and convert the result to a 'PGResult'.+pgresultOfInts :: IO [Only Int] -> IO (PGResult o)+pgresultOfInts = toPGResult++-- | Run an 'IO' action that returns 'Int64' and+-- convert the result to a 'PGResult'.+pgresultOfInt64 :: IO Int64 -> IO (PGResult o)+pgresultOfInt64 = toPGResult++-- | Class of types that can be converted to a+-- 'PGResult'.+--+-- This package provides instances for 'Int64'+-- and @['Only' 'Int']@+class ToPGResult r where+ fromRes :: r -> PGResult o++instance ToPGResult Int64 where+ fromRes = PGResult++instance ToPGResult [Only Int] where+ fromRes ns = PGResult n+ where n = getSum $ foldMap (Sum . fromIntegral . fromOnly) ns++-- | If the 'Int64' is smaller than 1, status 400 and a+-- suitable error message. Status 201 and empty message otherwise.+instance Response (UpdateResponse Add) (PGResult Add) where+ toResponse n = (response, statuscode)++ where response = UpdateResponse successful msg+ successful = n > 0+ msg = if successful then "" else "no entry added"+ statuscode = if successful then status201 else status400++-- | If the 'Int64' is smaller than 1, status 400 and a+-- suitable error message. Status200 and empty message otherwise.+instance Response (UpdateResponse Delete) (PGResult Delete) where+ toResponse n = (response, statuscode)++ where response = UpdateResponse successful msg+ successful = n > 0+ msg = if successful then "" else "couldn't delete: target entry doesn't exist"+ statuscode = if successful then status200 else status404++-- | If the 'Int64' is smaller than 1, status 400 and a+-- suitable error message. Status200 and empty message otherwise.+instance Response (UpdateResponse Update) (PGResult Update) where+ toResponse n = (response, statuscode)++ where response = UpdateResponse successful msg+ successful = n > 0+ msg = if successful then "" else "couldn't update: target entry doesn't exist"+ statuscode = if successful then status200 else status404