persistent-database-url 1.0.0 → 1.1.0

raw patch · 2 files changed

+23/−16 lines, 2 filesdep +string-conversionsdep +textdep ~uri-bytestringnew-uploader

Dependencies added: string-conversions, text

Dependency ranges changed: uri-bytestring

Files

• persistent-database-url.cabal +6/−2
• src/Database/Persist/URL.hs +17/−14

@@ -1,5 +1,5 @@ name:                   persistent-database-url-version:                1.0.0+version:                1.1.0 author:                 Joe Ferris <jferris@thoughtbot.com> maintainer:             Joe Ferris <jferris@thoughtbot.com> license:                MIT@@ -24,8 +24,10 @@   build-depends:        base >= 4 && < 5                       , bytestring                       , persistent-postgresql >= 1.0.0-                      , uri-bytestring+                      , uri-bytestring < 0.2.0                       , fail+                      , string-conversions+                      , text  test-suite spec   type:                 exitcode-stdio-1.0@@ -37,6 +39,8 @@                       , hspec                       , persistent-database-url                       , persistent-postgresql+                      , bytestring+                      , text  source-repository head   type:                 git

@@ -1,12 +1,14 @@+{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} module Database.Persist.URL     ( fromDatabaseUrl     ) where -import Control.Monad (unless)-import Control.Monad.Fail (MonadFail)+import Control.Monad (MonadPlus, mzero, unless) import Data.ByteString (ByteString, uncons) import Data.Monoid ((<>))+import Data.String.Conversions (ConvertibleStrings(..))+import Data.String.Conversions.Monomorphic (toStrictByteString) import Database.Persist.Postgresql (PostgresConf(..)) import URI.ByteString     ( Authority(..)@@ -22,15 +24,16 @@ import qualified Data.ByteString.Char8 as Char8  -- | Build a @'PostgresConf'@ by parsing a database URL String-fromDatabaseUrl :: MonadFail m => Int -> ByteString -> m PostgresConf+fromDatabaseUrl+    :: (MonadPlus m, ConvertibleStrings s ByteString)+    => Int -> s -> m PostgresConf fromDatabaseUrl size url = do-    uri <- abortLeft $ parseURI strictURIParserOptions url-    auth <- abortNothing "authority" $ uriAuthority uri-    userInfo <- abortNothing "user info" $ authorityUserInfo auth-    port <- abortNothing "port" $ authorityPort auth-    dbName <- abortNothing "path" $ snd <$> uncons (uriPath uri)-    unless (schemeBS (uriScheme uri) == "postgres") $-        fail "DATABASE_URL has unknown scheme"+    uri <- abortLeft $ parseURI strictURIParserOptions $ toStrictByteString url+    auth <- abortNothing $ uriAuthority uri+    userInfo <- abortNothing $ authorityUserInfo auth+    port <- abortNothing $ authorityPort auth+    dbName <- abortNothing $ snd <$> uncons (uriPath uri)+    unless (schemeBS (uriScheme uri) == "postgres") mzero      return PostgresConf         { pgConnStr =@@ -42,8 +45,8 @@         , pgPoolSize = size         } -abortLeft :: (MonadFail m, Show e) => Either e b -> m b-abortLeft = either (fail . ("DATABASE_URL failed to parse: " <>) . show) return+abortLeft :: (MonadPlus m, Show e) => Either e b -> m b+abortLeft = either (const mzero) return -abortNothing :: MonadFail m => String -> Maybe a -> m a-abortNothing s = maybe (fail $ "DATABASE_URL is missing " <> s) return+abortNothing :: MonadPlus m => Maybe a -> m a+abortNothing = maybe mzero return