describe 0.1.2.1 → 0.2.0.0

raw patch · 11 files changed

+250/−145 lines, 11 filesdep +fixed-vectorPVP ok

version bump matches the API change (PVP)

Dependencies added: fixed-vector

API changes (from Hackage documentation)

Files

• CHANGELOG.md +7/−0
• describe.cabal +23/−5
• src/Data/Serialize/Describe.hs +7/−0
• src/Data/Serialize/Describe/Class.hs +36/−0
• src/Data/Serialize/Describe/Combinators.hs +38/−0
• src/Data/Serialize/Describe/Combinators/BE.hs +47/−0
• src/Data/Serialize/Describe/Combinators/LE.hs +48/−0
• src/Data/Serialize/Describe/Descriptor.hs +44/−0
• src/Data/Serialize/Descriptor.hs +0/−45
• src/Data/Serialize/Descriptor/BE.hs +0/−47
• src/Data/Serialize/Descriptor/LE.hs +0/−48

@@ -1,5 +1,12 @@ # Revision history for describe +## 0.2.0.0 -- 2019-10-06++* Added `Describe` type class.+* Made `Describe` generically-derivable.+* Refactored module structure.+* Added type- and value-level combinators to be used with `Describe`.+ ## 0.1.2.1 -- 2019-09-08  * Fixed unwrapPut / serialize.

@@ -3,7 +3,7 @@ --   For further documentation, see http://haskell.org/cabal/users-guide/  name:                describe-version:             0.1.2.1+version:             0.2.0.0 synopsis:            Combinators for describing binary data structures description:         Combinators for describing binary data structures, which eliminate the boilerplate of having to write isomorphic Get and Put instances. Please see the Github page for examples. homepage:            https://github.com/riugabachi/describe@@ -19,17 +19,35 @@   location: https://github.com/RiugaBachi/describe.git  common deps+  default-extensions: TypeApplications,+                      MultiParamTypeClasses,+                      AllowAmbiguousTypes,+                      FunctionalDependencies,+                      TypeOperators,+                      FlexibleContexts,+                      DefaultSignatures,+                      DataKinds,+                      UndecidableInstances,+                      KindSignatures+                      ConstraintKinds,+                      EmptyDataDecls,+                      ScopedTypeVariables,+                      FlexibleInstances   build-depends: base ^>= 4.12.0.0,                  cereal >= 0.5.8 && < 0.6,-                 bytestring >= 0.10.8 && < 0.11+                 bytestring >= 0.10.8 && < 0.11,+                 fixed-vector >= 1.2.0 && < 1.3   ghc-options: -Wall   default-language: Haskell2010  library   import: deps-  exposed-modules:     Data.Serialize.Descriptor,-                       Data.Serialize.Descriptor.LE,-                       Data.Serialize.Descriptor.BE+  exposed-modules:     Data.Serialize.Describe,+                       Data.Serialize.Describe.Descriptor,+                       Data.Serialize.Describe.Combinators,+                       Data.Serialize.Describe.Combinators.LE,+                       Data.Serialize.Describe.Combinators.BE,+                       Data.Serialize.Describe.Class   hs-source-dirs:      src  test-suite describe-tests

@@ -0,0 +1,7 @@+module Data.Serialize.Describe(+  module Data.Serialize.Describe.Descriptor,+  module Data.Serialize.Describe.Class+) where++import Data.Serialize.Describe.Descriptor+import Data.Serialize.Describe.Class

@@ -0,0 +1,36 @@+module Data.Serialize.Describe.Class(+  Describe, describe+) where++import GHC.Generics+import Control.Monad+import Data.Serialize.Describe.Descriptor++class Describe a where+  describe :: (s -> a) -> Descriptor s a++  default describe :: (Generic a, GDescribe (Rep a)) => (s -> a) -> Descriptor s a +  describe f = fmap to . gdescribe $ from <$> f++class GDescribe f where+  gdescribe :: (s -> f a) -> Descriptor s (f a)+  +instance GDescribe U1 where+  gdescribe _ = pure U1++instance (GDescribe a, GDescribe b) => GDescribe (a :*: b) where+  gdescribe f = liftM2 (:*:) (gdescribe (l . f))  (gdescribe (r . f))+    where+      l (a :*: _) = a+      r (_ :*: b) = b++instance (GDescribe a) => GDescribe (M1 i c a) where+  gdescribe f = M1 <$> gdescribe (extract . f)+    where+      extract (M1 x) = x++instance (Describe a) => GDescribe (K1 i a) where+  gdescribe f = K1 <$> describe (extract . f)+    where+      extract (K1 x) = x+

