Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Upgrade to postgresql-simple 0.3.1

  • Loading branch information...
commit f5fb0f4166bbf6aa9ca4fe9a3c52f69e1fe1bd5d 1 parent 3d79dbc
@ocharles ocharles authored
View
5 musicbrainz-data.cabal
@@ -24,7 +24,7 @@ Library
nats >= 0.1,
network >= 2.3.0.10,
parsec >= 3.1.2,
- postgresql-simple >= 0.2.4.1 && < 0.3,
+ postgresql-simple >= 0.3.1 && < 0.4,
text >= 0.11.1.13 && < 0.12,
time >= 1.4,
transformers >= 0.2.2.0 && < 0.4,
@@ -74,7 +74,6 @@ Library
MusicBrainz.Schema
MusicBrainz.Types
other-modules:
- Database.PostgreSQL.Simple.Arrays
MusicBrainz.Data.Generic
MusicBrainz.Data.Relationship.Internal
MusicBrainz.Data.Revision.Internal
@@ -99,7 +98,7 @@ Test-Suite integration-tests
MonadCatchIO-mtl >= 0.3.0.0 && <0.4,
musicbrainz-data,
network >= 2.3.0.10,
- postgresql-simple >= 0.2.4.1 && < 0.3,
+ postgresql-simple >= 0.3.1 && < 0.4,
QuickCheck >= 2.4.2 && < 2.6,
test-framework >= 0.6.1 && <0.9,
test-framework-hunit >= 0.2.7 && <0.4,
View
94 src/Database/PostgreSQL/Simple/Arrays.hs
@@ -1,94 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE PatternGuards #-}
-
-------------------------------------------------------------------------------
--- |
--- Module: Database.PostgreSQL.Simple.Arrays
--- Copyright: (c) 2012 Leon P Smith
--- License: BSD3
--- Maintainer: Leon P Smith <leon@melding-monads.com>
--- Stability: experimental
--- Portability: portable
---
--- A Postgres array parser and pretty-printer.
-------------------------------------------------------------------------------
-
-module Database.PostgreSQL.Simple.Arrays where
-
-import Control.Applicative (Applicative(..), Alternative(..), (<$>))
-import Data.ByteString.Char8 (ByteString)
-import qualified Data.ByteString.Char8 as B
-import Data.Monoid
-import Data.Attoparsec.Char8
-
-
--- | Parse one of three primitive field formats: array, quoted and plain.
-arrayFormat :: Char -> Parser ArrayFormat
-arrayFormat delim = Array <$> array delim
- <|> Plain <$> plain delim
- <|> Quoted <$> quoted
-
-data ArrayFormat = Array [ArrayFormat]
- | Plain ByteString
- | Quoted ByteString
- deriving (Eq, Show, Ord)
-
-array :: Char -> Parser [ArrayFormat]
-array delim = char '{' *> option [] (arrays <|> strings) <* char '}'
- where
- strings = sepBy1 (Quoted <$> quoted <|> Plain <$> plain delim) (char delim)
- arrays = sepBy1 (Array <$> array delim) (char ',')
- -- NB: Arrays seem to always be delimited by commas.
-
--- | Recognizes a quoted string.
-quoted :: Parser ByteString
-quoted = char '"' *> option "" contents <* char '"'
- where
- esc' = char '\\' *> (char '\\' <|> char '"')
- unQ = takeWhile1 (notInClass "\"\\")
- contents = mconcat <$> many (unQ <|> B.singleton <$> esc')
-
--- | Recognizes a plain string literal, not containing quotes or brackets and
--- not containing the delimiter character.
-plain :: Char -> Parser ByteString
-plain delim = takeWhile1 (notInClass (delim:"\"{}"))
-
--- Mutually recursive 'fmt' and 'delimit' separate out value formatting
--- from the subtleties of delimiting.
-
--- | Format an array format item, using the delimiter character if the item is
--- itself an array.
-fmt :: Char -> ArrayFormat -> ByteString
-fmt = fmt' False
-
--- | Format a list of array format items, inserting the appropriate delimiter
--- between them. When the items are arrays, they will be delimited with
--- commas; otherwise, they are delimited with the passed-in-delimiter.
-delimit :: Char -> [ArrayFormat] -> ByteString
-delimit _ [] = ""
-delimit c [x] = fmt' True c x
-delimit c (x:y:z) = (fmt' True c x `B.snoc` c') `mappend` delimit c (y:z)
- where
- c' | Array _ <- x = ','
- | otherwise = c
-
--- | Format an array format item, using the delimiter character if the item is
--- itself an array, optionally applying quoting rules. Creates copies for
--- safety when used in 'FromField' instances.
-fmt' :: Bool -> Char -> ArrayFormat -> ByteString
-fmt' quoting c x =
- case x of
- Array items -> '{' `B.cons` (delimit c items `B.snoc` '}')
- Plain bytes -> B.copy bytes
- Quoted q | quoting -> '"' `B.cons` (esc q `B.snoc` '"')
- | otherwise -> B.copy q
- -- NB: The 'snoc' and 'cons' functions always copy.
-
--- | Escape a string according to Postgres double-quoted string format.
-esc :: ByteString -> ByteString
-esc = B.concatMap f
- where
- f '"' = "\\\""
- f '\\' = "\\\\"
- f c = B.singleton c
- -- TODO: Implement easy performance improvements with unfoldr.
View
2  src/MusicBrainz/Monad.hs
@@ -156,7 +156,7 @@ withTransaction' conclude action = view transactionDepth >>= runAt
{-| Begin a transaction. This is a low-level operation, and generally *not*
what you are really looking for, which is 'withTransaction'. -}
begin :: MonadIO m => MusicBrainzT m ()
-begin = withMBConn (PG.beginMode PG.defaultTransactionMode)
+begin = withMBConn PG.begin
{-| Commit a transaction. This is a low-level operation, and generally *not*
View
7 src/MusicBrainz/Schema.hs
@@ -203,8 +203,11 @@ instance FromField URI where
instance FromField UUID where
fromField f Nothing = returnError UnexpectedNull f "UUID cannot be null"
- fromField f (Just v) | typename f /= "uuid" = incompatible
- | otherwise = tryParse
+ fromField f (Just v) = do
+ t <- typename f
+ if t /= "uuid"
+ then incompatible
+ else tryParse
where
incompatible = returnError Incompatible f "UUIDs must be PG type 'uuid'"
tryParse = case UUID.fromString (LBS.unpack v) of
View
2  test/framework/Test/MusicBrainz.hs
@@ -77,7 +77,7 @@ testCase testName test = do
where
runTest ctx = runMbContext ctx (withTransactionRollBack test)
- isDeadlock (SqlError "40P01" _ _) = Just ()
+ isDeadlock (SqlError "40P01" _ _ _ _) = Just ()
isDeadlock _ = Nothing
go ctx retriesRemaining
View
4 test/suite/MusicBrainz/Schema/Tests.hs
@@ -23,7 +23,7 @@ testSelectNullMBID = testCase "An MBID field must be not-null" $
assertException expectNull $ nullQuery
where nullQuery :: MusicBrainz [Only (MBID Artist)]
nullQuery = query_ "SELECT null"
- expectNull (UnexpectedNull _ _ _) = Just True
+ expectNull (UnexpectedNull _ _ _ _ _) = Just True
expectNull _ = Nothing
testSelectNonUuidMBID :: Test
@@ -31,6 +31,6 @@ testSelectNonUuidMBID = testCase "An MBID field must be a PostgreSQL uuid" $
assertException expectIncompatible $ incompatQuery
where incompatQuery :: MusicBrainz [Only (MBID Artist)]
incompatQuery = query_ "SELECT 5"
- expectIncompatible (Incompatible _ _ _) = Just True
+ expectIncompatible (Incompatible _ _ _ _ _) = Just True
expectIncompatible _ = Nothing
Please sign in to comment.
Something went wrong with that request. Please try again.