diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,15 @@ # Changelog for binary-generic-combinators +## v0.4.2.0 + +- Ensure the modules are compatible with Safe Haskell. +- Add `MatchByte` alias. +- Finally write some documentation. + +## v0.4.1.0 + +- Derive `Functor`, `Foldable` and `Traversable` for `Many`, `Some` and `CountedBy`. + ## v0.4.0.0 - Initial release as a separate library. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,1 +1,95 @@ # binary-generic-combinators + +## tl;dr + +This library provides a set of combinators and utility types to make `Generic`-based deriving of +[binary](https://hackage.haskell.org/package/binary) (de)serialization instances easier and more flexible, +especially when dealing with existing formats. + +## Motivation + +Isn't it great to just define data types representing your problem domain and let the compiler derive all the instances? +If we are talking about [binary](https://hackage.haskell.org/package/binary) (de)serialization, +the `Binary` instance is already derivable for `Generic` types, but there are a couple of problems with that. + +### Compound types + +Firstly, the serialization format of compound types is carved in stone (again, we're talking about `Generic`-based deriving). +For example, for some list `[a]` the `binary` library always assumes the list length is mentioned explicitly. +This is totally fine if we just need to be able to serialize our type and deserialize it later in the same program without caring about outside world. +But what if we're writing a parser (or serializer) for some existing data format? +In this case (and it's often _the_ case) the format might just imply the strategy of +"try to parse the elements of some type `a` until failure, and build a list out of that" — pretty much like `Alternative`'s `some` or `many`. +With stock `binary`, we'd have to write a custom instance by hand: + +```haskell +data Element = Element { .. } deriving (Generic, Binary) +data MyType = MyType { elems :: [Element] } + +instance Binary MyType where + get = MyType <$> many + put = mapM_ put . elems +``` + +Wouldn't it be great if we could just annotate our types in such a way that we don't have to write that instance? +Something like, well... This? +```haskell +data Element = Element { .. } deriving (Generic, Binary) +data MyType = MyType { elems :: Many Element } deriving (Generic, Binary) +``` + +This library provides an array of wrappers that solve precisely this issue. + +### Utilities + +Then, what if we need to skip some number of bytes, or any number of bytes as long as their value is `0xff`? +Or, maybe, make sure that the input starts with a certain signature sequence of bytes? +With stock `binary`, we again have to write an instance by hand. +This library provides a few helpers for that too: +```haskell +data MyType = MyType + { header :: MatchBytes "my format header" '[ 0xd3, 0x4d, 0xf0, 0x0d ] -- consume 0xd34df00d, or fail the parse + , slack :: SkipByte 0xff -- skip all subsequent 0xff + , reserved :: SkipCount Word8 4 -- 4 bytes reserved + .. + } deriving (Generic, Binary) +``` + +### Deriving strategies + +With stock `binary`, if we serialize an ADT, then `binary` first writes the integer denoting the index of the constructor, +and then the contents of that constructor. +This is not always what's needed. +Consider: +```haskell +data JfifSegment + = App0Segment (MatchByte "app0 segment" 0xdb, JfifApp0) + | DqtSegment (MatchByte "dqt segment" 0xdb, QuantTable) + | SofSegment (MatchByte "sof segment" 0xc0, SofInfo) + | DhtSegment (MatchByte "dht segment" 0xc4, HuffmanTable) + | DriSegment (MatchByte "dri segment" 0xdd, RestartInterval) + | SosSegment (MatchByte "sos segment" 0xda, SosImage) + | UnknownSegment RawSegment +``` +Here, the identifiers of the constructors are effectively defined in the standard (by the way, this is JPEG/JFIF). +Deriving `Binary` for this type would yield incorrect results: we don't need to encode or decode the index of the constructor, +it's already baked in the `MatchBytes` part. +In this case, what we need is to try to parse each constructor in order, moving on to the next one if its segment identifier doesn't match +what's in the byte stream. +That's basically what `Alternative`'s `<|>` does! +Here, we can leverage that via this library's handy `Alternatively` type and `DerivingVia`: +```haskell +{-# LANGUAGE DerivingVia #-} + +data JfifSegment + = App0Segment (MatchByte "app0 segment" 0xdb, JfifApp0) + | DqtSegment (MatchByte "dqt segment" 0xdb, QuantTable) + | SofSegment (MatchByte "sof segment" 0xc0, SofInfo) + | DhtSegment (MatchByte "dht segment" 0xc4, HuffmanTable) + | DriSegment (MatchByte "dri segment" 0xdd, RestartInterval) + | SosSegment (MatchByte "sos segment" 0xda, SosImage) + | UnknownSegment RawSegment + deriving Generic + deriving Binary via Alternatively JfifSegment + +``` diff --git a/binary-generic-combinators.cabal b/binary-generic-combinators.cabal --- a/binary-generic-combinators.cabal +++ b/binary-generic-combinators.cabal @@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack -- --- hash: 1a85e157782b016bc20ca8aa8487ecead92a285a1fc236a94ad0e7d6186b37be +-- hash: e141cc9e5969922ea090f392042d502509c08b87e62ad0fec15e2472ad97061c name: binary-generic-combinators -version: 0.4.0.0 +version: 0.4.2.0 synopsis: Combinators and utilities to make Generic-based deriving of Binary easier and more expressive description: Please see the README on GitHub at category: Data, Parsing diff --git a/src/Data/Binary/Combinators.hs b/src/Data/Binary/Combinators.hs --- a/src/Data/Binary/Combinators.hs +++ b/src/Data/Binary/Combinators.hs @@ -1,8 +1,24 @@ {-# LANGUAGE DataKinds, PolyKinds, TypeOperators, GADTs #-} {-# LANGUAGE FlexibleInstances, FlexibleContexts, MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE StandaloneDeriving, DeriveTraversable #-} +{-# LANGUAGE Safe #-} +{-| Description : Combinators and utility types for making 'GHC.Generics.Generic'-based 'Binary' instances more expressive. + +This module defines a bunch of types to be used as fields of records with 'GHC.Generics.Generic'-based deriving of 'Binary' instances. +For example: + +@ +data MyFileFormat = MyFileFormat + { header :: MatchBytes "my format header" '[ 0xd3, 0x4d, 0xf0, 0x0d ] + , slack :: SkipByte 0xff + , reserved :: SkipCount Word8 4 + , subElements :: Some MyElement + } deriving (Generic, Binary) +@ +-} + module Data.Binary.Combinators ( Many(..) , Some(..) @@ -11,6 +27,7 @@ , SkipByte(..) , MatchBytes , matchBytes +, MatchByte ) where import Control.Applicative @@ -25,7 +42,10 @@ import Test.QuickCheck -newtype Many a = Many { getMany :: [a] } deriving (Eq, Ord) +-- | Zero or more elements of @a@, parsing as long as the parser for @a@ succeeds. +-- +-- @Many Word8@ will consume all your input! +newtype Many a = Many { getMany :: [a] } deriving (Eq, Ord, Functor, Foldable, Traversable) instance Show a => Show (Many a) where show = show . getMany @@ -39,7 +59,10 @@ shrink (Many xs) = Many <$> shrink xs -newtype Some a = Some { getSome :: [a] } deriving (Eq, Ord) +-- | One or more elements of @a@, parsing as long as the parser for @a@ succeeds. +-- +-- @Some Word8@ will consume all your non-empty input! +newtype Some a = Some { getSome :: [a] } deriving (Eq, Ord, Functor, Foldable, Traversable) instance Show a => Show (Some a) where show = show . getSome @@ -53,7 +76,8 @@ shrink (Some xs) = Some <$> filter (not . null) (shrink xs) -newtype CountedBy ty a = CountedBy { getCounted :: [a] } deriving (Eq, Ord) +-- | First, parse the elements count as type @ty@. Then, parse exactly as many elements of type @a@. +newtype CountedBy ty a = CountedBy { getCounted :: [a] } deriving (Eq, Ord, Functor, Foldable, Traversable) instance Show a => Show (CountedBy ty a) where show = show . getCounted @@ -68,6 +92,9 @@ shrink (CountedBy xs) = CountedBy <$> shrink xs +-- | Parse out and skip @n@ elements of type @ty@. +-- +-- Serializing this type produces no bytes. data SkipCount ty (n :: Nat) = SkipCount deriving (Eq, Ord, Show) instance (Num ty, Binary ty, KnownNat n) => Binary (SkipCount ty n) where @@ -78,6 +105,9 @@ arbitrary = pure SkipCount +-- | Skip any number of bytes with value @n@. +-- +-- Serializing this type produces no bytes. data SkipByte (n :: Nat) = SkipByte deriving (Eq, Ord, Show) instance (KnownNat n) => Binary (SkipByte n) where @@ -94,7 +124,14 @@ arbitrary = pure SkipByte -data MatchBytes :: Symbol -> [Nat] -> Type where +-- | @MatchBytes str bytes@ ensures that the subsequent bytes in the input stream are the same as @bytes@. +-- +-- @str@ can be used to denote the context in which @MatchBytes@ is used for better parse failure messages. +-- For example, @MatchBytes "my format header" '[ 0xd3, 0x4d, 0xf0, 0x0d ]@ consumes four bytes from the input stream +-- if they are equal to @[ 0xd3, 0x4d, 0xf0, 0x0d ]@ respectively, or fails otherwise. +-- +-- Serializing this type produces the @bytes@. +data MatchBytes (ctx :: Symbol) (bytes :: [Nat]) :: Type where ConsumeNil :: MatchBytes ctx '[] ConsumeCons :: KnownNat n => Proxy n -> MatchBytes ctx ns -> MatchBytes ctx (n ': ns) @@ -136,8 +173,12 @@ instance (KnownNat n, MatchBytesSing ctx ns) => MatchBytesSing ctx (n ': ns) where matchBytesSing = ConsumeCons Proxy matchBytesSing +-- | Produce the (singleton) value of type 'MatchBytes' @ctx ns@. matchBytes :: MatchBytesSing ctx ns => MatchBytes ctx ns matchBytes = matchBytesSing instance MatchBytesSing ctx ns => Arbitrary (MatchBytes ctx ns) where arbitrary = pure matchBytes + +-- | An alias for 'MatchBytes' when you only need to match a single byte. +type MatchByte ctx byte = MatchBytes ctx '[ byte ] diff --git a/src/Data/Binary/DerivingVia.hs b/src/Data/Binary/DerivingVia.hs --- a/src/Data/Binary/DerivingVia.hs +++ b/src/Data/Binary/DerivingVia.hs @@ -1,5 +1,11 @@ {-# LANGUAGE TypeOperators, FlexibleContexts, UndecidableInstances #-} +{-# LANGUAGE Safe #-} +{-| Description : Deriving strategies for making 'GHC.Generics.Generic'-based 'Binary' instances more expressive. + +This module defines some types to be used with @DerivingVia@ when deriving 'Binary' instances. +-} + module Data.Binary.DerivingVia ( Alternatively(..) ) where @@ -7,6 +13,23 @@ import Control.Applicative import Data.Binary import GHC.Generics + +-- | Try to deserialize each constructor of @a@ in order. +-- +-- For sum types, stock 'Binary' writes (and expects to read) an integer denoting the index of the constructor. +-- This isn't always what's needed. In the following example, the constructor is uniquely identified by the marker byte, +-- and its index in the Haskell ADT is irrelevant: +-- +-- > data JfifSegment +-- > = App0Segment (MatchByte "app0 segment" 0xdb, JfifApp0) +-- > | DqtSegment (MatchByte "dqt segment" 0xdb, QuantTable) +-- > | SofSegment (MatchByte "sof segment" 0xc0, SofInfo) +-- > | DhtSegment (MatchByte "dht segment" 0xc4, HuffmanTable) +-- > | DriSegment (MatchByte "dri segment" 0xdd, RestartInterval) +-- > | SosSegment (MatchByte "sos segment" 0xda, SosImage) +-- > | UnknownSegment RawSegment +-- > deriving Generic +-- > deriving Binary via Alternatively JfifSegment newtype Alternatively a = Alternatively { getAlt :: a }