packages feed

postgresql-simple-opts 0.4.0.0 → 0.5.0.0

raw patch · 4 files changed

+424/−232 lines, 4 filesdep +containersdep +envy

Dependencies added: containers, envy

Files

postgresql-simple-opts.cabal view
@@ -1,7 +1,7 @@ name:                postgresql-simple-opts-version:             0.4.0.0-synopsis:            An optparse-applicative parser for postgresql-simple's connection options-description:         This package exports a optparse-applicative parser and type for postgresql-simple's Options and connection string.+version:             0.5.0.0+synopsis:            An optparse-applicative and envy parser for postgresql-simple's connection options+description:         This package exports a optparse-applicative and envy parser and type for postgresql-simple's Options and connection string. homepage:            https://github.com/jfischoff/postgresql-simple-opts#readme license:             BSD3 license-file:        LICENSE@@ -15,7 +15,8 @@  library   hs-source-dirs:      src-  exposed-modules:     Database.PostgreSQL.Simple.PartialOptions+  exposed-modules: Database.PostgreSQL.Simple.PartialOptions+                 , Database.PostgreSQL.Simple.PartialOptions.Internal   build-depends: base >= 4.6 && < 5                , postgresql-simple                , optparse-applicative@@ -27,6 +28,7 @@                , uri-bytestring                , generic-deriving                , postgres-options+               , envy   default-language:    Haskell2010   ghc-options: -Wall                -fno-warn-unused-do-bind@@ -36,6 +38,7 @@   hs-source-dirs:      test   main-is:             Spec.hs   build-depends:       base+                     , containers                      , postgresql-simple-opts                      , hspec                      , postgresql-simple
src/Database/PostgreSQL/Simple/PartialOptions.hs view
@@ -3,228 +3,10 @@ -} {-# LANGUAGE RecordWildCards, LambdaCase, DeriveGeneric, DeriveDataTypeable #-} {-# LANGUAGE CPP, GADTs, OverloadedStrings #-}--module Database.PostgreSQL.Simple.PartialOptions where--import Control.Monad ((<=<), foldM)-import Data.ByteString (ByteString)-import qualified Data.ByteString as BS-import qualified Data.ByteString.Char8 as BSC-import Data.Char (isUpper, toLower)-import Data.Default (Default(..))-import qualified Data.Either.Validation as DEV-import Data.Either.Validation (Validation(..), validationToEither)-import Data.List (intercalate)-import Data.List.Split (splitOn)-import Data.Typeable (Typeable)-import Database.PostgreSQL.Simple (ConnectInfo(..), Connection, connectPostgreSQL, defaultConnectInfo)-import Database.PostgreSQL.Simple.Options (Options(..), toConnectionString)-import GHC.Generics (Generic)-import Generics.Deriving.Monoid (Last(..), gmappenddefault, gmemptydefault)-import Options.Applicative (Parser, (<|>), eitherReader, long, option)-import Options.Generic (Modifiers(..), ParseRecord(..), defaultModifiers, parseRecordWithModifiers)-import Text.Read (readMaybe)-import URI.ByteString as URI---- | An optional version of 'Options'. This includes an instance of--- | 'ParseRecord' which provides the optparse-applicative Parser.-data PartialOptions = PartialOptions-  { host                    :: Last String-  , hostaddr                :: Last String-  , port                    :: Last Int-  , user                    :: Last String-  , password                :: Last String-  , dbname                  :: Last String-  , connectTimeout          :: Last Int-  , clientEncoding          :: Last String-  , options                 :: Last String-  , fallbackApplicationName :: Last String-  , keepalives              :: Last Int-  , keepalivesIdle          :: Last Int-  , keepalivesCount         :: Last Int-  , sslmode                 :: Last String-  , requiressl              :: Last Int-  , sslcompression          :: Last Int-  , sslcert                 :: Last String-  , sslkey                  :: Last String-  , sslrootcert             :: Last String-  , requirepeer             :: Last String-  , krbsrvname              :: Last String-  , gsslib                  :: Last String-  , service                 :: Last String-  } deriving (Show, Eq, Read, Ord, Generic, Typeable)--instance ParseRecord PartialOptions where-  parseRecord = option (eitherReader parseConnectionString) (long "connectString")-    <|> parseRecordWithModifiers defaultModifiers--instance Semigroup PartialOptions where-  (<>) = gmappenddefault--instance Monoid PartialOptions where-  mempty = gmemptydefault-  mappend = (<>)---- Copied from Options.Generic source code-underscoreModifiers :: Modifiers-underscoreModifiers = Modifiers lispCase lispCase (const Nothing)-  where-    lispCase = dropWhile (== '_') . (>>= lower) . dropWhile (== '_')-    lower c | isUpper c = ['_', toLower c]-            | otherwise = [c]---unSingleQuote :: String -> Maybe String-unSingleQuote (x : xs@(_ : _))-  | x == '\'' && last xs == '\'' = Just $ init xs-  | otherwise                    = Nothing-unSingleQuote _                  = Nothing--parseString :: String -> Maybe String-parseString x = readMaybe x <|> unSingleQuote x <|> Just x--mkLast :: a -> Last a-mkLast = Last . Just---- | The 'PartialOptions' version of 'defaultOptions'-instance Default PartialOptions where-    def = mempty-      { host     = mkLast $                connectHost     defaultConnectInfo-      , port     = mkLast $ fromIntegral $ connectPort     defaultConnectInfo-      , user     = mkLast $                connectUser     defaultConnectInfo-      , password = mkLast $                connectPassword defaultConnectInfo-      , dbname = mkLast $                  connectDatabase defaultConnectInfo-      }--getOption :: String -> Last a -> Validation [String] a-getOption optionName = \case-    Last (Just x) -> pure x-    Last Nothing  -> DEV.Failure ["Missing " ++ optionName ++ " option"]--getLast' :: Applicative f => Last a -> f (Maybe a)-getLast' = pure . getLast--completeOptions :: PartialOptions -> Either [String] Options-completeOptions PartialOptions {..} = validationToEither $-  Options <$> getLast' host-          <*> getLast' hostaddr-          <*> (fmap fromIntegral <$> getLast' port)-          <*> getLast' user-          <*> getLast' password-          <*> getOption "dbname" dbname-          <*> getLast' connectTimeout-          <*> getLast' clientEncoding-          <*> getLast' options-          <*> getLast' fallbackApplicationName-          <*> getLast' keepalives-          <*> getLast' keepalivesIdle-          <*> getLast' keepalivesCount-          <*> getLast' sslmode-          <*> getLast' requiressl-          <*> getLast' sslcompression-          <*> getLast' sslcert-          <*> getLast' sslkey-          <*> getLast' sslrootcert-          <*> getLast' requirepeer-          <*> getLast' krbsrvname-          <*> getLast' gsslib-          <*> getLast' service---- | Useful for testing or if only Options are needed.-completeParser :: Parser Options-completeParser =-    fmap (either (error . unlines) id . completeOptions . mappend def) parseRecord---- | Create a connection with an 'Option'-run :: Options -> IO Connection-run = connectPostgreSQL . toConnectionString--userInfoToPartialOptions :: UserInfo -> PartialOptions-userInfoToPartialOptions UserInfo {..} = mempty { user = return $ BSC.unpack uiUsername } <> if BS.null uiPassword-  then mempty-  else mempty { password = return $ BSC.unpack uiPassword }--autorityToPartialOptions :: Authority -> PartialOptions-autorityToPartialOptions Authority {..} = maybe mempty userInfoToPartialOptions authorityUserInfo <>-  mempty { host = return $ BSC.unpack $ hostBS authorityHost } <>-  maybe mempty (\p -> mempty { port = return $ portNumber p }) authorityPort--pathToPartialOptions :: ByteString -> PartialOptions-pathToPartialOptions path = case drop 1 $ BSC.unpack path of-  "" -> mempty-  x  -> mempty {dbname = return x }--parseInt :: String -> String -> Either String Int-parseInt msg v = maybe (Left (msg <> " value of: " <> v <> " is not a number")) Right $-      readMaybe v--keywordToPartialOptions :: String -> String -> Either String PartialOptions-keywordToPartialOptions k v = case k of-  "host" -> return $ mempty { host = return v }-  "hostaddress" -> return $ mempty { hostaddr = return v }-  "port" -> do-    portValue <- parseInt "port" v-    return $ mempty { port = return portValue }-  "user" -> return $ mempty { user = return v }-  "password" -> return $ mempty { password = return v }-  "dbname" -> return $ mempty { dbname = return v}-  "connect_timeout" -> do-    x <- parseInt "connect_timeout" v-    return $ mempty { connectTimeout = return x }-  "client_encoding" -> return $ mempty { clientEncoding = return v }-  "options" -> return $ mempty { options = return v }-  "fallback_applicationName" -> return $ mempty { fallbackApplicationName = return v }-  "keepalives" -> do-    x <- parseInt "keepalives" v-    return $ mempty { keepalives = return x }-  "keepalives_idle" -> do-    x <- parseInt "keepalives_idle" v-    return $ mempty { keepalivesIdle = return x }-  "keepalives_count" -> do-    x <- parseInt "keepalives_count" v-    return $ mempty { keepalivesCount = return x }-  "sslmode" -> return $ mempty { sslmode = return v }-  "requiressl" -> do-    x <- parseInt "requiressl" v-    return $ mempty { requiressl = return x }-  "sslcompression" -> do-    x <- parseInt "sslcompression" v-    return $ mempty { sslcompression = return x }-  "sslcert" -> return $ mempty { sslcert = return v }-  "sslkey" -> return $ mempty { sslkey = return v }-  "sslrootcert" -> return $ mempty { sslrootcert = return v }-  "requirepeer" -> return $ mempty { requirepeer = return v }-  "krbsrvname" -> return $ mempty { krbsrvname = return v }-  "gsslib" -> return $ mempty { gsslib = return v }-  "service" -> return $ mempty { service = return v }--  x -> Left $ "Unrecongnized option: " ++ show x--queryToPartialOptions :: URI.Query -> Either String PartialOptions-queryToPartialOptions Query {..} = foldM (\acc (k, v) -> fmap (mappend acc) $ keywordToPartialOptions (BSC.unpack k) $ BSC.unpack v) mempty queryPairs--uriToOptions :: URIRef Absolute -> Either String PartialOptions-uriToOptions URI {..} = case schemeBS uriScheme of-  "postgresql" -> do-    queryParts <- queryToPartialOptions uriQuery-    return $ maybe mempty autorityToPartialOptions uriAuthority <>-      pathToPartialOptions uriPath <> queryParts--  x -> Left $ "Wrong protocol. Expected \"postgresql\" but got: " ++ show x--parseURIStr :: String -> Either String (URIRef Absolute)-parseURIStr = left show . parseURI strictURIParserOptions . BSC.pack where-  left f = \case-    Left x -> Left $ f x-    Right x -> Right x--parseKeywords :: String -> Either String PartialOptions-parseKeywords [] = Left "Failed to parse keywords"-parseKeywords x = fmap mconcat . mapM (uncurry keywordToPartialOptions <=< toTuple . splitOn "=") $ words x where-  toTuple [k, v] = return (k, v)-  toTuple xs = Left $ "invalid opts:" ++ show (intercalate "=" xs)--parseConnectionString :: String -> Either String PartialOptions-parseConnectionString url = do-  url' <- maybe (Left "failed to parse as string") Right $ parseString url-  parseKeywords url' <|> (uriToOptions =<< parseURIStr url')+module Database.PostgreSQL.Simple.PartialOptions+  ( PartialOptions(..)+  , parseConnectionString+  , completeParser+  , completeOptions+  ) where+import Database.PostgreSQL.Simple.PartialOptions.Internal
+ src/Database/PostgreSQL/Simple/PartialOptions/Internal.hs view
@@ -0,0 +1,291 @@+{-| A resuable optparse-applicative parser for creating a postgresql-simple+   'Connection'+-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# LANGUAGE RecordWildCards, LambdaCase, DeriveGeneric, DeriveDataTypeable #-}+{-# LANGUAGE CPP, GADTs, OverloadedStrings, StandaloneDeriving, GeneralizedNewtypeDeriving #-}++module Database.PostgreSQL.Simple.PartialOptions.Internal where++import Control.Monad ((<=<), foldM)+import Data.ByteString (ByteString)+import qualified Data.ByteString as BS+import qualified Data.ByteString.Char8 as BSC+import Data.Char (isUpper, toLower)+import Data.Default (Default(..))+import qualified Data.Either.Validation as DEV+import Data.Either.Validation (Validation(..), validationToEither)+import Data.List (intercalate)+import Data.List.Split (splitOn)+import Data.Typeable (Typeable)+import Database.PostgreSQL.Simple (ConnectInfo(..), Connection, connectPostgreSQL, defaultConnectInfo)+import Database.PostgreSQL.Simple.Options (Options(..), toConnectionString)+import GHC.Generics (Generic)+import Generics.Deriving.Monoid (Last(..), gmappenddefault, gmemptydefault)+import Options.Applicative (Parser, (<|>), eitherReader, long, option)+import Options.Generic (Modifiers(..), ParseRecord(..), defaultModifiers, parseRecordWithModifiers)+import Text.Read (readMaybe)+import URI.ByteString as URI+import System.Envy hiding (Parser)++-- | An optional version of 'Options'. This includes an instance of+-- | 'ParseRecord' which provides the optparse-applicative Parser.+data PartialOptions = PartialOptions+  { host                    :: Last String+  , hostaddr                :: Last String+  , port                    :: Last Int+  , user                    :: Last String+  , password                :: Last String+  , dbname                  :: Last String+  , connectTimeout          :: Last Int+  , clientEncoding          :: Last String+  , options                 :: Last String+  , fallbackApplicationName :: Last String+  , keepalives              :: Last Int+  , keepalivesIdle          :: Last Int+  , keepalivesCount         :: Last Int+  , sslmode                 :: Last String+  , requiressl              :: Last Int+  , sslcompression          :: Last Int+  , sslcert                 :: Last String+  , sslkey                  :: Last String+  , sslrootcert             :: Last String+  , requirepeer             :: Last String+  , krbsrvname              :: Last String+  , gsslib                  :: Last String+  , service                 :: Last String+  } deriving (Show, Eq, Read, Ord, Generic, Typeable)++instance FromEnv PartialOptions where+  fromEnv+      = PartialOptions+    <$> env "PGHOST"+    <*> env "PGHOSTADDR"+    <*> env "PGPORT"+    <*> env "PGUSER"+    <*> env "PGPASSWORD"+    <*> env "PGDATABASE"+    <*> env "PGCONNECT_TIMEOUT"+    <*> env "PGCLIENTENCODING"+    <*> env "PGOPTIONS"+    <*> env "PGAPPNAME"+    <*> env "PGKEEPALIVES"+    <*> env "PGKEEPALIVESIDLE"+    <*> env "PGKEEPALIVESCOUNT"+    <*> env "PGSSLMODE"+    <*> env "PGREQUIRESSL"+    <*> env "PGSSLCOMPRESSION"+    <*> env "PGSSLCERT"+    <*> env "PGSSLKEY"+    <*> env "PGSSLROOTCERT"+    <*> env "PGREQUIREPEER"+    <*> env "PGKRBSRVNAME"+    <*> env "PGGSSLIB"+    <*> env "PGSERVICE"++instance ToEnv PartialOptions where+  toEnv PartialOptions {..} = makeEnv+    [ "PGHOST"            .= host+    , "PGHOSTADDR"        .= hostaddr+    , "PGPORT"            .= port+    , "PGUSER"            .= user+    , "PGPASSWORD"        .= password+    , "PGDATABASE"        .= dbname+    , "PGCONNECT_TIMEOUT" .= connectTimeout+    , "PGCLIENTENCODING"  .= clientEncoding+    , "PGOPTIONS"         .= options+    , "PGAPPNAME"         .= fallbackApplicationName+    , "PGKEEPALIVES"      .= keepalives+    , "PGKEEPALIVESIDLE"  .= keepalivesIdle+    , "PGKEEPALIVESCOUNT" .= keepalivesCount+    , "PGSSLMODE"         .= sslmode+    , "PGREQUIRESSL"      .= requiressl+    , "PGSSLCOMPRESSION"  .= sslcompression+    , "PGSSLCERT"         .= sslcert+    , "PGSSLKEY"          .= sslkey+    , "PGSSLROOTCERT"     .= sslrootcert+    , "PGREQUIREPEER"     .= requirepeer+    , "PGKRBSRVNAME"      .= krbsrvname+    , "PGGSSLIB"          .= gsslib+    , "PGSERVICE"         .= service+    ]++deriving instance (Var a, Typeable a) => Var (Last a)++instance DefConfig PartialOptions where+  defConfig = mempty++instance ParseRecord PartialOptions where+  parseRecord = option (eitherReader parseConnectionString) (long "connectString")+    <|> parseRecordWithModifiers defaultModifiers++instance Semigroup PartialOptions where+  (<>) = gmappenddefault++instance Monoid PartialOptions where+  mempty = gmemptydefault+  mappend = (<>)++-- Copied from Options.Generic source code+underscoreModifiers :: Modifiers+underscoreModifiers = Modifiers lispCase lispCase (const Nothing)+  where+    lispCase = dropWhile (== '_') . (>>= lower) . dropWhile (== '_')+    lower c | isUpper c = ['_', toLower c]+            | otherwise = [c]+++unSingleQuote :: String -> Maybe String+unSingleQuote (x : xs@(_ : _))+  | x == '\'' && last xs == '\'' = Just $ init xs+  | otherwise                    = Nothing+unSingleQuote _                  = Nothing++parseString :: String -> Maybe String+parseString x = readMaybe x <|> unSingleQuote x <|> Just x++mkLast :: a -> Last a+mkLast = Last . Just++-- | The 'PartialOptions' version of 'defaultOptions'+instance Default PartialOptions where+    def = mempty+      { host     = mkLast $                connectHost     defaultConnectInfo+      , port     = mkLast $ fromIntegral $ connectPort     defaultConnectInfo+      , user     = mkLast $                connectUser     defaultConnectInfo+      , password = mkLast $                connectPassword defaultConnectInfo+      , dbname   = mkLast $                connectDatabase defaultConnectInfo+      }++getOption :: String -> Last a -> Validation [String] a+getOption optionName = \case+    Last (Just x) -> pure x+    Last Nothing  -> DEV.Failure ["Missing " ++ optionName ++ " option"]++getLast' :: Applicative f => Last a -> f (Maybe a)+getLast' = pure . getLast++completeOptions :: PartialOptions -> Either [String] Options+completeOptions PartialOptions {..} = validationToEither $+  Options <$> getLast' host+          <*> getLast' hostaddr+          <*> (fmap fromIntegral <$> getLast' port)+          <*> getLast' user+          <*> getLast' password+          <*> getOption "dbname" dbname+          <*> getLast' connectTimeout+          <*> getLast' clientEncoding+          <*> getLast' options+          <*> getLast' fallbackApplicationName+          <*> getLast' keepalives+          <*> getLast' keepalivesIdle+          <*> getLast' keepalivesCount+          <*> getLast' sslmode+          <*> getLast' requiressl+          <*> getLast' sslcompression+          <*> getLast' sslcert+          <*> getLast' sslkey+          <*> getLast' sslrootcert+          <*> getLast' requirepeer+          <*> getLast' krbsrvname+          <*> getLast' gsslib+          <*> getLast' service++-- | Useful for testing or if only Options are needed.+completeParser :: Parser Options+completeParser =+    fmap (either (error . unlines) id . completeOptions . mappend def) parseRecord++-- | Create a connection with an 'Option'+run :: Options -> IO Connection+run = connectPostgreSQL . toConnectionString++userInfoToPartialOptions :: UserInfo -> PartialOptions+userInfoToPartialOptions UserInfo {..} = mempty { user = return $ BSC.unpack uiUsername } <> if BS.null uiPassword+  then mempty+  else mempty { password = return $ BSC.unpack uiPassword }++autorityToPartialOptions :: Authority -> PartialOptions+autorityToPartialOptions Authority {..} = maybe mempty userInfoToPartialOptions authorityUserInfo <>+  mempty { host = return $ BSC.unpack $ hostBS authorityHost } <>+  maybe mempty (\p -> mempty { port = return $ portNumber p }) authorityPort++pathToPartialOptions :: ByteString -> PartialOptions+pathToPartialOptions path = case drop 1 $ BSC.unpack path of+  "" -> mempty+  x  -> mempty {dbname = return x }++parseInt :: String -> String -> Either String Int+parseInt msg v = maybe (Left (msg <> " value of: " <> v <> " is not a number")) Right $+      readMaybe v++keywordToPartialOptions :: String -> String -> Either String PartialOptions+keywordToPartialOptions k v = case k of+  "host" -> return $ mempty { host = return v }+  "hostaddress" -> return $ mempty { hostaddr = return v }+  "port" -> do+    portValue <- parseInt "port" v+    return $ mempty { port = return portValue }+  "user" -> return $ mempty { user = return v }+  "password" -> return $ mempty { password = return v }+  "dbname" -> return $ mempty { dbname = return v}+  "connect_timeout" -> do+    x <- parseInt "connect_timeout" v+    return $ mempty { connectTimeout = return x }+  "client_encoding" -> return $ mempty { clientEncoding = return v }+  "options" -> return $ mempty { options = return v }+  "fallback_applicationName" -> return $ mempty { fallbackApplicationName = return v }+  "keepalives" -> do+    x <- parseInt "keepalives" v+    return $ mempty { keepalives = return x }+  "keepalives_idle" -> do+    x <- parseInt "keepalives_idle" v+    return $ mempty { keepalivesIdle = return x }+  "keepalives_count" -> do+    x <- parseInt "keepalives_count" v+    return $ mempty { keepalivesCount = return x }+  "sslmode" -> return $ mempty { sslmode = return v }+  "requiressl" -> do+    x <- parseInt "requiressl" v+    return $ mempty { requiressl = return x }+  "sslcompression" -> do+    x <- parseInt "sslcompression" v+    return $ mempty { sslcompression = return x }+  "sslcert" -> return $ mempty { sslcert = return v }+  "sslkey" -> return $ mempty { sslkey = return v }+  "sslrootcert" -> return $ mempty { sslrootcert = return v }+  "requirepeer" -> return $ mempty { requirepeer = return v }+  "krbsrvname" -> return $ mempty { krbsrvname = return v }+  "gsslib" -> return $ mempty { gsslib = return v }+  "service" -> return $ mempty { service = return v }++  x -> Left $ "Unrecongnized option: " ++ show x++queryToPartialOptions :: URI.Query -> Either String PartialOptions+queryToPartialOptions Query {..} = foldM (\acc (k, v) -> fmap (mappend acc) $ keywordToPartialOptions (BSC.unpack k) $ BSC.unpack v) mempty queryPairs++uriToOptions :: URIRef Absolute -> Either String PartialOptions+uriToOptions URI {..} = case schemeBS uriScheme of+  "postgresql" -> do+    queryParts <- queryToPartialOptions uriQuery+    return $ maybe mempty autorityToPartialOptions uriAuthority <>+      pathToPartialOptions uriPath <> queryParts++  x -> Left $ "Wrong protocol. Expected \"postgresql\" but got: " ++ show x++parseURIStr :: String -> Either String (URIRef Absolute)+parseURIStr = left show . parseURI strictURIParserOptions . BSC.pack where+  left f = \case+    Left x -> Left $ f x+    Right x -> Right x++parseKeywords :: String -> Either String PartialOptions+parseKeywords [] = Left "Failed to parse keywords"+parseKeywords x = fmap mconcat . mapM (uncurry keywordToPartialOptions <=< toTuple . splitOn "=") $ words x where+  toTuple [k, v] = return (k, v)+  toTuple xs = Left $ "invalid opts:" ++ show (intercalate "=" xs)++parseConnectionString :: String -> Either String PartialOptions+parseConnectionString url = do+  url' <- maybe (Left "failed to parse as string") Right $ parseString url+  parseKeywords url' <|> (uriToOptions =<< parseURIStr url')
test/Spec.hs view
@@ -1,19 +1,135 @@ {-# LANGUAGE OverloadedStrings, CPP #-} import Test.Hspec import Database.PostgreSQL.Simple.PartialOptions+import Database.PostgreSQL.Simple.Options import System.Environment import Options.Applicative import System.Exit import Data.Default-#if !MIN_VERSION_base(4,8,0)-import Data.Monoid-#endif+import qualified System.Envy as E+import qualified Data.Map as Map  testParser :: IO Options testParser = execParser $ info completeParser mempty  main :: IO () main = hspec $ do+  describe "Env Parser" $ do+    it "parses all options" $ do+      mapM_ (uncurry setEnv)+        [ ("PGHOST"           , "localhost")+        , ("PGHOSTADDR"       , "127.0.0.1")+        , ("PGPORT"           , "1234")+        , ("PGUSER"           , "postgres")+        , ("PGPASSWORD"       , "postgres")+        , ("PGDATABASE"       , "temp1")+        , ("PGCONNECT_TIMEOUT", "100")+        , ("PGCLIENTENCODING" , "something")+        , ("PGOPTIONS"        , "options")+        , ("PGAPPNAME"        , "da app")+        , ("PGKEEPALIVES"     , "1")+        , ("PGKEEPALIVESIDLE" , "2")+        , ("PGKEEPALIVESCOUNT", "3")+        , ("PGSSLMODE"        , "on")+        , ("PGREQUIRESSL"     , "1")+        , ("PGSSLCOMPRESSION" , "0")+        , ("PGSSLCERT"        , "ca.cert")+        , ("PGSSLKEY"         , "fda.key")+        , ("PGSSLROOTCERT"    , "root.cert")+        , ("PGREQUIREPEER"    , "yes")+        , ("PGKRBSRVNAME"     , "blah")+        , ("PGGSSLIB"         , "foo")+        , ("PGSERVICE"        , "bar")+        ]++      let expected = PartialOptions+            { host                    = pure "localhost"+            , hostaddr                = pure "127.0.0.1"+            , port                    = pure 1234+            , user                    = pure "postgres"+            , password                = pure "postgres"+            , dbname                  = pure "temp1"+            , connectTimeout          = pure 100+            , clientEncoding          = pure "something"+            , options                 = pure "options"+            , fallbackApplicationName = pure "da app"+            , keepalives              = pure 1+            , keepalivesIdle          = pure 2+            , keepalivesCount         = pure 3+            , sslmode                 = pure "on"+            , requiressl              = pure 1+            , sslcompression          = pure 0+            , sslcert                 = pure "ca.cert"+            , sslkey                  = pure "fda.key"+            , sslrootcert             = pure "root.cert"+            , requirepeer             = pure "yes"+            , krbsrvname              = pure "blah"+            , gsslib                  = pure "foo"+            , service                 = pure "bar"+            }++      E.decode `shouldReturn` Just expected++    it "adds to the environment all options" $ do+      let intial = PartialOptions+            { host                    = pure "localhost"+            , hostaddr                = pure "127.0.0.1"+            , port                    = pure 1234+            , user                    = pure "postgres"+            , password                = pure "postgres"+            , dbname                  = pure "temp1"+            , connectTimeout          = pure 100+            , clientEncoding          = pure "something"+            , options                 = pure "options"+            , fallbackApplicationName = pure "da app"+            , keepalives              = pure 1+            , keepalivesIdle          = pure 2+            , keepalivesCount         = pure 3+            , sslmode                 = pure "on"+            , requiressl              = pure 1+            , sslcompression          = pure 0+            , sslcert                 = pure "ca.cert"+            , sslkey                  = pure "fda.key"+            , sslrootcert             = pure "root.cert"+            , requirepeer             = pure "yes"+            , krbsrvname              = pure "blah"+            , gsslib                  = pure "foo"+            , service                 = pure "bar"+            }+      mapM_ (unsetEnv . fst) =<< getEnvironment++      E.setEnvironment' intial `shouldReturn` Right ()++      let expected = Map.fromList+            [ ("PGHOST"           , "localhost")+            , ("PGHOSTADDR"       , "127.0.0.1")+            , ("PGPORT"           , "1234")+            , ("PGUSER"           , "postgres")+            , ("PGPASSWORD"       , "postgres")+            , ("PGDATABASE"       , "temp1")+            , ("PGCONNECT_TIMEOUT", "100")+            , ("PGCLIENTENCODING" , "something")+            , ("PGOPTIONS"        , "options")+            , ("PGAPPNAME"        , "da app")+            , ("PGKEEPALIVES"     , "1")+            , ("PGKEEPALIVESIDLE" , "2")+            , ("PGKEEPALIVESCOUNT", "3")+            , ("PGSSLMODE"        , "on")+            , ("PGREQUIRESSL"     , "1")+            , ("PGSSLCOMPRESSION" , "0")+            , ("PGSSLCERT"        , "ca.cert")+            , ("PGSSLKEY"         , "fda.key")+            , ("PGSSLROOTCERT"    , "root.cert")+            , ("PGREQUIREPEER"    , "yes")+            , ("PGKRBSRVNAME"     , "blah")+            , ("PGGSSLIB"         , "foo")+            , ("PGSERVICE"        , "bar")+            ]++      fmap Map.fromList getEnvironment `shouldReturn` expected+++   describe "Options Parser" $ do     it "parses all options" $ do       let testArgs = [ "--host=example.com"