packages feed

winery 1.1.2 → 1.1.3

raw patch · 5 files changed

+45/−28 lines, 5 files

Files

README.md view
@@ -20,7 +20,7 @@ 0200 0541 6c69 6365 0103 426f 62    [(0, "Alice"), (1, "Bob")] ``` -Unlike `binary` or `cereal` which doesn't preserve metadata at all, winery also+Unlike other libraries that don't preserve metadata (e.g.` binary`, `cereal`, `store`) at all, winery also allows readers to decode values regardless of the current implementation.  ## Interface
src/Codec/Winery.hs view
@@ -37,6 +37,7 @@   , readFileDeserialise   -- * Separate serialisation   , serialiseSchema+  , schemaToBuilder   , deserialiseSchema   , Extractor(..)   , unwrapExtractor@@ -108,7 +109,6 @@ import Control.Exception (throw, throwIO) import qualified Data.ByteString as B import qualified Data.ByteString.FastBuilder as BB-import qualified Data.ByteString.Lazy as BL import Data.Function (fix) import qualified Data.Text as T import Data.Text.Prettyprint.Doc (pretty, dquotes)@@ -221,7 +221,7 @@ -- -- /"Write the vision, and make it plain upon tables, that he may run that readeth it."/ serialise :: Serialise a => a -> B.ByteString-serialise = BL.toStrict . BB.toLazyByteString . toBuilderWithSchema+serialise = BB.toStrictByteString . toBuilderWithSchema {-# INLINE serialise #-}  -- | 'serialise' then write it to a file.@@ -246,11 +246,13 @@       Decoder $ \bs' i -> DecoderResult (B.length bs') (sch, B.drop i bs')   Nothing -> Left EmptyInput --- | Serialise a schema.+-- | Serialise a schema (prefix with the version number only). serialiseSchema :: Schema -> B.ByteString-serialiseSchema = BL.toStrict . BB.toLazyByteString-  . mappend (BB.word8 currentSchemaVersion) . toBuilder+serialiseSchema = BB.toStrictByteString . schemaToBuilder +schemaToBuilder :: Schema -> BB.Builder+schemaToBuilder = mappend (BB.word8 currentSchemaVersion) . toBuilder+ -- | Deserialise a 'serialise'd 'B.Bytestring'. -- -- /"Old wood to burn! Old wine to drink! Old friends to trust! Old authors to read!"/@@ -284,7 +286,7 @@ -- -- /"Any unsaved progress will be lost."/ serialiseOnly :: Serialise a => a -> B.ByteString-serialiseOnly = BL.toStrict . BB.toLazyByteString . toBuilder+serialiseOnly = BB.toStrictByteString . toBuilder {-# INLINE serialiseOnly #-}  -- | Build an extractor from a 'Subextractor'.
src/Codec/Winery/Class.hs view
@@ -945,6 +945,8 @@     | i < len' = L1 <$> variantDecoder len' i     | otherwise = R1 <$> variantDecoder (len - len') (i - len')     where+      -- Nested ':+:' are balanced+      -- cf. https://github.com/GaloisInc/cereal/blob/cereal-0.5.8.1/src/Data/Serialize.hs#L659       len' = unsafeShiftR len 1   {-# INLINE variantDecoder #-} @@ -963,6 +965,8 @@   variantEncoder len i (L1 f) = variantEncoder (unsafeShiftR len 1) i f   variantEncoder len i (R1 g) = variantEncoder (len - len') (i + len') g     where+      -- Nested ':+:' are balanced+      -- cf. https://github.com/GaloisInc/cereal/blob/cereal-0.5.8.1/src/Data/Serialize.hs#L659       len' = unsafeShiftR len 1   {-# INLINE variantEncoder #-}
src/Codec/Winery/Test.hs view
@@ -7,6 +7,7 @@ {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE OverloadedStrings #-} ---------------------------------------------------------------------------- -- | -- Module      :  Codec.Winery.Test@@ -24,6 +25,7 @@   ( -- * Generating tests   TestGen(..)   , printTests+  , buildTestGroups   -- * Test cases   , Tested(..)   , testCase@@ -39,6 +41,7 @@ import Data.Functor.Identity import Data.Hashable import Data.Proxy+import qualified Data.Set as Set import qualified Data.Sequence as S import Data.Typeable import Codec.Winery@@ -76,6 +79,13 @@   -- | List of test cases for the type.   testCases :: [Test] +  default testCases :: (Serialise a, Eq a, Show a) => [Test]+  testCases = [testCase sch b a | (sch, xs) <- testGroups @ a, (b, a) <- xs]++  testGroups :: [(Schema, [(B.ByteString, a)])]+  testGroups = []+  {-# MINIMAL testGroups | testCases #-}+ -- these are already covered by the QuickCheck tests from winery instance Tested Void where testCases = [] instance Tested Bool where testCases = []@@ -93,6 +103,7 @@ instance Tested a => Tested (Identity a) where   testCases = testCases @ a instance Tested a => Tested (S.Seq a) where testCases = []+instance (Ord a, Tested a) => Tested (Set.Set a) where testCases = [] instance Tested a => Tested [a] where testCases = [] instance (Tested a, Tested b) => Tested (Either a b) where testCases = [] instance (Tested a, Tested b) => Tested (a, b) where testCases = []@@ -102,11 +113,16 @@ instance (UV.Unbox a, Tested a) => Tested (UV.Vector a) where testCases = [] instance (Hashable k, Tested k, Tested a) => Tested (HM.HashMap k a) where testCases = [] instance (Ord k, Tested k, Tested a) => Tested (M.Map k a) where testCases = []+instance Tested a => TestGen (Maybe a)+instance Tested a => Tested (Maybe a) where testCases = []  -- | Generate test cases and print them to the standard output. printTests :: forall a. (TestGen a, Serialise a, Show a) => IO () printTests = putStrLn $ showTests (genTestCases :: [a]) +buildTestGroups :: forall a. (TestGen a, Serialise a) => [(Schema, [(B.ByteString, a)])]+buildTestGroups = [(schema (Proxy @ a), [(serialiseOnly a, a) | a <- genTestCases :: [a]])]+ showTests :: (Serialise a, Show a) => [a] -> String showTests xs = showListWith ppTest xs "" @@ -184,6 +200,10 @@   genTestCases = [[]]   inheritedTests _ = allTests @ a +instance (Ord a, Tested a) => TestGen (Set.Set a) where+  genTestCases = [mempty]+  inheritedTests _ = allTests @ a+ instance Tested a => TestGen (S.Seq a) where   genTestCases = [mempty]   inheritedTests _ = allTests @ a@@ -213,27 +233,27 @@   inheritedTests = mempty  instance TestGen Word8 where-  genTestCases = [42]+  genTestCases = [8]   inheritedTests = mempty  instance TestGen Word16 where-  genTestCases = [42]+  genTestCases = [16]   inheritedTests = mempty  instance TestGen Word32 where-  genTestCases = [42]+  genTestCases = [32]   inheritedTests = mempty  instance TestGen Word64 where-  genTestCases = [42]+  genTestCases = [64]   inheritedTests = mempty  instance TestGen Float where-  genTestCases = [pi]-  inheritedTests = mempty+  genTestCases = [0.1] +  inheritedTests = mempty instance TestGen Double where-  genTestCases = [pi]+  genTestCases = [0.2]   inheritedTests = mempty  instance TestGen Char where@@ -241,9 +261,9 @@   inheritedTests = mempty  instance TestGen T.Text where-  genTestCases = [mempty]+  genTestCases = ["葡"]   inheritedTests = mempty  instance TestGen B.ByteString where-  genTestCases = [mempty]+  genTestCases = ["B"]   inheritedTests = mempty
winery.cabal view
@@ -1,7 +1,6 @@-cabal-version: 1.12-+cabal-version:  2.0 name:           winery-version:        1.1.2+version:        1.1.3 synopsis:       A compact, well-typed seralisation format for Haskell values description:   <<https://i.imgur.com/lTosHnE.png>>@@ -15,7 +14,7 @@ copyright:      Copyright (c) 2019 Fumiaki Kinoshita license:        BSD3 license-file:   LICENSE-tested-with:    GHC == 8.4.4, GHC == 8.6.3+tested-with:    GHC == 8.4.4, GHC == 8.6.3, GHC ==8.8.1 build-type:     Simple extra-source-files:   README.md@@ -39,8 +38,6 @@       Codec.Winery.Test       Data.Winery       Data.Winery.Test-  other-modules:-      Paths_winery   hs-source-dirs:       src   ghc-options: -Wall -O2 -Wcompat@@ -69,8 +66,6 @@  executable winery   main-is: Main.hs-  other-modules:-      Paths_winery   hs-source-dirs:       app   ghc-options: -Wall -O2 -Wcompat@@ -89,8 +84,6 @@   type: exitcode-stdio-1.0   main-is: Spec.hs   ghc-options: -Wall -Wcompat-  other-modules:-      Paths_winery   hs-source-dirs:       test   build-depends:@@ -111,8 +104,6 @@ benchmark bench-winery   type: exitcode-stdio-1.0   main-is: bench.hs-  other-modules:-      Paths_winery   hs-source-dirs:       benchmarks   ghc-options: -O2 -Wall -Wcompat