Merge pull request #22 from quetz/master

build with ghc-8.6.3 + tests fix

Author: Anton Gushcha

.travis.yml

@@ -1,5 +1,5 @@
 # Use new container infrastructure to enable caching
-dist: trusty
+dist: xenial
 sudo: false
 
 # Do not choose a language; we provide our own build tools.
@@ -8,8 +8,9 @@ language: generic
 os:
   - linux
 env:
-  - STACK_YAML=stack-ghc7.10.3.yaml
-  - STACK_YAML=stack-ghc8.0.2.yaml
+  - STACK_YAML=stack-ghc8.2.2.yaml
+  - STACK_YAML=stack-ghc8.4.4.yaml
+  - STACK_YAML=stack-ghc8.6.3.yaml
 
 services:
   - postgresql
@@ -24,7 +25,7 @@ addons:
   apt:
     packages:
       - libgmp-dev
-  postgresql: "9.6"
+  postgresql: "10"
 
 before_install:
   # Download and unpack the stack executable

src/Database/PostgreSQL/Protocol/Codecs/Encoders.hs

@@ -46,7 +46,9 @@ bytea = putByteString
 
 {-# INLINE char #-}
 char :: Char -> Encode
-char = putWord8 . fromIntegral . ord 
+char c
+  | ord(c) >= 128 = error "Character code must be below 128"
+  | otherwise = (putWord8 . fromIntegral . ord) c
 
 {-# INLINE date #-}
 date :: Day -> Encode

src/Database/PostgreSQL/Protocol/Store/Encode.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
 module Database.PostgreSQL.Protocol.Store.Encode 
     ( Encode
     , getEncodeLen
@@ -26,14 +27,21 @@ import Data.ByteString.Internal (toForeignPtr)
 import Data.Store.Core          (Poke(..), unsafeEncodeWith, pokeStatePtr,
                                  pokeFromForeignPtr)
 
+import qualified Data.Semigroup as Sem
+
 data Encode = Encode {-# UNPACK #-} !Int !(Poke ())
 
+instance Sem.Semigroup Encode where
+  {-# INLINE (<>) #-}
+  (Encode len1 f1) <> (Encode len2 f2) = Encode (len1 + len2) (f1 *> f2)
+
 instance Monoid Encode where
     {-# INLINE mempty #-}
     mempty = Encode 0 . Poke $ \_ offset -> pure (offset, ())
+#if !(MIN_VERSION_base(4,11,0))
+    mappend = (Sem.<>)
+#endif
 
-    {-# INLINE mappend #-}
-    (Encode len1 f1) `mappend` (Encode len2 f2) = Encode (len1 + len2) (f1 *> f2)
 
 instance Show Encode where
     show (Encode len _) = "Encode instance of length " ++ show len

stack-ghc7.10.3.yaml

@@ -0,0 +1,22 @@
+# This file was automatically generated by 'stack init'
+#
+resolver: lts-11.22
+
+packages:
+- '.'
+# Dependency packages to be pulled from upstream that are not in the resolver
+# (e.g., acme-missiles-0.3)
+extra-deps: 
+    - socket-0.8.2.0
+    - socket-unix-0.2.0.0
+# <<<<<<< HEAD
+# =======
+#     - store-core-0.3
+#     - QuickCheck-2.9.2
+# >>>>>>> QuickCheck tests for existing codecs
+
+# Override default flag values for local packages and extra-deps
+flags: {}
+
+# Extra package databases containing global packages
+extra-package-dbs: []

stack-ghc8.2.2.yaml

@@ -0,0 +1,22 @@
+# This file was automatically generated by 'stack init'
+#
+resolver: lts-12.26
+
+packages:
+- '.'
+# Dependency packages to be pulled from upstream that are not in the resolver
+# (e.g., acme-missiles-0.3)
+extra-deps: 
+    - socket-0.8.2.0
+    - socket-unix-0.2.0.0
+# <<<<<<< HEAD
+# =======
+#     - store-core-0.3
+#     - QuickCheck-2.9.2
+# >>>>>>> QuickCheck tests for existing codecs
+
+# Override default flag values for local packages and extra-deps
+flags: {}
+
+# Extra package databases containing global packages
+extra-package-dbs: []

stack-ghc8.4.4.yaml

@@ -1,13 +1,13 @@
 # This file was automatically generated by 'stack init'
 #
-resolver: lts-8.21
+resolver: lts-13.4
 
 packages:
 - '.'
 # Dependency packages to be pulled from upstream that are not in the resolver
 # (e.g., acme-missiles-0.3)
 extra-deps: 
-    - socket-0.8.0.0
+    - socket-0.8.2.0
     - socket-unix-0.2.0.0
 # <<<<<<< HEAD
 # =======

stack-ghc8.0.2.yaml renamed to stack-ghc8.6.3.yaml

@@ -1 +1 @@
-stack-ghc8.0.2.yaml
+stack-ghc8.6.3.yaml

stack.yaml

@@ -95,17 +95,18 @@ testCodecsEncodeDecode :: TestTree
 testCodecsEncodeDecode = testGroup "Codecs property 'encode . decode = id'"
     [ mkCodecTest "bool" PGT.bool PE.bool PD.bool
     , mkCodecTest "bytea" PGT.bytea PE.bytea PD.bytea
-    , mkCodecTest "char" PGT.char PE.char PD.char
+    , mkCodecTest "char" PGT.char (PE.char . unAsciiChar)
+                                  (fmap AsciiChar <$> PD.char)
     , mkCodecTest "date" PGT.date PE.date PD.date
     , mkCodecTest "float4" PGT.float4 PE.float4 PD.float4
     , mkCodecTest "float8" PGT.float8 PE.float8 PD.float8
     , mkCodecTest "int2" PGT.int2 PE.int2 PD.int2
     , mkCodecTest "int4" PGT.int4 PE.int4 PD.int4
     , mkCodecTest "int8" PGT.int8 PE.int8 PD.int8
     , mkCodecTest "interval" PGT.interval PE.interval PD.interval
-    , mkCodecTest "json" PGT.json (PE.bsJsonText . unJsonString ) 
+    , mkCodecTest "json" PGT.json (PE.bsJsonText . unJsonString)
                                   (fmap JsonString <$> PD.bsJsonText)
-    , mkCodecTest "jsonb" PGT.jsonb (PE.bsJsonBytes .unJsonString) 
+    , mkCodecTest "jsonb" PGT.jsonb (PE.bsJsonBytes . unJsonString)
                                     (fmap JsonString <$> PD.bsJsonBytes)
     , mkCodecTest "numeric" PGT.numeric PE.numeric PD.numeric
     , mkCodecTest "text" PGT.text PE.bsText PD.bsText
@@ -145,6 +146,12 @@ testCodecsEncodePrint = testGroup
 -- Orphan instances
 --
 
+newtype AsciiChar = AsciiChar { unAsciiChar :: Char }
+    deriving (Show, Eq)
+
+instance Arbitrary AsciiChar where
+    arbitrary = AsciiChar <$> choose ('\0', '\127')
+
 -- Helper to generate valid json strings
 newtype JsonString = JsonString { unJsonString :: B.ByteString }
     deriving (Show, Eq, IsString)

tests/Codecs/QuickCheck.hs

@@ -5,7 +5,7 @@ import Data.Foldable
 import Control.Monad
 import Data.Maybe
 import Data.Int
-import Data.Either
+import Data.Either hiding (fromRight)
 import qualified Data.ByteString as B
 import qualified Data.ByteString.Lazy as BL
 import qualified Data.ByteString.Char8 as BS