@@ -0,0 +1,38 @@+module Data.Serialize.Describe.Combinators(+  Optional(..),+  StaticPred(..),+  LE(..),+  BE(..)+) where++import GHC.TypeNats+import Data.Proxy+import Data.Maybe+import Data.Serialize.Describe.Descriptor+import Data.Serialize.Describe.Class+import qualified Data.Serialize.Get as G++newtype LE a = LE { unwrapLE :: a }++newtype BE a = BE { unwrapBE :: a }++newtype Optional p t = Optional { unwrapOptional :: Maybe t }++class StaticPred t a where+  check :: t -> Bool++data Equals (n :: Nat)++instance (KnownNat n, Integral i) => StaticPred i (Equals n) where+  check i = i == (fromIntegral $ natVal (Proxy :: Proxy n))++instance (Describe a, StaticPred a p) => Describe (Optional p a) where+  describe f = Descriptor (g, p)+    where+      g = do +        let d = unwrapGet $ describe @a $ fromJust . unwrapOptional . f+        v <- G.lookAhead d+        Optional <$> if check @a @p v then Just <$> d else pure Nothing+      p s = case unwrapOptional $ f s of+        Just x -> Optional . Just <$> unwrapPut s (describe $ const x)+        Nothing -> pure $ Optional Nothing

