packages feed

postgresql-typed 0.6.1.2 → 0.6.2.0

raw patch · 5 files changed

+68/−26 lines, 5 filesdep ~attoparsecPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: attoparsec

API changes (from Hackage documentation)

- Database.PostgreSQL.Typed.Types: PGTypeProxy :: PGTypeID
+ Database.PostgreSQL.Typed.Types: PGTypeProxy :: PGTypeID (t :: Symbol)

Files

Database/PostgreSQL/Typed/Protocol.hs view
@@ -707,6 +707,7 @@     , ("bytea_output", "hex")     , ("DateStyle", "ISO, YMD")     , ("IntervalStyle", "iso_8601")+    , ("extra_float_digits", "3")     ] ++ pgDBParams db   pgFlush c   conn c
Database/PostgreSQL/Typed/Query.hs view
@@ -25,6 +25,8 @@ import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as BSC import qualified Data.ByteString.Lazy as BSL+import qualified Data.ByteString.Lazy.UTF8 as BSLU+import qualified Data.ByteString.UTF8 as BSU import Data.Char (isSpace, isAlphaNum) import qualified Data.Foldable as Fold import Data.List (dropWhileEnd)@@ -148,7 +150,7 @@     | inRange bnds n = exprs ! n     | otherwise = error $ "SQL placeholder '$" ++ show n ++ "' out of range (not recognized by PostgreSQL)"   sst (SQLParam n) = expr n-  sst t = TH.VarE 'fromString `TH.AppE` TH.LitE (TH.StringL $ show t)+  sst t = TH.VarE 'BSU.fromString `TH.AppE` TH.LitE (TH.StringL $ show t)  splitCommas :: String -> [String] splitCommas = spl where@@ -185,7 +187,7 @@ makePGQuery :: QueryFlags -> String -> TH.ExpQ makePGQuery QueryFlags{ flagQuery = False } sqle = pgSubstituteLiterals sqle makePGQuery QueryFlags{ flagNullable = nulls, flagPrepare = prep } sqle = do-  (pt, rt) <- TH.runIO $ tpgDescribe (fromString sqlp) (fromMaybe [] prep) (isNothing nulls)+  (pt, rt) <- TH.runIO $ tpgDescribe (BSU.fromString sqlp) (fromMaybe [] prep) (isNothing nulls)   when (length pt < length exprs) $ fail "Not all expression placeholders were recognized by PostgreSQL"    e <- TH.newName "_tenv"@@ -208,7 +210,7 @@       (TH.ConE 'SimpleQuery         `TH.AppE` sqlSubstitute sqlp vals)       (\p -> TH.ConE 'PreparedQuery-        `TH.AppE` (TH.VarE 'fromString `TH.AppE` TH.LitE (TH.StringL sqlp))+        `TH.AppE` (TH.VarE 'BSU.fromString `TH.AppE` TH.LitE (TH.StringL sqlp))         `TH.AppE` TH.ListE (map (TH.LitE . TH.IntegerL . toInteger . tpgValueTypeOID . snd) $ zip p pt)         `TH.AppE` TH.ListE vals          `TH.AppE` TH.ListE @@ -255,7 +257,7 @@ qqTop True ('!':sql) = qqTop False sql qqTop err sql = do   r <- TH.runIO $ try $ withTPGConnection $ \c ->-    pgSimpleQuery c (fromString sql)+    pgSimpleQuery c (BSLU.fromString sql)   either ((if err then TH.reportError else TH.reportWarning) . (show :: PGError -> String)) (const $ return ()) r   return []
Database/PostgreSQL/Typed/Types.hs view
@@ -232,7 +232,9 @@  -- |Produce a SQL string literal by wrapping (and escaping) a string with single quotes. pgQuote :: BS.ByteString -> BS.ByteString-pgQuote = pgQuoteUnsafe . BSC.intercalate (BSC.pack "''") . BSC.split '\''+pgQuote s+  | '\0' `BSC.elem` s = error "pgQuote: unhandled null in literal"+  | otherwise = pgQuoteUnsafe $ BSC.intercalate (BSC.pack "''") $ BSC.split '\'' s  -- |Shorthand for @'BSL.toStrict' . 'BSB.toLazyByteString'@ buildPGValue :: BSB.Builder -> BS.ByteString
postgresql-typed.cabal view
@@ -1,5 +1,5 @@ Name:          postgresql-typed-Version:       0.6.1.2+Version:       0.6.2.0 Cabal-Version: >= 1.10 License:       BSD3 License-File:  COPYING@@ -71,7 +71,7 @@     template-haskell,     haskell-src-meta,     network,-    attoparsec >= 0.12 && < 0.14,+    attoparsec >= 0.12 && < 0.15,     utf8-string   Exposed-Modules:     Database.PostgreSQL.Typed
test/Main.hs view
@@ -5,8 +5,6 @@  import Control.Exception (try) import Control.Monad (unless)-import qualified Data.ByteString as BS-import qualified Data.ByteString.Char8 as BSC import Data.Char (isDigit, toUpper) import Data.Int (Int32) import qualified Data.Time as Time@@ -38,7 +36,8 @@ -- This runs at compile-time: [pgSQL|!CREATE TYPE myenum AS enum ('abc', 'DEF', 'XX_ye')|] -[pgSQL|!CREATE TABLE myfoo (id serial primary key, adx myenum, bar char(4))|]+[pgSQL|!DROP TABLE myfoo|]+[pgSQL|!CREATE TABLE myfoo (id serial primary key, adé myenum, bar float)|]  dataPGEnum "MyEnum" "myenum" ("MyEnum_" ++) @@ -46,11 +45,13 @@  dataPGRelation "MyFoo" "myfoo" (\(c:s) -> "foo" ++ toUpper c : s) -_fooRow :: MyFoo-_fooRow = MyFoo{ fooId = 1, fooAdx = Just MyEnum_DEF, fooBar = Just "abcd" }- instance Q.Arbitrary MyEnum where   arbitrary = Q.arbitraryBoundedEnum+instance Q.Arbitrary MyFoo where+  arbitrary = MyFoo 0 <$> Q.arbitrary <*> Q.arbitrary+instance Eq MyFoo where+  MyFoo _ a b == MyFoo _ a' b' = a == a' && b == b'+deriving instance Show MyFoo  instance Q.Arbitrary Time.Day where   arbitrary = Time.ModifiedJulianDay <$> Q.arbitrary@@ -84,15 +85,15 @@     , SQLExpr <$> Q.arbitrary     , SQLQMark <$> Q.arbitrary     ]-    -newtype Str = Str { strString :: [Char] } deriving (Eq, Show)-strByte :: Str -> BS.ByteString-strByte = BSC.pack . strString-byteStr :: BS.ByteString -> Str-byteStr = Str . BSC.unpack-instance Q.Arbitrary Str where-  arbitrary = Str <$> Q.listOf (Q.choose (' ', '~')) +newtype SafeString = SafeString Q.UnicodeString+  deriving (Eq, Ord, Show)+instance Q.Arbitrary SafeString where+  arbitrary = SafeString <$> Q.suchThat Q.arbitrary (notElem '\0' . Q.getUnicodeString)++getSafeString :: SafeString -> String+getSafeString (SafeString s) = Q.getUnicodeString s+ simple :: PGConnection -> OID -> IO [String] simple c t = pgQuery c [pgSQL|SELECT typname FROM pg_catalog.pg_type WHERE oid = ${t} AND oid = $1|] simpleApply :: PGConnection -> OID -> IO [Maybe String]@@ -102,26 +103,60 @@ preparedApply :: PGConnection -> Int32 -> IO [String] preparedApply c = pgQuery c . [pgSQL|$(integer)SELECT typname FROM pg_catalog.pg_type WHERE oid = $1|] -selectProp :: PGConnection -> Bool -> Word8 -> Int32 -> Float -> Time.LocalTime -> Time.UTCTime -> Time.Day -> Time.DiffTime -> Str -> [Maybe Str] -> Range.Range Int32 -> MyEnum -> PGInet -> Q.Property+selectProp :: PGConnection -> Bool -> Word8 -> Int32 -> Float -> Time.LocalTime -> Time.UTCTime -> Time.Day -> Time.DiffTime -> SafeString -> [Maybe SafeString] -> Range.Range Int32 -> MyEnum -> PGInet -> Q.Property selectProp pgc b c i f t z d p s l r e a = Q.ioProperty $ do   [(Just b', Just c', Just i', Just f', Just s', Just d', Just t', Just z', Just p', Just l', Just r', Just e', Just a')] <- pgQuery pgc-    [pgSQL|$SELECT ${b}::bool, ${c}::"char", ${Just i}::int, ${f}::float4, ${strString s}::varchar, ${Just d}::date, ${t}::timestamp, ${z}::timestamptz, ${p}::interval, ${map (fmap strByte) l}::text[], ${r}::int4range, ${e}::myenum, ${a}::inet|]-  return $ Q.conjoin +    [pgSQL|$SELECT ${b}::bool, ${c}::"char", ${Just i}::int, ${f}::float4, ${getSafeString s}::varchar, ${Just d}::date, ${t}::timestamp, ${z}::timestamptz, ${p}::interval, ${map (fmap getSafeString) l}::text[], ${r}::int4range, ${e}::myenum, ${a}::inet|]+  return $ Q.conjoin     [ i Q.=== i'     , c Q.=== c'     , b Q.=== b'-    , strString s Q.=== s'+    , getSafeString s Q.=== s'     , f Q.=== f'     , d Q.=== d'     , t Q.=== t'     , z Q.=== z'     , p Q.=== p'-    , l Q.=== map (fmap byteStr) l'+    , map (fmap getSafeString) l Q.=== l'     , Range.normalize' r Q.=== r'     , e Q.=== e'     , a Q.=== a'     ] +selectProp' :: PGConnection -> Bool -> Int32 -> Float -> Time.LocalTime -> Time.UTCTime -> Time.Day -> Time.DiffTime -> SafeString -> [Maybe SafeString] -> Range.Range Int32 -> MyEnum -> PGInet -> Q.Property+selectProp' pgc b i f t z d p s l r e a = Q.ioProperty $ do+  [(Just b', Just i', Just f', Just s', Just d', Just t', Just z', Just p', Just l', Just r', Just e', Just a')] <- pgQuery pgc+    [pgSQL|SELECT ${b}::bool, ${Just i}::int, ${f}::float4, ${getSafeString s}::varchar, ${Just d}::date, ${t}::timestamp, ${z}::timestamptz, ${p}::interval, ${map (fmap getSafeString) l}::text[], ${r}::int4range, ${e}::myenum, ${a}::inet|]+  return $ Q.conjoin+    [ i Q.=== i'+    , b Q.=== b'+    , getSafeString s Q.=== s'+    , f Q.=== f'+    , d Q.=== d'+    , t Q.=== t'+    , z Q.=== z'+    , p Q.=== p'+    , map (fmap getSafeString) l Q.=== l'+    , Range.normalize' r Q.=== r'+    , e Q.=== e'+    , a Q.=== a'+    ]++selectFoo :: PGConnection -> [MyFoo] -> Q.Property+selectFoo pgc l = Q.ioProperty $ do+  _ <- pgExecute pgc [pgSQL|TRUNCATE myfoo|]+  let loop [] = return ()+      loop [x] = do+        1 <- pgExecute pgc [pgSQL|INSERT INTO myfoo (bar, adé) VALUES (${fooBar x}, ${fooAdé x})|]+        return ()+      loop (x:y:r) = do+        1 <- pgExecute pgc [pgSQL|INSERT INTO myfoo (adé, bar) VALUES (${fooAdé x}, ${fooBar x})|]+        1 <- pgExecute pgc [pgSQL|$INSERT INTO myfoo (adé, bar) VALUES (${fooAdé y}, ${fooBar y})|]+        loop r+  loop l+  r <- pgQuery pgc [pgSQL|SELECT * FROM myfoo ORDER BY id|]+  return $ l Q.=== map (\(i,a,b) -> MyFoo i a b) r+ tokenProp :: String -> Q.Property tokenProp s =   not (has0 s) Q.==> s Q.=== show (sqlTokens s) where@@ -135,6 +170,8 @@    r <- Q.quickCheckResult     $ selectProp c+    Q..&&. selectProp' c+    Q..&&. selectFoo c     Q..&&. tokenProp     Q..&&. [pgSQL|#abc ${3.14::Float} def $f$ $$ ${1} $f$${2::Int32}|] Q.=== "abc 3.14::real def $f$ $$ ${1} $f$2::integer"     Q..&&. getQueryString (pgTypeEnv c) ([pgSQL|SELECT ${"ab'cd"::String}::text, ${3.14::Float}::float4|] :: PGSimpleQuery (Maybe String, Maybe Float)) Q.=== "SELECT 'ab''cd'::text, 3.14::float4"