postgresql-typed 0.4.2.1 → 0.4.2.2

raw patch · 5 files changed

+170/−22 lines, 5 filesdep +QuickCheckdep ~postgresql-binaryPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: QuickCheck

Dependency ranges changed: postgresql-binary

API changes (from Hackage documentation)

Files

• Database/PostgreSQL/Typed/Inet.hs +87/−2
• Database/PostgreSQL/Typed/Range.hs +2/−2
• postgresql-typed.cabal +3/−2
• test/Connect.hs +14/−0
• test/Main.hs +64/−16

@@ -9,28 +9,45 @@  module Database.PostgreSQL.Typed.Inet where +import Control.Monad (void, guard, liftM2) import qualified Data.ByteString.Char8 as BSC+import Data.Bits (shiftL, (.|.)) import Data.Maybe (fromJust)+import Data.Word (Word8, Word16, Word32)+import Foreign.Marshal.Array (withArray)+import Foreign.Ptr (castPtr)+import Foreign.Storable (peek) import qualified Network.Socket as Net+import Numeric (readDec, readHex) import System.IO.Unsafe (unsafeDupablePerformIO)+import qualified Text.ParserCombinators.ReadP as RP+import qualified Text.ParserCombinators.ReadPrec as RP (lift)+import Text.Read (Read(readPrec))  import Database.PostgreSQL.Typed.Types  data PGInet    = PGInet     { pgInetAddr :: !Net.HostAddress-    , pgInetMask :: !Int+    , pgInetMask :: !Word8     }   | PGInet6     { pgInetAddr6 :: !Net.HostAddress6-    , pgInetMask :: !Int+    , pgInetMask :: !Word8     }+  deriving (Eq)  sockAddrPGInet :: Net.SockAddr -> Maybe PGInet sockAddrPGInet (Net.SockAddrInet _ a) = Just $ PGInet a 32 sockAddrPGInet (Net.SockAddrInet6 _ _ a _) = Just $ PGInet6 a 128 sockAddrPGInet _ = Nothing +-- |Convert four bytes to network byte order, using unsafe casting.+-- 'Data.Word.byteSwap32' would be better, but I couldn't find a good way to determine host byte order.+bton32 :: (Word8, Word8, Word8, Word8) -> Word32+bton32 (b1, b2, b3, b4) = unsafeDupablePerformIO $+  withArray [b1, b2, b3, b4] (peek . castPtr)+ instance Show PGInet where   -- This is how Network.Socket's Show SockAddr does it:   show (PGInet a 32) = unsafeDupablePerformIO $ Net.inet_ntoa a@@ -39,9 +56,77 @@     Net.getNameInfo [Net.NI_NUMERICHOST] True False (Net.SockAddrInet6 0 0 a 0)   show (PGInet6 a m) = show (PGInet6 a 128) ++ '/' : show m +instance Read PGInet where+  -- This is even less pleasant, but we only have to deal with representations pg generates+  -- Not at all efficient, since in ReadP, but should get us by+  readPrec = RP.lift $ r4 RP.+++ r6 where+    r4i = do+      o1 <- rdec+      _ <- RP.char '.'+      o2 <- rdec+      _ <- RP.char '.'+      o3 <- rdec+      _ <- RP.char '.'+      o4 <- rdec+      return (o1, o2, o3, o4)+    -- ipv4+    r4 = do+      q <- r4i+      m <- mask 32+      return $ PGInet (bton32 q) m++    -- trailing ipv4 in ipv6+    r64 = do+      (b1, b2, b3, b4) <- r4i+      return [jb b1 b2, jb b3 b4]+    -- ipv6 pre-double-colon+    r6l 0 = return []+    r6l 2 = colon >> r6lc 2 RP.+++ r64+    r6l n = colon >> r6lc n+    r6lc n = r6lp n RP.+++ r6b n+    r6lp n = r6w (r6l (pred n))+    -- ipv6 double-colon+    r6b n = do+      colon+      r <- r6rp (pred n) RP.<++ return []+      let l = length r+      return $ replicate (n - l) 0 ++ r+    -- ipv6 post-double-colon+    r6r 0 = return []+    r6r n = (colon >> r6rp n) RP.<++ return []+    r6rp n+      | n >= 2 = r6rc n RP.+++ r64+      | otherwise = r6rc n+    r6rc n = r6w (r6r (pred n))+    r6w = liftM2 (:) rhex+    -- ipv6+    r6 = do+      [w1, w2, w3, w4, w5, w6, w7, w8] <- r6lp 8 RP.<++ (colon >> r6b 8)+      m <- mask 128+      return $ PGInet6 (jw w1 w2, jw w3 w4, jw w5 w6, jw w7 w8) m++    colon = void $ RP.char ':'+    mask m = RP.option m $ do+      _ <- RP.char '/'+      n <- rdec+      guard (n <= m)+      return n+    rdec :: RP.ReadP Word8+    rdec = RP.readS_to_P readDec+    rhex :: RP.ReadP Word16+    rhex = RP.readS_to_P readHex+    jw :: Word16 -> Word16 -> Word32+    jw x y = fromIntegral x `shiftL` 16 .|. fromIntegral y+    jb :: Word8 -> Word8 -> Word16+    jb x y = fromIntegral x `shiftL` 8 .|. fromIntegral y+ instance PGType "inet" instance PGType "cidr" instance PGParameter "inet" PGInet where   pgEncode _ = BSC.pack . show instance PGParameter "cidr" PGInet where   pgEncode _ = BSC.pack . show+instance PGColumn "inet" PGInet where+  pgDecode _ = read . BSC.unpack+instance PGColumn "cidr" PGInet where+  pgDecode _ = read . BSC.unpack

