binrep 0.1.0 → 0.2.0

raw patch · 44 files changed

+3240/−423 lines, 44 filesdep +QuickCheckdep +binrepdep +eitherdep −cerealdep −refined-withdep ~refinedPVP ok

version bump matches the API change (PVP)

Dependencies added: QuickCheck, binrep, either, flatparse, generic-random, hspec, mason, megaparsec, quickcheck-instances, strongweak, text-icu, vector, vector-sized

Dependencies removed: cereal, refined-with

Dependency ranges changed: refined

API changes (from Hackage documentation)

Files

• CHANGELOG.md +12/−0
• README.md +131/−10
• binrep.cabal +123/−24
• src/Binrep.hs +16/−0
• src/Binrep/BLen.hs +69/−0
• src/Binrep/BLen/Internal/AsBLen.hs +65/−0
• src/Binrep/ByteLen.hs +0/−34
• src/Binrep/CBLen.hs +21/−0
• src/Binrep/Codec.hs +0/−86
• src/Binrep/Example.hs +67/−0
• src/Binrep/Example/FileTable.hs +105/−0
• src/Binrep/Example/Tar.hs +67/−0
• src/Binrep/Example/Tiff.hs +62/−0
• src/Binrep/Example/Wav.hs +31/−0
• src/Binrep/Extra/HexByteString.hs +109/−0
• src/Binrep/Generic.hs +49/−0
• src/Binrep/Generic/BLen.hs +51/−0
• src/Binrep/Generic/CBLen.hs +72/−0
• src/Binrep/Generic/Get.hs +66/−0
• src/Binrep/Generic/Internal.hs +21/−0
• src/Binrep/Generic/Put.hs +66/−0
• src/Binrep/Get.hs +68/−0
• src/Binrep/Predicates/NullPadTo.hs +0/−69
• src/Binrep/Put.hs +63/−0
• src/Binrep/Type/AsciiNat.hs +112/−0
• src/Binrep/Type/Byte.hs +821/−0
• src/Binrep/Type/ByteString.hs +101/−0
• src/Binrep/Type/Common.hs +10/−0
• src/Binrep/Type/Int.hs +142/−0
• src/Binrep/Type/LenPfx.hs +110/−0
• src/Binrep/Type/Magic.hs +97/−0
• src/Binrep/Type/Magic/UTF8.hs +47/−0
• src/Binrep/Type/NullPadded.hs +70/−0
• src/Binrep/Type/Sized.hs +44/−0
• src/Binrep/Type/Text.hs +184/−0
• src/Binrep/Type/Vector.hs +26/−0
• src/Binrep/Types/Ints.hs +0/−89
• src/Binrep/Types/Strings.hs +0/−111
• src/Binrep/Util.hs +24/−0
• src/Data/Aeson/Extra/SizedVector.hs +19/−0
• test/ArbitraryOrphans.hs +10/−0
• test/Binrep/Extra/HexByteStringSpec.hs +39/−0
• test/Binrep/LawsSpec.hs +49/−0
• test/Spec.hs +1/−0

@@ -1,3 +1,15 @@+## 0.2.0 (2022-07-07)+Multiple rewrites (unable to push to Hackage for a while due to dependencies).++  * BinaryCodec split into Get and Put+  * fast serializing via fumieval's mason+  * fast parsing via András Kovács' flatparse+  * integration with my strongweak library+  * generics+  * tests+  * CBLen for constant length types+  * plenty more+ ## 0.1.0 (2022-04-22) Initial release. 

@@ -1,14 +1,135 @@+[gh-strongweak]: https://github.com/raehik/strongweak+[gh-flatparse]:  https://github.com/AndrasKovacs/flatparse+[gh-mason]:      https://github.com/fumieval/mason+[gh-refined]:    https://github.com/nikita-volkov/refined+ # binrep-Haskell data types with their binary representation explicitly built into the-types. Intended for simple binary file parsing.+binrep is a library for **precisely modelling binary schemas** and working with+them effectively and efficiently in Haskell. Here's why it's useful: -The binary and cereal libraries are for passing Haskell data between other-binary and cereal users. Thus, data representation is largely obscured. For-example, in `cereal`, all data is handled in big-endian format. If you use the-`Serialize` typeclass methods for parsing and serializing, you would never know.+  * **Explicit:** Binary representation primitives such as C-style bytestrings+    (null-terminated), sized explicit-endian machine integers, and null-padded+    data enable defining Haskell data types with the binary schema "baked in".+  * **Low boilerplate:** Generic parsers and serializers further reduce boilerplate for+    straightforward schemas. (See [Generic binary+    representation](#generic-binary-representation) for details.)+  * **Easy validation:** Goes hand in hand with my [strongweak][gh-strongweak]+    library to allow working with unwrapped data internally, and enforcing all+    the binary representation invariants before serializing - no extra+    definitions required.+  * **Performant:** Parsing and serialization is low-level and *extremely fast*,+    using [flatparse][gh-flatparse] and [mason][gh-mason] respectively. -binrep never makes decisions by itself. You can't parse/serialize a `Word64`-without either providing the endianness to use at runtime, or encoding the-endianness into the type.+## Philosophy+### Modelling, not serializing+binrep is good at modelling binary data formats. It is not a plain+"serialization" library, where the actual binary representation is hidden from+the user (intentionally, with good reason). The binary and cereal libraries are+great choices for that. They are interested in defining efficient binary codecs+for Haskell data. However, their codec typeclasses *hide representation+decisions* from the user. In cereal, -See the Hackage documentation for details.+  * machine integers are encoded with+    [big endian](https://hackage.haskell.org/package/cereal-0.5.8.2/docs/src/Data.Serialize.html#line-182)+  * bytestrings are written with an+    [8-byte length prefix](https://hackage.haskell.org/package/cereal-0.5.8.2/docs/src/Data.Serialize.html#line-498)++These are fine decisions. But they aren't accurate to the types. Endianness is+an implementation decision.++binrep refuses to work with a machine integer unless it knows the endianness.+Bytestrings are split into C-style (null-terminated) and Pascal-style+(length-prefixed). This enforces careful consideration for the binary data being+modelled.++### Validation without boilerplate+A C-style bytestring must not contain any `0x00` null bytes. A Pascal-style+bytestring must be short enough to be able to encode its length in the length+prefix machine integer. But checking such invariants is tedious work. Am I+really going to wrap everything in a bunch of newtypes and force users to call a+bunch of checker functions every time?++Yes and no. Yes, binrep uses newtypes extensively, though most are type synonyms+over the `Refined` newtype from Nikita Volkov's wonderful [refined][gh-refined]+library. No, binrep doesn't want you to wrangle with these day-to-day. One+solution is to define a simplified "weak" type, and convert between it and the+binary-safe "strong" type. My [strongweak][gh-strongweak] library provides+supporting definitions for this pattern, and generic derivers which will work+with binrep's binary representation primitives.++### Performant primitives+Parsing uses András Kovács' [flatparse][gh-flatparse] library. Serializing is+via Fumiaki Kinoshita's [mason][gh-mason] library. These are about as fast as+you can get in 2022.++We only define serializers for validated types, meaning we can potentially skip+safety checks, that other serializers would do. Except we still do them, but+validation is an explicitly required step before serialization.++*This might change if we start to support weirder binary representations,+specifically offset-based data.*++## Generic binary representation+binrep's generic deriving makes very few decisions:++  * Constructors are encoded by sequentially encoding every enclosed field.+    * Empty constructors thus serialize to 0 bytes.+  * Sum types are encoded via a tag obtained from the constructor names.+    * It's the same approach as aeson, with a bit more flexibility: see below.++Sum types (data types with multiple constructors) are handled by first encoding+a "tag field", the value of which then indicates which constructor to use. You+must provide a function to convert from a constructor name to a (unique) tag.+You could encode them as a null-terminated ASCII bytestring (this is the+default), or as a single byte. To ease this, you may consider putting the tag+value in constructor names:++```haskell+data BinarySumType = B1 | B2++getConstructorTag :: String -> Word8+getConstructorTag = read . drop 1++-- >>> getConstructorTag "B1"+-- 1++-- Or use our generic helper, which takes hex values:+--+-- >>> cSumTagHex @Word8 (drop . 1) "BFF"+-- 255+```++## Similar projects+### Kaitai Struct+[Kaitai Struct](https://kaitai.io/) is a wonderful declarative parser generator+project. They bolt an expression language and a whole lot of binary cleverness+on top of a nice YAML schema. It comes with an IDE, a visualizer, and you can+compile schemas down to parsers for various different languages (no Haskell...).++Design principles like their fancy absolute offset handling and language+neutrality have stunted serialization support. Though it's more like they have+such powerful parsing that they can parse formats that can't be edited and+re-serialized naively, like archives with file indexes. For proper handling, one+should store a file table, and serialization generates the index. So in reverse,+you would want to combine them. But it's a bit program-y. In binrep, you are in+a programming language, so it's less of a problem... but I'm not sure if we can+be very efficient at absolute offset stuff.++Realistically, Kaitai Struct is the best decision for fast iteration on+reversing unknown data. binrep is useful for loading data straight into Haskell+for further processing, especially converting between simpler formats.++### Wuffs+[Wuffs](https://github.com/google/wuffs) is a crazy exploration into safe+low-level code via strong typing. You have to annotate every possibly dangerous+statement with a proof of safety. It's a tedious, explicit, very safe and very+fast imperative language for defining parsers and serializers.++Wuffs is more a codec engineer's tool than a reverse engineer's one. binrep+isn't really interested in speed, and being a Haskell library we get to focus on+defining types and their composition in a declarative & functional manner. As+such, we get to define more useful things quicker using binrep. Though we share+many core ideas, such as refinement types.++Check out Wuffs if you need to write a bunch of codecs and they really, really+need to be both fast and safe. The trade-off is, of course, your time.

@@ -5,10 +5,10 @@ -- see: https://github.com/sol/hpack  name:           binrep-version:        0.1.0-synopsis:       Encode binary representations via types.+version:        0.2.0+synopsis:       Encode precise binary representations directly in types description:    Please see README.md.-category:       Data+category:       Data, Serialization homepage:       https://github.com/raehik/binrep#readme bug-reports:    https://github.com/raehik/binrep/issues author:         Ben Orchard@@ -17,7 +17,7 @@ license-file:   LICENSE build-type:     Simple tested-with:-    GHC ==8.10.7 || ==9.2.2+    GHC ==9.2.2 extra-source-files:     README.md     CHANGELOG.md@@ -28,25 +28,50 @@  library   exposed-modules:-      Binrep.ByteLen-      Binrep.Codec-      Binrep.Predicates.NullPadTo-      Binrep.Types.Ints-      Binrep.Types.Strings+      Binrep+      Binrep.BLen+      Binrep.BLen.Internal.AsBLen+      Binrep.CBLen+      Binrep.Example+      Binrep.Example.FileTable+      Binrep.Example.Tar+      Binrep.Example.Tiff+      Binrep.Example.Wav+      Binrep.Extra.HexByteString+      Binrep.Generic+      Binrep.Generic.BLen+      Binrep.Generic.CBLen+      Binrep.Generic.Get+      Binrep.Generic.Internal+      Binrep.Generic.Put+      Binrep.Get+      Binrep.Put+      Binrep.Type.AsciiNat+      Binrep.Type.Byte+      Binrep.Type.ByteString+      Binrep.Type.Common+      Binrep.Type.Int+      Binrep.Type.LenPfx+      Binrep.Type.Magic+      Binrep.Type.Magic.UTF8+      Binrep.Type.NullPadded+      Binrep.Type.Sized+      Binrep.Type.Text+      Binrep.Type.Vector       Binrep.Util+      Data.Aeson.Extra.SizedVector   other-modules:       Paths_binrep   hs-source-dirs:       src   default-extensions:       EmptyCase-      FlexibleContexts-      FlexibleInstances-      InstanceSigs-      MultiParamTypeClasses-      PolyKinds       LambdaCase+      InstanceSigs+      BangPatterns+      ExplicitNamespaces       DerivingStrategies+      DerivingVia       StandaloneDeriving       DeriveAnyClass       DeriveGeneric@@ -55,27 +80,101 @@       DeriveFoldable       DeriveTraversable       DeriveLift-      ImportQualifiedPost-      StandaloneKindSignatures-      DerivingVia+      FlexibleContexts+      FlexibleInstances+      MultiParamTypeClasses+      GADTs+      PolyKinds       RoleAnnotations+      RankNTypes       TypeApplications-      DataKinds+      DefaultSignatures       TypeFamilies+      DataKinds+      MagicHash+      ImportQualifiedPost+      StandaloneKindSignatures+      ScopedTypeVariables       TypeOperators+  ghc-options: -Wall+  build-depends:+      aeson ==2.0.*+    , base >=4.14 && <5+    , bytestring ==0.11.*+    , either >=5.0.1.1 && <5.1+    , flatparse >=0.3.5.0 && <0.4+    , mason >=0.2.5 && <0.3+    , megaparsec >=9.2.0 && <9.3+    , refined ==0.7.*+    , strongweak >=0.3.1 && <0.4+    , text ==1.2.*+    , text-icu >=0.8.0.1 && <0.9+    , vector >=0.12.3.1 && <0.13+    , vector-sized >=1.5.0 && <1.6+  default-language: Haskell2010++test-suite spec+  type: exitcode-stdio-1.0+  main-is: Spec.hs+  other-modules:+      ArbitraryOrphans+      Binrep.Extra.HexByteStringSpec+      Binrep.LawsSpec+      Paths_binrep+  hs-source-dirs:+      test+  default-extensions:+      EmptyCase+      LambdaCase+      InstanceSigs       BangPatterns+      ExplicitNamespaces+      DerivingStrategies+      DerivingVia+      StandaloneDeriving+      DeriveAnyClass+      DeriveGeneric+      DeriveDataTypeable+      DeriveFunctor+      DeriveFoldable+      DeriveTraversable+      DeriveLift+      FlexibleContexts+      FlexibleInstances+      MultiParamTypeClasses       GADTs-      DefaultSignatures+      PolyKinds+      RoleAnnotations       RankNTypes-      UndecidableInstances+      TypeApplications+      DefaultSignatures+      TypeFamilies+      DataKinds       MagicHash+      ImportQualifiedPost+      StandaloneKindSignatures       ScopedTypeVariables+      TypeOperators+  ghc-options: -Wall+  build-tool-depends:+      hspec-discover:hspec-discover >=2.7 && <2.10   build-depends:-      aeson ==2.0.*+      QuickCheck >=2.14.2 && <2.15+    , aeson ==2.0.*     , base >=4.14 && <5+    , binrep     , bytestring ==0.11.*-    , cereal >=0.5.8.1 && <0.6-    , refined >=0.6.3 && <0.7-    , refined-with >=0.1.0 && <0.2+    , either >=5.0.1.1 && <5.1+    , flatparse >=0.3.5.0 && <0.4+    , generic-random >=1.5.0.1 && <1.6+    , hspec >=2.7 && <2.10+    , mason >=0.2.5 && <0.3+    , megaparsec >=9.2.0 && <9.3+    , quickcheck-instances >=0.3.26 && <0.4+    , refined ==0.7.*+    , strongweak >=0.3.1 && <0.4     , text ==1.2.*+    , text-icu >=0.8.0.1 && <0.9+    , vector >=0.12.3.1 && <0.13+    , vector-sized >=1.5.0 && <1.6   default-language: Haskell2010

@@ -0,0 +1,16 @@+{- | Helper module to bring most functionality into scope.++Generics are in a separate module (to prevent module import cycles).+-}++module Binrep+  ( module Binrep.BLen+  , module Binrep.CBLen+  , module Binrep.Put+  , module Binrep.Get+  ) where++import Binrep.BLen+import Binrep.CBLen+import Binrep.Put+import Binrep.Get

