arbor-postgres 0.0.1 → 0.0.2

raw patch · 2 files changed

+51/−23 lines, 2 filesdep +bytestringnew-uploaderPVP ok

version bump matches the API change (PVP)

Dependencies added: bytestring

API changes (from Hackage documentation)

Files

• arbor-postgres.cabal +11/−11
• src/Arbor/Postgres/Core.hs +40/−12

@@ -1,11 +1,9 @@--- This file has been generated from package.yaml by hpack version 0.28.2.+-- This file has been generated from package.yaml by hpack version 0.18.1. -- -- see: https://github.com/sol/hpack------ hash: 7a648493a1802368bb2f1a09b72f5ee62b46affb3916b8846f6d9d0d6e8c8b84  name:           arbor-postgres-version:        0.0.1+version:        0.0.2 synopsis:       Convenience types and functions for postgresql-simple. description:    Please see the README on Github at <https://github.com/arbor/arbor-postgres#readme> category:       Services@@ -18,6 +16,7 @@ license-file:   LICENSE build-type:     Simple cabal-version:  >= 1.10+ extra-source-files:     ChangeLog.md     README.md@@ -32,13 +31,14 @@   default-extensions: BangPatterns FlexibleContexts FlexibleInstances GeneralizedNewtypeDeriving MultiParamTypeClasses OverloadedStrings TupleSections   ghc-options: -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints   build-depends:-      base >=4.7 && <5-    , generic-lens >=1.0.0.2 && <2-    , lens >=4.16 && <5-    , network-uri >=2.6 && <3-    , optparse-applicative >=0.14 && <0.15-    , postgresql-simple >=0.5 && <0.6-    , text >=1.2 && <1.3+      base                  >= 4.7      && < 5+    , bytestring            >= 0.10     && < 0.11+    , generic-lens          >= 1.0.0.2  && < 2+    , lens                  >= 4.16     && < 5+    , network-uri           >= 2.6      && < 3+    , optparse-applicative  >= 0.14     && < 0.15+    , postgresql-simple     >= 0.5      && < 0.6+    , text                  >= 1.2      && < 1.3   exposed-modules:       Arbor.Postgres.Config       Arbor.Postgres.Core

@@ -1,40 +1,68 @@-{-# LANGUAGE DataKinds        #-}-{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE DataKinds         #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeApplications  #-}  module Arbor.Postgres.Core where -import Arbor.Postgres.Config     (PostgresConfig) import Arbor.Postgres.Password+import Control.Exception         (catch, throw) import Control.Lens+import Control.Monad             (void)+import Data.ByteString import Data.Generics.Product.Any+import Data.Int import Data.Monoid               ((<>)) import Data.String import Network.URI +import qualified Arbor.Postgres.Config      as Z import qualified Arbor.Postgres.Env         as E import qualified Data.Text                  as T import qualified Data.Text.Encoding         as T import qualified Database.PostgreSQL.Simple as PGS -connectPostgres :: PostgresConfig -> IO E.PostgresEnv-connectPostgres postgresConfig = do-  let host     = postgresConfig ^. the @"host"-  let dbname   = postgresConfig ^. the @"database"-  let user     = postgresConfig ^. the @"user"-  let mPassword = postgresConfig ^. the @"password"+parseConfig :: Z.PostgresConfig -> ByteString+parseConfig postgresConfig = do+  let host       = postgresConfig ^. the @"host"+  let dbname     = postgresConfig ^. the @"database"+  let user       = postgresConfig ^. the @"user"+  let mPassword  = postgresConfig ^. the @"password"   let kvPassword = case mPassword of         Just (Password password) -> [("password", password)]         Nothing                  -> []   let kvs = [("host", host), ("dbname", dbname), ("user", user)] <> kvPassword-  let kvStrings = kvs <&> (\(k, v) -> k <> "='" <> v <> "'")-  conn <- PGS.connectPostgreSQL $ T.encodeUtf8 $ T.intercalate " " kvStrings+  let pairs = kvs <&> (\(k, v) -> k <> "='" <> v <> "'")+  T.encodeUtf8 $ T.intercalate " " pairs++-- because we need a double quoted, not single quoted string,+-- we need to explicitly not use sql interpolation here.+createDatabaseStatement :: T.Text -> PGS.Query+createDatabaseStatement db = fromString . T.unpack $ "CREATE DATABASE \"" <> db <> "\""++createDatabase :: Z.PostgresConfig -> IO ()+createDatabase postgresConfig = do+  conn <- PGS.connectPostgreSQL $ parseConfig $ postgresConfig { Z.database = "postgres" }+  let q = createDatabaseStatement (postgresConfig ^. the @"database")+  void $ PGS.execute_ conn q `catch` duplicateDatabase++-- https://www.postgresql.org/docs/8.2/static/errcodes-appendix.html+-- 42P04	DUPLICATE DATABASE	duplicate_database+duplicateDatabase :: PGS.SqlError -> IO Int64+duplicateDatabase e =+  if PGS.sqlState e == "42P04"+    then return 0+    else throw e++connectPostgres :: Z.PostgresConfig -> IO E.PostgresEnv+connectPostgres postgresConfig = do+  conn <- PGS.connectPostgreSQL $ parseConfig postgresConfig   return $ E.PostgresEnv conn (mkConnectionString postgresConfig)  newtype Table = Table   { table :: T.Text }   deriving (IsString, Show) -mkConnectionString :: PostgresConfig -> URI+mkConnectionString :: Z.PostgresConfig -> URI mkConnectionString config = do   let host = config ^. the @"host" & T.unpack   let dbname = config ^. the @"database" & T.unpack