postgresql-simple-url (empty) → 0.1.0.0

raw patch · 7 files changed

+142/−0 lines, 7 filesdep +basedep +network-uridep +postgresql-simplesetup-changed

Dependencies added: base, network-uri, postgresql-simple, postgresql-simple-url, split, tasty, tasty-quickcheck

Files

• .gitignore +4/−0
• LICENSE +20/−0
• README.md +5/−0
• Setup.hs +2/−0
• postgresql-simple-url.cabal +36/−0
• src/Database/PostgreSQL/Simple/URL.hs +56/−0
• tests/Tests.hs +19/−0

@@ -0,0 +1,4 @@+dist/++cabal.sandbox.config+.cabal-sandbox/

@@ -0,0 +1,20 @@+Copyright (c) 2014 Futurice OY, Oleg Grenrus++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

@@ -0,0 +1,5 @@+# posgresql-simple-url++[![Build Status](https://travis-ci.org/futurice/postgresql-simple-url.svg)](https://travis-ci.org/futurice/postgresql-simple-url)++Url parser for posgresql-simple. Useful in heroku.

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,36 @@+name:                postgresql-simple-url+version:             0.1.0.0+synopsis:            PostgreSQL+homepage:            https://github.com/futurice/pulmurice-heroku+license:             MIT+license-file:        LICENSE+author:              Oleg Grenrus+maintainer:          Oleg Grenrus <oleg.grenrus@iki.fi>+copyright:           Copyright © 2014 Futurice OY, Oleg Grenrus+stability:           experimental+category:            Game+build-type:          Simple+extra-source-files:  README.md, .gitignore+cabal-version:       >=1.10++library+  exposed-modules:     Database.PostgreSQL.Simple.URL+  build-depends:       base               >=4.6 && <4.9,+                       split              >=0.2 && <0.3,+                       network-uri        >=2.6 && <2.7,+                       postgresql-simple  >=0.4 && <0.5+  hs-source-dirs:      src+  ghc-options:         -Wall+  default-language:    Haskell2010++test-suite test+  default-language:    Haskell2010+  type:                exitcode-stdio-1.0+  hs-source-dirs:      tests+  main-is:             Tests.hs+  ghc-options:         -Wall+  build-depends:       base               >=4.6  && <4.9,+                       tasty              >=0.10 && <0.11,+                       tasty-quickcheck   >=0.8  && <0.9,+                       postgresql-simple  >=0.4 && <0.5,+                       postgresql-simple-url

@@ -0,0 +1,56 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Database.PostgreSQL.Simple.URL+-- Copyright   :  2014, 2015 © Futurice OY, Oleg Grenrus+-- License     :  MIT (see the file LICENSE)+--+-- Maintainer  :  Oleg Grenrus <oleg.grenrus@iki.fi>+--+----------------------------------------------------------------------------+module Database.PostgreSQL.Simple.URL (parseDatabaseUrl, uriToConnectInfo) where++import Control.Applicative+import Data.List.Split+import Database.PostgreSQL.Simple+import Network.URI++-- | Parse string url into `ConnectInfo`.+-- +-- > parseDatabaseURL "postgres://foo:bar@example.com:2345/database" == ConnectInfo "example.com" 2345 "foo" "bar" "database"+parseDatabaseUrl :: String -> Maybe ConnectInfo+parseDatabaseUrl databaseUrl = parseURI databaseUrl >>= uriToConnectInfo+  where ++uriToConnectInfo :: URI -> Maybe ConnectInfo+uriToConnectInfo uri+  | uriScheme uri /= "postgres:" = Nothing+  | otherwise                    = ($ defaultConnectInfo) <$> mkConnectInfo uri++type ConnectInfoChange = ConnectInfo -> ConnectInfo++mkConnectInfo :: URI -> Maybe ConnectInfoChange+mkConnectInfo uri = case uriPath uri of+                           ('/' : rest) | not (null rest) -> Just $ uriParameters uri+                           _                              -> Nothing++uriParameters :: URI -> ConnectInfoChange+uriParameters uri = (\info -> info { connectDatabase = tail $ uriPath uri }) . maybe id uriAuthParameters (uriAuthority uri)++dropLast :: [a] -> [a]+dropLast []     = []+dropLast [_]    = []+dropLast (x:xs) = x : dropLast xs++uriAuthParameters :: URIAuth -> ConnectInfoChange+uriAuthParameters uriAuth = port . host . auth+  where port = case uriPort uriAuth of+                 (':' : p) -> \info -> info { connectPort = read p }+                 _         -> id+        host = case uriRegName uriAuth of+                 "" -> id+                 h  -> \info -> info { connectHost = h }+        auth = case splitOn ":" (uriUserInfo uriAuth) of+                 [""]   -> id+                 [u]    -> \info -> info { connectUser = dropLast u }+                 [u, p] -> \info -> info { connectUser = u, connectPassword = dropLast p }+                 _      -> id

@@ -0,0 +1,19 @@+import Database.PostgreSQL.Simple+import Test.Tasty+import Test.Tasty.QuickCheck as QC++import Database.PostgreSQL.Simple.URL++main :: IO ()+main = defaultMain casesProps++cases :: [(String, Maybe ConnectInfo)]+cases =+  [ ("postgres:///local", Just $ defaultConnectInfo { connectDatabase = "local"} )+  , ("mysql:///typo", Nothing)+  , ("postgres://foo:bar@example.com:2345/database", Just $ ConnectInfo "example.com" 2345 "foo" "bar" "database")+  ]++casesProps :: TestTree+casesProps = testGroup "different cases" $ map f cases+  where f (str, expected) = QC.testProperty str $ once $ property $expected == parseDatabaseUrl str