@@ -0,0 +1,47 @@+-- | Big endian combinators.+--+-- All combinators take a function that takes the structure being described ('a') and produces the specified data type from it.+-- Most of the time, this will be one of the structure's fields, which are all functions from the structure to the field type.++module Data.Serialize.Describe.Combinators.BE(+  w8, w16, w32, w64,+  i8, i16, i32, i64,+  f32, f64+) where++import Data.Word+import Data.Int+import Data.Serialize.IEEE754+import Data.Serialize.Get+import Data.Serialize.Put+import Data.Serialize.Describe.Descriptor++w8 :: (a -> Word8) -> Descriptor a Word8+w8 f = Descriptor (getWord8, \s' -> putWord8 (f s') >> pure (f s'))++w16 :: (a -> Word16) -> Descriptor a Word16+w16 f = Descriptor (getWord16be, \s' -> putWord16be (f s') >> pure (f s'))++w32 :: (a -> Word32) -> Descriptor a Word32+w32 f = Descriptor (getWord32be, \s' -> putWord32be (f s') >> pure (f s'))++w64 :: (a -> Word64) -> Descriptor a Word64+w64 f = Descriptor (getWord64be, \s' -> putWord64be (f s') >> pure (f s'))++i8 :: (a -> Int8) -> Descriptor a Int8+i8 f = Descriptor (getInt8, \s' -> putInt8 (f s') >> pure (f s'))++i16 :: (a -> Int16) -> Descriptor a Int16+i16 f = Descriptor (getInt16be, \s' -> putInt16be (f s') >> pure (f s'))++i32 :: (a -> Int32) -> Descriptor a Int32+i32 f = Descriptor (getInt32be, \s' -> putInt32be (f s') >> pure (f s'))++i64 :: (a -> Int64) -> Descriptor a Int64+i64 f = Descriptor (getInt64be, \s' -> putInt64be (f s') >> pure (f s'))++f32 :: (a -> Float) -> Descriptor a Float+f32 f = Descriptor (getFloat32be, \s' -> putFloat32be (f s') >> pure (f s'))++f64 :: (a -> Double) -> Descriptor a Double+f64 f = Descriptor (getFloat64be, \s' -> putFloat64be (f s') >> pure (f s'))

@@ -0,0 +1,48 @@+-- | Little endian combinators.+--+-- All combinators take a function that takes the structure being described ('a') and produces the specified data type from it.+-- Most of the time, this will be one of the structure's fields, which are all functions from the structure to the field type.+++module Data.Serialize.Describe.Combinators.LE(+  w8, w16, w32, w64,+  i8, i16, i32, i64,+  f32, f64+) where++import Data.Word+import Data.Int+import Data.Serialize.IEEE754+import Data.Serialize.Get+import Data.Serialize.Put+import Data.Serialize.Describe.Descriptor++w8 :: (a -> Word8) -> Descriptor a Word8+w8 f = Descriptor (getWord8, \s' -> putWord8 (f s') >> pure (f s'))++w16 :: (a -> Word16) -> Descriptor a Word16+w16 f = Descriptor (getWord16le, \s' -> putWord16le (f s') >> pure (f s'))++w32 :: (a -> Word32) -> Descriptor a Word32+w32 f = Descriptor (getWord32le, \s' -> putWord32le (f s') >> pure (f s'))++w64 :: (a -> Word64) -> Descriptor a Word64+w64 f = Descriptor (getWord64le, \s' -> putWord64le (f s') >> pure (f s'))++i8 :: (a -> Int8) -> Descriptor a Int8+i8 f = Descriptor (getInt8, \s' -> putInt8 (f s') >> pure (f s'))++i16 :: (a -> Int16) -> Descriptor a Int16+i16 f = Descriptor (getInt16le, \s' -> putInt16le (f s') >> pure (f s'))++i32 :: (a -> Int32) -> Descriptor a Int32+i32 f = Descriptor (getInt32le, \s' -> putInt32le (f s') >> pure (f s'))++i64 :: (a -> Int64) -> Descriptor a Int64+i64 f = Descriptor (getInt64le, \s' -> putInt64le (f s') >> pure (f s'))++f32 :: (a -> Float) -> Descriptor a Float+f32 f = Descriptor (getFloat32le, \s' -> putFloat32le (f s') >> pure (f s'))++f64 :: (a -> Double) -> Descriptor a Double+f64 f = Descriptor (getFloat64le, \s' -> putFloat64le (f s') >> pure (f s'))

@@ -0,0 +1,44 @@+module Data.Serialize.Describe.Descriptor(+  Descriptor(Descriptor),+  unwrapGet,+  unwrapPut,+  serialize,+  deserialize+) where+import Data.ByteString (ByteString)+import Data.Serialize.Get+import Data.Serialize.Put++-- | @Descriptor s a@ is an applicative functor that describes the binary structure for a structure 's' while deserializing value 'a'.+newtype Descriptor s a = Descriptor {+    unwrapDescriptor :: (Get a, s -> PutM a)+}++-- | @unwrapGet desc@ takes a 'Descriptor' and returns only the internal 'Get' monad.+unwrapGet :: Descriptor s a -> Get a+unwrapGet = fst . unwrapDescriptor++-- | @unwrapPut s desc@ takes the structure being described and a 'Descriptor' for it, and returns the internal 'Put' monad.+unwrapPut :: s -> Descriptor s a -> PutM a+unwrapPut s = ($ s) . snd . unwrapDescriptor++-- | Convenience function for @runPut . unwrapPut s@+serialize :: s -> Descriptor s a -> ByteString+serialize s = snd . runPutM . unwrapPut s++-- | Convenience function for @flip runGet bs . unwrapGet@+deserialize :: ByteString -> Descriptor s s -> Either String s+deserialize bs = flip runGet bs . unwrapGet++instance Functor (Descriptor s) where+  fmap f (Descriptor (g, p)) = Descriptor (f <$> g, (f <$>) . p)++instance Applicative (Descriptor s) where+  pure a = Descriptor (pure a, \_ -> pure a)+  (Descriptor (f, p)) <*> (Descriptor (g, p')) =+    Descriptor (f <*> g, \s' -> p s' <*> p' s')++instance Monad (Descriptor s) where+  (Descriptor (g, p)) >>= f =+    Descriptor (g >>= fst . unwrapDescriptor . f, \s -> p s >>= ($ s) . snd . unwrapDescriptor . f)+

@@ -1,45 +0,0 @@-module Data.Serialize.Descriptor(-    Descriptor(Descriptor),-    unwrapGet,-    unwrapPut,-    serialize,-    deserialize-) where--import Data.ByteString (ByteString)-import Data.Serialize.Get-import Data.Serialize.Put---- | @Descriptor s a@ is an applicative functor that describes the binary structure for a structure 's' while deserializing value 'a'.-newtype Descriptor s a = Descriptor {-    unwrapDescriptor :: (Get a, s -> PutM a)-}---- | @unwrapGet desc@ takes a 'Descriptor' and returns only the internal 'Get' monad.-unwrapGet :: Descriptor s a -> Get a-unwrapGet = fst . unwrapDescriptor---- | @unwrapPut s desc@ takes the structure being described and a 'Descriptor' for it, and returns the internal 'Put' monad.-unwrapPut :: s -> Descriptor s a -> PutM a-unwrapPut s = ($ s) . snd . unwrapDescriptor---- | Convenience function for @runPut . unwrapPut s@-serialize :: s -> Descriptor s a -> ByteString-serialize s = snd . runPutM . unwrapPut s---- | Convenience function for @flip runGet bs . unwrapGet@-deserialize :: ByteString -> Descriptor s s -> Either String s-deserialize bs = flip runGet bs . unwrapGet--instance Functor (Descriptor s) where-  fmap f (Descriptor (g, p)) = Descriptor (f <$> g, (f <$>) . p)--instance Applicative (Descriptor s) where-  pure a = Descriptor (pure a, \_ -> pure a)-  (Descriptor (f, p)) <*> (Descriptor (g, p')) =-    Descriptor (f <*> g, \s' -> p s' <*> p' s')--instance Monad (Descriptor s) where-  (Descriptor (g, p)) >>= f =-    Descriptor (g >>= fst . unwrapDescriptor . f, \s -> p s >>= ($ s) . snd . unwrapDescriptor . f)-

@@ -1,47 +0,0 @@--- | Big endian combinators.------ All combinators take a function that takes the structure being described ('a') and produces the specified data type from it.--- Most of the time, this will be one of the structure's fields, which are all functions from the structure to the field type.--module Data.Serialize.Descriptor.BE(-  w8, w16, w32, w64,-  i8, i16, i32, i64,-  f32, f64-) where--import Data.Word-import Data.Int-import Data.Serialize.IEEE754-import Data.Serialize.Get-import Data.Serialize.Put-import Data.Serialize.Descriptor--w8 :: (a -> Word8) -> Descriptor a Word8-w8 f = Descriptor (getWord8, \s' -> putWord8 (f s') >> pure (f s'))--w16 :: (a -> Word16) -> Descriptor a Word16-w16 f = Descriptor (getWord16be, \s' -> putWord16be (f s') >> pure (f s'))--w32 :: (a -> Word32) -> Descriptor a Word32-w32 f = Descriptor (getWord32be, \s' -> putWord32be (f s') >> pure (f s'))--w64 :: (a -> Word64) -> Descriptor a Word64-w64 f = Descriptor (getWord64be, \s' -> putWord64be (f s') >> pure (f s'))--i8 :: (a -> Int8) -> Descriptor a Int8-i8 f = Descriptor (getInt8, \s' -> putInt8 (f s') >> pure (f s'))--i16 :: (a -> Int16) -> Descriptor a Int16-i16 f = Descriptor (getInt16be, \s' -> putInt16be (f s') >> pure (f s'))--i32 :: (a -> Int32) -> Descriptor a Int32-i32 f = Descriptor (getInt32be, \s' -> putInt32be (f s') >> pure (f s'))--i64 :: (a -> Int64) -> Descriptor a Int64-i64 f = Descriptor (getInt64be, \s' -> putInt64be (f s') >> pure (f s'))--f32 :: (a -> Float) -> Descriptor a Float-f32 f = Descriptor (getFloat32be, \s' -> putFloat32be (f s') >> pure (f s'))--f64 :: (a -> Double) -> Descriptor a Double-f64 f = Descriptor (getFloat64be, \s' -> putFloat64be (f s') >> pure (f s'))

@@ -1,48 +0,0 @@--- | Little endian combinators.------ All combinators take a function that takes the structure being described ('a') and produces the specified data type from it.--- Most of the time, this will be one of the structure's fields, which are all functions from the structure to the field type.---module Data.Serialize.Descriptor.LE(-  w8, w16, w32, w64,-  i8, i16, i32, i64,-  f32, f64-) where--import Data.Word-import Data.Int-import Data.Serialize.IEEE754-import Data.Serialize.Get-import Data.Serialize.Put-import Data.Serialize.Descriptor--w8 :: (a -> Word8) -> Descriptor a Word8-w8 f = Descriptor (getWord8, \s' -> putWord8 (f s') >> pure (f s'))--w16 :: (a -> Word16) -> Descriptor a Word16-w16 f = Descriptor (getWord16le, \s' -> putWord16le (f s') >> pure (f s'))--w32 :: (a -> Word32) -> Descriptor a Word32-w32 f = Descriptor (getWord32le, \s' -> putWord32le (f s') >> pure (f s'))--w64 :: (a -> Word64) -> Descriptor a Word64-w64 f = Descriptor (getWord64le, \s' -> putWord64le (f s') >> pure (f s'))--i8 :: (a -> Int8) -> Descriptor a Int8-i8 f = Descriptor (getInt8, \s' -> putInt8 (f s') >> pure (f s'))--i16 :: (a -> Int16) -> Descriptor a Int16-i16 f = Descriptor (getInt16le, \s' -> putInt16le (f s') >> pure (f s'))--i32 :: (a -> Int32) -> Descriptor a Int32-i32 f = Descriptor (getInt32le, \s' -> putInt32le (f s') >> pure (f s'))--i64 :: (a -> Int64) -> Descriptor a Int64-i64 f = Descriptor (getInt64le, \s' -> putInt64le (f s') >> pure (f s'))--f32 :: (a -> Float) -> Descriptor a Float-f32 f = Descriptor (getFloat32le, \s' -> putFloat32le (f s') >> pure (f s'))--f64 :: (a -> Double) -> Descriptor a Double-f64 f = Descriptor (getFloat64le, \s' -> putFloat64le (f s') >> pure (f s'))