persistent-postgresql 0.6.0 → 0.6.1

raw patch · 2 files changed

+46/−2 lines, 2 filesdep +data-objectdep +neitherdep ~persistent

Dependencies added: data-object, neither

Dependency ranges changed: persistent

Files

• Database/Persist/Postgresql.hs +42/−0
• persistent-postgresql.cabal +4/−2

@@ -1,10 +1,12 @@ {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeFamilies #-} -- | A postgresql backend for persistent. module Database.Persist.Postgresql     ( withPostgresqlPool     , withPostgresqlConn     , module Database.Persist     , module Database.Persist.GenericSql+    , PostgresConf (..)     ) where  import Database.Persist hiding (Update)@@ -31,6 +33,9 @@ import qualified Data.Text.Encoding.Error as T import Data.Time.LocalTime (localTimeToUTC, utc) import Data.Text (Text, pack, unpack)+import Data.Object+import Control.Monad (forM)+import Data.Neither (meither, MEither (..))  withPostgresqlPool :: MonadControlIO m                    => T.Text@@ -447,3 +452,40 @@  bsToChars :: ByteString -> String bsToChars = T.unpack . T.decodeUtf8With T.lenientDecode++-- | Information required to connect to a postgres database+data PostgresConf = PostgresConf+    { pgConnStr  :: Text+    , pgPoolSize :: Int+    }++instance PersistConfig PostgresConf where+    type PersistConfigBackend PostgresConf = SqlPersist+    type PersistConfigPool PostgresConf = ConnectionPool+    withPool (PostgresConf cs size) = withPostgresqlPool cs size+    runPool _ = runSqlPool+    loadConfig e' = meither Left Right $ do+        e <- go $ fromMapping e'+        db <- go $ lookupScalar "database" e+        pool' <- go $ lookupScalar "poolsize" e+        pool <- safeRead "poolsize" pool'++        -- TODO: default host/port?+        connparts <- forM ["user", "password", "host", "port"] $ \k -> do+            v <- go $ lookupScalar k e+            return $ T.concat [k, "=", v, " "]++        let conn = T.concat connparts++        return $ PostgresConf (T.concat [conn, " dbname=", db]) pool+      where+        go :: MEither ObjectExtractError a -> MEither String a+        go (MLeft e) = MLeft $ show e+        go (MRight a) = MRight a++safeRead :: String -> T.Text -> MEither String Int+safeRead name t = case reads s of+    (i, _):_ -> MRight i+    []       -> MLeft $ concat ["Invalid value for ", name, ": ", s]+  where+    s = T.unpack t

@@ -1,5 +1,5 @@ name:            persistent-postgresql-version:         0.6.0+version:         0.6.1 license:         BSD3 license-file:    LICENSE author:          Michael Snoyman <michael@snoyman.com>@@ -17,12 +17,14 @@                    , HDBC                  >= 2.2.6    && < 2.4                    , transformers          >= 0.2.1    && < 0.3                    , HDBC-postgresql       >= 2.2.3.1  && < 2.4-                   , persistent            >= 0.6      && < 0.7+                   , persistent            >= 0.6.3    && < 0.7                    , containers            >= 0.2      && < 0.5                    , bytestring            >= 0.9      && < 0.10                    , text                  >= 0.7      && < 0.12                    , monad-control         >= 0.2      && < 0.3                    , time                  >= 1.1      && < 1.3+                   , data-object           >= 0.3      && < 0.4+                   , neither               >= 0.3      && < 0.4     exposed-modules: Database.Persist.Postgresql     ghc-options:     -Wall