@@ -0,0 +1,69 @@+{-# LANGUAGE AllowAmbiguousTypes #-}++module Binrep.BLen+  ( module Binrep.BLen+  , module Binrep.BLen.Internal.AsBLen+  ) where++import Binrep.BLen.Internal.AsBLen+import Binrep.CBLen+import Binrep.Util ( natVal'' )++import GHC.TypeNats+import Data.ByteString qualified as B+import Data.Word+import Data.Int++type BLenT = Int++-- | The length in bytes of a value of the given type can be known on the cheap+--   e.g. by reading a length field, or using compile time information.+--+-- Concepts such as null padding require the notion of length in bytes in order+-- to handle. In a hand-rolled parser, you may keep count of the current length+-- as you go. Here, the individual types keep track, and expose it via this+-- typeclass.+--+-- Obtaining the length of a value is usually an @O(1)@ operation like reading a+-- field or returning a constant. When it's not, it's often an indicator of a+-- problematic type e.g. plain Haskell lists.+--+-- We derive a default instance for constant-size types by throwing away the+-- value and reifying the type level natural.+--+-- Note that one can derive a free 'BLen' instance for any type with a 'Put'+-- instance via serializing it and checking the length. _Do not do this._ If you+-- find you can't write a decent 'BLen' instance for a type, it may be that you+-- need to rethink the representation.+class BLen a where+    blen :: a -> BLenT+    default blen :: KnownNat (CBLen a) => a -> BLenT+    blen _ = cblen @a++typeNatToBLen :: forall n. KnownNat n => BLenT+typeNatToBLen = natToBLen $ natVal'' @n+{-# INLINE typeNatToBLen #-}++-- | Reify a type's constant byte length to the term level.+cblen :: forall a n. (n ~ CBLen a, KnownNat n) => BLenT+cblen = typeNatToBLen @n+{-# INLINE cblen #-}++-- | @O(n)@+instance BLen a => BLen [a] where+    blen = sum . map blen++instance (BLen a, BLen b) => BLen (a, b) where+    blen (a, b) = blen a + blen b++instance BLen B.ByteString where+    blen = posIntToBLen . B.length++deriving anyclass instance BLen Word8+deriving anyclass instance BLen  Int8+deriving anyclass instance BLen Word16+deriving anyclass instance BLen  Int16+deriving anyclass instance BLen Word32+deriving anyclass instance BLen  Int32+deriving anyclass instance BLen Word64+deriving anyclass instance BLen  Int64

@@ -0,0 +1,65 @@+module Binrep.BLen.Internal.AsBLen where++import GHC.Natural ( minusNaturalMaybe )+import GHC.Num.Natural+import GHC.Exts+import Binrep.Util ( posIntToNat )++-- | Helper definitions for using the given type to store byte lengths.+--+-- Byte lengths must be non-negative. Thus, the ideal representation is a+-- 'Natural'. However, most underlying types that we use ('B.ByteString', lists)+-- store their length in 'Int's. By similarly storing an 'Int' ourselves, we+-- could potentially improve performance.+--+-- I like both options, and don't want to give up either. So we provide helpers+-- via a typeclass so that the user doesn't ever have to think about the+-- underlying type.+--+-- For simplicity, documentation may consider 'a' to be an "unsigned" type. For+-- example, underflow refers to a negative 'a' result.+class AsBLen a where+    -- | Safe blen subtraction, returning 'Nothing' for negative results.+    --+    -- Regular subtraction should only be used when you have a guarantee that it+    -- won't underflow.+    safeBLenSub :: a -> a -> Maybe a++    -- | Convert some 'Int' @i@ where @i >= 0@ to a blen.+    --+    -- This is intended for wrapping the output of 'length' functions.+    posIntToBLen :: Int -> a++    -- | Convert some 'Word#' @w@ where @w <= maxBound @a@ to a blen.+    wordToBLen# :: Word# -> a++    -- | Convert some 'Natural' @n@ where @n <= maxBound @a@ to a blen.+    natToBLen :: Natural -> a++instance AsBLen Int where+    safeBLenSub x y = if z >= 0 then Just z else Nothing where z = x - y+    {-# INLINE safeBLenSub #-}++    posIntToBLen = id+    {-# INLINE posIntToBLen #-}++    natToBLen = \case+      NS w# -> wordToBLen# w#+      NB _  -> error "TODO natural too large"+    {-# INLINE natToBLen #-}++    wordToBLen# w# = I# (word2Int# w#)+    {-# INLINE wordToBLen# #-}++instance AsBLen Natural where+    safeBLenSub = minusNaturalMaybe+    {-# INLINE safeBLenSub #-}++    posIntToBLen = posIntToNat+    {-# INLINE posIntToBLen #-}++    wordToBLen# = NS+    {-# INLINE wordToBLen# #-}++    natToBLen = id+    {-# INLINE natToBLen #-}

@@ -1,34 +0,0 @@-{- TODO-Potentially should be moved into BinaryCodec. We need this for padding-based-combinators. Each inside combinator must report the number of bytes they-serialized. It *should* be extremely cheap.--So far I haven't got another use for it, and I feel there should be some better-way to define it but the types don't fit well. So I'll leave it as is for now.--}--module Binrep.ByteLen where--import Numeric.Natural---- | The size in bytes of the type can be known, preferably on the cheap e.g.---   reading a length field.------ Aim to make this O(1). Except for where you can't like lists lol.------ Importantly goes hand in hand with BinaryCodec! Maybe we should make it a--- function there lol!------ This is useful for padding types generically, without having to track the--- read/write cursor. Yes, that feature *is* common and cheap for parsers (and--- to lesser extent, serializers), but you should really only be padding types--- that have a "static-ish" (= cheaply calculated) size. At least, I think so?--- I'm not quite sure.------ Some instances ignore the argument. It would be possible to pull those out--- into a statically-known bytelength typeclass, but it wouldn't improve clarity--- or performance, just get rid of a couple 'undefined's.-class ByteLen a where-    blen :: a -> Natural--instance ByteLen a => ByteLen [a] where blen = sum . map blen

@@ -0,0 +1,21 @@+module Binrep.CBLen where++import Data.Word+import Data.Int+import GHC.TypeNats ( Natural )++-- | The length in bytes of any value of the given type is constant.+--+-- Many binary representation primitives are constant, or store their size in+-- their type. This is a stronger statement about their length than @BLen@.+type family CBLen a :: Natural++-- Explicitly-sized Haskell machine words are constant size.+type instance CBLen Word8  = 1+type instance CBLen  Int8  = 1+type instance CBLen Word16 = 2+type instance CBLen  Int16 = 2+type instance CBLen Word32 = 4+type instance CBLen  Int32 = 4+type instance CBLen Word64 = 8+type instance CBLen  Int64 = 8

@@ -1,86 +0,0 @@-module Binrep.Codec where--import Data.ByteString qualified as BS-import Data.ByteString.Lazy qualified as BL-import Data.ByteString.Builder qualified as B-import Data.Serialize---- | Types that can be coded precisely between binary and a Haskell type.------ This class looks identical to cereal's 'Serialize', but we take a different--- approach to instances.------ 'Data.Serialize.Serialize' defines an internal binary codec for common--- Haskell types. It makes implicit decisions, such as big-endian for all--- integer types, and coding lists with a (big-endian) 'Word64' length prefix.--- It only works with other data serialized with the same library.------ This typeclass defines composable binary codec combinators. If you want to--- write a codec for a 'Word64', it needs to specify its endianness in the type.--- If you want to write a codec for a list with a 'Word8' length prefix, it must--- come with a proof that it's not oversized.------ The idea is to use this typeclass along with various annotated newtypes to--- allow defining a Haskell type's binary representation directly in the types.--- In cases where you're doing intermediate serialization and not much else, it--- may be convenient. You will need to do a bunch of (free at runtime) wrapping--- though.-class BinaryCodec a where-    toBin   :: Putter a     -- ^ Encode to   binary. Same as cereal's 'put'.-    fromBin :: Get a        -- ^ Decode from binary. Same as cereal's 'get'.---- | Run the encoder for a supporting type.-binEncode :: BinaryCodec a => a -> BS.ByteString-binEncode = runPut . toBin---- | Run the decoder a supporting type.-binDecode :: BinaryCodec a => BS.ByteString -> Either String a-binDecode = runGet fromBin---- | Serialize each element in order. No length indicator, so parse until either---   error or EOF. Usually not what you want, but sometimes used at the "top" of---   binary formats.-instance BinaryCodec a => BinaryCodec [a] where-    toBin as = mapM_ toBin as-    fromBin = go []-      where-        go as = do-            a <- fromBin-            isEmpty >>= \case-              True -> return $ reverse $ a : as-              False -> go $ a : as---- | Types that can be coded between binary and a Haskell type given some---   runtime information.------ We can't prove something related to a value and pass that proof along without--- dependent types, meaning we can't split validation from encoding like in--- 'BinaryCodec', so encoding can fail. However, by allowing an arbitrary--- environment, we can define many more convenient instances.------ For example, you can't write a 'BinaryCodec' instance for 'Word16' because it--- doesn't specify its endianness. But you can define 'BinaryCodecWith--- Endianness Word16'! This was, you can decide how much of the binary schema--- you want to place directly in the types, and how much to configure--- dynamically.------ This class defaults to the free implementation provided by 'BinaryCodec',--- which ignores the environment and wraps serializing with 'Right'.-class BinaryCodecWith r a where-    -- | Encode to binary with the given environment.-    toBinWith   :: r -> a -> Either String B.Builder-    default toBinWith :: BinaryCodec a => r -> a -> Either String B.Builder-    toBinWith = const $ Right . execPut . toBin--    -- | Decode to binary with the given environment.-    fromBinWith :: r -> Get a-    default fromBinWith :: BinaryCodec a => r -> Get a-    fromBinWith = const fromBin---- | Run the encoder for a supporting type using the given environment.-binEncodeWith :: BinaryCodecWith r a => r -> a -> Either String BS.ByteString-binEncodeWith r a = BL.toStrict . B.toLazyByteString <$> toBinWith r a---- | Run the decoder for a supporting type using the given environment.-binDecodeWith :: BinaryCodecWith r a => r -> BS.ByteString -> Either String a-binDecodeWith = runGet . fromBinWith

@@ -0,0 +1,67 @@+{-# LANGUAGE UndecidableInstances #-}++module Binrep.Example where++import Binrep+import Binrep.Generic+import Binrep.Generic qualified as BR+import Binrep.Type.Common ( Endianness(..) )+import Binrep.Type.Int++import GHC.Generics ( Generic )+import Data.Data ( Data )++brCfgNoSum :: BR.Cfg (I 'U 'I1 'LE)+brCfgNoSum = BR.Cfg { BR.cSumTag = undefined }++data DV+    deriving stock (Generic, Data)++-- Disallowed. No binrepping void datatypes.+{-+instance BLen DV where blen = blenGeneric brCfgNoSum+instance Put  DV where put  = putGeneric  brCfgNoSum+instance Get  DV where get  = getGeneric  brCfgNoSum+-}++data DU = DU+    deriving stock (Generic, Data, Show, Eq)++instance BLen DU where blen = blenGeneric brCfgNoSum+instance Put  DU where put  = putGeneric  brCfgNoSum+instance Get  DU where get  = getGeneric  brCfgNoSum++data DSS = DSS+  { dss1 :: I 'U 'I1 'LE+  , dss2 :: I 'U 'I2 'LE+  , dss3 :: I 'U 'I4 'LE+  , dss4 :: I 'U 'I8 'LE+  , dss5 :: I 'U 'I1 'LE+  } deriving stock (Generic, Data, Show, Eq)++instance BLen DSS where blen = blenGeneric brCfgNoSum+instance Put  DSS where put  = putGeneric  brCfgNoSum+instance Get  DSS where get  = getGeneric  brCfgNoSum++data DCS = DCS1 {- DSS -} | DCS2 | DCS3 | DCS4 | DCS5+    deriving stock (Generic, Data, Show, Eq)++brCfgDCS :: BR.Cfg (I 'U 'I1 'LE)+brCfgDCS = BR.Cfg { BR.cSumTag = BR.cSumTagHex $ drop 3 }++--instance BR.BLen DCS where blen = BR.blenGeneric brCfgDCS+deriving anyclass instance BLen DCS+instance Put  DCS where put  = putGeneric  brCfgDCS+instance Get  DCS where get  = getGeneric  brCfgDCS++data DX = DX DU+    deriving stock (Generic, Data, Show, Eq)++type instance CBLen DX  = CBLenGeneric (I 'U 'I1 'LE) DX+type instance CBLen DU  = CBLenGeneric (I 'U 'I1 'LE) DU+type instance CBLen DSS = CBLenGeneric (I 'U 'I1 'LE) DSS+type instance CBLen DCS = CBLenGeneric (I 'U 'I1 'LE) DCS+deriving anyclass instance BLen DX++-- TODO clean up that CBLen messing around, probably don't mention it outside+-- the module (it's weird and will probably break things)

@@ -0,0 +1,105 @@+module Binrep.Example.FileTable where++import Binrep+import Refined hiding ( Weaken )+import Refined.Unsafe+import Binrep.Type.Common ( Endianness(..) )+import Binrep.Type.Int+import Binrep.Type.LenPfx+import FlatParse.Basic qualified as FP+import Data.ByteString qualified as B+import Strongweak+import Strongweak.Generic+--import Data.Map ( Map )+import GHC.Generics ( Generic )+import GHC.Exts+import Data.Vector.Sized qualified as V+import Data.Word++type BS = B.ByteString++-- We're unable to put one invariant in the types: an entry can't be placed past+-- the maximum offset. Validating that requires quite a lot of work: we have to+-- do much of the layouting work, which will be repeated for serializing. This+-- is a downside of phase separation, it crops up every now and then.+--+-- The BLen instance will similarly be a bit complex, but it could probably be+-- implemented with similar code to strengthening.+newtype Table s a = Table { unTable :: SW s (LenPfx 'I1 'LE (Entry s a)) }++instance (Put a, BLen a) => Put (Table 'Strong a) where put = putFileTable++putFileTable :: (Put a, BLen a) => Table 'Strong a -> Builder+putFileTable (Table a@(LenPfx es)) =+    let es' = V.map prepEntry es+        osBase = V.sum $ V.map (\(l, _, _) -> l) es'+    in  case V.foldl go ((fromIntegral osBase) - 1, mempty, mempty) es' of+          (_, bh, bd) -> put (lenPfxSize a) <> bh <> bd+  where+    go :: (Word8, Builder, Builder) -> (BLenT, Word8 -> Builder, BS) -> (Word8, Builder, Builder)+    go (os, bh, bd) (_, eh, ed) = (os+fromIntegral (B.length ed), bh<>eh os, bd<>put ed)++prepEntry :: (Put a, BLen a) => Entry 'Strong a -> (BLenT, Word8 -> Builder, BS)+prepEntry (Entry nm bs) = (l, b, bs')+  where+    bs' = unrefine bs+    b os =+        put nm <> put os <> put (fromIntegral (B.length bs') :: Word8)+    l = blen nm + 1 + 1 + blen bs'++instance Get a => Get (Table 'Strong a) where get = getFileTable++getFileTable :: Get a => Getter (Table 'Strong a)+getFileTable = FP.withAddr# $ \addr# -> Table <$> getLenPfx (getWith addr#)++{-+This is certainly a weird type.++  * Can use regular strongweak generics+  * Has no 'Get' instance+  * Has a 'GetWith Addr#' instance+  * Has no 'Put' instance+  * Has no 'PutWith' instance++You can't serialize an 'Entry' by itself, because it serializes to two+artifacts, a header entry and the associated data. Now I see why Kaitai Struct+was having trouble with serializing this sort of type.+-}+data Entry s a = Entry+  { entryName :: a+  , entryData :: SW s (Refined (SizeLessThan (IMax 'U 'I1)) BS)+  } deriving stock (Generic)+deriving stock instance Show a => Show (Entry 'Weak   a)+deriving stock instance Eq   a => Eq   (Entry 'Weak   a)+deriving stock instance Show a => Show (Entry 'Strong a)+deriving stock instance Eq   a => Eq   (Entry 'Strong a)+instance Weaken (Entry 'Strong a) where+    type Weak (Entry 'Strong a) = Entry 'Weak a+    weaken = weakenGeneric+instance Strengthen (Entry 'Strong a) where+    strengthen = strengthenGeneric++instance Get a => GetWith Addr# (Entry 'Strong a) where getWith = getEntry++getEntry :: Get a => Addr# -> Getter (Entry 'Strong a)+getEntry addr# = do+    name <- get+    dat  <- FP.withAnyWord8# $ \offset# -> FP.withAnyWord8# $ \len# ->+        FP.takeBsOffAddr# addr# (w8i# offset#) (w8i# len#)+    return $ Entry name (reallyUnsafeRefine dat)++w8i# :: Word8# -> Int#+w8i# w# = word2Int# (word8ToWord# w#)++exBs :: BS+exBs = B.pack+  [ 0x02+  , 0x30, 0x31, 0x32, 0x00+  , 12 -- <- offset!!+  , 0x01+  , 0x39, 0x38, 0x00+  , 13+  , 0x01+  , 0xFF+  , 0xF0+  ]

@@ -0,0 +1,67 @@+module Binrep.Example.Tar where++import Binrep+import Binrep.Generic+import Binrep.Generic qualified as BR+import Binrep.Type.Common ( Endianness(..) )+import Binrep.Type.Int+import Binrep.Type.NullPadded+import Binrep.Type.AsciiNat++import GHC.Generics ( Generic )++import Data.Word ( Word8 )++import GHC.TypeNats++import Data.ByteString qualified as B++import FlatParse.Basic qualified as FP++type BS = B.ByteString++brCfgNoSum :: BR.Cfg (I 'U 'I1 'LE)+brCfgNoSum = BR.Cfg { BR.cSumTag = undefined }++-- | The naturals in tars are sized octal ASCII digit strings that end with a+--   null byte (and may start with leading ASCII zeroes). The size includes the+--   terminating null, so you get @n-1@ digits. What a farce.+--+-- Don't use this constructor directly! The size must be checked to ensure it+-- fits.+newtype TarNat n = TarNat { getTarNat :: AsciiNat 8 }+    deriving stock (Generic, Show, Eq)++type instance CBLen (TarNat n) = n+instance KnownNat n => BLen (TarNat n)++-- | No need to check for underflow etc. as TarNat guarantees good sizing.+instance KnownNat n => Put (TarNat n) where+    put (TarNat an) = put pfxNulls <> put an <> put @Word8 0x00+      where+        pfxNulls = B.replicate (fromIntegral pfxNullCount) 0x30+        pfxNullCount = n - blen an - 1+        n = typeNatToBLen @n++instance KnownNat n => Get (TarNat n) where+    get = do+        an <- FP.isolate (fromIntegral (n - 1)) get+        get @Word8 >>= \case+          0x00 -> return $ TarNat an+          w    -> FP.err $ "TODO expected null byte, got " <> show w+      where+        n = typeNatToBLen @n++-- Partial header+data Tar = Tar+  { tarFileName :: NullPadded 100 BS+  , tarFileMode :: TarNat 8+  , tarFileUIDOwner :: TarNat 8+  , tarFileUIDGroup :: TarNat 8+  , tarFileFileSize :: TarNat 12+  , tarFileLastMod :: TarNat 12+  } deriving stock (Generic, Show, Eq)++instance BLen Tar where blen = blenGeneric brCfgNoSum+instance Put  Tar where put  = putGeneric  brCfgNoSum+instance Get  Tar where get  = getGeneric  brCfgNoSum

@@ -0,0 +1,62 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE UndecidableInstances #-}++module Binrep.Example.Tiff where++import Binrep+import Binrep.Generic+import Binrep.Generic qualified as BR+import Binrep.Type.Common ( Endianness(..) )+import Binrep.Type.Int+import Binrep.Type.Magic+import Binrep.Type.Byte+import FlatParse.Basic ( (<|>) )++import GHC.Generics ( Generic )+import Data.Data ( Data, Typeable )+import GHC.TypeLits++import Data.ByteString qualified as B++type W8 = I 'U 'I1 'LE++brCfgNoSum :: BR.Cfg W8+brCfgNoSum = BR.Cfg { BR.cSumTag = undefined }++data Tiff where+    Tiff :: (Put (I 'U 'I4 end), bs ~ MagicVals (TiffMagic end), ByteVals bs, KnownNat (Length bs)) => TiffBody end -> Tiff++instance Show Tiff where+    show (Tiff body) = "Tiff " <> show body++data TiffBody (end :: Endianness) = TiffBody+  { tiffBodyMagic :: Magic (TiffMagic end)+  , tiffBodyExInt :: I 'U 'I4 end+  } deriving stock (Generic, Show, Eq)+deriving stock instance (KnownSymbol (TiffMagic end), Typeable end) => Data (TiffBody end)++instance (bs ~ MagicVals (TiffMagic end), KnownNat (Length bs)) => BLen (TiffBody end) where+    blen = blenGeneric brCfgNoSum+instance (bs ~ MagicVals (TiffMagic end), ByteVals bs, irep ~ I 'U 'I4 end, Put irep) => Put  (TiffBody end) where+    put  = putGeneric  brCfgNoSum+instance (bs ~ MagicVals (TiffMagic end), ByteVals bs, irep ~ I 'U 'I4 end, Get irep) => Get  (TiffBody end) where+    get  = getGeneric  brCfgNoSum++instance BLen Tiff where+    blen (Tiff body) = blen body++instance Put Tiff where+    put (Tiff body) = put body++instance Get Tiff where+    get = fmap Tiff (get @(TiffBody 'LE)) <|> fmap Tiff (get @(TiffBody 'BE))++type family TiffMagic (end :: Endianness) :: Symbol where+    TiffMagic 'LE = "II"+    TiffMagic 'BE = "MM"++tiffLEbs :: B.ByteString+tiffLEbs = B.pack [0x49, 0x49, 0xFF, 0x00, 0x00, 0x00]++tiffBEbs :: B.ByteString+tiffBEbs = B.pack [0x4D, 0x4D, 0x00, 0x00, 0x00, 0xFF]

@@ -0,0 +1,31 @@+module Binrep.Example.Wav where++import Binrep+import Binrep.Generic+import Binrep.Generic qualified as BR+import Binrep.Type.Common ( Endianness(..) )+import Binrep.Type.Int+import Binrep.Type.Magic++import GHC.Generics ( Generic )+import Data.Data ( Data )++type E = 'LE+type W32 = I 'U 'I4 E+type W16 = I 'U 'I2 E++brCfgNoSum :: BR.Cfg (I 'U 'I1 'LE)+brCfgNoSum = BR.Cfg { BR.cSumTag = undefined }++data WavHeader = WavHeader+  { wavHeaderMagic :: Magic "RIFF"+  , wavHeaderChunkSize :: W32 -- file size - 8+  , wavHeaderFmt :: Magic "WAVE"+  , wavHeaderFmtChunkMarker :: Magic "fmt "+  , wavHeaderFmtType :: W16+  , wavHeaderChannels :: W16+  } deriving stock (Generic, Data, Show, Eq)++instance BLen WavHeader where blen = blenGeneric brCfgNoSum+instance Put  WavHeader where put  = putGeneric  brCfgNoSum+instance Get  WavHeader where get  = getGeneric  brCfgNoSum

@@ -0,0 +1,109 @@+-- | Pretty bytestrings via printing each byte as two hex digits.+--+-- This is primarily for aeson and when we want better 'show'ing of non-textual+-- bytestrings. It's not really binrep-related, but it needs _somewhere_ to go+-- and my projects that need it usually also touch binrep, so here it is.+--+-- Sadly, we can't use it to make aeson print integers as hex literals. It only+-- deals in Scientifics, and if we tried printing them as strings, it would+-- quote them. I need a YAML-like with better literals...++module Binrep.Extra.HexByteString where++import GHC.Generics ( Generic )+import Data.Data ( Data )++import Data.ByteString qualified as B+import Data.ByteString.Short qualified as B.Short+import Data.Char qualified as Char+import Data.Word+import Data.Text qualified as Text+import Data.Text ( Text )+import Data.List as List++import Text.Megaparsec hiding ( parse )+import Text.Megaparsec.Char qualified as MC+import Data.Void++import Data.Aeson++-- TODO could add some integer instances to print them as hex too++-- No harm in being polymorphic over the byte representation.+newtype Hex a = Hex { unHex :: a }+    deriving stock (Generic, Data)+    deriving Eq via a++-- But most users will probably just want this.+type HexByteString = Hex B.ByteString++instance Show (Hex B.ByteString) where+    show = Text.unpack . prettyHexByteString B.unpack . unHex++instance FromJSON (Hex B.ByteString) where+    parseJSON = withText "hex bytestring" $ \t ->+        case parseMaybe @Void (parseHexByteString B.pack) t of+          Nothing -> fail "failed to parse hex bytestring (TODO)"+          Just t' -> pure (Hex t')++instance ToJSON   (Hex B.ByteString) where+    toJSON = String . prettyHexByteString B.unpack . unHex++instance Show (Hex B.Short.ShortByteString) where+    show = Text.unpack . prettyHexByteString B.Short.unpack . unHex++instance FromJSON (Hex B.Short.ShortByteString) where+    parseJSON = withText "hex bytestring" $ \t ->+        case parseMaybe @Void (parseHexByteString B.Short.pack) t of+          Nothing -> fail "failed to parse hex bytestring (TODO)"+          Just t' -> pure (Hex t')++instance ToJSON   (Hex B.Short.ShortByteString) where+    toJSON = String . prettyHexByteString B.Short.unpack . unHex++-- | A hex bytestring looks like this: @00 01 89 8a   FEff@. You can mix and+-- match capitalization and spacing, but I prefer to space each byte, full caps.+parseHexByteString+    :: (MonadParsec e s m, Token s ~ Char)+    => ([Word8] -> a) -> m a+parseHexByteString pack = pack <$> parseHexByte `sepBy` MC.hspace++-- | Parse a byte formatted as two hex digits e.g. EF. You _must_ provide both+-- nibbles e.g. @0F@, not @F@. They cannot be spaced e.g. @E F@ is invalid.+--+-- Returns a value 0-255, so can fit in any Num type that can store that.+parseHexByte :: (MonadParsec e s m, Token s ~ Char, Num a) => m a+parseHexByte = do+    c1 <- MC.hexDigitChar+    c2 <- MC.hexDigitChar+    return $ 0x10 * fromIntegral (Char.digitToInt c1) + fromIntegral (Char.digitToInt c2)++-- | Pretty print to default format @00 12 AB FF@: space between each byte, all+--   caps.+--+-- This format I consider most human readable. I prefer caps to draw attention+-- to this being data instead of text (you don't see that many capital letters+-- packed together in prose).+prettyHexByteString :: (a -> [Word8]) -> a -> Text+prettyHexByteString unpack =+      Text.concat+    . List.intersperse (Text.singleton ' ')+    . fmap (f . prettyHexByte Char.toUpper)+    . unpack+  where+    f :: (Char, Char) -> Text+    f (c1, c2) = Text.cons c1 $ Text.singleton c2++prettyHexByte :: (Char -> Char) -> Word8 -> (Char, Char)+prettyHexByte f w = (prettyNibble h, prettyNibble l)+  where+    (h,l) = fromIntegral w `divMod` 0x10+    prettyNibble = f . Char.intToDigit -- Char.intToDigit returns lower case++-- | Pretty print to "compact" format @0012abff@ (often output by hashers).+prettyHexByteStringCompact :: (a -> [Word8]) -> a -> Text+prettyHexByteStringCompact unpack =+    Text.concat . fmap (f . prettyHexByte id) . unpack+  where+    f :: (Char, Char) -> Text+    f (c1, c2) = Text.cons c1 $ Text.singleton c2

@@ -0,0 +1,49 @@+-- | Derive 'BLen', 'Put', 'Get' and 'CBLen' instances generically.++module Binrep.Generic+  ( Cfg(..)+  , cSumTagHex, cSumTagNullTerm, cDef+  , blenGeneric, putGeneric, getGeneric, CBLenGeneric+  ) where++import Binrep.Generic.Internal+import Binrep.Generic.BLen+import Binrep.Generic.Put+import Binrep.Generic.Get+import Binrep.Generic.CBLen++import Binrep.Type.ByteString ( AsByteString, Rep(..) )+import Refined.Unsafe ( reallyUnsafeRefine )+import Data.Text qualified as Text+import Data.Text.Encoding qualified as Text++import Numeric ( readHex )++-- TODO better error handling (see what aeson does)++-- | Obtain the tag for a sum type value by applying a function to the+--   constructor name, and reading the result as a hexadecimal number.+cSumTagHex :: forall a. Integral a => (String -> String) -> String -> a+cSumTagHex f = forceRead . readHex . f++-- | Successfully parse exactly one result, or runtime error.+forceRead :: [(a, String)] -> a+forceRead = \case []        -> error "no parse"+                  [(x, "")] -> x+                  [(_x, _)] -> error "incomplete parse"+                  (_:_)     -> error "too many parses (how??)"++-- | Obtain the tag for a sum type value using the constructor name directly+--   (with a null terminator).+--+-- This is probably not what you want in a binary representation, but it's safe+-- and may be useful for debugging.+--+-- The refine force is safe under the assumption that Haskell constructor names+-- are UTF-8 with no null bytes allowed. I haven't confirmed that, but I'm+-- fairly certain.+cSumTagNullTerm :: String -> AsByteString 'C+cSumTagNullTerm = reallyUnsafeRefine . Text.encodeUtf8 . Text.pack++cDef :: Cfg (AsByteString 'C)+cDef = Cfg { cSumTag = cSumTagNullTerm }

@@ -0,0 +1,51 @@+{-# LANGUAGE UndecidableInstances #-} -- required for TypeError >:(++module Binrep.Generic.BLen where++import GHC.Generics+import GHC.TypeLits ( TypeError )++import Binrep.BLen+import Binrep.Generic.Internal++blenGeneric :: (Generic a, GBLen (Rep a), BLen w) => Cfg w -> a -> BLenT+blenGeneric cfg = gblen cfg . from++class GBLen f where+    gblen :: BLen w => Cfg w -> f p -> BLenT++-- | Empty constructor.+instance GBLen U1 where+    gblen _ U1 = 0++-- | Field.+instance BLen c => GBLen (K1 i c) where+    gblen _ (K1 c) = blen c++-- | Product type fields are consecutive.+instance (GBLen l, GBLen r) => GBLen (l :*: r) where+    gblen cfg (l :*: r) = gblen cfg l + gblen cfg r++-- | Constructor sums are differentiated by a prefix tag.+instance GBLenSum (l :+: r) => GBLen (l :+: r) where+    gblen = gblensum++-- | Refuse to derive instance for void datatype.+instance TypeError GErrRefuseVoid => GBLen V1 where+    gblen = undefined++-- | Any datatype, constructor or record.+instance GBLen f => GBLen (M1 i d f) where+    gblen cfg = gblen cfg . unM1++--------------------------------------------------------------------------------++class GBLenSum f where+    gblensum :: BLen w => Cfg w -> f p -> BLenT++instance (GBLenSum l, GBLenSum r) => GBLenSum (l :+: r) where+    gblensum cfg = \case L1 l -> gblensum cfg l+                         R1 r -> gblensum cfg r++instance (GBLen f, Constructor c) => GBLenSum (C1 c f) where+    gblensum cfg x = blen ((cSumTag cfg) (conName' @c)) + gblen cfg (unM1 x)

@@ -0,0 +1,72 @@+{-# LANGUAGE UndecidableInstances #-}++{- | Generically derive 'CBLen' type family instances.++This is mostly playing around -- I've only just learned regular GHC generics,+and pulling everything up to the type level is even more confusing and weird.++A 'CBLen' instance usually indicates a type is either extremely simple or comes+with size information in the type. Be careful deriving or writing instances for+your own types - @BLen@ is usually correct/sufficient.++You can attempt to derive a 'CBLen' type family instance generically for a type+via++    type instance CBLen a = CBLenGeneric w a++As with deriving @BLen@, you must provide the type used to store the sum tag for+sum types.++Then try doing something with it e.g. have GHC derive a @BLen@ instance for you+via the default method (that reifies CBLen)++    deriving anyclass BLen a++Hopefully it either compiles, or you get a useful type error. If not, sorry.+-}++module Binrep.Generic.CBLen where++import Binrep.CBLen+import Binrep.Generic.Internal++import GHC.Generics+import GHC.TypeLits+import Data.Kind++import Data.Type.Equality+import Data.Type.Bool++type CBLenGeneric w a = GCBLen w (Rep a)++type family GCBLen w (f :: k -> Type) :: Natural where+    GCBLen _ U1         = 0+    GCBLen _ (K1 i c)   = CBLen c+    GCBLen w (l :*: r)  = GCBLen w l + GCBLen w r++    GCBLen w (l :+: r)  = CBLen w + GCBLenCaseMaybe (GCBLenSum w (l :+: r))++    GCBLen _ V1         = TypeError GErrRefuseVoid+    GCBLen w (M1 _ _ f) = GCBLen w f++--type family GCBLenSum w (f :: k -> Type) :: Maybe Natural where+type family GCBLenSum w (f :: k -> Type) where+    GCBLenSum w (C1 ('MetaCons name _ _) f)  = JustX (GCBLen w f) name+    GCBLenSum w (l :+: r) = MaybeEq (GCBLenSum w l) (GCBLenSum w r)++type family MaybeEq a b where+    MaybeEq (JustX n nName) (JustX m _) = If (n == m) (JustX n nName) NothingX+    MaybeEq _        _          = NothingX++-- | I don't know how to pattern match in types without writing type families.+type family GCBLenCaseMaybe a where+    GCBLenCaseMaybe (JustX n _) = n+    GCBLenCaseMaybe NothingX  =+        TypeError+            (     'Text "Two constructors didn't have equal constant size."+            ':$$: 'Text "Sry dunno how to thread errors thru LOL"+            )++-- TODO rewrite this stuff to thread error info through!+data JustX a b+data NothingX

@@ -0,0 +1,66 @@+{-# LANGUAGE UndecidableInstances #-} -- required for TypeError >:(++module Binrep.Generic.Get where++import GHC.Generics+import GHC.TypeLits ( TypeError )++import Binrep.Get+import Binrep.Generic.Internal++import FlatParse.Basic qualified as FP+import FlatParse.Basic ( Parser )+import Control.Applicative ( (<|>) )++getGeneric :: (Generic a, GGet (Rep a), Get w, Eq w, Show w) => Cfg w -> Parser String a+getGeneric cfg = to <$> gget cfg++class GGet f where+    gget :: (Get w, Eq w, Show w) => Cfg w -> Parser String (f a)++-- | Empty constructor.+instance GGet U1 where+    gget _ = return U1++-- | Field.+instance Get c => GGet (K1 i c) where+    gget _ = K1 <$> get++-- | Product type fields are consecutive.+instance (GGet l, GGet r) => GGet (l :*: r) where+    gget cfg = do l <- gget cfg+                  r <- gget cfg+                  return $ l :*: r++-- | Constructor sums are differentiated by a prefix tag.+instance GGetSum (l :+: r) => GGet (l :+: r) where+    gget cfg = do+        tag <- get+        case ggetsum cfg tag of+          Just parser -> parser+          Nothing -> FP.err $ "invalid sum type tag: "<>show tag++-- | Refuse to derive instance for void datatype.+instance TypeError GErrRefuseVoid => GGet V1 where+    gget = undefined++-- | Any datatype, constructor or record.+instance GGet f => GGet (M1 i d f) where+    gget cfg = M1 <$> gget cfg++--------------------------------------------------------------------------------++class GGetSum f where+    ggetsum :: (Get w, Eq w, Show w) => Cfg w -> w -> Maybe (Parser String (f a))++instance (GGetSum l, GGetSum r) => GGetSum (l :+: r) where+    ggetsum cfg tag = l <|> r+      where+        l = fmap L1 <$> ggetsum cfg tag+        r = fmap R1 <$> ggetsum cfg tag++-- | Bad. Need to wrap this like SumFromString in Aeson.+instance (GGet r, Constructor c) => GGetSum (C1 c r) where+    ggetsum cfg tag+     | tag == (cSumTag cfg) (conName' @c) = Just $ gget cfg+     | otherwise = Nothing

@@ -0,0 +1,21 @@+{-# LANGUAGE AllowAmbiguousTypes #-}++module Binrep.Generic.Internal where++import GHC.TypeLits+import GHC.Generics++data Cfg a = Cfg+  { cSumTag :: String -> a+  -- ^ How to turn a constructor name into a byte tag.+  }++-- | Common type error string for when GHC attempts to derive an binrep instance+--   for a (the?) void datatype @V1@.+type GErrRefuseVoid =+    'Text "Refusing to derive binary representation for void datatype"++-- | 'conName' without the value (only used as a proxy). Lets us push our+--   'undefined's into one place.+conName' :: forall c. Constructor c => String+conName' = conName @c undefined

@@ -0,0 +1,66 @@+{-# LANGUAGE UndecidableInstances #-} -- required for TypeError >:(++module Binrep.Generic.Put where++import GHC.Generics+import GHC.TypeLits ( TypeError )++import Binrep.Put+import Binrep.Generic.Internal++putGeneric :: (Generic a, GPut (Rep a), Put w) => Cfg w -> a -> Builder+putGeneric cfg = gput cfg . from++class GPut f where+    gput :: Put w => Cfg w -> f p -> Builder++-- | Empty constructor.+instance GPut U1 where+    gput _ U1 = mempty++-- | Field.+instance Put c => GPut (K1 i c) where+    gput _ = put . unK1++-- | Product type fields are consecutive.+instance (GPut l, GPut r) => GPut (l :*: r) where+    gput cfg (l :*: r) = gput cfg l <> gput cfg r++-- | Constructor sums are differentiated by a prefix tag.+instance (GPutSum (l :+: r), GetConName (l :+: r)) => GPut (l :+: r) where+    gput = gputsum++-- | Refuse to derive instance for void datatype.+instance TypeError GErrRefuseVoid => GPut V1 where+    gput = undefined++-- | Any datatype, constructor or record.+instance GPut f => GPut (M1 i d f) where+    gput cfg = gput cfg . unM1++--------------------------------------------------------------------------------++class GPutSum f where+    gputsum :: Put w => Cfg w -> f a -> Builder++instance (GPutSum l, GPutSum r) => GPutSum (l :+: r) where+    gputsum cfg = \case L1 a -> gputsum cfg a+                        R1 a -> gputsum cfg a++instance (GPut r, Constructor c) => GPutSum (C1 c r) where+    gputsum cfg x = putTag <> putConstructor+      where putTag = put $ (cSumTag cfg) (conName' @c)+            putConstructor = gput cfg $ unM1 x++---++-- | Get the name of the constructor of a sum datatype.+class GetConName f where+    getConName :: f a -> String++instance (GetConName a, GetConName b) => GetConName (a :+: b) where+    getConName (L1 x) = getConName x+    getConName (R1 x) = getConName x++instance Constructor c => GetConName (C1 c a) where+    getConName = conName

@@ -0,0 +1,68 @@+{-# LANGUAGE FunctionalDependencies #-}++module Binrep.Get+  ( Getter, Get(..), runGet, runGetter+  , GetWith(..), runGetWith+  ) where++import FlatParse.Basic qualified as FP+import FlatParse.Basic ( Parser )+import Data.ByteString qualified as B+import Data.Word+import Data.Int+import GHC.Exts++type Getter a = Parser String a++class Get a where+    -- | Parse from binary.+    get :: Getter a++runGet :: Get a => B.ByteString -> Either String (a, B.ByteString)+runGet = runGetter get++runGetter :: Getter a -> B.ByteString -> Either String (a, B.ByteString)+runGetter g bs = case FP.runParser g bs of+                   FP.OK a bs' -> Right (a, bs')+                   FP.Fail     -> Left "TODO fail"+                   FP.Err e    -> Left e++-- | Parse heterogeneous lists in order. No length indicator, so either fails or+--   succeeds by reaching EOF. Probably not what you usually want, but sometimes+--   used at the "top" of binary formats.+instance Get a => Get [a] where+    get = do as <- FP.many get+             FP.eof+             return as++instance (Get a, Get b) => Get (a, b) where+    get = do+        a <- get+        b <- get+        return (a, b)++instance Get B.ByteString where+    get = FP.takeRestBs++instance Get Word8 where get = FP.anyWord8+instance Get  Int8 where get = FP.anyInt8++-- | A type that can be parsed from binary given some environment.+--+-- Making this levity polymorphic makes things pretty strange, but is useful.+-- See @Binrep.Example.FileTable@.+class GetWith (r :: TYPE rep) a | a -> r where+    -- | Parse from binary with the given environment.+    getWith :: r -> Getter a+    -- can no longer provide default implementation due to levity polymorphism+    --default getWith :: Get a => r -> Getter a+    --getWith _ = get++--deriving anyclass instance Get a => GetWith r [a]++-- Note that @r@ is not levity polymorphic, GHC forces it to be lifted. You+-- can't bind (LHS) a levity polymorphic value.+runGetWith+    :: GetWith (r :: TYPE LiftedRep) a+    => r -> B.ByteString -> Either String (a, B.ByteString)+runGetWith r bs = runGetter (getWith r) bs

@@ -1,69 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Binrep.Predicates.NullPadTo where--import Binrep.Codec-import Binrep.ByteLen-import Binrep.Util ( tshow )-import Refined-import Refined.WithRefine-import Data.Serialize-import GHC.TypeNats-import Numeric.Natural-import GHC.Natural ( minusNaturalMaybe )-import GHC.Exts ( proxy#, Proxy# )-import Data.Typeable-import Data.ByteString qualified as BS--data NullPadTo (n :: Nat)--instance KnownNat n => ByteLen (WithRefine 'Enforced (NullPadTo n) a) where-    blen = const n-      where n = natVal' (proxy# :: Proxy# n)--instance (ByteLen a, KnownNat n) => Predicate (NullPadTo n) a where-    validate p a-      | len > n-          = throwRefineOtherException (typeRep p) $-                   "too long: " <> tshow len <> " > " <> tshow n-      | otherwise = success-      where-        n = natVal' (proxy# :: Proxy# n)-        len = blen a---- | predicate is inherently enforced due to checking length to calculate how---   many succeeding nulls to parse------ Note that the consumer probably doesn't care about the content of the--- padding, just that the data is chunked correctly. I figure we care about--- correctness here, so it'd be nice to know about the padding well-formedness--- (i.e. that it's all nulls).-instance (BinaryCodec a, ByteLen a, KnownNat n)-      => BinaryCodec (WithRefine 'Enforced (NullPadTo n) a) where-    fromBin = do-        a <- fromBin-        let len = blen a-        case minusNaturalMaybe n len of-          Nothing -> fail $ "too long: " <> show len <> " > " <> show n-          Just nullstrLen -> do-            getNNulls nullstrLen-            return $ reallyUnsafeEnforce a-      where-        n = natVal' (proxy# :: Proxy# n)-    toBin wrnpa = do-        let npa = unWithRefine wrnpa-        toBin npa-        let paddingLength = n - blen npa-        putByteString $ BS.replicate (fromIntegral paddingLength) 0x00-      where-        n = natVal' (proxy# :: Proxy# n)--getNNulls :: Natural -> Get ()-getNNulls = \case 0 -> return ()-                  n -> getWord8 >>= \case-                         0x00    -> getNNulls $ n-1-                         nonNull -> do-                           offset <- bytesRead-                           fail $  "expected null, found: "<> show nonNull-                                <> " at offset " <> show offset-                                <> ", " <> show n <> " more nulls to go"

@@ -0,0 +1,63 @@+module Binrep.Put where++import Mason.Builder qualified as Mason++import Data.ByteString qualified as B+import Data.Word+import Data.Int++type Builder = Mason.BuilderFor Mason.StrictByteStringBackend++class Put a where+    -- | Serialize to binary.+    put :: a -> Builder++-- | Run the serializer.+runPut :: Put a => a -> B.ByteString+runPut = runBuilder . put++runBuilder :: Builder -> B.ByteString+runBuilder = Mason.toStrictByteString++-- | Serialize each element in order. No length indicator, so parse until either+--   error or EOF. Usually not what you want, but sometimes used at the "top" of+--   binary formats.+instance Put a => Put [a] where+    put = mconcat . map put++instance (Put a, Put b) => Put (a, b) where+    put (a, b) = put a <> put b++-- | Serialize the bytestring as-is.+--+-- Careful -- the only way you're going to be able to parse this is to read+-- until EOF.+instance Put B.ByteString where+    put = Mason.byteString+    {-# INLINE put #-}++-- need to give args for RankNTypes reasons I don't understand+instance Put Word8 where+    put w = Mason.word8 w+    {-# INLINE put #-}+instance Put  Int8 where+    put w = Mason.int8 w+    {-# INLINE put #-}++-- | Put with inlined checks via an environment.+class PutWith r a where+    -- | Attempt to serialize to binary with the given environment.+    putWith :: r -> a -> Either String Builder+    default putWith :: Put a => r -> a -> Either String Builder+    putWith _ = putWithout++-- | Helper for wrapping a 'BinRep' into a 'BinRepWith' (for encoding).+putWithout :: Put a => a -> Either String Builder+putWithout = Right . put++instance Put a => PutWith r [a]++-- | Run the serializer with the given environment.+runPutWith :: PutWith r a => r -> a -> Either String B.ByteString+runPutWith r a = case putWith r a of Left  e -> Left e+                                     Right x -> Right $ runBuilder x

@@ -0,0 +1,112 @@+{-| Naturals represented via ASCII numerals.++A concept which sees occasional use in places where neither speed nor size+efficiency matter.++The tar file format uses it, apparently to sidestep making a decision on byte+ordering. Though digits are encoded "big-endian", so, uh. I don't get it.++I don't really see the usage of these. It seems silly and inefficient, aimed+solely at easing debugging.+-}++{-# LANGUAGE AllowAmbiguousTypes #-}++module Binrep.Type.AsciiNat where++import Binrep+import Binrep.Util ( natVal'' )++import Data.Word ( Word8 )+import Data.List.NonEmpty ( NonEmpty( (:|) ) )+import Mason.Builder qualified as Mason+import Data.ByteString qualified as B+import Data.Semigroup ( sconcat )++import GHC.TypeNats ( Natural, KnownNat )+import GHC.Num.Natural ( naturalSizeInBase#, naturalToWord# )++import GHC.Generics ( Generic )+import Data.Data ( Data )+import Numeric ( showOct, showHex, showBin, showInt )++import FlatParse.Basic qualified as FP++-- | A 'Natural' represented in binary as an ASCII string, where each character+--   a is a digit in the given base (> 1).+--+-- 'Show' instances display the stored number in the given base. If the base has+-- a common prefix (e.g. @0x@ for hex), it is used.+newtype AsciiNat (base :: Natural) = AsciiNat { getAsciiNat :: Natural }+    deriving stock (Generic, Data)+    deriving (Eq, Ord) via Natural++instance Show (AsciiNat 2)  where showsPrec _ n = showString "0b" . showBin (getAsciiNat n)+instance Show (AsciiNat 8)  where showsPrec _ n = showString "0o" . showOct (getAsciiNat n)+instance Show (AsciiNat 10) where showsPrec _ n = showInt (getAsciiNat n)+instance Show (AsciiNat 16) where showsPrec _ n = showString "0x" . showHex (getAsciiNat n)++-- | Compare two 'AsciiNat's with arbitrary bases.+asciiNatCompare :: AsciiNat b1 -> AsciiNat b2 -> Ordering+asciiNatCompare (AsciiNat n1) (AsciiNat n2) = compare n1 n2++-- | The bytelength of an 'AsciiNat' is the number of digits in the number in+--   the given base. We can calculate this generically with great efficiency+--   using GHC primitives.+instance KnownNat base => BLen (AsciiNat base) where+    blen (AsciiNat n) = wordToBLen# (naturalSizeInBase# (naturalToWord# base) n)+      where base = natVal'' @base++--------------------------------------------------------------------------------++instance Put (AsciiNat 8) where+    put = natToAsciiBytes (+ 0x30) 8 . getAsciiNat++instance Get (AsciiNat 8) where+    get = do+        bs <- get+        case asciiBytesToNat octalFromAsciiDigit 8 bs of+          Left bs' -> FP.err $ "TODO " <> show bs'+          Right n  -> return $ AsciiNat n++octalFromAsciiDigit :: Word8 -> Maybe Word8+octalFromAsciiDigit = \case+  0x30 -> Just 0+  0x31 -> Just 1+  0x32 -> Just 2+  0x33 -> Just 3+  0x34 -> Just 4+  0x35 -> Just 5+  0x36 -> Just 6+  0x37 -> Just 7+  _    -> Nothing++--------------------------------------------------------------------------------++natToAsciiBytes :: (Word8 -> Word8) -> Natural -> Natural -> Builder+natToAsciiBytes f base =+    sconcat . fmap (\w -> Mason.word8 w) . fmap f . digits @Word8 base++asciiBytesToNat :: (Word8 -> Maybe Word8) -> Natural -> B.ByteString -> Either Word8 Natural+asciiBytesToNat f base bs =+    case B.foldr go (Right (0, 0)) bs of+      Left w -> Left w+      Right (n, _) -> Right n+  where+    go :: Word8 -> Either Word8 (Natural, Natural) -> Either Word8 (Natural, Natural)+    go _ (Left w) = Left w+    go w (Right (n, expo)) =+        case f w of+          Nothing -> Left w+          Just d  -> Right (n + fromIntegral d * base^expo, expo+1)++digits :: forall b a. (Integral a, Integral b) => a -> a -> NonEmpty b+digits base = go []+  where+    go s x = loop (head' :| s) tail'+      where+        head' = fromIntegral (x `mod` base)+        tail' = x `div` base+    loop s@(r :| rs) = \case+        0 -> s+        x -> go (r : rs) x

@@ -0,0 +1,821 @@+{- | Safe, if silly, byte representation for use at the type level.++'Word8' is a special type that GHC doesn't (and I think can't) promote to the+type level. We only have 'Natural's, which are unbounded. So we define a safe,+promotable representation, to allow us to prove well-sizedness at compile time.+Then we provide a bunch of type families and reifying typeclasses to enable+going between "similar" kinds ('Natural') and types ('Word8', 'B.ByteString')+respectively.++Type-level functionality is stored in 'Binrep.Type.Byte.TypeLevel' because the+definitions are even sillier than the ones here.++Do not use this on the term level. That would be _extremely_ silly.+-}++{-# LANGUAGE AllowAmbiguousTypes, UndecidableInstances #-}++module Binrep.Type.Byte where++import Mason.Builder qualified as Mason+import Data.ByteString.Builder.Prim.Internal qualified as BI+import Binrep.Util ( natVal'' )+import Binrep.Put ( Builder )+import GHC.TypeNats+import GHC.Exts++-- Needs to be a function type to work. Interesting. It's perhaps not an+-- improvement on regular boxed. But interesting idea, so sticking with it.+class ByteVal (n :: Natural) where byteVal :: Proxy# n -> Word8#++instance ByteVal 0x00 where+    byteVal _ = wordToWord8# 0x00##+    {-# INLINE byteVal #-}+instance ByteVal 0x01 where+    byteVal _ = wordToWord8# 0x01##+    {-# INLINE byteVal #-}+instance ByteVal 0x02 where+    byteVal _ = wordToWord8# 0x02##+    {-# INLINE byteVal #-}+instance ByteVal 0x03 where+    byteVal _ = wordToWord8# 0x03##+    {-# INLINE byteVal #-}+instance ByteVal 0x04 where+    byteVal _ = wordToWord8# 0x04##+    {-# INLINE byteVal #-}+instance ByteVal 0x05 where+    byteVal _ = wordToWord8# 0x05##+    {-# INLINE byteVal #-}+instance ByteVal 0x06 where+    byteVal _ = wordToWord8# 0x06##+    {-# INLINE byteVal #-}+instance ByteVal 0x07 where+    byteVal _ = wordToWord8# 0x07##+    {-# INLINE byteVal #-}+instance ByteVal 0x08 where+    byteVal _ = wordToWord8# 0x08##+    {-# INLINE byteVal #-}+instance ByteVal 0x09 where+    byteVal _ = wordToWord8# 0x09##+    {-# INLINE byteVal #-}+instance ByteVal 0x0a where+    byteVal _ = wordToWord8# 0x0a##+    {-# INLINE byteVal #-}+instance ByteVal 0x0b where+    byteVal _ = wordToWord8# 0x0b##+    {-# INLINE byteVal #-}+instance ByteVal 0x0c where+    byteVal _ = wordToWord8# 0x0c##+    {-# INLINE byteVal #-}+instance ByteVal 0x0d where+    byteVal _ = wordToWord8# 0x0d##+    {-# INLINE byteVal #-}+instance ByteVal 0x0e where+    byteVal _ = wordToWord8# 0x0e##+    {-# INLINE byteVal #-}+instance ByteVal 0x0f where+    byteVal _ = wordToWord8# 0x0f##+    {-# INLINE byteVal #-}+instance ByteVal 0x10 where+    byteVal _ = wordToWord8# 0x10##+    {-# INLINE byteVal #-}+instance ByteVal 0x11 where+    byteVal _ = wordToWord8# 0x11##+    {-# INLINE byteVal #-}+instance ByteVal 0x12 where+    byteVal _ = wordToWord8# 0x12##+    {-# INLINE byteVal #-}+instance ByteVal 0x13 where+    byteVal _ = wordToWord8# 0x13##+    {-# INLINE byteVal #-}+instance ByteVal 0x14 where+    byteVal _ = wordToWord8# 0x14##+    {-# INLINE byteVal #-}+instance ByteVal 0x15 where+    byteVal _ = wordToWord8# 0x15##+    {-# INLINE byteVal #-}+instance ByteVal 0x16 where+    byteVal _ = wordToWord8# 0x16##+    {-# INLINE byteVal #-}+instance ByteVal 0x17 where+    byteVal _ = wordToWord8# 0x17##+    {-# INLINE byteVal #-}+instance ByteVal 0x18 where+    byteVal _ = wordToWord8# 0x18##+    {-# INLINE byteVal #-}+instance ByteVal 0x19 where+    byteVal _ = wordToWord8# 0x19##+    {-# INLINE byteVal #-}+instance ByteVal 0x1a where+    byteVal _ = wordToWord8# 0x1a##+    {-# INLINE byteVal #-}+instance ByteVal 0x1b where+    byteVal _ = wordToWord8# 0x1b##+    {-# INLINE byteVal #-}+instance ByteVal 0x1c where+    byteVal _ = wordToWord8# 0x1c##+    {-# INLINE byteVal #-}+instance ByteVal 0x1d where+    byteVal _ = wordToWord8# 0x1d##+    {-# INLINE byteVal #-}+instance ByteVal 0x1e where+    byteVal _ = wordToWord8# 0x1e##+    {-# INLINE byteVal #-}+instance ByteVal 0x1f where+    byteVal _ = wordToWord8# 0x1f##+    {-# INLINE byteVal #-}+instance ByteVal 0x20 where+    byteVal _ = wordToWord8# 0x20##+    {-# INLINE byteVal #-}+instance ByteVal 0x21 where+    byteVal _ = wordToWord8# 0x21##+    {-# INLINE byteVal #-}+instance ByteVal 0x22 where+    byteVal _ = wordToWord8# 0x22##+    {-# INLINE byteVal #-}+instance ByteVal 0x23 where+    byteVal _ = wordToWord8# 0x23##+    {-# INLINE byteVal #-}+instance ByteVal 0x24 where+    byteVal _ = wordToWord8# 0x24##+    {-# INLINE byteVal #-}+instance ByteVal 0x25 where+    byteVal _ = wordToWord8# 0x25##+    {-# INLINE byteVal #-}+instance ByteVal 0x26 where+    byteVal _ = wordToWord8# 0x26##+    {-# INLINE byteVal #-}+instance ByteVal 0x27 where+    byteVal _ = wordToWord8# 0x27##+    {-# INLINE byteVal #-}+instance ByteVal 0x28 where+    byteVal _ = wordToWord8# 0x28##+    {-# INLINE byteVal #-}+instance ByteVal 0x29 where+    byteVal _ = wordToWord8# 0x29##+    {-# INLINE byteVal #-}+instance ByteVal 0x2a where+    byteVal _ = wordToWord8# 0x2a##+    {-# INLINE byteVal #-}+instance ByteVal 0x2b where+    byteVal _ = wordToWord8# 0x2b##+    {-# INLINE byteVal #-}+instance ByteVal 0x2c where+    byteVal _ = wordToWord8# 0x2c##+    {-# INLINE byteVal #-}+instance ByteVal 0x2d where+    byteVal _ = wordToWord8# 0x2d##+    {-# INLINE byteVal #-}+instance ByteVal 0x2e where+    byteVal _ = wordToWord8# 0x2e##+    {-# INLINE byteVal #-}+instance ByteVal 0x2f where+    byteVal _ = wordToWord8# 0x2f##+    {-# INLINE byteVal #-}+instance ByteVal 0x30 where+    byteVal _ = wordToWord8# 0x30##+    {-# INLINE byteVal #-}+instance ByteVal 0x31 where+    byteVal _ = wordToWord8# 0x31##+    {-# INLINE byteVal #-}+instance ByteVal 0x32 where+    byteVal _ = wordToWord8# 0x32##+    {-# INLINE byteVal #-}+instance ByteVal 0x33 where+    byteVal _ = wordToWord8# 0x33##+    {-# INLINE byteVal #-}+instance ByteVal 0x34 where+    byteVal _ = wordToWord8# 0x34##+    {-# INLINE byteVal #-}+instance ByteVal 0x35 where+    byteVal _ = wordToWord8# 0x35##+    {-# INLINE byteVal #-}+instance ByteVal 0x36 where+    byteVal _ = wordToWord8# 0x36##+    {-# INLINE byteVal #-}+instance ByteVal 0x37 where+    byteVal _ = wordToWord8# 0x37##+    {-# INLINE byteVal #-}+instance ByteVal 0x38 where+    byteVal _ = wordToWord8# 0x38##+    {-# INLINE byteVal #-}+instance ByteVal 0x39 where+    byteVal _ = wordToWord8# 0x39##+    {-# INLINE byteVal #-}+instance ByteVal 0x3a where+    byteVal _ = wordToWord8# 0x3a##+    {-# INLINE byteVal #-}+instance ByteVal 0x3b where+    byteVal _ = wordToWord8# 0x3b##+    {-# INLINE byteVal #-}+instance ByteVal 0x3c where+    byteVal _ = wordToWord8# 0x3c##+    {-# INLINE byteVal #-}+instance ByteVal 0x3d where+    byteVal _ = wordToWord8# 0x3d##+    {-# INLINE byteVal #-}+instance ByteVal 0x3e where+    byteVal _ = wordToWord8# 0x3e##+    {-# INLINE byteVal #-}+instance ByteVal 0x3f where+    byteVal _ = wordToWord8# 0x3f##+    {-# INLINE byteVal #-}+instance ByteVal 0x40 where+    byteVal _ = wordToWord8# 0x40##+    {-# INLINE byteVal #-}+instance ByteVal 0x41 where+    byteVal _ = wordToWord8# 0x41##+    {-# INLINE byteVal #-}+instance ByteVal 0x42 where+    byteVal _ = wordToWord8# 0x42##+    {-# INLINE byteVal #-}+instance ByteVal 0x43 where+    byteVal _ = wordToWord8# 0x43##+    {-# INLINE byteVal #-}+instance ByteVal 0x44 where+    byteVal _ = wordToWord8# 0x44##+    {-# INLINE byteVal #-}+instance ByteVal 0x45 where+    byteVal _ = wordToWord8# 0x45##+    {-# INLINE byteVal #-}+instance ByteVal 0x46 where+    byteVal _ = wordToWord8# 0x46##+    {-# INLINE byteVal #-}+instance ByteVal 0x47 where+    byteVal _ = wordToWord8# 0x47##+    {-# INLINE byteVal #-}+instance ByteVal 0x48 where+    byteVal _ = wordToWord8# 0x48##+    {-# INLINE byteVal #-}+instance ByteVal 0x49 where+    byteVal _ = wordToWord8# 0x49##+    {-# INLINE byteVal #-}+instance ByteVal 0x4a where+    byteVal _ = wordToWord8# 0x4a##+    {-# INLINE byteVal #-}+instance ByteVal 0x4b where+    byteVal _ = wordToWord8# 0x4b##+    {-# INLINE byteVal #-}+instance ByteVal 0x4c where+    byteVal _ = wordToWord8# 0x4c##+    {-# INLINE byteVal #-}+instance ByteVal 0x4d where+    byteVal _ = wordToWord8# 0x4d##+    {-# INLINE byteVal #-}+instance ByteVal 0x4e where+    byteVal _ = wordToWord8# 0x4e##+    {-# INLINE byteVal #-}+instance ByteVal 0x4f where+    byteVal _ = wordToWord8# 0x4f##+    {-# INLINE byteVal #-}+instance ByteVal 0x50 where+    byteVal _ = wordToWord8# 0x50##+    {-# INLINE byteVal #-}+instance ByteVal 0x51 where+    byteVal _ = wordToWord8# 0x51##+    {-# INLINE byteVal #-}+instance ByteVal 0x52 where+    byteVal _ = wordToWord8# 0x52##+    {-# INLINE byteVal #-}+instance ByteVal 0x53 where+    byteVal _ = wordToWord8# 0x53##+    {-# INLINE byteVal #-}+instance ByteVal 0x54 where+    byteVal _ = wordToWord8# 0x54##+    {-# INLINE byteVal #-}+instance ByteVal 0x55 where+    byteVal _ = wordToWord8# 0x55##+    {-# INLINE byteVal #-}+instance ByteVal 0x56 where+    byteVal _ = wordToWord8# 0x56##+    {-# INLINE byteVal #-}+instance ByteVal 0x57 where+    byteVal _ = wordToWord8# 0x57##+    {-# INLINE byteVal #-}+instance ByteVal 0x58 where+    byteVal _ = wordToWord8# 0x58##+    {-# INLINE byteVal #-}+instance ByteVal 0x59 where+    byteVal _ = wordToWord8# 0x59##+    {-# INLINE byteVal #-}+instance ByteVal 0x5a where+    byteVal _ = wordToWord8# 0x5a##+    {-# INLINE byteVal #-}+instance ByteVal 0x5b where+    byteVal _ = wordToWord8# 0x5b##+    {-# INLINE byteVal #-}+instance ByteVal 0x5c where+    byteVal _ = wordToWord8# 0x5c##+    {-# INLINE byteVal #-}+instance ByteVal 0x5d where+    byteVal _ = wordToWord8# 0x5d##+    {-# INLINE byteVal #-}+instance ByteVal 0x5e where+    byteVal _ = wordToWord8# 0x5e##+    {-# INLINE byteVal #-}+instance ByteVal 0x5f where+    byteVal _ = wordToWord8# 0x5f##+    {-# INLINE byteVal #-}+instance ByteVal 0x60 where+    byteVal _ = wordToWord8# 0x60##+    {-# INLINE byteVal #-}+instance ByteVal 0x61 where+    byteVal _ = wordToWord8# 0x61##+    {-# INLINE byteVal #-}+instance ByteVal 0x62 where+    byteVal _ = wordToWord8# 0x62##+    {-# INLINE byteVal #-}+instance ByteVal 0x63 where+    byteVal _ = wordToWord8# 0x63##+    {-# INLINE byteVal #-}+instance ByteVal 0x64 where+    byteVal _ = wordToWord8# 0x64##+    {-# INLINE byteVal #-}+instance ByteVal 0x65 where+    byteVal _ = wordToWord8# 0x65##+    {-# INLINE byteVal #-}+instance ByteVal 0x66 where+    byteVal _ = wordToWord8# 0x66##+    {-# INLINE byteVal #-}+instance ByteVal 0x67 where+    byteVal _ = wordToWord8# 0x67##+    {-# INLINE byteVal #-}+instance ByteVal 0x68 where+    byteVal _ = wordToWord8# 0x68##+    {-# INLINE byteVal #-}+instance ByteVal 0x69 where+    byteVal _ = wordToWord8# 0x69##+    {-# INLINE byteVal #-}+instance ByteVal 0x6a where+    byteVal _ = wordToWord8# 0x6a##+    {-# INLINE byteVal #-}+instance ByteVal 0x6b where+    byteVal _ = wordToWord8# 0x6b##+    {-# INLINE byteVal #-}+instance ByteVal 0x6c where+    byteVal _ = wordToWord8# 0x6c##+    {-# INLINE byteVal #-}+instance ByteVal 0x6d where+    byteVal _ = wordToWord8# 0x6d##+    {-# INLINE byteVal #-}+instance ByteVal 0x6e where+    byteVal _ = wordToWord8# 0x6e##+    {-# INLINE byteVal #-}+instance ByteVal 0x6f where+    byteVal _ = wordToWord8# 0x6f##+    {-# INLINE byteVal #-}+instance ByteVal 0x70 where+    byteVal _ = wordToWord8# 0x70##+    {-# INLINE byteVal #-}+instance ByteVal 0x71 where+    byteVal _ = wordToWord8# 0x71##+    {-# INLINE byteVal #-}+instance ByteVal 0x72 where+    byteVal _ = wordToWord8# 0x72##+    {-# INLINE byteVal #-}+instance ByteVal 0x73 where+    byteVal _ = wordToWord8# 0x73##+    {-# INLINE byteVal #-}+instance ByteVal 0x74 where+    byteVal _ = wordToWord8# 0x74##+    {-# INLINE byteVal #-}+instance ByteVal 0x75 where+    byteVal _ = wordToWord8# 0x75##+    {-# INLINE byteVal #-}+instance ByteVal 0x76 where+    byteVal _ = wordToWord8# 0x76##+    {-# INLINE byteVal #-}+instance ByteVal 0x77 where+    byteVal _ = wordToWord8# 0x77##+    {-# INLINE byteVal #-}+instance ByteVal 0x78 where+    byteVal _ = wordToWord8# 0x78##+    {-# INLINE byteVal #-}+instance ByteVal 0x79 where+    byteVal _ = wordToWord8# 0x79##+    {-# INLINE byteVal #-}+instance ByteVal 0x7a where+    byteVal _ = wordToWord8# 0x7a##+    {-# INLINE byteVal #-}+instance ByteVal 0x7b where+    byteVal _ = wordToWord8# 0x7b##+    {-# INLINE byteVal #-}+instance ByteVal 0x7c where+    byteVal _ = wordToWord8# 0x7c##+    {-# INLINE byteVal #-}+instance ByteVal 0x7d where+    byteVal _ = wordToWord8# 0x7d##+    {-# INLINE byteVal #-}+instance ByteVal 0x7e where+    byteVal _ = wordToWord8# 0x7e##+    {-# INLINE byteVal #-}+instance ByteVal 0x7f where+    byteVal _ = wordToWord8# 0x7f##+    {-# INLINE byteVal #-}+instance ByteVal 0x80 where+    byteVal _ = wordToWord8# 0x80##+    {-# INLINE byteVal #-}+instance ByteVal 0x81 where+    byteVal _ = wordToWord8# 0x81##+    {-# INLINE byteVal #-}+instance ByteVal 0x82 where+    byteVal _ = wordToWord8# 0x82##+    {-# INLINE byteVal #-}+instance ByteVal 0x83 where+    byteVal _ = wordToWord8# 0x83##+    {-# INLINE byteVal #-}+instance ByteVal 0x84 where+    byteVal _ = wordToWord8# 0x84##+    {-# INLINE byteVal #-}+instance ByteVal 0x85 where+    byteVal _ = wordToWord8# 0x85##+    {-# INLINE byteVal #-}+instance ByteVal 0x86 where+    byteVal _ = wordToWord8# 0x86##+    {-# INLINE byteVal #-}+instance ByteVal 0x87 where+    byteVal _ = wordToWord8# 0x87##+    {-# INLINE byteVal #-}+instance ByteVal 0x88 where+    byteVal _ = wordToWord8# 0x88##+    {-# INLINE byteVal #-}+instance ByteVal 0x89 where+    byteVal _ = wordToWord8# 0x89##+    {-# INLINE byteVal #-}+instance ByteVal 0x8a where+    byteVal _ = wordToWord8# 0x8a##+    {-# INLINE byteVal #-}+instance ByteVal 0x8b where+    byteVal _ = wordToWord8# 0x8b##+    {-# INLINE byteVal #-}+instance ByteVal 0x8c where+    byteVal _ = wordToWord8# 0x8c##+    {-# INLINE byteVal #-}+instance ByteVal 0x8d where+    byteVal _ = wordToWord8# 0x8d##+    {-# INLINE byteVal #-}+instance ByteVal 0x8e where+    byteVal _ = wordToWord8# 0x8e##+    {-# INLINE byteVal #-}+instance ByteVal 0x8f where+    byteVal _ = wordToWord8# 0x8f##+    {-# INLINE byteVal #-}+instance ByteVal 0x90 where+    byteVal _ = wordToWord8# 0x90##+    {-# INLINE byteVal #-}+instance ByteVal 0x91 where+    byteVal _ = wordToWord8# 0x91##+    {-# INLINE byteVal #-}+instance ByteVal 0x92 where+    byteVal _ = wordToWord8# 0x92##+    {-# INLINE byteVal #-}+instance ByteVal 0x93 where+    byteVal _ = wordToWord8# 0x93##+    {-# INLINE byteVal #-}+instance ByteVal 0x94 where+    byteVal _ = wordToWord8# 0x94##+    {-# INLINE byteVal #-}+instance ByteVal 0x95 where+    byteVal _ = wordToWord8# 0x95##+    {-# INLINE byteVal #-}+instance ByteVal 0x96 where+    byteVal _ = wordToWord8# 0x96##+    {-# INLINE byteVal #-}+instance ByteVal 0x97 where+    byteVal _ = wordToWord8# 0x97##+    {-# INLINE byteVal #-}+instance ByteVal 0x98 where+    byteVal _ = wordToWord8# 0x98##+    {-# INLINE byteVal #-}+instance ByteVal 0x99 where+    byteVal _ = wordToWord8# 0x99##+    {-# INLINE byteVal #-}+instance ByteVal 0x9a where+    byteVal _ = wordToWord8# 0x9a##+    {-# INLINE byteVal #-}+instance ByteVal 0x9b where+    byteVal _ = wordToWord8# 0x9b##+    {-# INLINE byteVal #-}+instance ByteVal 0x9c where+    byteVal _ = wordToWord8# 0x9c##+    {-# INLINE byteVal #-}+instance ByteVal 0x9d where+    byteVal _ = wordToWord8# 0x9d##+    {-# INLINE byteVal #-}+instance ByteVal 0x9e where+    byteVal _ = wordToWord8# 0x9e##+    {-# INLINE byteVal #-}+instance ByteVal 0x9f where+    byteVal _ = wordToWord8# 0x9f##+    {-# INLINE byteVal #-}+instance ByteVal 0xa0 where+    byteVal _ = wordToWord8# 0xa0##+    {-# INLINE byteVal #-}+instance ByteVal 0xa1 where+    byteVal _ = wordToWord8# 0xa1##+    {-# INLINE byteVal #-}+instance ByteVal 0xa2 where+    byteVal _ = wordToWord8# 0xa2##+    {-# INLINE byteVal #-}+instance ByteVal 0xa3 where+    byteVal _ = wordToWord8# 0xa3##+    {-# INLINE byteVal #-}+instance ByteVal 0xa4 where+    byteVal _ = wordToWord8# 0xa4##+    {-# INLINE byteVal #-}+instance ByteVal 0xa5 where+    byteVal _ = wordToWord8# 0xa5##+    {-# INLINE byteVal #-}+instance ByteVal 0xa6 where+    byteVal _ = wordToWord8# 0xa6##+    {-# INLINE byteVal #-}+instance ByteVal 0xa7 where+    byteVal _ = wordToWord8# 0xa7##+    {-# INLINE byteVal #-}+instance ByteVal 0xa8 where+    byteVal _ = wordToWord8# 0xa8##+    {-# INLINE byteVal #-}+instance ByteVal 0xa9 where+    byteVal _ = wordToWord8# 0xa9##+    {-# INLINE byteVal #-}+instance ByteVal 0xaa where+    byteVal _ = wordToWord8# 0xaa##+    {-# INLINE byteVal #-}+instance ByteVal 0xab where+    byteVal _ = wordToWord8# 0xab##+    {-# INLINE byteVal #-}+instance ByteVal 0xac where+    byteVal _ = wordToWord8# 0xac##+    {-# INLINE byteVal #-}+instance ByteVal 0xad where+    byteVal _ = wordToWord8# 0xad##+    {-# INLINE byteVal #-}+instance ByteVal 0xae where+    byteVal _ = wordToWord8# 0xae##+    {-# INLINE byteVal #-}+instance ByteVal 0xaf where+    byteVal _ = wordToWord8# 0xaf##+    {-# INLINE byteVal #-}+instance ByteVal 0xb0 where+    byteVal _ = wordToWord8# 0xb0##+    {-# INLINE byteVal #-}+instance ByteVal 0xb1 where+    byteVal _ = wordToWord8# 0xb1##+    {-# INLINE byteVal #-}+instance ByteVal 0xb2 where+    byteVal _ = wordToWord8# 0xb2##+    {-# INLINE byteVal #-}+instance ByteVal 0xb3 where+    byteVal _ = wordToWord8# 0xb3##+    {-# INLINE byteVal #-}+instance ByteVal 0xb4 where+    byteVal _ = wordToWord8# 0xb4##+    {-# INLINE byteVal #-}+instance ByteVal 0xb5 where+    byteVal _ = wordToWord8# 0xb5##+    {-# INLINE byteVal #-}+instance ByteVal 0xb6 where+    byteVal _ = wordToWord8# 0xb6##+    {-# INLINE byteVal #-}+instance ByteVal 0xb7 where+    byteVal _ = wordToWord8# 0xb7##+    {-# INLINE byteVal #-}+instance ByteVal 0xb8 where+    byteVal _ = wordToWord8# 0xb8##+    {-# INLINE byteVal #-}+instance ByteVal 0xb9 where+    byteVal _ = wordToWord8# 0xb9##+    {-# INLINE byteVal #-}+instance ByteVal 0xba where+    byteVal _ = wordToWord8# 0xba##+    {-# INLINE byteVal #-}+instance ByteVal 0xbb where+    byteVal _ = wordToWord8# 0xbb##+    {-# INLINE byteVal #-}+instance ByteVal 0xbc where+    byteVal _ = wordToWord8# 0xbc##+    {-# INLINE byteVal #-}+instance ByteVal 0xbd where+    byteVal _ = wordToWord8# 0xbd##+    {-# INLINE byteVal #-}+instance ByteVal 0xbe where+    byteVal _ = wordToWord8# 0xbe##+    {-# INLINE byteVal #-}+instance ByteVal 0xbf where+    byteVal _ = wordToWord8# 0xbf##+    {-# INLINE byteVal #-}+instance ByteVal 0xc0 where+    byteVal _ = wordToWord8# 0xc0##+    {-# INLINE byteVal #-}+instance ByteVal 0xc1 where+    byteVal _ = wordToWord8# 0xc1##+    {-# INLINE byteVal #-}+instance ByteVal 0xc2 where+    byteVal _ = wordToWord8# 0xc2##+    {-# INLINE byteVal #-}+instance ByteVal 0xc3 where+    byteVal _ = wordToWord8# 0xc3##+    {-# INLINE byteVal #-}+instance ByteVal 0xc4 where+    byteVal _ = wordToWord8# 0xc4##+    {-# INLINE byteVal #-}+instance ByteVal 0xc5 where+    byteVal _ = wordToWord8# 0xc5##+    {-# INLINE byteVal #-}+instance ByteVal 0xc6 where+    byteVal _ = wordToWord8# 0xc6##+    {-# INLINE byteVal #-}+instance ByteVal 0xc7 where+    byteVal _ = wordToWord8# 0xc7##+    {-# INLINE byteVal #-}+instance ByteVal 0xc8 where+    byteVal _ = wordToWord8# 0xc8##+    {-# INLINE byteVal #-}+instance ByteVal 0xc9 where+    byteVal _ = wordToWord8# 0xc9##+    {-# INLINE byteVal #-}+instance ByteVal 0xca where+    byteVal _ = wordToWord8# 0xca##+    {-# INLINE byteVal #-}+instance ByteVal 0xcb where+    byteVal _ = wordToWord8# 0xcb##+    {-# INLINE byteVal #-}+instance ByteVal 0xcc where+    byteVal _ = wordToWord8# 0xcc##+    {-# INLINE byteVal #-}+instance ByteVal 0xcd where+    byteVal _ = wordToWord8# 0xcd##+    {-# INLINE byteVal #-}+instance ByteVal 0xce where+    byteVal _ = wordToWord8# 0xce##+    {-# INLINE byteVal #-}+instance ByteVal 0xcf where+    byteVal _ = wordToWord8# 0xcf##+    {-# INLINE byteVal #-}+instance ByteVal 0xd0 where+    byteVal _ = wordToWord8# 0xd0##+    {-# INLINE byteVal #-}+instance ByteVal 0xd1 where+    byteVal _ = wordToWord8# 0xd1##+    {-# INLINE byteVal #-}+instance ByteVal 0xd2 where+    byteVal _ = wordToWord8# 0xd2##+    {-# INLINE byteVal #-}+instance ByteVal 0xd3 where+    byteVal _ = wordToWord8# 0xd3##+    {-# INLINE byteVal #-}+instance ByteVal 0xd4 where+    byteVal _ = wordToWord8# 0xd4##+    {-# INLINE byteVal #-}+instance ByteVal 0xd5 where+    byteVal _ = wordToWord8# 0xd5##+    {-# INLINE byteVal #-}+instance ByteVal 0xd6 where+    byteVal _ = wordToWord8# 0xd6##+    {-# INLINE byteVal #-}+instance ByteVal 0xd7 where+    byteVal _ = wordToWord8# 0xd7##+    {-# INLINE byteVal #-}+instance ByteVal 0xd8 where+    byteVal _ = wordToWord8# 0xd8##+    {-# INLINE byteVal #-}+instance ByteVal 0xd9 where+    byteVal _ = wordToWord8# 0xd9##+    {-# INLINE byteVal #-}+instance ByteVal 0xda where+    byteVal _ = wordToWord8# 0xda##+    {-# INLINE byteVal #-}+instance ByteVal 0xdb where+    byteVal _ = wordToWord8# 0xdb##+    {-# INLINE byteVal #-}+instance ByteVal 0xdc where+    byteVal _ = wordToWord8# 0xdc##+    {-# INLINE byteVal #-}+instance ByteVal 0xdd where+    byteVal _ = wordToWord8# 0xdd##+    {-# INLINE byteVal #-}+instance ByteVal 0xde where+    byteVal _ = wordToWord8# 0xde##+    {-# INLINE byteVal #-}+instance ByteVal 0xdf where+    byteVal _ = wordToWord8# 0xdf##+    {-# INLINE byteVal #-}+instance ByteVal 0xe0 where+    byteVal _ = wordToWord8# 0xe0##+    {-# INLINE byteVal #-}+instance ByteVal 0xe1 where+    byteVal _ = wordToWord8# 0xe1##+    {-# INLINE byteVal #-}+instance ByteVal 0xe2 where+    byteVal _ = wordToWord8# 0xe2##+    {-# INLINE byteVal #-}+instance ByteVal 0xe3 where+    byteVal _ = wordToWord8# 0xe3##+    {-# INLINE byteVal #-}+instance ByteVal 0xe4 where+    byteVal _ = wordToWord8# 0xe4##+    {-# INLINE byteVal #-}+instance ByteVal 0xe5 where+    byteVal _ = wordToWord8# 0xe5##+    {-# INLINE byteVal #-}+instance ByteVal 0xe6 where+    byteVal _ = wordToWord8# 0xe6##+    {-# INLINE byteVal #-}+instance ByteVal 0xe7 where+    byteVal _ = wordToWord8# 0xe7##+    {-# INLINE byteVal #-}+instance ByteVal 0xe8 where+    byteVal _ = wordToWord8# 0xe8##+    {-# INLINE byteVal #-}+instance ByteVal 0xe9 where+    byteVal _ = wordToWord8# 0xe9##+    {-# INLINE byteVal #-}+instance ByteVal 0xea where+    byteVal _ = wordToWord8# 0xea##+    {-# INLINE byteVal #-}+instance ByteVal 0xeb where+    byteVal _ = wordToWord8# 0xeb##+    {-# INLINE byteVal #-}+instance ByteVal 0xec where+    byteVal _ = wordToWord8# 0xec##+    {-# INLINE byteVal #-}+instance ByteVal 0xed where+    byteVal _ = wordToWord8# 0xed##+    {-# INLINE byteVal #-}+instance ByteVal 0xee where+    byteVal _ = wordToWord8# 0xee##+    {-# INLINE byteVal #-}+instance ByteVal 0xef where+    byteVal _ = wordToWord8# 0xef##+    {-# INLINE byteVal #-}+instance ByteVal 0xf0 where+    byteVal _ = wordToWord8# 0xf0##+    {-# INLINE byteVal #-}+instance ByteVal 0xf1 where+    byteVal _ = wordToWord8# 0xf1##+    {-# INLINE byteVal #-}+instance ByteVal 0xf2 where+    byteVal _ = wordToWord8# 0xf2##+    {-# INLINE byteVal #-}+instance ByteVal 0xf3 where+    byteVal _ = wordToWord8# 0xf3##+    {-# INLINE byteVal #-}+instance ByteVal 0xf4 where+    byteVal _ = wordToWord8# 0xf4##+    {-# INLINE byteVal #-}+instance ByteVal 0xf5 where+    byteVal _ = wordToWord8# 0xf5##+    {-# INLINE byteVal #-}+instance ByteVal 0xf6 where+    byteVal _ = wordToWord8# 0xf6##+    {-# INLINE byteVal #-}+instance ByteVal 0xf7 where+    byteVal _ = wordToWord8# 0xf7##+    {-# INLINE byteVal #-}+instance ByteVal 0xf8 where+    byteVal _ = wordToWord8# 0xf8##+    {-# INLINE byteVal #-}+instance ByteVal 0xf9 where+    byteVal _ = wordToWord8# 0xf9##+    {-# INLINE byteVal #-}+instance ByteVal 0xfa where+    byteVal _ = wordToWord8# 0xfa##+    {-# INLINE byteVal #-}+instance ByteVal 0xfb where+    byteVal _ = wordToWord8# 0xfb##+    {-# INLINE byteVal #-}+instance ByteVal 0xfc where+    byteVal _ = wordToWord8# 0xfc##+    {-# INLINE byteVal #-}+instance ByteVal 0xfd where+    byteVal _ = wordToWord8# 0xfd##+    {-# INLINE byteVal #-}+instance ByteVal 0xfe where+    byteVal _ = wordToWord8# 0xfe##+    {-# INLINE byteVal #-}+instance ByteVal 0xff where+    byteVal _ = wordToWord8# 0xff##+    {-# INLINE byteVal #-}++type family Length (a :: [k]) :: Natural where+    Length '[]       = 0+    Length (a ': as) = 1 + Length as++-- | Efficiently reify a list of type-level 'Byte's to a bytestring builder.+--+-- This is about as far as one should go for pointless performance here, I+-- should think.+class ByteVals (ns :: [Natural]) where byteVals :: Builder+instance (n ~ Length ns, KnownNat n, WriteByteVals ns) => ByteVals ns where+    byteVals = Mason.primFixed (BI.fixedPrim (fromIntegral n) go) ()+      where+        n = natVal'' @n+        go = \() (Ptr p#) -> writeByteVals @ns p#++class WriteByteVals (ns :: [Natural]) where writeByteVals :: Addr# -> IO ()+instance WriteByteVals '[] where writeByteVals _ = pure ()+instance (ByteVal n, WriteByteVals ns) => WriteByteVals (n ': ns) where+    writeByteVals p# =+        case runRW# (writeWord8OffAddr# p# 0# w#) of+          _ -> writeByteVals @ns (plusAddr# p# 1#)+      where w# = byteVal @n proxy#

@@ -0,0 +1,101 @@+{- | Machine bytestrings.++I mix string and bytestring terminology here due to bad C influences, but this+module is specifically interested in bytestrings and their encoding. String/text+encoding is handled in another module.++Note that the length prefix predicate is also defined here... because that's+just Pascal-style bytestrings, extended to other types. I can't easily put it in+an orphan module, because we define byte length for *all length-prefixed types*+in one fell swoop.+-}++-- TODO redocument. pretty all over the place++{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE OverloadedStrings #-}++module Binrep.Type.ByteString where++import Binrep+import Binrep.Type.Common ( Endianness )+import Binrep.Type.Int+import Binrep.Util++import Refined+import Refined.Unsafe++import Data.ByteString qualified as B+import FlatParse.Basic qualified as FP+import FlatParse.Basic ( Parser )+import Data.Word ( Word8 )+import GHC.TypeNats ( KnownNat )++import GHC.Generics ( Generic )+import Data.Data ( Data )++import Data.Typeable ( Typeable, typeRep )++-- | Bytestring representation.+data Rep+  = C+  -- ^ C-style bytestring. Arbitrary length, terminated with a null byte.+  --   Permits no null bytes inside the bytestring.++  | Pascal ISize Endianness+  -- ^ Pascal-style bytestring. Length defined in a prefixing integer of given+  --   size and endianness.+    deriving stock (Generic, Data, Show, Eq)++-- | A bytestring using the given representation, stored in the 'Text' type.+type AsByteString (rep :: Rep) = Refined rep B.ByteString++getCString :: Parser String B.ByteString+getCString = FP.anyCString++instance BLen (AsByteString 'C) where+    blen cbs = posIntToBLen $ B.length (unrefine cbs) + 1++instance Put (AsByteString 'C) where+    put = putCString . unrefine++putCString :: B.ByteString -> Builder+putCString bs = put bs <> put @Word8 0x00++instance Get (AsByteString 'C) where+    get = reallyUnsafeRefine <$> getCString++instance (itype ~ I 'U size end, irep ~ IRep 'U size, KnownNat (CBLen irep)) => BLen (AsByteString ('Pascal size end)) where+    blen pbs = cblen @itype + blen (unrefine pbs)++instance (itype ~ I 'U size end, irep ~ IRep 'U size, Put itype, Num irep) => Put (AsByteString ('Pascal size end)) where+    put pbs = put @itype (fromIntegral (B.length bs)) <> put bs+      where bs = unrefine pbs++instance (itype ~ I 'U size end, irep ~ IRep 'U size, Integral irep, Get itype) => Get (AsByteString ('Pascal size end)) where+    get = do+        len <- get @itype+        bs <- FP.takeBs $ fromIntegral len+        return $ reallyUnsafeRefine bs++-- | A C-style bytestring must not contain any null bytes.+instance Predicate 'C B.ByteString where+    validate p bs+     | B.any (== 0x00) bs = throwRefineOtherException (typeRep p) $+        "null byte not permitted in in C-style bytestring"+     | otherwise = success++instance+    ( irep ~ IRep 'U size+    , Bounded irep, Integral irep+    , Show irep, Typeable size, Typeable e+    ) => Predicate ('Pascal size e) B.ByteString where+    validate p bs+     | len > fromIntegral max'+        = throwRefineOtherException (typeRep p) $+              "bytestring too long for given length prefix type: "+            <>tshow len<>" > "<>tshow max'+     | otherwise = success+      where+        len  = B.length bs+        max' = maxBound @irep

@@ -0,0 +1,10 @@+module Binrep.Type.Common where++import GHC.Generics ( Generic )+import Data.Data ( Data )++-- | Byte order.+data Endianness+  = BE -- ^    big endian, MSB first. e.g. most network protocols+  | LE -- ^ little endian, MSB last.  e.g. most processor architectures+    deriving stock (Generic, Data, Show, Eq)

@@ -0,0 +1,142 @@+{-# LANGUAGE UndecidableInstances #-}++{- TODO can I replace this with a closed newtype family?? idk if I even want to+    it's just this is clumsy to use sometimes+-}++module Binrep.Type.Int where++import Binrep+import Binrep.Type.Common ( Endianness(..) )+import Strongweak++import Data.Word+import Data.Int+import Data.Aeson+import FlatParse.Basic qualified as FP+import Mason.Builder qualified as Mason++import GHC.Generics ( Generic )+import Data.Data ( Typeable, Data )+import GHC.TypeNats++-- | Wrapper type grouping machine integers (sign, size) along with an explicit+--   endianness.+--+-- The internal representation is selected via a type family to correspond to+-- the relevant Haskell data type, so common overflow behaviour should match.+-- We derive lots of handy instances, so you may perform regular arithmetic on+-- pairs of these types. For example:+--+-- >>> 255 + 1 :: I 'U 'I1 e+-- 0+--+-- >>> 255 + 1 :: I 'U 'I2 e+-- 256+newtype I (sign :: ISign) (size :: ISize) (e :: Endianness)+  = I { getI :: IRep sign size }+    deriving stock (Generic)++deriving instance (Data (IRep sign size), Typeable sign, Typeable size, Typeable e) => Data (I sign size e)+deriving via (IRep sign size) instance Show     (IRep sign size) => Show     (I sign size e)++-- Steal various numeric instances from the representation types.+deriving via (IRep sign size) instance Eq       (IRep sign size) => Eq       (I sign size e)+deriving via (IRep sign size) instance Ord      (IRep sign size) => Ord      (I sign size e)+deriving via (IRep sign size) instance Bounded  (IRep sign size) => Bounded  (I sign size e)+deriving via (IRep sign size) instance Num      (IRep sign size) => Num      (I sign size e)+deriving via (IRep sign size) instance Real     (IRep sign size) => Real     (I sign size e)+deriving via (IRep sign size) instance Enum     (IRep sign size) => Enum     (I sign size e)+deriving via (IRep sign size) instance Integral (IRep sign size) => Integral (I sign size e)++-- | Unsigned machine integers can be idealized as naturals.+instance (irep ~ IRep 'U size, Integral irep) => Weaken (I 'U size end) where+    type Weak (I 'U size end) = Natural+    weaken = fromIntegral+instance (irep ~ IRep 'U size, Integral irep, Bounded irep, Show irep, Typeable size, Typeable end)+  => Strengthen (I 'U size end) where+      strengthen = strengthenBounded++-- | Signed machine integers can be idealized as integers.+instance (irep ~ IRep 'S size, Integral irep) => Weaken (I 'S size end) where+    type Weak (I 'S size end) = Integer+    weaken = fromIntegral+instance (irep ~ IRep 'S size, Integral irep, Bounded irep, Show irep, Typeable size, Typeable end)+  => Strengthen (I 'S size end) where+      strengthen = strengthenBounded++-- | Machine integer sign.+data ISign+  = S -- ^   signed+  | U -- ^ unsigned+    deriving stock (Generic, Data, Show, Eq)++-- | Machine integer size in number of bytes.+data ISize = I1 | I2 | I4 | I8+    deriving stock (Generic, Data, Show, Eq)++-- | Grouping for matching a signedness and size to a Haskell integer data type.+type family IRep (sign :: ISign) (size :: ISize) where+    IRep 'U 'I1 = Word8+    IRep 'S 'I1 =  Int8+    IRep 'U 'I2 = Word16+    IRep 'S 'I2 =  Int16+    IRep 'U 'I4 = Word32+    IRep 'S 'I4 =  Int32+    IRep 'U 'I8 = Word64+    IRep 'S 'I8 =  Int64++-- Also steal Aeson instances. The parser applies bounding checks appropriately.+deriving via (IRep sign size) instance ToJSON   (IRep sign size) => ToJSON   (I sign size e)+deriving via (IRep sign size) instance FromJSON (IRep sign size) => FromJSON (I sign size e)++type instance CBLen (I sign size end) = CBLen (IRep sign size)++deriving anyclass instance KnownNat (CBLen (I sign size end)) => BLen (I sign size end)++instance Put (I 'U 'I1 e) where put = put . getI+instance Get (I 'U 'I1 e) where get = I <$> get+instance Put (I 'S 'I1 e) where put = put . getI+instance Get (I 'S 'I1 e) where get = I <$> get++instance Put (I 'U 'I2 'BE) where put (I i) = Mason.word16BE i+instance Get (I 'U 'I2 'BE) where get = I <$> FP.anyWord16be+instance Put (I 'U 'I2 'LE) where put (I i) = Mason.word16LE i+instance Get (I 'U 'I2 'LE) where get = I <$> FP.anyWord16le+instance Put (I 'S 'I2 'BE) where put (I i) = Mason.int16BE i+instance Get (I 'S 'I2 'BE) where get = I <$> FP.anyInt16be+instance Put (I 'S 'I2 'LE) where put (I i) = Mason.int16LE i+instance Get (I 'S 'I2 'LE) where get = I <$> FP.anyInt16le++instance Put (I 'U 'I4 'BE) where put (I i) = Mason.word32BE i+instance Get (I 'U 'I4 'BE) where get = I <$> FP.anyWord32be+instance Put (I 'U 'I4 'LE) where put (I i) = Mason.word32LE i+instance Get (I 'U 'I4 'LE) where get = I <$> FP.anyWord32le+instance Put (I 'S 'I4 'BE) where put (I i) = Mason.int32BE i+instance Get (I 'S 'I4 'BE) where get = I <$> FP.anyInt32be+instance Put (I 'S 'I4 'LE) where put (I i) = Mason.int32LE i+instance Get (I 'S 'I4 'LE) where get = I <$> FP.anyInt32le++instance Put (I 'U 'I8 'BE) where put (I i) = Mason.word64BE i+instance Get (I 'U 'I8 'BE) where get = I <$> FP.anyWord64be+instance Put (I 'U 'I8 'LE) where put (I i) = Mason.word64LE i+instance Get (I 'U 'I8 'LE) where get = I <$> FP.anyWord64le+instance Put (I 'S 'I8 'BE) where put (I i) = Mason.int64BE i+instance Get (I 'S 'I8 'BE) where get = I <$> FP.anyInt64be+instance Put (I 'S 'I8 'LE) where put (I i) = Mason.int64LE i+instance Get (I 'S 'I8 'LE) where get = I <$> FP.anyInt64le++-- | Shortcut.+type family IMax (sign :: ISign) (size :: ISize) :: Natural where+    IMax sign size = MaxBound (IRep sign size)++-- | Restricted reflected version of @maxBound@.+type family MaxBound w :: Natural where+    MaxBound Word8  = 255+    MaxBound  Int8  = 127+    MaxBound Word16 = 65535+    MaxBound  Int16 = 32767+    MaxBound Word32 = 4294967295+    MaxBound  Int32 = 2147483647+    MaxBound Word64 = 18446744073709551615+    MaxBound  Int64 = 9223372036854775807

@@ -0,0 +1,110 @@+-- TODO cleanup proxy usage (can we be faster via unboxed @Proxy#@ s ?)++{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE UndecidableInstances #-}++module Binrep.Type.LenPfx where++import Binrep+import Strongweak+import Data.Either.Validation+import Binrep.Type.Vector ( getVector )+import Binrep.Type.Common ( Endianness )+import Binrep.Type.Int+import Binrep.Util ( natVal'' )+import Data.Vector.Sized ( Vector )+import Data.Vector.Sized qualified as V+import GHC.TypeNats+import GHC.TypeLits ( OrderingI(..) )+import Data.Proxy ( Proxy(..) )++import GHC.Generics+import Data.Typeable ( Typeable )++-- | Holy shit - no need to do a smart constructor, it's simply impossible to+--   instantiate invalid values of this type!+data LenPfx (size :: ISize) (end :: Endianness) a =+    forall n. (KnownNat n, n <= IMax 'U size) => LenPfx { unLenPfx :: Vector n a }++-- uhhhhhhhhhh i dunno. TODO+instance Generic (LenPfx size end a) where+    type Rep (LenPfx size end a) = Rec0 (LenPfx size end a)+    from = K1+    to = unK1++instance Eq a => Eq (LenPfx size end a) where+    (LenPfx a) == (LenPfx b) = vsEq a b++-- TODO+instance Show a => Show (LenPfx size end a) where+    show (LenPfx a) = "LenPfx ("<>show a<>")"++vsEq :: forall a n m. (Eq a, KnownNat n, KnownNat m) => Vector n a -> Vector m a -> Bool+vsEq vn vm =+    if   natVal'' @n == natVal'' @m+    then V.toList vn == V.toList vm+    else False++instance Weaken (LenPfx size end a) where+    type Weak (LenPfx size end a) = [a]+    weaken (LenPfx v) = V.toList v++instance (KnownNat (MaxBound (IRep 'U size)), Show a, Typeable a, Typeable size, Typeable end)+  => Strengthen (LenPfx size end a) where+    strengthen l = case lenPfxFromList l of+                     Nothing -> strengthenFailBase l "TODO doesn't fit"+                     Just v  -> Success v++asLenPfx+    :: forall size end n a irep+    .  (irep ~ IRep 'U size, KnownNat n, KnownNat (MaxBound irep))+    => Vector n a -> Maybe (LenPfx size end a)+asLenPfx v =+    case cmpNat (Proxy :: Proxy n) (Proxy :: Proxy (MaxBound (IRep 'U size))) of+      LTI -> Just $ LenPfx v+      EQI -> Just $ LenPfx v+      GTI -> Nothing++lenPfxFromList+    :: forall size end a irep+    .  (irep ~ IRep 'U size, KnownNat (MaxBound irep))+    => [a] -> Maybe (LenPfx size end a)+lenPfxFromList l = V.withSizedList l asLenPfx++instance (BLen a, itype ~ I 'U size end, KnownNat (CBLen itype))+  => BLen (LenPfx size end a) where+    blen (LenPfx v) = cblen @itype + blen v++instance (itype ~ I 'U size end, irep ~ IRep 'U size, Put a, Put itype, Num irep)+  => Put (LenPfx size end a) where+    put (LenPfx v) = put @itype (fromIntegral (vnatVal v)) <> put v+      where+        vnatVal :: forall n x. KnownNat n => Vector n x -> Natural+        vnatVal _ = natVal'' @n++lenPfxSize :: Num (IRep 'U size) => LenPfx size end a -> I 'U size end+lenPfxSize (LenPfx v) = fromIntegral (vnatVal v)+  where+    vnatVal :: forall n x. KnownNat n => Vector n x -> Natural+    vnatVal _ = natVal'' @n++instance (itype ~ I 'U size end, irep ~ IRep 'U size, Get itype, Integral irep, Get a, KnownNat (MaxBound irep))+  => Get (LenPfx size end a) where+    get = getLenPfx get++getLenPfx+    :: forall size end a itype irep+    .  (itype ~ I 'U size end, irep ~ IRep 'U size, Get itype, Integral irep, KnownNat (MaxBound irep))+    => Getter a -> Getter (LenPfx size end a)+getLenPfx g = do+    len <- get @itype+    case someNatVal (fromIntegral len) of+      SomeNat (Proxy :: Proxy n) -> do+        x <- getVector @n g+        -- TODO we actually know that @n <= MaxBound irep@ before doing this+        -- because @len <= maxBound (_ :: irep)@ but that's hard to prove to+        -- GHC without lots of refactoring. This is good enough.+        case cmpNat (Proxy :: Proxy n) (Proxy :: Proxy (MaxBound irep)) of+          GTI -> error "impossible"+          LTI -> return $ LenPfx x+          EQI -> return $ LenPfx x

@@ -0,0 +1,97 @@+{-# LANGUAGE UndecidableInstances #-}++{- | Magic numbers (also just magic): short constant bytestrings usually+     found at the top of a file, included as a safety check for parsing.++TODO rename: MagicBytes -> MagicVals, and have ByteVal be a "consumer" of+MagicVals where each value must be a byte. (It's conceivable that we have+another consumer which makes each value into a non-empty list of bytes, LE/BE.)++TODO unassociated type fams bad (maybe). turn into class -- and turn the reifier+into a default method! (TODO think about this)++There are two main flavors of magics:++  * "random" bytes e.g. Zstandard: @28 B5 2F FD@+  * printable ASCII bytes e.g. Ogg: @4F 67 67 53@ -> OggS++For bytewise magics, use type-level 'Natural' lists.+For ASCII magics, use 'Symbol's (type-level strings).++Previously, I squashed these into a representationally-safe type. Now the check+only occurs during reification. So you are able to define invalid magics now+(bytes over 255, non-ASCII characters), and potentially use them, but you'll get+a clear type error like "no instance for ByteVal 256" when attempting to reify.++String magics are restricted to ASCII, and will type error during reification+otherwise. If you really want UTF-8, please read 'Binrep.Type.Magic.UTF8'.+-}++module Binrep.Type.Magic where++import Binrep+import Binrep.Type.Byte++import GHC.TypeLits+import Data.ByteString qualified as B+import FlatParse.Basic qualified as FP++import GHC.Generics ( Generic )+import Data.Data ( Data )++import Mason.Builder qualified as Mason++data Magic (a :: k) = Magic+    deriving stock (Generic, Data, Show, Eq)++-- | Assumes magic values are individual bytes.+type instance CBLen (Magic a) = Length (MagicVals a)++-- | Assumes magic values are individual bytes.+deriving anyclass instance KnownNat (Length (MagicVals a)) => BLen (Magic a)++-- | Forces magic values to be individual bytes.+instance (bs ~ MagicVals a, ByteVals bs) => Put (Magic a) where+    put Magic = byteVals @bs++-- | Forces magic values to be individual bytes.+--+-- TODO improve show - maybe hexbytestring goes here? lol+instance (bs ~ MagicVals a, ByteVals bs) => Get (Magic a) where+    get = do+        let expected = Mason.toStrictByteString $ byteVals @bs+        actual <- FP.takeBs $ B.length expected+        if   actual == expected+        then return Magic+        else FP.err $ "bad magic: expected "<>show expected<>", got "<>show actual++{-+I do lots of functions on lists, because they're structurally simple. But you+can't pass type-level functions as arguments between type families. singletons+solves a related (?) problem using defunctionalization, where you manually write+out the function applications or something. Essentially, you can't do this:++    type family Map (f :: x -> y) (a :: [x]) :: [y] where+        Map _ '[]       = '[]+        Map f (a ': as) = f a ': Map f as++So you have to write that out for every concrete function over lists.+-}++type family MagicVals (a :: k) :: [Natural]+type instance MagicVals (a :: Symbol)    = SymbolUnicodeCodepoints a+type instance MagicVals (a :: [Natural]) = a++type family SymbolUnicodeCodepoints (a :: Symbol) :: [Natural] where+    SymbolUnicodeCodepoints a = CharListUnicodeCodepoints (SymbolAsCharList a)++type family CharListUnicodeCodepoints (a :: [Char]) :: [Natural] where+    CharListUnicodeCodepoints '[]       = '[]+    CharListUnicodeCodepoints (c ': cs) = CharToNat c ': CharListUnicodeCodepoints cs++type family SymbolAsCharList (a :: Symbol) :: [Char] where+    SymbolAsCharList a = SymbolAsCharList' (UnconsSymbol a)++type family SymbolAsCharList' (a :: Maybe (Char, Symbol)) :: [Char] where+    SymbolAsCharList' 'Nothing = '[]+    SymbolAsCharList' ('Just '(c, s)) = c ': SymbolAsCharList' (UnconsSymbol s)

@@ -0,0 +1,47 @@+{- | Inefficient attempt at UTF-8 magics.++To encode UTF-8 strings to bytestrings at compile time, we really need more+support from the compiler. We can go @Char -> Natural@, but we can't go @Natural+-> [Natural]@ where each value is @<= 255@. Doing so is hard without bit+twiddling.++The best we can do is get reify the 'Symbol' directly, then encode as UTF-8 at+runtime. It's a bit of a farce, and we can't derive a 'CBLen' instance, but+works just fine. Actually, I dunno, it might be faster than the bytewise magic+handling, depending on how GHC optimizes its instances.+-}++{-# LANGUAGE AllowAmbiguousTypes #-}++module Binrep.Type.Magic.UTF8 where++import Binrep++import GHC.TypeLits+import GHC.Exts ( proxy#, Proxy# )+import Data.Text qualified as Text+import Data.Text.Encoding qualified as Text+import Data.ByteString qualified as B+import FlatParse.Basic qualified as FP++data MagicUTF8 (str :: Symbol) = MagicUTF8 deriving Show++symVal :: forall str. KnownSymbol str => String+symVal = symbolVal' (proxy# :: Proxy# str)++instance KnownSymbol str => BLen (MagicUTF8 str) where+    blen MagicUTF8 = posIntToBLen $ B.length $ encodeStringUtf8 $ symVal @str++instance KnownSymbol str => Put  (MagicUTF8 str) where+    put  MagicUTF8 = put $ encodeStringUtf8 $ symVal @str++instance KnownSymbol str => Get  (MagicUTF8 str) where+    get = do+        let expected = encodeStringUtf8 $ symVal @str+        actual <- FP.takeBs $ B.length expected+        if   actual == expected+        then return MagicUTF8+        else FP.err $ "bad magic: expected "<>show expected<>", got "<>show actual++encodeStringUtf8 :: String -> B.ByteString+encodeStringUtf8 = Text.encodeUtf8 . Text.pack

@@ -0,0 +1,70 @@+{-# LANGUAGE OverloadedStrings #-}++module Binrep.Type.NullPadded where++import Binrep+import Binrep.Util ( tshow )++import Refined+import Refined.Unsafe++import GHC.TypeNats+import Data.Typeable ( typeRep )+import FlatParse.Basic qualified as FP+import FlatParse.Basic ( Parser )+import Mason.Builder qualified as Mason+import Data.ByteString qualified as BS++data NullPad (n :: Natural)++type NullPadded n a = Refined (NullPad n) a++-- | The size of some null-padded data is known - at compile time!+type instance CBLen (NullPadded n a) = n++deriving anyclass instance KnownNat n => BLen (NullPadded n a)++instance (BLen a, KnownNat n) => Predicate (NullPad n) a where+    validate p a+      | len > n+          = throwRefineOtherException (typeRep p) $+                   "too long: " <> tshow len <> " > " <> tshow n+      | otherwise = success+      where+        n = typeNatToBLen @n+        len = blen a++-- TODO cleanup+instance (Put a, BLen a, KnownNat n) => Put (NullPadded n a) where+    put wrnpa =+        let npa = unrefine wrnpa+            paddingLength = n - blen npa+         in put npa <> Mason.byteString (BS.replicate (fromIntegral paddingLength) 0x00)+      where+        n = typeNatToBLen @n++-- | Safety: we assert actual length is within expected length (in order to+--   calculate how much padding to parse).+--+-- Note that the consumer probably doesn't care about the content of the+-- padding, just that the data is chunked correctly. I figure we care about+-- correctness here, so it'd be nice to know about the padding well-formedness+-- (i.e. that it's all nulls).+--+-- TODO maybe better definition via isolate+instance (Get a, BLen a, KnownNat n) => Get (NullPadded n a) where+    get = do+        a <- get+        let len = blen a+            nullStrLen = n - len+        if   nullStrLen < 0+        then FP.err $ "too long: " <> show len <> " > " <> show n+        else getNNulls nullStrLen >> return (reallyUnsafeRefine a)+      where+        n = typeNatToBLen @n++getNNulls :: BLenT -> Parser String ()+getNNulls = \case 0 -> return ()+                  n -> FP.anyWord8 >>= \case+                         0x00    -> getNNulls $ n-1+                         nonNull -> FP.err "TODO expected null, wasn't"

@@ -0,0 +1,44 @@+-- | Constant-size data.++{-# LANGUAGE OverloadedStrings #-}++module Binrep.Type.Sized where++import Binrep+import Binrep.Util ( tshow )++import Refined+import Refined.Unsafe++import GHC.TypeNats+import Data.Typeable ( typeRep )+import FlatParse.Basic qualified as FP++data Size (n :: Natural)++type Sized n a = Refined (Size n) a++type instance CBLen (Sized n a) = n++deriving anyclass instance KnownNat n => BLen (Sized n a)++instance (BLen a, KnownNat n) => Predicate (Size n) a where+    validate p a+     | len > n+        = throwRefineOtherException (typeRep p) $+            "not correctly sized: "<>tshow len<>" /= "<>tshow n+     | otherwise = success+      where+        n = typeNatToBLen @n+        len = blen a++instance Put a => Put (Sized n a) where+    put = put . unrefine++-- TODO safety: isolate consumes all bytes if succeeds+instance (Get a, KnownNat n) => Get (Sized n a) where+    get = do+        a <- FP.isolate (fromIntegral n) get+        return $ reallyUnsafeRefine a+      where+        n = typeNatToBLen @n

@@ -0,0 +1,184 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE CPP #-}++module Binrep.Type.Text+  ( Encoding(..)+  , AsText+  , Encode, encode+  , Decode(..)+  , encodeToRep+  , decodeViaTextICU+  ) where++import Binrep.Type.Common ( Endianness(..) )+import Binrep.Type.ByteString ( Rep )++import Refined+import Refined.Unsafe++import Data.ByteString qualified as B+import Data.Text qualified as Text+import Data.Text ( Text )+import Data.Char qualified as Char+import Data.Text.Encoding qualified as Text+import Data.Either.Combinators qualified as Either++import GHC.Generics ( Generic )+import Data.Data ( Data )++import Data.Typeable ( Typeable, typeRep )++import System.IO.Unsafe qualified+import Control.Exception qualified+import Data.Text.Encoding.Error qualified++import Data.Text.ICU.Convert qualified as ICU++type Bytes = B.ByteString++-- | Character encoding.+--+-- Byte-oriented encodings like ASCII and UTF-8 don't need to worry about+-- endianness. For UTF-16 and UTF-32, the designers decided to allow different+-- endiannesses, rather than saying "codepoints must be X-endian".+data Encoding+  = UTF8+  | UTF16 Endianness+  | UTF32 Endianness+  | ASCII -- ^ 7-bit+  | SJIS+    deriving stock (Generic, Data, Show, Eq)++-- | A string of a given encoding, stored in the 'Text' type.+type AsText (enc :: Encoding) = Refined enc Text++-- | Bytestring encoders for text validated for a given encoding.+class Encode (enc :: Encoding) where+    -- | Encode text to bytes. Internal function, use 'encode'.+    encode' :: Text -> Bytes++instance Encode 'UTF8 where encode' = Text.encodeUtf8++-- | ASCII is a subset of UTF-8, so valid ASCII is valid UTF-8, so this is safe.+instance Encode 'ASCII where encode' = encode' @'UTF8++instance Encode ('UTF16 'BE) where encode' = Text.encodeUtf16BE+instance Encode ('UTF16 'LE) where encode' = Text.encodeUtf16LE+instance Encode ('UTF32 'BE) where encode' = Text.encodeUtf32BE+instance Encode ('UTF32 'LE) where encode' = Text.encodeUtf32LE++instance Encode 'SJIS where encode' = encodeViaTextICU' "Shift-JIS"++-- | Encode some validated text.+encode :: forall enc. Encode enc => AsText enc -> Bytes+encode = encode' @enc . unrefine++-- | Any 'Text' value is always valid UTF-8.+instance Predicate 'UTF8 Text where validate _ _ = success++-- | Any 'Text' value is always valid UTF-16.+instance Typeable e => Predicate ('UTF16 e) Text where validate _ _ = success++-- | Any 'Text' value is always valid UTF-32.+instance Typeable e => Predicate ('UTF32 e) Text where validate _ _ = success++-- | 'Text' must be validated if you want to permit 7-bit ASCII only.+instance Predicate 'ASCII Text where+    validate p t = if   Text.all Char.isAscii t+                   then success+                   else throwRefineOtherException (typeRep p) "not valid 7-bit ASCII"++-- | TODO Unsafely assume all 'Text's are valid Shift-JIS.+instance Predicate 'SJIS Text where validate _ _ = success++class Decode (enc :: Encoding) where+    -- | Decode a 'ByteString' to 'Text' with an explicit encoding.+    --+    -- This is intended to be used with visible type applications.+    decode :: Bytes -> Either String (AsText enc)++instance Decode 'UTF8  where decode = decodeText show Text.decodeUtf8'+instance Decode ('UTF16 'BE) where decode = decodeText show $ wrapUnsafeDecoder Text.decodeUtf16BE+instance Decode ('UTF16 'LE) where decode = decodeText show $ wrapUnsafeDecoder Text.decodeUtf16LE+instance Decode ('UTF32 'BE) where decode = decodeText show $ wrapUnsafeDecoder Text.decodeUtf32BE+instance Decode ('UTF32 'LE) where decode = decodeText show $ wrapUnsafeDecoder Text.decodeUtf32LE++-- Pre-@text-2.0@, @decodeASCII@ generated a warning and ran @decodeUtf8@.+#if MIN_VERSION_text(2,0,0)+instance Decode 'ASCII where decode = decodeText $ wrapUnsafeDecoder Text.decodeASCII+#endif++instance Decode 'SJIS where decode = decodeText id $ decodeViaTextICU' "Shift-JIS"++--------------------------------------------------------------------------------+-- Helpers++-- | Encode some text to a bytestring, asserting that the resulting value is+--   valid for the requested bytestring representation.+--+-- This is intended to be used with visible type applications:+--+-- >>> let Right t = refine @'UTF8 (Text.pack "hi")+-- >>> :t t+-- t :: AsText 'UTF8+-- >>> let Right bs = encodeToRep @'C t+-- >>> :t bs+-- bs :: Refined 'C Bytes+encodeToRep+    :: forall (rep :: Rep) enc+    .  (Encode enc, Predicate rep Bytes)+    => AsText enc+    -> Either RefineException (Refined rep Bytes)+encodeToRep = refine . encode++--------------------------------------------------------------------------------+-- Internal helpers++-- | Helper for decoding a 'Bytes' to a 'Text' tagged with its encoding.+decodeText+    :: forall enc e+    .  (e -> String) -> (Bytes -> Either e Text) -> Bytes+    -> Either String (AsText enc)+decodeText g f = Either.mapBoth g reallyUnsafeRefine . f++-- | Run an unsafe decoder safely.+--+-- Copied from @Data.Text.Encoding.decodeUtf8'@, so should be bulletproof?+wrapUnsafeDecoder+    :: (Bytes -> Text)+    -> Bytes -> Either Data.Text.Encoding.Error.UnicodeException Text+wrapUnsafeDecoder f =+      System.IO.Unsafe.unsafeDupablePerformIO+    . Control.Exception.try+    . Control.Exception.evaluate+    . f++-- | Encode some 'Text' to the given character set using text-icu.+--+-- No guarantees about correctness. Encodings are weird. e.g. Shift JIS's+-- yen/backslash problem is apparently to do with OSs treating it differently.+--+-- Expects a 'Text' that is confirmed valid for converting to the character set.+--+-- The charset must be valid, or it's exception time. See text-icu.+encodeViaTextICU :: String -> Text -> IO B.ByteString+encodeViaTextICU charset t = do+    conv <- ICU.open charset Nothing+    return $ ICU.fromUnicode conv t++encodeViaTextICU' :: String -> Text -> B.ByteString+encodeViaTextICU' charset t =+    System.IO.Unsafe.unsafeDupablePerformIO $ encodeViaTextICU charset t++-- TODO Shitty library doesn't let us say how to handle errors. Apparently, the+-- only solution is to scan through the resulting 'Text' to look for @\SUB@+-- characters, or lie about correctness. Sigh.+decodeViaTextICU :: String -> B.ByteString -> IO (Either String Text)+decodeViaTextICU charset t = do+    conv <- ICU.open charset Nothing+    return $ Right $ ICU.toUnicode conv t++decodeViaTextICU' :: String -> B.ByteString -> Either String Text+decodeViaTextICU' charset t = do+    System.IO.Unsafe.unsafeDupablePerformIO $ decodeViaTextICU charset t

@@ -0,0 +1,26 @@+-- | Sized vectors.++{-# LANGUAGE NoStarIsType #-}+{-# LANGUAGE UndecidableInstances #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++module Binrep.Type.Vector where++import Binrep+import Data.Vector.Sized qualified as V+import Data.Vector.Sized ( Vector )+import GHC.TypeNats++type instance CBLen (Vector n a) = CBLen a * n++instance BLen a => BLen (Vector n a) where+    blen = V.sum . V.map blen++instance Put a => Put (Vector n a) where+    put = mconcat . V.toList . V.map put++instance (Get a, KnownNat n) => Get (Vector n a) where+    get = getVector get++getVector :: KnownNat n => Getter a -> Getter (Vector n a)+getVector g = V.replicateM g

@@ -1,89 +0,0 @@-module Binrep.Types.Ints where--import Binrep.Codec-import Binrep.ByteLen-import GHC.Generics ( Generic )-import Data.Typeable-import Data.Word-import Data.Int-import Data.Aeson-import Data.Serialize---- | Wrapper type grouping machine integers (sign, size) along with an explicit---   endianness.-newtype I (sign :: ISign) (size :: ISize) (e :: Endianness)-  = I { getI :: IRep sign size }-    deriving stock (Generic, Typeable)---- | Lots of deriving boilerplate due to the type family usage.-deriving stock                instance Show     (IRep sign size) => Show     (I sign size e)-deriving via (IRep sign size) instance Eq       (IRep sign size) => Eq       (I sign size e)-deriving via (IRep sign size) instance Ord      (IRep sign size) => Ord      (I sign size e)-deriving via (IRep sign size) instance Bounded  (IRep sign size) => Bounded  (I sign size e)-deriving via (IRep sign size) instance Num      (IRep sign size) => Num      (I sign size e)-deriving via (IRep sign size) instance Real     (IRep sign size) => Real     (I sign size e)-deriving via (IRep sign size) instance Enum     (IRep sign size) => Enum     (I sign size e)-deriving via (IRep sign size) instance Integral (IRep sign size) => Integral (I sign size e)-deriving via (IRep sign size) instance ToJSON   (IRep sign size) => ToJSON   (I sign size e)-deriving via (IRep sign size) instance FromJSON (IRep sign size) => FromJSON (I sign size e)--instance ByteLen (I s 'I1 e) where blen = const 1-instance ByteLen (I s 'I2 e) where blen = const 2-instance ByteLen (I s 'I4 e) where blen = const 4-instance ByteLen (I s 'I8 e) where blen = const 8---- | Endianness doesn't apply for single-byte machine integers.-instance BinaryCodec (I 'U 'I1 e) where toBin   = putWord8 . getI-                                        fromBin = I <$> getWord8-instance BinaryCodec (I 'S 'I1 e) where toBin   = putInt8 . getI-                                        fromBin = I <$> getInt8--instance BinaryCodec (I 'U 'I2 'BE) where toBin   = putWord16be . getI-                                          fromBin = I <$> getWord16be-instance BinaryCodec (I 'U 'I2 'LE) where toBin   = putWord16le . getI-                                          fromBin = I <$> getWord16le-instance BinaryCodec (I 'S 'I2 'BE) where toBin   = putInt16be . getI-                                          fromBin = I <$> getInt16be-instance BinaryCodec (I 'S 'I2 'LE) where toBin   = putInt16le . getI-                                          fromBin = I <$> getInt16le--instance BinaryCodec (I 'U 'I4 'BE) where toBin   = putWord32be . getI-                                          fromBin = I <$> getWord32be-instance BinaryCodec (I 'U 'I4 'LE) where toBin   = putWord32le . getI-                                          fromBin = I <$> getWord32le-instance BinaryCodec (I 'S 'I4 'BE) where toBin   = putInt32be . getI-                                          fromBin = I <$> getInt32be-instance BinaryCodec (I 'S 'I4 'LE) where toBin   = putInt32le . getI-                                          fromBin = I <$> getInt32le--instance BinaryCodec (I 'U 'I8 'BE) where toBin   = putWord64be . getI-                                          fromBin = I <$> getWord64be-instance BinaryCodec (I 'U 'I8 'LE) where toBin   = putWord64le . getI-                                          fromBin = I <$> getWord64le-instance BinaryCodec (I 'S 'I8 'BE) where toBin   = putInt64be . getI-                                          fromBin = I <$> getInt64be-instance BinaryCodec (I 'S 'I8 'LE) where toBin   = putInt64le . getI-                                          fromBin = I <$> getInt64le---- | Byte order.-data Endianness-  = BE -- ^ big    endian, MSB first. e.g. most network protocols-  | LE -- ^ little endian, MSB last.  e.g. most processor architectures---- | Machine integer sign-data ISign-  = S -- ^   signed-  | U -- ^ unsigned---- | Machine integer size in number of bytes.-data ISize = I1 | I2 | I4 | I8--type family IRep (sign :: ISign) (size :: ISize) where-    IRep 'U 'I1 = Word8-    IRep 'S 'I1 =  Int8-    IRep 'U 'I2 = Word16-    IRep 'S 'I2 =  Int16-    IRep 'U 'I4 = Word32-    IRep 'S 'I4 =  Int32-    IRep 'U 'I8 = Word64-    IRep 'S 'I8 =  Int64

@@ -1,111 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Binrep.Types.Strings where--import Binrep.Codec-import Binrep.ByteLen-import Binrep.Types.Ints-import Binrep.Util-import Refined-import Refined.WithRefine-import Data.ByteString qualified as BS-import Data.ByteString.Lazy qualified as BL-import Data.ByteString.Builder qualified as B-import Data.Serialize-import Data.Word-import Data.Typeable ( Typeable, typeRep )-import Control.Monad ( replicateM )---- | TODO-data StrRep = C | Pascal ISize Endianness---- | TODO------ We also use this as a predicate, because the 'Pascal' constructor looks--- identical to what we would want for a @LengthPrefixed@ predicate.-newtype Str (rep :: StrRep)-  = Str { getStr :: BS.ByteString }--fromBinCString :: Get BS.ByteString-fromBinCString = go mempty-  where go buf = do-            getWord8 >>= \case-              0x00    -> return $ BL.toStrict $ B.toLazyByteString buf-              nonNull -> go $ buf <> B.word8 nonNull--instance ByteLen (Str 'C) where-    blen cstr = fromIntegral $ BS.length (getStr cstr) + 1--instance ByteLen (I 'U size e) => ByteLen (Str ('Pascal size e )) where-    blen pstr = fromIntegral (blen @(I 'U size e) undefined) + fromIntegral (BS.length (getStr pstr))---- | Total shite parsing efficiency. But, to be fair, that's why we don't---   serialize arbitrary-length C strings!-instance BinaryCodec (Str 'C) where-    toBin cstr = do-        putByteString $ getStr cstr-        putWord8 0x00-    fromBin = Str <$> fromBinCString--instance BinaryCodecWith _r (Str 'C)---- TODO yeah I gotta do this because now the size info is actually in the--- newtype -- which makes the most sense, because I want to do similar on the--- value level! looks a tiny bit jank but ✓-data WellSized---- | TODO explain why safe-instance BinaryCodec (WithRefine 'Enforced WellSized (Str ('Pascal 'I1 e))) where-    toBin wrepstr = do-        toBin @(I 'U 'I1 e) $ fromIntegral $ BS.length bs-        putByteString bs-      where bs = getStr $ unWithRefine wrepstr-    fromBin = do-        len <- fromBin @(I 'U 'I1 e)-        bs <- getByteString $ fromIntegral len-        return $ reallyUnsafeEnforce $ Str bs--instance BinaryCodecWith StrRep BS.ByteString where-    toBinWith strRep bs =-        case strRep of-          C -> toBinWith undefined $ Str @'C bs-          Pascal size _e -> do-            case size of-              I1 -> do-                if   len > fromIntegral (maxBound @Word8)-                then Left "bytestring too long for configured static-size length prefix"-                else Right $ B.byteString bs-              _ -> undefined-      where len = BS.length bs-    fromBinWith = \case C -> fromBinCString-                        Pascal _size _e -> undefined---- Fun and correct, but it does give us an orphan instance lol-type LenPfx size e = Str ('Pascal size e)---- | TODO why safe-instance (ByteLen a, itype ~ I 'U size e, ByteLen itype)-      => ByteLen (WithRefine 'Enforced (LenPfx size e) a) where-    blen wrelpa = blen @itype undefined + blen (unWithRefine wrelpa)--instance (Foldable f, Typeable f, Typeable e) => Predicate (LenPfx 'I4 e) (f a) where-    validate p a-      | len > fromIntegral max'-          = throwRefineOtherException (typeRep p) $-              "too long for given length prefix type: "<>tshow len<>" > "<>tshow max'-      | otherwise = success-      where-        len = length a-        max' = maxBound @(IRep 'U 'I4)---- | TODO why safe-instance (BinaryCodec a, irep ~ IRep 'U size, itype ~ I 'U size e, Num irep, Integral irep, BinaryCodec itype)-      => BinaryCodec (WithRefine 'Enforced (LenPfx size e) [a]) where-    fromBin = do-        len <- fromBin @itype-        as <- replicateM (fromIntegral len) (fromBin @a)-        return $ reallyUnsafeEnforce as-    toBin wreas = do-        toBin @itype $ fromIntegral $ length as-        mapM_ (toBin @a) as-      where as = unWithRefine wreas

@@ -1,7 +1,31 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+ module Binrep.Util where +-- tshow import Data.Text qualified as Text import Data.Text ( Text ) +-- posIntToNat+import GHC.Exts ( Int(..), int2Word# )+import GHC.Num.Natural ( Natural(..) )++-- natVal''+import GHC.TypeNats ( KnownNat, natVal' )+import GHC.Exts ( proxy#, Proxy# )+ tshow :: Show a => a -> Text tshow = Text.pack . show++-- | Convert some 'Int' @i@ where @i >= 0@ to a 'Natural'.+--+-- This is intended for wrapping the output of 'length' functions.+--+-- underflows if you call it with a negative 'Int' :)+posIntToNat :: Int -> Natural+posIntToNat (I# i#) = NS (int2Word# i#)+{-# INLINE posIntToNat #-}++natVal'' :: forall a. KnownNat a => Natural+natVal'' = natVal' (proxy# :: Proxy# a)+{-# INLINE natVal'' #-}

@@ -0,0 +1,19 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}++module Data.Aeson.Extra.SizedVector where++import Data.Aeson+import Data.Vector.Generic.Sized.Internal qualified as VSI+import Data.Vector.Generic.Sized qualified as VS+import Data.Vector.Generic qualified as V+import GHC.TypeNats ( KnownNat )++instance ToJSON   (v a) => ToJSON   (VSI.Vector v n a) where+    toJSON     (VSI.Vector v) = toJSON     v+    toEncoding (VSI.Vector v) = toEncoding v+instance (FromJSON (v a), KnownNat n, V.Vector v a) => FromJSON (VSI.Vector v n a) where+    parseJSON j = do+        v <- parseJSON j+        case VS.toSized v of+          Nothing -> fail "TODO bad size"+          Just v' -> return v'

@@ -0,0 +1,10 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# LANGUAGE UndecidableInstances #-}++module ArbitraryOrphans() where++import Test.QuickCheck ( Arbitrary )+import Binrep.Type.Int ( I(..), IRep )++-- | Machine integers steal their underlying representation's instance.+deriving via (IRep sign size) instance Arbitrary (IRep sign size) => Arbitrary (I sign size e)

@@ -0,0 +1,39 @@+{-# LANGUAGE OverloadedStrings #-}++module Binrep.Extra.HexByteStringSpec ( spec ) where++import Binrep.Extra.HexByteString+import Test.Hspec++import Data.ByteString qualified as B+import Text.Megaparsec+import Data.Void ( Void )++megaparsecParseFromCharStream :: forall s a. (Stream s, Token s ~ Char) => Parsec Void s a -> s -> Maybe a+megaparsecParseFromCharStream parser text = parseMaybe parser text++spec :: Spec+spec = do+    let bs = B.pack+    describe "parse" $ do+      let p = megaparsecParseFromCharStream @String (parseHexByteString B.pack)+      it "parses valid hex bytestrings" $ do+        p "00" `shouldBe` Just (bs [0x00])+        p "FF" `shouldBe` Just (bs [0xFF])+        p "1234" `shouldBe` Just (bs [0x12, 0x34])+        p "01 9A FE" `shouldBe` Just (bs [0x01, 0x9A, 0xFE])+        p "FFFFFFFF" `shouldBe` Just (B.replicate 4 0xFF)+        p "12 34    AB CD" `shouldBe` Just (bs [0x12, 0x34, 0xAB, 0xCD])+      it "fails to parse invalid hex bytestrings" $ do+        p "-00" `shouldBe` Nothing+        p "FG" `shouldBe` Nothing+      it "fails to parse 0x prefix" $ do+        p   "1234" `shouldBe` Just (bs [0x12, 0x34])+        p "0x1234" `shouldBe` Nothing+    describe "print" $ do+      it "prints pretty hex bytestrings" $ do+        let p = prettyHexByteString B.unpack+        p (bs [0x5a, 0x7d]) `shouldBe` "5A 7D"+      it "prints compact hex bytestrings" $ do+        let pc = prettyHexByteStringCompact B.unpack+        pc (bs [0xab, 0x25]) `shouldBe` "ab25"

@@ -0,0 +1,49 @@+{-# LANGUAGE OverloadedStrings #-}++module Binrep.LawsSpec ( spec ) where++import Test.Hspec+import Test.Hspec.QuickCheck+import Test.QuickCheck.Instances.ByteString()+import Generic.Random+import Test.QuickCheck+import ArbitraryOrphans()++import Binrep+import Binrep.Generic+import Binrep.Type.Int+import Binrep.Type.Common ( Endianness(..) )+import Binrep.Type.ByteString+import Data.Word ( Word8 )+import Data.ByteString qualified as B+import GHC.Generics ( Generic )++spec :: Spec+spec = do+    prop "put is identity on ByteString" $ do+      \(bs :: B.ByteString) -> runPut bs  `shouldBe` bs+    prop "parse-print roundtrip isomorphism (ByteString)" $ do+      \(bs :: B.ByteString) -> runGet (runPut bs) `shouldBe` Right (bs, "")+    prop "parse-print roundtrip isomorphism (generic, sum tag via nullterm constructor)" $ do+      \(d :: D) -> runGet (runPut d) `shouldBe` Right (d, "")++--------------------------------------------------------------------------------++type W1   = (I 'U 'I1 'LE)+type W2LE = (I 'U 'I2 'LE)+type W8BE = (I 'U 'I8 'BE)++data D+  = D01Bla     Word8 W1 W8BE+  | D23        W2LE  B.ByteString -- dangerous bytestring, must be last+  | DUnicode例 Word8+  | DSymbols_#+    deriving stock (Generic, Eq, Show)+deriving via (GenericArbitraryU `AndShrinking` D) instance Arbitrary D++dCfg :: Cfg (AsByteString 'C)+dCfg = Cfg { cSumTag = cSumTagNullTerm }++instance BLen D where blen = blenGeneric dCfg+instance Put  D where put  = putGeneric  dCfg+instance Get  D where get  = getGeneric  dCfg

@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}