postgresql-binary (empty) → 0.1.0
raw patch · 16 files changed
+1531/−0 lines, 16 filesdep +HTFdep +QuickCheckdep +attoparsecsetup-changed
Dependencies added: HTF, QuickCheck, attoparsec, base, base-prelude, bytestring, criterion, deepseq, loch-th, mtl-prelude, placeholders, postgresql-binary, postgresql-libpq, quickcheck-instances, scientific, text, time, uuid
Files
- LICENSE +22/−0
- Setup.hs +2/−0
- executables/Decoding.hs +44/−0
- executables/Encoding.hs +43/−0
- executables/Tests.hs +440/−0
- library/PostgreSQLBinary/Array.hs +73/−0
- library/PostgreSQLBinary/Date.hs +39/−0
- library/PostgreSQLBinary/Decoder.hs +189/−0
- library/PostgreSQLBinary/Decoder/Atto.hs +45/−0
- library/PostgreSQLBinary/Decoder/Zepto.hs +52/−0
- library/PostgreSQLBinary/Encoder.hs +145/−0
- library/PostgreSQLBinary/Encoder/Builder.hs +136/−0
- library/PostgreSQLBinary/Integral.hs +24/−0
- library/PostgreSQLBinary/Numeric.hs +38/−0
- library/PostgreSQLBinary/Prelude.hs +63/−0
- postgresql-binary.cabal +176/−0
+ LICENSE view
@@ -0,0 +1,22 @@+Copyright (c) 2014, Nikita Volkov++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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ executables/Decoding.hs view
@@ -0,0 +1,44 @@+module Main where++import BasePrelude+import MTLPrelude+import Control.DeepSeq+import Criterion+import Criterion.Main+import Data.Text (Text)+import Data.ByteString (ByteString)+import Data.Scientific (Scientific)+import Data.Time+import qualified PostgreSQLBinary.Encoder as E+import qualified PostgreSQLBinary.Decoder as D+import qualified PostgreSQLBinary.Array as Array+++main =+ defaultMain+ [+ b "bool" D.bool (E.bool True),+ b "int2" (D.int :: D.D Int16) (E.int2 (Left 1000)),+ b "int4" (D.int :: D.D Int32) (E.int4 (Left 1000)),+ b "int8" (D.int :: D.D Int64) (E.int8 (Left 1000)),+ b "float4" D.float4 (E.float4 12.65468468),+ b "float8" D.float8 (E.float8 12.65468468),+ b "numeric" D.numeric (E.numeric (read "20.213290183")),+ b "char" D.char (E.char 'Я'),+ b "text" D.text (E.text (Left "alsdjflskjдывлоаы оады")),+ b "bytea" D.bytea (E.bytea (Left "alskdfj;dasjfl;dasjflksdj")),+ b "date" D.date (E.date (read "2000-01-19")),+ b "time" D.time (E.time (read "10:41:06")),+ b "timetz" D.timetz (E.timetz (read "(10:41:06, +0300)")),+ b "timestamp" D.timestamp (E.timestamp (read "2000-01-19 10:41:06")),+ b "timestamptz" D.timestamptz (E.timestamptz (read "2000-01-19 10:41:06")),+ b "interval" D.interval (E.interval (secondsToDiffTime 23472391470128374)),+ b "uuid" D.uuid (E.uuid (read "550e8400-e29b-41d4-a716-446655440000")),+ b "array" D.array (E.array + (Array.fromListUnsafe + [Array.fromSingleton (Just "dfs") True 0,+ Array.fromSingleton Nothing True 0]))+ ]+ where+ b name decoder value = + bench name $ nf decoder value
+ executables/Encoding.hs view
@@ -0,0 +1,43 @@+module Main where++import BasePrelude+import MTLPrelude+import Control.DeepSeq+import Criterion+import Criterion.Main+import Data.Text (Text)+import Data.ByteString (ByteString)+import Data.Scientific (Scientific)+import Data.Time+import qualified PostgreSQLBinary.Encoder as E+import qualified PostgreSQLBinary.Decoder as D+import qualified PostgreSQLBinary.Array as Array+++main =+ defaultMain+ [+ b "bool" E.bool True,+ b "int2" E.int2 (Left 1000),+ b "int4" E.int4 (Left 1000),+ b "int8" E.int8 (Left 1000),+ b "float4" E.float4 12.65468468,+ b "float8" E.float8 12.65468468,+ b "numeric" E.numeric (read "20.213290183"),+ b "char" E.char 'Я',+ b "text" E.text (Left "alsdjflskjдывлоаы оады"),+ b "bytea" E.bytea (Left "alskdfj;dasjfl;dasjflksdj"),+ b "date" E.date (read "2000-01-19"),+ b "time" E.time (read "10:41:06"),+ b "timetz" E.timetz (read "(10:41:06, +0300)"),+ b "timestamp" E.timestamp (read "2000-01-19 10:41:06"),+ b "timestamptz" E.timestamptz (read "2000-01-19 10:41:06"),+ b "interval" E.interval (secondsToDiffTime 23472391470128374),+ b "uuid" E.uuid (read "550e8400-e29b-41d4-a716-446655440000"),+ b "array" E.array (Array.fromListUnsafe + [Array.fromSingleton (Just "dfs") True 0,+ Array.fromSingleton Nothing True 0])+ ]+ where+ b name encoder value = + bench name $ nf encoder value
+ executables/Tests.hs view
@@ -0,0 +1,440 @@+{-# OPTIONS_GHC -F -pgmF htfpp #-}+module Main where++import BasePrelude hiding (assert)+import Test.Framework+import Test.QuickCheck.Instances+import Data.Time+import qualified Data.Text as T+import qualified Data.Text.Encoding as TE+import qualified Data.Text.Lazy as TL+import qualified Data.ByteString as B+import qualified Data.ByteString.Char8 as BC+import qualified Data.ByteString.Lazy as BL+import qualified Data.ByteString.Lazy.Char8 as BLC+import qualified Data.Scientific as Scientific+import qualified Data.UUID as UUID+import qualified Database.PostgreSQL.LibPQ as PQ+import qualified PostgreSQLBinary.PTI as PTI+import qualified PostgreSQLBinary.Encoder as Encoder+import qualified PostgreSQLBinary.Decoder as Decoder+import qualified PostgreSQLBinary.Array as Array+++type Text = T.Text+type LazyText = TL.Text+type ByteString = B.ByteString+type LazyByteString = BL.ByteString+type Scientific = Scientific.Scientific++main = + htfMain $ htf_thisModulesTests++floatEqProp :: RealFrac a => Show a => a -> a -> Property+floatEqProp a b =+ counterexample (show a ++ " /~ " ++ show b) $+ a + error >= b && a - error <= b+ where+ error = max (abs a) 1 / 10^3++mappingP :: + (Show a, Eq a) => + Word32 -> (a -> Maybe ByteString) -> (Maybe ByteString -> Either Text a) -> a -> Property+mappingP oid encode decode v =+ Right v === do+ unsafePerformIO $ do+ c <- connect+ initConnection c+ Just result <-+ let param = (,,) <$> pure (PQ.Oid $ fromIntegral oid) <*> encode v <*> pure PQ.Binary+ in PQ.execParams c "SELECT $1" [param] PQ.Binary+ binaryResult <- PQ.getvalue result 0 0+ PQ.finish c+ return $ decode binaryResult++mappingTextP ::+ (Show a, Eq a) => + Word32 -> (a -> Maybe ByteString) -> (a -> Maybe ByteString) -> a -> Property+mappingTextP oid encode render value =+ render value === do unsafePerformIO $ checkText oid (encode value)++checkText :: Word32 -> Maybe ByteString -> IO (Maybe ByteString)+checkText oid v =+ do+ c <- connect+ initConnection c+ Just result <-+ let param = (,,) <$> pure (PQ.Oid $ fromIntegral oid) <*> v <*> pure PQ.Binary+ in PQ.execParams c "SELECT $1" [param] PQ.Text+ encodedResult <- PQ.getvalue result 0 0+ PQ.finish c+ return $ encodedResult++query :: ByteString -> [Maybe (PQ.Oid, ByteString, PQ.Format)] -> PQ.Format -> IO (Maybe ByteString)+query statement params outFormat =+ do+ connection <- connect+ initConnection connection+ Just result <- PQ.execParams connection statement params outFormat+ encodedResult <- PQ.getvalue result 0 0+ PQ.finish connection+ return $ encodedResult++connect :: IO PQ.Connection+connect =+ PQ.connectdb bs+ where+ bs = + B.intercalate " " components+ where+ components = + [+ "host=" <> host,+ "port=" <> (fromString . show) port,+ "user=" <> user,+ "password=" <> password,+ "dbname=" <> db+ ]+ where+ host = "localhost"+ port = 5432+ user = "postgres"+ password = ""+ db = "postgres"++initConnection :: PQ.Connection -> IO ()+initConnection c =+ void $ PQ.exec c $ mconcat $ map (<> ";") $ + [ "SET standard_conforming_strings TO on",+ "SET datestyle TO ISO",+ "SET client_encoding = 'UTF8'",+ "SET client_min_messages TO WARNING",+ "SET bytea_output = 'hex'" ]++nonNullParser p =+ fromMaybe (Left "Unexpected NULL") . fmap p++nonNullRenderer r =+ return . r++-- * Generators+-------------------------++scientificGen :: Gen Scientific+scientificGen =+ Scientific.scientific <$> arbitrary <*> arbitrary++microsTimeOfDayGen :: Gen TimeOfDay+microsTimeOfDayGen =+ timeToTimeOfDay <$> microsDiffTimeGen++microsLocalTimeGen :: Gen LocalTime+microsLocalTimeGen = + LocalTime <$> arbitrary <*> microsTimeOfDayGen++microsUTCTimeGen :: Gen UTCTime+microsUTCTimeGen =+ localTimeToUTC <$> timeZoneGen <*> microsLocalTimeGen++microsDiffTimeGen :: Gen DiffTime+microsDiffTimeGen = do+ fmap picosecondsToDiffTime $ fmap (* (10^6)) $ choose (0, (10^6)*24*60*60)++timeZoneGen :: Gen TimeZone+timeZoneGen =+ minutesToTimeZone <$> choose (- 60 * 12 + 1, 60 * 12)++uuidGen :: Gen UUID.UUID+uuidGen =+ UUID.fromWords <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary++arrayGen :: Gen (Word32, Array.Data)+arrayGen =+ do+ ndims <- choose (1, 4)+ dims <- replicateM ndims dimGen+ (valueGen', oid, arrayOID) <- valueGen+ values <- replicateM (dimsToNValues dims) valueGen'+ let nulls = elem Nothing values+ return (arrayOID, (dims, values, nulls, oid))+ where+ dimGen =+ (,) <$> choose (1, 7) <*> pure 1+ valueGen =+ do+ (pti, gen) <- elements [(PTI.int8, mkGen (Encoder.int8 . Left)),+ (PTI.bool, mkGen Encoder.bool),+ (PTI.date, mkGen Encoder.date),+ (PTI.text, mkGen Encoder.text),+ (PTI.bytea, mkGen Encoder.bytea)]+ return (gen, PTI.oidOf pti, fromJust $ PTI.arrayOIDOf pti)+ where+ mkGen renderer =+ fmap (fmap renderer) arbitrary+ dimsToNValues =+ product . map dimensionWidth+ where+ dimensionWidth (x, _) = fromIntegral x+++-- * Properties+-------------------------++prop_uuid =+ forAll uuidGen $ + mappingP (PTI.oidOf PTI.uuid) + (nonNullRenderer Encoder.uuid)+ (nonNullParser Decoder.uuid)++test_uuidParsing =+ assertEqual (Right (read "550e8400-e29b-41d4-a716-446655440000" :: UUID.UUID)) =<< do+ fmap (Decoder.uuid . fromJust) $ + query "SELECT '550e8400-e29b-41d4-a716-446655440000' :: uuid" [] PQ.Binary++prop_interval =+ forAll microsDiffTimeGen $ + mappingP (PTI.oidOf PTI.interval) + (nonNullRenderer Encoder.interval)+ (nonNullParser Decoder.interval)++test_intervalParsing =+ assertEqual (Right (secondsToDiffTime (44 + 60 * (10 + 60 * 24 * (20 + 31 * 2))))) =<< do+ fmap (Decoder.interval . fromJust) $ + query "SELECT 'P0000-02-20T00:10:44' :: interval" [] PQ.Binary++prop_timestamp =+ forAll microsUTCTimeGen $ + mappingP (PTI.oidOf PTI.timestamp) + (nonNullRenderer Encoder.timestamp)+ (nonNullParser Decoder.timestamp)++test_timestampParsing1 =+ assertEqual (Right (read "2000-01-19 10:41:06" :: UTCTime)) =<< do+ fmap (Decoder.timestamp . fromJust) $ + query "SELECT '2000-01-19 10:41:06' :: timestamp" [] PQ.Binary++prop_timestamptz =+ forAll microsLocalTimeGen $ + mappingP (PTI.oidOf PTI.timestamptz) + (nonNullRenderer Encoder.timestamptz)+ (nonNullParser Decoder.timestamptz)++prop_timetz =+ forAll ((,) <$> microsTimeOfDayGen <*> timeZoneGen) $ + mappingP (PTI.oidOf PTI.timetz) + (nonNullRenderer Encoder.timetz)+ (nonNullParser Decoder.timetz)++test_timetzParsing1 =+ assertEqual (Right (read "(10:41:06.002897, +0500)" :: (TimeOfDay, TimeZone))) =<< do+ fmap (Decoder.timetz . fromJust) $ + query "SELECT '10:41:06.002897+05' :: timetz" [] PQ.Binary++prop_timeOfDay =+ forAll microsTimeOfDayGen $ + mappingP (PTI.oidOf PTI.time) + (nonNullRenderer Encoder.time)+ (nonNullParser Decoder.time)++prop_timeOfDayParsing =+ forAll microsTimeOfDayGen $ \x ->+ Right x === do+ unsafePerformIO $ + fmap (Decoder.time . fromJust) $ + query "SELECT $1" + [Just (PQ.Oid $ fromIntegral $ PTI.oidOf PTI.time, (fromString . show) x, PQ.Text)] + PQ.Binary++prop_scientific (c, e) =+ let x = Scientific.scientific c e+ in+ mappingP (PTI.oidOf PTI.numeric) + (nonNullRenderer Encoder.numeric)+ (nonNullParser Decoder.numeric)+ (x)++test_scientificParsing1 =+ assertEqual (Right (read "-1234560.789" :: Scientific)) =<< do+ fmap (Decoder.numeric . fromJust) $ + query "SELECT -1234560.789 :: numeric" [] PQ.Binary++test_scientificParsing2 =+ assertEqual (Right (read "-0.0789" :: Scientific)) =<< do+ fmap (Decoder.numeric . fromJust) $ + query "SELECT -0.0789 :: numeric" [] PQ.Binary++test_scientificParsing3 =+ assertEqual (Right (read "10000" :: Scientific)) =<< do+ fmap (Decoder.numeric . fromJust) $ + query "SELECT 10000 :: numeric" [] PQ.Binary++prop_scientificParsing (c, e) =+ let x = Scientific.scientific c e+ in+ Right x === do+ unsafePerformIO $ + fmap (Decoder.numeric . fromJust) $ + query "SELECT $1 :: numeric" + [Just (PQ.Oid $ fromIntegral $ PTI.oidOf PTI.numeric, (fromString . show) x, PQ.Text)] + PQ.Binary++prop_float =+ mappingP (PTI.oidOf PTI.float4) + (nonNullRenderer Encoder.float4)+ (nonNullParser Decoder.float4)++prop_floatText =+ \x -> + floatEqProp x $ do+ fromJust $ unsafePerformIO $ (fmap . fmap) reader $ checkText (PTI.oidOf pti) (encoder x)+ where+ pti = PTI.float4+ reader = read . BC.unpack+ encoder = nonNullRenderer Encoder.float4++prop_double =+ mappingP (PTI.oidOf PTI.float8) + (nonNullRenderer Encoder.float8)+ (nonNullParser Decoder.float8)++prop_doubleText =+ \x -> + floatEqProp x $ do+ fromJust $ unsafePerformIO $ (fmap . fmap) reader $ checkText (PTI.oidOf pti) (encoder x)+ where+ pti = PTI.float8+ reader = read . BC.unpack+ encoder = nonNullRenderer Encoder.float8++prop_char x =+ (x /= '\NUL') ==>+ mappingP (PTI.oidOf PTI.text) + (nonNullRenderer Encoder.char)+ (nonNullParser Decoder.char)+ (x)++prop_charText x =+ (x /= '\NUL') ==>+ mappingTextP (PTI.oidOf PTI.text) + (nonNullRenderer Encoder.char) + (Just . TE.encodeUtf8 . T.singleton)+ (x)++test_emptyArrayElements =+ assertEqual [] (Array.elements ([], [], False, 0))++test_arrayElements =+ assertEqual result (Array.elements arrayData)+ where+ arrayData = ([(3, 1)], [Just "1", Just "2", Just "3"], False, 0)+ result = [([], [Just "1"], False, 0), ([], [Just "2"], False, 0), ([], [Just "3"], False, 0)]++prop_arrayDataFromAndToListIsomporphism =+ forAll arrayGen $ \(oid, x) ->+ x === (Array.fromListUnsafe . Array.elements) x++prop_byteString =+ mappingP (PTI.oidOf PTI.bytea)+ (nonNullRenderer (Encoder.bytea . Left))+ (nonNullParser Decoder.bytea)++prop_lazyByteString =+ mappingP (PTI.oidOf PTI.bytea)+ (nonNullRenderer (Encoder.bytea . Right))+ (nonNullParser (fmap BL.fromStrict . Decoder.bytea))++prop_text v =+ (isNothing $ T.find (== '\NUL') v) ==>+ mappingP (PTI.oidOf PTI.text) + (nonNullRenderer (Encoder.text . Left))+ (nonNullParser Decoder.text)+ (v)++prop_lazyText v =+ (isNothing $ TL.find (== '\NUL') v) ==>+ mappingP (PTI.oidOf PTI.text) + (nonNullRenderer (Encoder.text . Right))+ (nonNullParser (fmap TL.fromStrict . Decoder.text))+ (v)++prop_bool =+ mappingP (PTI.oidOf PTI.bool) + (nonNullRenderer Encoder.bool)+ (nonNullParser Decoder.bool)++prop_int =+ mappingP (PTI.oidOf PTI.int8) + (nonNullRenderer (Encoder.int8 . Left) . (fromIntegral :: Int -> Int64))+ (nonNullParser Decoder.int)++prop_int8 =+ mappingP (PTI.oidOf PTI.int2) + (nonNullRenderer (Encoder.int2 . Left) . (fromIntegral :: Int8 -> Int16))+ (nonNullParser Decoder.int)++prop_int16 =+ mappingP (PTI.oidOf PTI.int2) + (nonNullRenderer (Encoder.int2 . Left))+ (nonNullParser Decoder.int)++prop_int32 =+ mappingP (PTI.oidOf PTI.int4) + (nonNullRenderer (Encoder.int4 . Left))+ (nonNullParser Decoder.int)++prop_int64 =+ mappingP (PTI.oidOf PTI.int8) + (nonNullRenderer (Encoder.int8 . Left))+ (nonNullParser Decoder.int)++prop_int64Text =+ mappingTextP (PTI.oidOf PTI.int8) + (nonNullRenderer (Encoder.int8 . Left)) + (Just . fromString . show)++prop_word =+ mappingP (PTI.oidOf PTI.int8) + (nonNullRenderer (Encoder.int8 . Right) . (fromIntegral :: Word -> Word64))+ (nonNullParser Decoder.int)++prop_word8 =+ mappingP (PTI.oidOf PTI.int2) + (nonNullRenderer (Encoder.int2 . Right) . (fromIntegral :: Word8 -> Word16))+ (nonNullParser Decoder.int)++prop_word16 =+ mappingP (PTI.oidOf PTI.int2) + (nonNullRenderer (Encoder.int2 . Right))+ (nonNullParser Decoder.int)++prop_word32 =+ mappingP (PTI.oidOf PTI.int4) + (nonNullRenderer (Encoder.int4 . Right))+ (nonNullParser Decoder.int)++prop_word64 =+ mappingP (PTI.oidOf PTI.int8) + (nonNullRenderer (Encoder.int8 . Right))+ (nonNullParser Decoder.int)++prop_word64Text =+ mappingTextP (PTI.oidOf PTI.int8) + (nonNullRenderer (Encoder.int8 . Right)) + (Just . fromString . show)++prop_day =+ mappingP (PTI.oidOf PTI.date) + (nonNullRenderer Encoder.date)+ (nonNullParser Decoder.date)++prop_dayText =+ mappingTextP (PTI.oidOf PTI.date) + (nonNullRenderer Encoder.date) + (Just . fromString . show)++prop_arrayData =+ forAll arrayGen $ uncurry $ \oid ->+ mappingP (oid)+ (nonNullRenderer Encoder.array)+ (nonNullParser Decoder.array)+
+ library/PostgreSQLBinary/Array.hs view
@@ -0,0 +1,73 @@+-- |+-- An intermediate array representation+-- and utilities for its (de)composition.+module PostgreSQLBinary.Array where++import PostgreSQLBinary.Prelude hiding (Data)+++-- | +-- A representation of a data serializable to the PostgreSQL array binary format.+-- +-- Consists of a list of dimensions, a list of encoded elements,+-- a flag specifying, whether it contains any nulls, and an oid.+type Data = ([Dimension], [Value], Bool, Word32)++-- | +-- A width and a lower bound.+-- +-- Currently the lower bound is only allowed to have a value of @1@.+type Dimension = (Word32, Word32)++-- |+-- An encoded value. 'Nothing' if it represents a @NULL@.+type Value = Maybe ByteString++-- |+-- Access a value of data, if the data represents a single value.+asSingleton :: Data -> Maybe Value+asSingleton (dimensions, elements, nulls, oid) =+ if null dimensions+ then case elements of+ [x] -> return x+ l -> $bug $ "Unexpected amount of elements: " <> show l+ else mzero++-- |+-- Construct from a non-empty list,+-- taking the shared parameters from the first element.+fromListUnsafe :: [Data] -> Data+fromListUnsafe list =+ case list of+ (dimensions, values, nulls, oid) : tail ->+ ((fromIntegral $ length list, 1) : dimensions, values <> foldMap valuesOf tail, nulls, oid)+ where+ valuesOf (_, x, _, _) = x+ _ ->+ error "Empty list"++fromSingleton :: Value -> Bool -> Word32 -> Data+fromSingleton value nullable oid =+ ([], [value], nullable, oid)++-- |+-- Get a list of elements.+elements :: Data -> [Data]+elements (dimensions, values, nulls, oid) =+ do+ subvalues <- slice values+ return (subdimensions, subvalues, nulls, oid)+ where+ ((width, lowerBound), subdimensions) =+ case dimensions of+ h : t -> (h, t)+ _ -> ((0, 1), [])+ chunkSize =+ if null subdimensions+ then 1+ else product $ map dimensionWidth $ subdimensions+ where+ dimensionWidth (x, _) = fromIntegral x+ slice = + foldr (\f g l -> case f l of (a, b) -> a : g b) (const mzero) $ + replicate (fromIntegral width) (splitAt chunkSize)
+ library/PostgreSQLBinary/Date.hs view
@@ -0,0 +1,39 @@+module PostgreSQLBinary.Date where++import PostgreSQLBinary.Prelude+import Data.Time.Calendar.Julian+++type YMD = (Integer, Int, Int)++{-# INLINE dayToJulianYMD #-}+dayToJulianYMD :: Day -> YMD+dayToJulianYMD = + toJulian++{-# INLINE dayToGregorianYMD #-}+dayToGregorianYMD :: Day -> YMD+dayToGregorianYMD = + toGregorian++{-# INLINABLE ymdToInt #-}+ymdToInt :: YMD -> Int+ymdToInt (y, m, d) =+ let (m', y') = if m > 2 then (m + 1, fromIntegral $ y + 4800)+ else (m + 13, fromIntegral $ y + 4799)+ century = y' `div` 100+ in + y' * 365 - 32167 + + y' `div` 4 - century + century `div` 4 + + 7834 * m' `div` 256 + d++{-# INLINABLE dayToPostgresJulian #-}+dayToPostgresJulian :: Day -> Integer+dayToPostgresJulian =+ (+ (2400001 - 2451545)) . toModifiedJulianDay++{-# INLINABLE postgresJulianToDay #-}+postgresJulianToDay :: Integer -> Day+postgresJulianToDay =+ ModifiedJulianDay . (subtract (2400001 - 2451545))+
+ library/PostgreSQLBinary/Decoder.hs view
@@ -0,0 +1,189 @@+module PostgreSQLBinary.Decoder where++import PostgreSQLBinary.Prelude hiding (bool)+import qualified Data.ByteString as B+import qualified Data.ByteString.Builder as BB+import qualified Data.ByteString.Lazy as BL+import qualified Data.Text as T+import qualified Data.Text.Encoding as TE+import qualified Data.Text.Lazy as TL+import qualified Data.Text.Lazy.Encoding as TLE+import qualified Data.Scientific as Scientific+import qualified Data.UUID as UUID+import qualified PostgreSQLBinary.Decoder.Atto as Atto+import qualified PostgreSQLBinary.Decoder.Zepto as Zepto+import qualified PostgreSQLBinary.Array as Array+import qualified PostgreSQLBinary.Date as Date+import qualified PostgreSQLBinary.Integral as Integral+import qualified PostgreSQLBinary.Numeric as Numeric+++-- |+-- A function for decoding a byte string into a value.+type D a = ByteString -> Either Text a+++-- * Numbers+-------------------------++-- |+-- Any of PostgreSQL integer types.+{-# INLINABLE int #-}+int :: (Integral a, Bits a) => D a+int =+ Right . Integral.pack++{-# INLINABLE float4 #-}+float4 :: D Float+float4 =+ unsafeCoerce . (int :: D Word32)++{-# INLINABLE float8 #-}+float8 :: D Double+float8 =+ unsafeCoerce . (int :: D Word64)++{-# INLINABLE numeric #-}+numeric :: D Scientific+numeric =+ evalStateT $ do+ componentsAmount <- intOfSize 2+ pointIndex :: Int16 <- intOfSize 2+ signCode <- intOfSize 2+ modify (B.drop 2)+ components <- replicateM componentsAmount (intOfSize 2)+ signer <-+ if | signCode == Numeric.negSignCode -> return negate+ | signCode == Numeric.posSignCode -> return id+ | signCode == Numeric.nanSignCode -> lift $ Left "NAN sign"+ | otherwise -> lift $ Left $ "Unexpected sign value: " <> (fromString . show) signCode+ let+ c = signer $ fromIntegral $ (Numeric.mergeComponents components :: Word64)+ e = (fromIntegral (pointIndex + 1) - length components) * 4+ in return $ Scientific.scientific c e+ where+ intOfSize n =+ lift . int =<< state (B.splitAt n)+++-- * Text+-------------------------++-- |+-- A UTF-8-encoded char.+{-# INLINABLE char #-}+char :: D Char+char x =+ maybe (Left "Empty input") (return . fst) . T.uncons =<< text x++-- |+-- Any of the variable-length character types:+-- BPCHAR, VARCHAR, NAME and TEXT.+{-# INLINABLE text #-}+text :: D Text+text =+ either (Left . fromString . show) Right . TE.decodeUtf8'++{-# INLINE bytea #-}+bytea :: D ByteString+bytea =+ Right++-- * Date and Time+-------------------------++{-# INLINABLE date #-}+date :: D Day+date =+ fmap (Date.postgresJulianToDay . fromIntegral) . (int :: D Int32)++{-# INLINABLE time #-}+time :: D TimeOfDay+time =+ fmap (timeToTimeOfDay . picosecondsToDiffTime . (* (10^6)) . fromIntegral) . + (int :: D Word64)++{-# INLINABLE timetz #-}+timetz :: D (TimeOfDay, TimeZone)+timetz =+ \x -> + let (timeX, zoneX) = B.splitAt 8 x+ in (,) <$> time timeX <*> tz zoneX+ where+ tz =+ fmap (minutesToTimeZone . negate . (`div` 60) . fromIntegral) . (int :: D Int32)++{-# INLINABLE timestamp #-}+timestamp :: D UTCTime+timestamp =+ fmap fromMicros . (int :: D Int64)+ where+ fromMicros =+ evalState $ do+ days <- state $ (`divMod` (10^6 * 60 * 60 * 24))+ micros <- get+ return $+ UTCTime + (Date.postgresJulianToDay . fromIntegral $ days)+ (picosecondsToDiffTime . (* (10^6)) . fromIntegral $ micros)++{-# INLINABLE timestamptz #-}+timestamptz :: D LocalTime+timestamptz =+ fmap fromMicros . (int :: D Int64)+ where+ fromMicros =+ evalState $ do+ days <- state $ (`divMod` (10^6 * 60 * 60 * 24))+ micros <- get+ return $+ LocalTime + (Date.postgresJulianToDay . fromIntegral $ days)+ (timeToTimeOfDay . picosecondsToDiffTime . (* (10^6)) . fromIntegral $ micros)++{-# INLINABLE interval #-}+interval :: D DiffTime+interval =+ evalStateT $ do+ ub <- state $ B.splitAt 8+ db <- state $ B.splitAt 4+ mb <- get+ lift $ do+ u <- int ub+ d <- int db+ m <- int mb+ return $ picosecondsToDiffTime $ fromIntegral $+ (10 ^ 6 * (u + 10 ^ 6 * 60 * 60 * 24 * (d + 31 * m)) :: Int)++++-- * Misc+-------------------------++{-# INLINABLE bool #-}+bool :: D Bool+bool b =+ case B.uncons b of+ Just (0, _) -> return False+ Just (1, _) -> return True+ _ -> Left ("Invalid value: " <> (fromString . show) b)++{-# INLINABLE uuid #-}+uuid :: D UUID+uuid =+ evalStateT $ + UUID.fromWords <$> word <*> word <*> word <*> word+ where+ word = + lift . int =<< state (B.splitAt 4)+++-- |+-- Arbitrary array.+-- +-- Returns an intermediate representation,+-- which can then be used to decode into a specific data type.+{-# INLINABLE array #-}+array :: D Array.Data+array =+ flip Zepto.run Zepto.array
+ library/PostgreSQLBinary/Decoder/Atto.hs view
@@ -0,0 +1,45 @@+-- |+-- Composable Attoparsec parsers.+module PostgreSQLBinary.Decoder.Atto where++import PostgreSQLBinary.Prelude hiding (take, bool)+import Data.Attoparsec.ByteString+import Data.Attoparsec.ByteString.Char8 hiding (double)+import qualified PostgreSQLBinary.Integral as Integral+import qualified PostgreSQLBinary.Array as Array+import qualified Data.Scientific as Scientific+++{-# INLINABLE run #-}+run :: ByteString -> Parser a -> Either Text a+run input parser =+ onResult $ parse (parser <* endOfInput) input + where+ onResult =+ \case+ Fail remainder contexts message ->+ Left $ "Message: " <> (fromString . show) message <> "; " <>+ "Contexts: " <> (fromString . show) contexts <> "; " <>+ "Failing input: " <> (fromString . show) remainder+ Partial c ->+ onResult $ c mempty+ Done _ result ->+ Right result++{-# INLINE integral #-}+integral :: forall a. (Integral a, Bits a) => Parser a+integral =+ intOfSize (Integral.byteSize (undefined :: a))++{-# INLINE intOfSize #-}+intOfSize :: (Integral a, Bits a) => Int -> Parser a+intOfSize x =+ Integral.pack <$> take x++bool :: Parser Bool+bool =+ (word8 0 *> pure False) <|> (word8 1 *> pure True)++double :: Parser Double+double =+ unsafeCoerce (intOfSize 8 :: Parser Int64)
+ library/PostgreSQLBinary/Decoder/Zepto.hs view
@@ -0,0 +1,52 @@+-- |+-- Composable Attoparsec parsers.+module PostgreSQLBinary.Decoder.Zepto where++import PostgreSQLBinary.Prelude hiding (take, bool)+import Data.Attoparsec.Zepto+import qualified PostgreSQLBinary.Integral as Integral+import qualified PostgreSQLBinary.Array as Array+import qualified Data.Scientific as Scientific+++{-# INLINE run #-}+run :: ByteString -> Parser a -> Either Text a+run input parser =+ either (Left . fromString . show) Right $ parse parser input ++{-# INLINE endOfInput #-}+endOfInput :: Parser ()+endOfInput =+ atEnd >>= \case True -> return (); False -> fail "Not an end of input"++{-# INLINE intOfSize #-}+intOfSize :: (Integral a, Bits a) => Int -> Parser a+intOfSize x =+ Integral.pack <$> take x++{-# INLINABLE array #-}+array :: Parser Array.Data+array =+ do+ dimensionsAmountV <- intOfSize 4+ nullsV <- nulls+ oidV <- intOfSize 4+ dimensionsV <- replicateM dimensionsAmountV dimension+ valuesV <- many value+ return (dimensionsV, valuesV, nullsV, oidV)+ where+ dimension =+ (,) <$> intOfSize 4 <*> intOfSize 4+ value =+ nothing <|> just+ where+ nothing =+ string (Integral.unpack (-1 :: Word32)) *> pure Nothing+ just =+ Just <$> (take =<< intOfSize 4)+ nulls =+ (intOfSize 4 :: Parser Word32) >>= \case+ 0 -> return False+ 1 -> return True+ w -> fail $ "Invalid value: " <> show w+
+ library/PostgreSQLBinary/Encoder.hs view
@@ -0,0 +1,145 @@+module PostgreSQLBinary.Encoder where++import PostgreSQLBinary.Prelude+import qualified Data.ByteString as B+import qualified Data.ByteString.Char8 as BC+import qualified Data.ByteString.Builder as BB+import qualified Data.ByteString.Lazy as BL+import qualified Data.ByteString.Lazy.Char8 as BLC+import qualified Data.Text as T+import qualified Data.Text.Encoding as TE+import qualified Data.Text.Lazy as TL+import qualified Data.Text.Lazy.Encoding as TLE+import qualified PostgreSQLBinary.Encoder.Builder as Builder+import qualified PostgreSQLBinary.Array as Array+import qualified PostgreSQLBinary.Date as Date+import qualified PostgreSQLBinary.Integral as Integral+import qualified PostgreSQLBinary.Numeric as Numeric+++-- |+-- A function for rendering a value into a byte string.+type E a = a -> ByteString+++-- * Numbers+-------------------------++{-# INLINABLE int2 #-}+int2 :: E (Either Int16 Word16)+int2 = + either unpack unpack+ where+ unpack = Integral.unpackBySize 2++{-# INLINABLE int4 #-}+int4 :: E (Either Int32 Word32)+int4 = + either unpack unpack+ where+ unpack = Integral.unpackBySize 4++{-# INLINABLE int8 #-}+int8 :: E (Either Int64 Word64)+int8 = + either unpack unpack+ where+ unpack = Integral.unpackBySize 8++{-# INLINABLE float4 #-}+float4 :: E Float+float4 =+ int4 . Right . (unsafeCoerce :: Float -> Word32)++{-# INLINABLE float8 #-}+float8 :: E Double+float8 =+ int8 . Right . (unsafeCoerce :: Double -> Word64)++{-# INLINABLE numeric #-}+numeric :: E Scientific+numeric =+ Builder.run . Builder.numeric++-- * Text+-------------------------++-- |+-- A UTF-8-encoded char.+-- +-- Note that since it's UTF-8-encoded+-- not a \"char\" but a \"text\" OID should be used with it.+{-# INLINABLE char #-}+char :: E Char+char = + text . Left . T.singleton++-- |+-- Either a strict or a lazy text.+{-# INLINABLE text #-}+text :: E (Either Text TL.Text)+text =+ either strict lazy+ where+ strict = TE.encodeUtf8 . T.filter (/= '\0')+ lazy = BL.toStrict . TLE.encodeUtf8 . TL.filter (/= '\0')++-- |+-- Either a strict or a lazy bytestring.+{-# INLINABLE bytea #-}+bytea :: E (Either ByteString BL.ByteString)+bytea =+ either id BL.toStrict++-- * Date and Time+-------------------------++{-# INLINABLE date #-}+date :: E Day+date =+ Builder.run . Builder.date++{-# INLINABLE time #-}+time :: E TimeOfDay+time =+ Builder.run . Builder.time++{-# INLINABLE timetz #-}+timetz :: E (TimeOfDay, TimeZone)+timetz =+ Builder.run . Builder.timetz++{-# INLINABLE timestamp #-}+timestamp :: E UTCTime+timestamp =+ Builder.run . Builder.timestamp++{-# INLINABLE timestamptz #-}+timestamptz :: E LocalTime+timestamptz =+ Builder.run . Builder.timestamptz++{-# INLINABLE interval #-}+interval :: E DiffTime+interval =+ Builder.run . Builder.interval++-- * Misc+-------------------------++{-# INLINABLE bool #-}+bool :: E Bool+bool =+ \case+ False -> B.singleton 0+ True -> B.singleton 1++{-# INLINABLE uuid #-}+uuid :: E UUID+uuid =+ Builder.run . Builder.uuid++{-# INLINABLE array #-}+array :: E Array.Data+array = + Builder.run . Builder.array
+ library/PostgreSQLBinary/Encoder/Builder.hs view
@@ -0,0 +1,136 @@+module PostgreSQLBinary.Encoder.Builder where++import PostgreSQLBinary.Prelude hiding (bool)+import Data.ByteString.Builder+import qualified Data.ByteString as B+import qualified Data.ByteString.Char8 as BC+import qualified Data.ByteString.Lazy as BL+import qualified Data.ByteString.Lazy.Char8 as BLC+import qualified Data.Text as T+import qualified Data.Text.Encoding as T+import qualified Data.Text.Lazy as TL+import qualified Data.Text.Lazy.Encoding as TL+import qualified Data.Scientific as Scientific+import qualified Data.UUID as UUID+import qualified PostgreSQLBinary.Array as Array+import qualified PostgreSQLBinary.Date as Date+import qualified PostgreSQLBinary.Numeric as Numeric+++{-# INLINE run #-}+run :: Builder -> B.ByteString+run = + BL.toStrict . toLazyByteString++{-# INLINE bool #-}+bool :: Bool -> Builder+bool = + \case True -> word8 1; False -> word8 0++{-# INLINE array #-}+array :: Array.Data -> Builder+array (dimensionsV, valuesV, nullsV, oidV) =+ dimensionsLength <> nulls <> oid <> dimensions <> values+ where+ dimensionsLength = + word32BE $ fromIntegral $ length dimensionsV+ nulls = + word32BE $ if nullsV then 1 else 0+ oid = + word32BE oidV+ dimensions = + foldMap dimension dimensionsV+ values = + foldMap value valuesV+ dimension (w, l) = + word32BE w <> word32BE l+ value =+ \case+ Nothing -> word32BE (-1)+ Just b -> word32BE (fromIntegral (B.length b)) <> byteString b++{-# INLINE date #-}+date :: Day -> Builder+date =+ int32BE . fromIntegral . Date.dayToPostgresJulian++{-# INLINE time #-}+time :: TimeOfDay -> Builder+time =+ word64BE . (`div` (10^6)) . unsafeCoerce timeOfDayToTime++{-# INLINE timetz #-}+timetz :: (TimeOfDay, TimeZone) -> Builder+timetz (timeX, tzX) =+ time timeX <> tz tzX++{-# INLINE tz #-}+tz :: TimeZone -> Builder+tz =+ int32BE . fromIntegral . (*60) . negate . timeZoneMinutes++{-# INLINE timestamp #-}+timestamp :: UTCTime -> Builder+timestamp (UTCTime dayX timeX) =+ let days = Date.dayToPostgresJulian dayX * 10^6 * 60 * 60 * 24+ time = (`div` (10^6)) . unsafeCoerce $ timeX+ in int64BE $ fromIntegral $ days + time++{-# INLINE timestamptz #-}+timestamptz :: LocalTime -> Builder+timestamptz (LocalTime dayX timeX) =+ let days = Date.dayToPostgresJulian dayX * 10^6 * 60 * 60 * 24+ time = (`div` (10^6)) . unsafeCoerce timeOfDayToTime $ timeX+ in int64BE $ fromIntegral $ days + time++{-# INLINE interval #-}+interval :: DiffTime -> Builder+interval x =+ flip evalState (unsafeCoerce x :: Integer) $ do+ u <- state (`divMod` (10 ^ 6))+ d <- state (`divMod` (10 ^ 6 * 60 * 60 * 24))+ m <- get+ return $+ int64BE (fromIntegral u) <> int32BE (fromIntegral d) <> int32BE (fromIntegral m)++{-# INLINE numeric #-}+numeric :: Scientific -> Builder+numeric x =+ word16BE (fromIntegral componentsAmount) <>+ int16BE (fromIntegral pointIndex) <>+ word16BE signCode <>+ word16BE (fromIntegral trimmedExponent) <>+ foldMap word16BE components+ where+ componentsAmount = + length components+ coefficient =+ Scientific.coefficient x+ exponent = + Scientific.base10Exponent x+ components = + Numeric.extractComponents tunedCoefficient+ pointIndex =+ componentsAmount + (tunedExponent `div` 4) - 1+ (tunedCoefficient, tunedExponent) =+ case mod exponent 4 of+ 0 -> (coefficient, exponent)+ x -> (coefficient * 10 ^ x, exponent - x)+ trimmedExponent =+ if tunedExponent >= 0+ then 0+ else negate tunedExponent+ signCode =+ if coefficient < 0+ then Numeric.negSignCode+ else Numeric.posSignCode++{-# INLINE uuid #-}+uuid :: UUID -> Builder+uuid =+ UUID.toWords >>> \(a, b, c, d) -> + word32BE a <> + word32BE b <> + word32BE c <> + word32BE d+
+ library/PostgreSQLBinary/Integral.hs view
@@ -0,0 +1,24 @@+-- |+-- Utils for dealing with numbers.+module PostgreSQLBinary.Integral where++import PostgreSQLBinary.Prelude+import qualified Data.ByteString as B+++{-# INLINE byteSize #-}+byteSize :: (Bits a) => a -> Int+byteSize = (`div` 8) . bitSize++{-# INLINE pack #-}+pack :: (Bits a, Num a) => B.ByteString -> a+pack = B.foldl' (\n h -> (n `shiftL` 8) .|. fromIntegral h) 0++{-# INLINE unpack #-}+unpack :: (Bits a, Integral a) => a -> B.ByteString+unpack x = unpackBySize (byteSize x) x++{-# INLINE unpackBySize #-}+unpackBySize :: (Bits a, Integral a) => Int -> a -> B.ByteString+unpackBySize n x = B.pack $ map f $ reverse [0..n - 1]+ where f s = fromIntegral $ shiftR x (8 * s)
+ library/PostgreSQLBinary/Numeric.hs view
@@ -0,0 +1,38 @@+module PostgreSQLBinary.Numeric where++import PostgreSQLBinary.Prelude+++posSignCode = 0x0000 :: Word16+negSignCode = 0x4000 :: Word16+nanSignCode = 0xC000 :: Word16++{-# INLINE extractComponents #-}+extractComponents :: Integral a => a -> [Word16]+extractComponents =+ (reverse .) . (. abs) . unfoldr $ \case+ 0 -> Nothing+ x -> case divMod x 10000 of+ (d, m) -> Just (fromIntegral m, d)++{-# INLINE mergeComponents #-}+mergeComponents :: Integral a => [a] -> a+mergeComponents = + foldl' (\l r -> l * 10000 + r) 0++{-# INLINE mergeDigits #-}+mergeDigits :: Integral a => [a] -> a+mergeDigits = + foldl' (\l r -> l * 10 + r) 0++-- |+-- Unpack a component into digits.+{-# INLINE componentDigits #-}+componentDigits :: Word16 -> [Word16]+componentDigits =+ evalState $ do+ a <- state (`divMod` 1000)+ b <- state (`divMod` 100)+ c <- state (`divMod` 10)+ d <- get+ return $ [a, b, c, d]
+ library/PostgreSQLBinary/Prelude.hs view
@@ -0,0 +1,63 @@+module PostgreSQLBinary.Prelude+( + module Exports,+ LazyByteString,+ LazyText,+ bug,+ bottom,+ partial,+)+where+++-- base-prelude+-------------------------+import BasePrelude as Exports++-- mtl-prelude+-------------------------+import MTLPrelude as Exports hiding (shift)++-- text+-------------------------+import Data.Text as Exports (Text)++-- bytestring+-------------------------+import Data.ByteString as Exports (ByteString)++-- scientific+-------------------------+import Data.Scientific as Exports (Scientific)++-- uuid+-------------------------+import Data.UUID as Exports (UUID)++-- time+-------------------------+import Data.Time as Exports++-- placeholders+-------------------------+import Development.Placeholders as Exports++-- custom+-------------------------+import qualified Debug.Trace.LocationTH+import qualified Data.Text.Lazy+import qualified Data.ByteString.Lazy+++type LazyByteString = Data.ByteString.Lazy.ByteString+type LazyText = Data.Text.Lazy.Text++bug = [e| $(Debug.Trace.LocationTH.failure) . (msg <>) |]+ where+ msg = "A \"postgresql-binary\" package bug: " :: String++bottom = [e| $bug "Bottom evaluated" |]++partial :: Alternative f => (a -> Bool) -> a -> f a+partial p x = + if p x then pure x else empty
+ postgresql-binary.cabal view
@@ -0,0 +1,176 @@+name:+ postgresql-binary+version:+ 0.1.0+synopsis:+ Encoders and decoders for the PostgreSQL's binary format+description:+ An API for dealing with PostgreSQL's binary data format.+ .+ It can be used to implement high level APIs for Postgres.+ E.g., <http://hackage.haskell.org/package/hasql-postgres "hasql-postgres">+ is based on this library.+category:+ Database, Codecs, Parsing+homepage:+ https://github.com/nikita-volkov/postgresql-binary +bug-reports:+ https://github.com/nikita-volkov/postgresql-binary/issues +author:+ Nikita Volkov <nikita.y.volkov@mail.ru>+maintainer:+ Nikita Volkov <nikita.y.volkov@mail.ru>+copyright:+ (c) 2014, Nikita Volkov+license:+ MIT+license-file:+ LICENSE+build-type:+ Simple+cabal-version:+ >=1.10+++source-repository head+ type:+ git+ location:+ git://github.com/nikita-volkov/postgresql-binary.git+++library+ hs-source-dirs:+ library+ ghc-options:+ -funbox-strict-fields+ default-extensions:+ Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFunctor, DeriveGeneric, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, ImpredicativeTypes, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators, UnboxedTuples+ default-language:+ Haskell2010+ other-modules:+ PostgreSQLBinary.Prelude+ PostgreSQLBinary.Encoder.Builder+ PostgreSQLBinary.Decoder.Atto+ PostgreSQLBinary.Decoder.Zepto+ PostgreSQLBinary.Integral+ PostgreSQLBinary.Numeric+ PostgreSQLBinary.Date+ exposed-modules:+ PostgreSQLBinary.Array+ PostgreSQLBinary.Encoder+ PostgreSQLBinary.Decoder+ build-depends:+ -- parsers:+ attoparsec == 0.12.*,+ -- data:+ uuid == 1.3.*,+ time >= 1.4 && < 1.6,+ scientific == 0.3.*,+ text >= 1 && < 1.3,+ bytestring >= 0.10 && < 0.11,+ -- errors:+ loch-th == 0.2.*,+ placeholders == 0.1.*,+ -- general:+ mtl-prelude == 2.0.*,+ base-prelude >= 0.1.3 && < 0.2,+ base >= 4.5 && < 4.8+++test-suite tests+ type: + exitcode-stdio-1.0+ hs-source-dirs: + executables+ main-is: + Tests.hs+ ghc-options:+ -threaded+ "-with-rtsopts=-N"+ -funbox-strict-fields+ default-extensions:+ Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFunctor, DeriveGeneric, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, ImpredicativeTypes, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators, UnboxedTuples+ default-language:+ Haskell2010+ build-depends:+ -- testing:+ postgresql-binary,+ HTF == 0.12.*,+ quickcheck-instances == 0.3.*,+ QuickCheck == 2.7.*,+ -- database:+ postgresql-libpq == 0.9.*,+ -- data:+ uuid == 1.3.*,+ time >= 1.4 && < 1.6,+ scientific == 0.3.*,+ text >= 1 && < 1.3,+ bytestring >= 0.10 && < 0.11,+ -- general:+ base-prelude >= 0.1.3 && < 0.2,+ base >= 4.5 && < 4.8+++benchmark decoding+ type: + exitcode-stdio-1.0+ hs-source-dirs:+ executables+ main-is:+ Decoding.hs+ ghc-options:+ -O2+ -threaded+ "-with-rtsopts=-N"+ -funbox-strict-fields+ default-extensions:+ Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFunctor, DeriveGeneric, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, ImpredicativeTypes, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators, UnboxedTuples+ default-language:+ Haskell2010+ build-depends:+ postgresql-binary,+ -- benchmarking:+ criterion == 1.0.*,+ -- data:+ time >= 1.4 && < 1.6,+ scientific == 0.3.*,+ text >= 1 && < 1.3,+ bytestring >= 0.10 && < 0.11,+ -- general:+ deepseq == 1.3.*,+ mtl-prelude == 2.0.*,+ base-prelude >= 0.1.3 && < 0.2,+ base >= 4.5 && < 4.8+++benchmark encoding+ type: + exitcode-stdio-1.0+ hs-source-dirs:+ executables+ main-is:+ Encoding.hs+ ghc-options:+ -O2+ -threaded+ "-with-rtsopts=-N"+ -funbox-strict-fields+ default-extensions:+ Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFunctor, DeriveGeneric, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, ImpredicativeTypes, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators, UnboxedTuples+ default-language:+ Haskell2010+ build-depends:+ postgresql-binary,+ -- benchmarking:+ criterion == 1.0.*,+ -- data:+ time >= 1.4 && < 1.6,+ scientific == 0.3.*,+ text >= 1 && < 1.3,+ bytestring >= 0.10 && < 0.11,+ -- general:+ deepseq == 1.3.*,+ mtl-prelude == 2.0.*,+ base-prelude >= 0.1.3 && < 0.2,+ base >= 4.5 && < 4.8