@@ -79,7 +79,7 @@     { lower :: LowerBound a     , upper :: UpperBound a     }-  deriving (Eq)+  deriving (Eq, Ord)  instance Functor Range where   fmap _ Empty = Empty@@ -181,7 +181,7 @@     _ -> l   u' = case u of     Bounded True b -> Bounded False (succ b)-    _ -> l+    _ -> u  -- |Contains range (@>), (<@) :: Ord a => Range a -> Range a -> Bool

@@ -1,5 +1,5 @@ Name:          postgresql-typed-Version:       0.4.2.1+Version:       0.4.2.2 Cabal-Version: >= 1.8 License:       BSD3 License-File:  COPYING@@ -97,9 +97,10 @@     CPP-options: -DUSE_AESON  test-suite test-  build-depends: base, network, time, bytestring, postgresql-typed+  build-depends: base, network, time, bytestring, postgresql-typed, QuickCheck   type: exitcode-stdio-1.0   main-is: Main.hs+  Other-Modules: Connect   buildable: True   hs-source-dirs: test   Extensions: TemplateHaskell, QuasiQuotes

@@ -0,0 +1,14 @@+{-# LANGUAGE OverloadedStrings #-}+module Connect where++import Database.PostgreSQL.Typed (PGDatabase(..), defaultPGDatabase)+import Network (PortID(UnixSocket))++db :: PGDatabase+db = defaultPGDatabase+  { pgDBPort = UnixSocket "/tmp/.s.PGSQL.5432"+  , pgDBName = "templatepg"+  , pgDBUser = "templatepg"+  , pgDBDebug = True+  }+

@@ -2,16 +2,20 @@ -- {-# OPTIONS_GHC -ddump-splices #-} module Main (main) where -import Data.ByteString (ByteString)+import qualified Data.ByteString as BS+import qualified Data.ByteString.Char8 as BSC import Data.Int (Int32) import qualified Data.Time as Time import System.Exit (exitSuccess, exitFailure)+import qualified Test.QuickCheck as Q+import Test.QuickCheck.Test (isSuccess)  import Database.PostgreSQL.Typed import Database.PostgreSQL.Typed.Types (OID) import Database.PostgreSQL.Typed.Array () import qualified Database.PostgreSQL.Typed.Range as Range import Database.PostgreSQL.Typed.Enum+import Database.PostgreSQL.Typed.Inet  import Connect @@ -26,6 +30,42 @@  makePGEnum "myenum" "MyEnum" ("MyEnum_" ++) +instance Q.Arbitrary MyEnum where+  arbitrary = Q.arbitraryBoundedEnum++instance Q.Arbitrary Time.Day where+  arbitrary = Time.ModifiedJulianDay <$> Q.arbitrary+instance Q.Arbitrary Time.DiffTime where+  arbitrary = Time.picosecondsToDiffTime . (1000000 *) <$> Q.arbitrary+instance Q.Arbitrary Time.UTCTime where+  arbitrary = Time.UTCTime <$> Q.arbitrary <*> ((Time.picosecondsToDiffTime . (1000000 *)) <$> Q.choose (0,86399999999))+instance Q.Arbitrary Time.LocalTime where+  arbitrary = Time.utcToLocalTime Time.utc <$> Q.arbitrary++instance Q.Arbitrary a => Q.Arbitrary (Range.Bound a) where+  arbitrary = do+    u <- Q.arbitrary+    if u+      then return $ Range.Unbounded+      else Range.Bounded <$> Q.arbitrary <*> Q.arbitrary+instance (Ord a, Q.Arbitrary a) => Q.Arbitrary (Range.Range a) where+  arbitrary = Range.range <$> Q.arbitrary <*> Q.arbitrary++instance Q.Arbitrary PGInet where+  arbitrary = do+    v6 <- Q.arbitrary+    if v6+      then PGInet6 <$> Q.arbitrary <*> ((`mod` 129) <$> Q.arbitrary)+      else PGInet  <$> Q.arbitrary <*> ((`mod`  33) <$> 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 (' ', '~'))+ 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]@@ -35,24 +75,32 @@ preparedApply :: PGConnection -> Int32 -> IO [String] preparedApply c = pgQuery c . [pgSQL|$(integer)SELECT typname FROM pg_catalog.pg_type WHERE oid = $1|] +selectProp :: PGConnection -> Bool -> Int32 -> Float -> Time.LocalTime -> Time.UTCTime -> Time.Day -> Time.DiffTime -> Str -> [Maybe Str] -> Range.Range Int32 -> MyEnum -> PGInet -> Q.Property+selectProp c 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 c+    [pgSQL|$SELECT ${b}::bool, ${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 +    [ i Q.=== i'+    , b Q.=== b'+    , strString s Q.=== s'+    , f Q.=== f'+    , d Q.=== d'+    , t Q.=== t'+    , z Q.=== z'+    , p Q.=== p'+    , l Q.=== map (fmap byteStr) l'+    , Range.normalize' r Q.=== r'+    , e Q.=== e'+    , a Q.=== a'+    ]+ main :: IO () main = do   c <- pgConnect db-  z <- Time.getZonedTime-  let i = 1 :: Int32-      b = True-      f = 3.14 :: Float-      t = Time.zonedTimeToLocalTime z-      d = Time.localDay t-      p = -34881559 :: Time.DiffTime-      s = "\"hel\\o'" :: String-      l = [Just "a\\\"b,c", Nothing, Just "null", Just "nullish" :: Maybe ByteString]-      r = Range.normal (Just (-2 :: Int32)) Nothing-      e = MyEnum_XX_ye-  [(Just b', Just i', Just f', Just s', Just d', Just t', Just z', Just p', Just l', Just r', Just e')] <- pgQuery c-    [pgSQL|$SELECT ${b}::bool, ${Just i}::int, ${f}::float4, ${s}::varchar(10), ${Just d}::date, ${t}::timestamp, ${Time.zonedTimeToUTC z}::timestamptz, ${p}::interval, ${l}::text[], ${r}::int4range, ${e}::myenum|]-  assert $ i == i' && b == b' && s == s' && f == f' && d == d' && t == t' && Time.zonedTimeToUTC z == z' && p == p' && l == l' && r == r' && e == e' +  r <- Q.quickCheckResult $ selectProp c+  assert $ isSuccess r+   ["box"] <- simple c 603   [Just "box"] <- simpleApply c 603   [Just "box"] <- prepared c 603 "box"@@ -60,7 +108,7 @@   [Just "line"] <- prepared c 628 "line"   ["line"] <- preparedApply c 628 -  assert $ [pgSQL|#abc${f}def|] == "abc3.14::realdef"+  assert $ [pgSQL|#abc${3.14 :: Float}def|] == "abc3.14::realdef"    assert $ pgEnumValues == [(MyEnum_abc, "abc"), (MyEnum_DEF, "DEF"), (MyEnum_XX_ye, "XX_ye")]