describe (empty) → 0.1.0.0

raw patch · 8 files changed

+236/−0 lines, 8 filesdep +QuickCheckdep +basedep +bytestringsetup-changed

Dependencies added: QuickCheck, base, bytestring, cereal, describe

Files

CHANGELOG.md +5/−0
LICENSE +30/−0
Setup.hs +2/−0
Test.hs +23/−0
describe.cabal +41/−0
src/Data/Serialize/Descriptor.hs +40/−0
src/Data/Serialize/Descriptor/BE.hs +47/−0
src/Data/Serialize/Descriptor/LE.hs +48/−0

+ CHANGELOG.md view

@@ -0,0 +1,5 @@+# Revision history for describe++## 0.1.0.0 -- 2019-06-03++* Initial release.

+ LICENSE view

@@ -0,0 +1,30 @@+Copyright (c) 2019, Riuga++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Riuga nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

+ Test.hs view

@@ -0,0 +1,23 @@+module Main where++import Test.QuickCheck+import Test.QuickCheck.Monadic+import Data.Word+import Data.Either+import qualified Data.ByteString as B+import Data.Serialize.Descriptor+import Data.Serialize.Descriptor.LE++data Test = Test { f1 :: Word8, f2 :: Word16, f3 :: Word32, f4 :: Word8 }+          deriving (Eq)++prop_identity :: Bool+prop_identity =+  either (const False) (== struct) $ deserialize (serialize struct desc) desc+  where+    struct = Test 42 63 78 31+    desc = Test <$> w8 f1 <*> w16 f2 <*> w32 f3 <*> w8 f4 ++main :: IO ()+main = do+  quickCheck prop_identity

+ describe.cabal view

@@ -0,0 +1,41 @@+cabal-version:       2.4+-- Initial package description 'describe.cabal' generated by 'cabal init'.+--   For further documentation, see http://haskell.org/cabal/users-guide/++name:                describe+version:             0.1.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+-- bug-reports:+license:             BSD-3-Clause+license-file:        LICENSE+author:              Riuga+maintainer:          n/a+-- copyright:+category:            Data+extra-source-files:  CHANGELOG.md++common deps+  build-depends: base ^>= 4.12.0.0,+                 cereal >= 0.5.8 && < 0.6,+                 bytestring >= 0.10.8 && < 0.11+  ghc-options: -Wall+  default-language: Haskell2010++library+  import: deps+  exposed-modules:     Data.Serialize.Descriptor,+                       Data.Serialize.Descriptor.LE,+                       Data.Serialize.Descriptor.BE+  -- other-modules:+  -- other-extensions:+  hs-source-dirs:      src++test-suite describe-tests+  import: deps+  type: exitcode-stdio-1.0+  main-is: Test.hs+  build-depends: describe, QuickCheck++

+ src/Data/Serialize/Descriptor.hs view

@@ -0,0 +1,40 @@+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 -> Put)+}++-- | '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 -> Put+unwrapPut s = ($ s) . snd . unwrapDescriptor++-- | Convenience function for 'runPut . unwrapPut s'+serialize :: s -> Descriptor s a -> ByteString+serialize s = runPut . 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, p)++instance Applicative (Descriptor s) where+  pure a = Descriptor (pure a, \_ -> pure ())+  (Descriptor (f, p)) <*> (Descriptor (g, p')) =+    Descriptor (f <*> g, \s' -> p s' >> p' s')

+ src/Data/Serialize/Descriptor/BE.hs view

@@ -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.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'))++w16 :: (a -> Word16) -> Descriptor a Word16+w16 f = Descriptor (getWord16be, \s' -> putWord16be (f s'))++w32 :: (a -> Word32) -> Descriptor a Word32+w32 f = Descriptor (getWord32be, \s' -> putWord32be (f s'))++w64 :: (a -> Word64) -> Descriptor a Word64+w64 f = Descriptor (getWord64be, \s' -> putWord64be (f s'))++i8 :: (a -> Int8) -> Descriptor a Int8+i8 f = Descriptor (getInt8, \s' -> putInt8 (f s'))++i16 :: (a -> Int16) -> Descriptor a Int16+i16 f = Descriptor (getInt16be, \s' -> putInt16be (f s'))++i32 :: (a -> Int32) -> Descriptor a Int32+i32 f = Descriptor (getInt32be, \s' -> putInt32be (f s'))++i64 :: (a -> Int64) -> Descriptor a Int64+i64 f = Descriptor (getInt64be, \s' -> putInt64be (f s'))++f32 :: (a -> Float) -> Descriptor a Float+f32 f = Descriptor (getFloat32be, \s' -> putFloat32be (f s'))++f64 :: (a -> Double) -> Descriptor a Double+f64 f = Descriptor (getFloat64be, \s' -> putFloat64be (f s'))

+ src/Data/Serialize/Descriptor/LE.hs view

@@ -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.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'))++w16 :: (a -> Word16) -> Descriptor a Word16+w16 f = Descriptor (getWord16le, \s' -> putWord16le (f s'))++w32 :: (a -> Word32) -> Descriptor a Word32+w32 f = Descriptor (getWord32le, \s' -> putWord32le (f s'))++w64 :: (a -> Word64) -> Descriptor a Word64+w64 f = Descriptor (getWord64le, \s' -> putWord64le (f s'))++i8 :: (a -> Int8) -> Descriptor a Int8+i8 f = Descriptor (getInt8, \s' -> putInt8 (f s'))++i16 :: (a -> Int16) -> Descriptor a Int16+i16 f = Descriptor (getInt16le, \s' -> putInt16le (f s'))++i32 :: (a -> Int32) -> Descriptor a Int32+i32 f = Descriptor (getInt32le, \s' -> putInt32le (f s'))++i64 :: (a -> Int64) -> Descriptor a Int64+i64 f = Descriptor (getInt64le, \s' -> putInt64le (f s'))++f32 :: (a -> Float) -> Descriptor a Float+f32 f = Descriptor (getFloat32le, \s' -> putFloat32le (f s'))++f64 :: (a -> Double) -> Descriptor a Double+f64 f = Descriptor (getFloat64le, \s' -> putFloat64le (f s'))