bytebuild 0.3.8.0 → 0.3.9.0

raw patch · 8 files changed

+361/−13 lines, 8 filesdep +haskell-src-metadep +template-haskelldep ~byteslicedep ~text-shortPVP ok

version bump matches the API change (PVP)

Dependencies added: haskell-src-meta, template-haskell

Dependency ranges changed: byteslice, text-short

API changes (from Hackage documentation)

Files

• CHANGELOG.md +8/−1
• bytebuild.cabal +8/−2
• common/Word16Tree.hs +2/−1
• src/Data/Bytes/Builder.hs +6/−1
• src/Data/Bytes/Builder/Bounded/Class.hs +79/−0
• src/Data/Bytes/Builder/Class.hs +95/−0
• src/Data/Bytes/Builder/Template.hs +126/−0
• test/Main.hs +37/−8

@@ -5,10 +5,17 @@ `small-bytearray-builder` is now just a compatibility shim to ease the migration process. -## 0.3.8.0 -- 2020-??-??+## 0.3.9.0 -- 2021-11-19 +* Add `cstring#`+* Add `ToBuilder` and `ToBoundedBuilder` classes+* Add quasiquoter named `bldr` in `Data.Bytes.Builder.Template`.++## 0.3.8.0 -- 2021-06-25+ * Fix `doubleDec`, which was encoding small numbers incorrectly. * Add `runByteString` for producing `ByteString` from bounded builders.+* Add `cstring#` for producing builder from `Addr#`. * Correct the required length calculation for json string encoding.  ## 0.3.7.0 -- 2020-11-06

@@ -1,6 +1,6 @@ cabal-version: 2.2 name: bytebuild-version: 0.3.8.0+version: 0.3.9.0 synopsis: Serialize to a small byte arrays description:   This is similar to the builder facilities provided by@@ -37,20 +37,25 @@ library   exposed-modules:     Data.Bytes.Builder+    Data.Bytes.Builder.Class+    Data.Bytes.Builder.Template     Data.Bytes.Builder.Unsafe     Data.Bytes.Builder.Bounded+    Data.Bytes.Builder.Bounded.Class     Data.Bytes.Builder.Bounded.Unsafe   reexported-modules:     Data.Bytes.Chunks   build-depends:     , base >=4.12.0.0 && <5-    , byteslice >=0.2.5 && <0.3+    , byteslice >=0.2.6 && <0.3     , bytestring >=0.10.8.2 && <0.11+    , haskell-src-meta >=0.8     , integer-logarithms >=1.0.3 && <1.1     , natural-arithmetic >=0.1 && <0.2     , primitive-offset >=0.2 && <0.3     , primitive-unlifted >=0.1.2 && <0.2     , run-st >=0.1 && <0.2+    , template-haskell >=2.16     , text-short >=0.1.3 && <0.2     , wide-word >=0.1.0.9 && <0.2   if flag(checked)@@ -82,6 +87,7 @@     , primitive-unlifted >=0.1.2     , quickcheck-classes >=0.6.4     , quickcheck-instances >=0.3.22+    , text-short     , tasty >=1.2.3 && <1.3     , tasty-hunit >=0.10.0.2 && <0.11     , tasty-quickcheck >=0.10.1 && <0.11

@@ -13,6 +13,7 @@ import Data.Word (Word16) import Data.Primitive (ByteArray) import qualified Data.Bytes as Bytes+import qualified Data.Bytes.Text.Ascii  data Word16Tree   = Branch !Word16Tree !Word16Tree@@ -32,7 +33,7 @@   B.ascii ')'  expectedSmall :: ByteArray-expectedSmall = Bytes.toByteArray $ Bytes.fromAsciiString+expectedSmall = Bytes.toByteArray $ Data.Bytes.Text.Ascii.fromString   "((AB59,(1F33,2E71)),((((FA9A,247B),890C),(0F13,((55BF,7CF1),389B))),1205))"  

@@ -29,6 +29,7 @@   , shortTextUtf8   , shortTextJsonString   , cstring+  , cstring#   , cstringLen   , stringUtf8     -- * Encode Integral Types@@ -153,7 +154,7 @@ import GHC.ByteOrder (ByteOrder(BigEndian,LittleEndian),targetByteOrder) import GHC.Exts (Int(I#),Char(C#),Int#,State#,ByteArray#,(>=#)) import GHC.Exts (RealWorld,(+#),(-#),(<#))-import GHC.Exts ((*#))+import GHC.Exts (Addr#,(*#)) import GHC.Integer.Logarithms.Compat (integerLog2#) import GHC.IO (IO(IO),stToIO) import GHC.Natural (naturalFromInteger,naturalToInteger)@@ -390,6 +391,10 @@   )   where   !(I# newSz) = max (I# slen#) 4080++cstring# :: Addr# -> Builder+{-# inline cstring# #-}+cstring# x = cstring (Exts.Ptr x)  -- | Create a builder from a C string with explicit length. The builder -- must be executed before the C string is freed.

@@ -0,0 +1,79 @@+{-# language DataKinds #-}+{-# language TypeFamilies #-}++module Data.Bytes.Builder.Bounded.Class+  ( ToBoundedBuilder(..)+  ) where++import Data.Int+import Data.Word++import qualified Data.Bytes.Builder.Bounded as Bounded+import qualified GHC.TypeNats as GHC++-- | Variant of To that can be encoded as a builder. Human-readable encodings+-- are used when possible. For example, numbers are encoded an ascii-encoded+-- decimal characters. UTF-8 is preferred for textual types. For types+-- that represent arbitrary bytes (e.g. Bytes, ByteString), the bytes+-- are preserved.+--+-- The goal of this typeclass is to reduce the size of builders produced+-- by quasiquotation.+class ToBoundedBuilder a where+  type BoundedBuilderLength a :: GHC.Nat+  toBuilder :: a -> Bounded.Builder (BoundedBuilderLength a)++-- | Identity+instance ToBoundedBuilder (Bounded.Builder n) where+  type BoundedBuilderLength (Bounded.Builder n) = n+  toBuilder = id++-- | Uses @int64Dec@.+instance ToBoundedBuilder Int64 where+  type BoundedBuilderLength Int64 = 20+  toBuilder = Bounded.int64Dec++-- | Uses @int32Dec@.+instance ToBoundedBuilder Int32 where+  type BoundedBuilderLength Int32 = 11+  toBuilder = Bounded.int32Dec++-- | Uses @int16Dec@.+instance ToBoundedBuilder Int16 where+  type BoundedBuilderLength Int16 = 6+  toBuilder = Bounded.int16Dec++-- | Uses @int8Dec@.+instance ToBoundedBuilder Int8 where+  type BoundedBuilderLength Int8 = 4+  toBuilder = Bounded.int8Dec++-- | Uses @intDec@.+instance ToBoundedBuilder Int where+  type BoundedBuilderLength Int = 20+  toBuilder = Bounded.intDec++-- | Uses @word64Dec@.+instance ToBoundedBuilder Word64 where+  type BoundedBuilderLength Word64 = 19+  toBuilder = Bounded.word64Dec++-- | Uses @word32Dec@.+instance ToBoundedBuilder Word32 where+  type BoundedBuilderLength Word32 = 10+  toBuilder = Bounded.word32Dec++-- | Uses @word16Dec@.+instance ToBoundedBuilder Word16 where+  type BoundedBuilderLength Word16 = 5+  toBuilder = Bounded.word16Dec++-- | Uses @word8Dec@.+instance ToBoundedBuilder Word8 where+  type BoundedBuilderLength Word8 = 3+  toBuilder = Bounded.word8Dec++-- | Uses @wordDec@.+instance ToBoundedBuilder Word where+  type BoundedBuilderLength Word = 19+  toBuilder = Bounded.wordDec

@@ -0,0 +1,95 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeSynonymInstances #-}++module Data.Bytes.Builder.Class+  ( ToBuilder(..)+  ) where++import Data.Bytes (Bytes)+import Data.Bytes.Builder (Builder)+import Data.ByteString.Short (ShortByteString)+import Data.Int+import Data.Primitive.ByteArray (ByteArray)+import Data.Text.Short (ShortText)+import Data.Word++import qualified Data.Bytes.Builder as Builder++-- | Types that can be encoded as a builder. Human-readable encodings+-- are used when possible. For example, numbers are encoded an ascii-encoded+-- decimal characters. UTF-8 is preferred for textual types. For types+-- that represent arbitrary bytes (e.g. Bytes, ByteString), the bytes+-- are preserved.+--+-- The goal of this typeclass is to reduce the size of builders produced+-- by quasiquotation.+class ToBuilder a where+  toBuilder :: a -> Builder++-- | Identity+instance ToBuilder Builder where+  toBuilder = id++-- | Uses @bytes@.+instance ToBuilder Bytes where+  toBuilder = Builder.bytes++-- | Uses @byteArray@+instance ToBuilder ByteArray where+  toBuilder = Builder.byteArray++-- | Uses @shortByteString@+instance ToBuilder ShortByteString where+  toBuilder = Builder.shortByteString++-- | Uses @shortTextUtf8@.+instance ToBuilder ShortText where+  toBuilder = Builder.shortTextUtf8++-- | Uses @stringUtf8@+instance ToBuilder String where+  toBuilder = Builder.stringUtf8++-- | Uses @int64Dec@.+instance ToBuilder Int64 where+  toBuilder = Builder.int64Dec++-- | Uses @int32Dec@.+instance ToBuilder Int32 where+  toBuilder = Builder.int32Dec++-- | Uses @int16Dec@.+instance ToBuilder Int16 where+  toBuilder = Builder.int16Dec++-- | Uses @int8Dec@.+instance ToBuilder Int8 where+  toBuilder = Builder.int8Dec++-- | Uses @intDec@.+instance ToBuilder Int where+  toBuilder = Builder.intDec++-- | Uses @word64Dec@.+instance ToBuilder Word64 where+  toBuilder = Builder.word64Dec++-- | Uses @word32Dec@.+instance ToBuilder Word32 where+  toBuilder = Builder.word32Dec++-- | Uses @word16Dec@.+instance ToBuilder Word16 where+  toBuilder = Builder.word16Dec++-- | Uses @word8Dec@.+instance ToBuilder Word8 where+  toBuilder = Builder.word8Dec++-- | Uses @wordDec@.+instance ToBuilder Word where+  toBuilder = Builder.wordDec++-- | uses @doubleDec@+instance ToBuilder Double where+  toBuilder = Builder.doubleDec

@@ -0,0 +1,126 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE TemplateHaskell #-}++-- | Quasiquotation for byte builders.+module Data.Bytes.Builder.Template+  ( bldr+  ) where++import Control.Monad (when)+import Data.Bytes.Builder.Class (toBuilder)+import GHC.Ptr (Ptr(Ptr))+import Language.Haskell.Meta.Parse (parseExp)+import Language.Haskell.TH (Q,Exp)+import Language.Haskell.TH.Lib (integerL,stringPrimL,litE)+import Language.Haskell.TH.Quote (QuasiQuoter(..))++import qualified Data.Bytes.Builder as Builder+import qualified Data.ByteString.Short as SBS+import qualified Data.Text.Short as TS+import qualified Language.Haskell.TH as TH++-- | A quasiquoter for builders. Haskell expressions are interpolated+-- with backticks, and the @ToBuilder@ class is used to convert them+-- to builders. Several common escape sequences for whitespace and+-- control characters are recongized. Consider the following expression,+-- where the binding @partition@ has type @Word32@:+--+-- > [templ|[WARN] Partition `partition` has invalid data.\n|]+--+-- This expression has type @Builder@ and expands to:+--+-- > Builder.cstringLen (Ptr "[WARN] Partition "#, 17) <>+-- > Builder.toBuilder partition <>+-- > Builder.cstringLen (Ptr " has invalid data.\n"#, 19)+--+-- The @ToBuilder@ instance for @Word32@ uses decimal encoding, so this+-- would result in the following if @partition@ was 42 (with a newline+-- character at the end):+--+-- > [WARN] Partition 42 has invalid data.+--+-- In the future, a more sophisticated @bbldr@ variant will be added+-- that will support expressions where the maximum length of the entire+-- builder can be computed at compile time. +bldr :: QuasiQuoter+bldr = QuasiQuoter+  { quoteExp = templExp+  , quotePat = notHandled "patterns"+  , quoteType = notHandled "types"+  , quoteDec = notHandled "declarations"+  }+  where+  notHandled things _ = fail $+    things ++ "are not handled by the byte template quasiquoter"++templExp :: String -> Q Exp+templExp inp = do+  checkOverloadedStrings+  rawParts <- case parse inp of+    Left err -> fail err+    Right [] -> fail "empty template"+    Right v -> pure v+  let expParts = compile <$> rawParts+  foldl1 (\e1 e2 -> [| $e1 <> $e2 |]) expParts++checkOverloadedStrings :: Q ()+checkOverloadedStrings = do+  olEnabled <- TH.isExtEnabled TH.OverloadedStrings+  when (not olEnabled) $+    fail "Byte templates require the OverloadedStrings extension enabled."++type Template = [TemplPart]+data TemplPart+  = Literal String+  | Splice String++compile :: TemplPart -> Q Exp+compile (Literal lit) =+  let bytes = SBS.unpack . TS.toShortByteString . TS.pack $ lit+      strExp = litE . stringPrimL $ bytes+      strLen = litE . integerL . fromIntegral $ length bytes+   in [|Builder.cstringLen (Ptr $(strExp), $(strLen))|]+compile (Splice str) = case parseExp str of+  Left err -> fail err+  Right hs -> [|toBuilder $(pure hs)|]++parse :: String -> Either String Template+parse = partsLoop+  where+  partsLoop "" = do+    pure []+  partsLoop ('`':inp) = do+    (!spl, !rest) <- spliceLoop inp+    (Splice spl:) <$> partsLoop rest+  partsLoop inp = do+    (!lit, !rest) <- litLoop "" inp+    (Literal lit:) <$> partsLoop rest+  litLoop :: String -> String -> Either String (String, String)+  litLoop !acc rest@"" = pure (reverse acc, rest)+  litLoop !acc rest@('`':_) = pure (reverse acc, rest)+  litLoop !acc ('\\':next) = do+    (c, rest) <- parseEscape next+    litLoop (c:acc) rest+  litLoop !acc (c:rest) = litLoop (c:acc) rest+  spliceLoop :: String -> Either String (String, String)+  spliceLoop inp = case break (== '`') inp of+    ([], _) -> Left "internal error"+    (hs, '`':rest) -> pure (hs, rest)+    (_, _:_) -> Left "internal error"+    (_, []) -> Left "unterminated interpolation"+  parseEscape :: String -> Either String (Char, String)+  parseEscape "" = Left "incomplete escape"+  parseEscape ('\\':rest) = pure ('\\', rest)+  parseEscape ('`':rest) = pure ('`', rest)+  parseEscape ('\'':rest) = pure ('\'', rest)+  parseEscape ('\"':rest) = pure ('\"', rest)+  parseEscape ('0':rest) = pure ('\0', rest)+  parseEscape ('a':rest) = pure ('\a', rest)+  parseEscape ('b':rest) = pure ('\b', rest)+  parseEscape ('f':rest) = pure ('\f', rest)+  parseEscape ('n':rest) = pure ('\n', rest)+  parseEscape ('r':rest) = pure ('\r', rest)+  parseEscape ('t':rest) = pure ('\t', rest)+  parseEscape ('v':rest) = pure ('\v', rest)+  parseEscape (c:_) = Left $ "unrecognized escape: \\" ++ [c]

@@ -1,8 +1,9 @@ {-# language BangPatterns #-} {-# language NumericUnderscores #-}+{-# language OverloadedStrings #-}+{-# language QuasiQuotes #-} {-# language ScopedTypeVariables #-} {-# language TypeApplications #-}-{-# language OverloadedStrings #-}  {-# OPTIONS_GHC -fno-warn-orphans #-} @@ -11,28 +12,34 @@ import Control.Applicative (liftA2) import Control.Monad.ST (runST) import Data.Bytes.Builder+import Data.Bytes.Builder.Template (bldr) import Data.Bytes.Types (MutableBytes(MutableBytes))-import Data.Primitive (PrimArray)-import Data.Word import Data.Char (ord,chr) import Data.IORef (IORef,newIORef,readIORef,writeIORef)+import Data.Maybe (fromMaybe) import Data.Primitive (ByteArray)+import Data.Primitive (PrimArray)+import Data.Text.Short (ShortText) import Data.WideWord (Word128(Word128),Word256(Word256))+import Data.Word import Numeric.Natural (Natural)-import Test.Tasty (defaultMain,testGroup,TestTree) import Test.QuickCheck ((===),Arbitrary) import Test.QuickCheck.Instances.Natural ()-import Text.Printf (printf)+import Test.Tasty (defaultMain,testGroup,TestTree) import Test.Tasty.HUnit ((@=?))+import Text.Printf (printf)  import qualified Arithmetic.Nat as Nat import qualified Data.Bits as Bits-import qualified Data.Bytes.Builder.Bounded as Bounded import qualified Data.Bytes as Bytes+import qualified Data.Bytes.Builder as Builder+import qualified Data.Bytes.Builder.Bounded as Bounded+import qualified Data.Bytes.Chunks as Chunks+import qualified Data.Bytes.Text.Ascii as Ascii+import qualified Data.Bytes.Text.Latin1 as Latin1 import qualified Data.ByteString as ByteString import qualified Data.ByteString.Builder as BB import qualified Data.ByteString.Lazy.Char8 as LB-import qualified Data.Bytes.Chunks as Chunks import qualified Data.List as L import qualified Data.Primitive as PM import qualified Data.Text as T@@ -286,6 +293,28 @@           , 0x00 : 0x09 : map c2w "listening"           ] @=? map Exts.toList (Exts.toList res)     ]+  , testGroup "bytes templates"+    [ THU.testCase "A" $ do+        let name = Just ("foo" :: ShortText)+            msgBuilder = [bldr|Hello `fromMaybe "World" name`!\n|]+            msg = Chunks.concat . Builder.run 200 $ msgBuilder+         in Ascii.fromString "Hello foo!\n" @=? msg+    , THU.testCase "B" $ do+        let one = "foo" :: ShortText+            two = "bar" :: String+            msgBuilder = [bldr|`one``two`|]+            msg = Chunks.concat . Builder.run 200 $ msgBuilder+         in Ascii.fromString "foobar" @=? msg+    , THU.testCase "C" $ do+        let msgBuilder = [bldr|a backtick for you: \`|]+            msg = Chunks.concat . Builder.run 200 $ msgBuilder+         in Ascii.fromString "a backtick for you: `" @=? msg+    , THU.testCase "D" $ do+        let i = 137 :: Int+            msgBuilder = [bldr|there are `i` lights!|]+            msg = Chunks.concat . Builder.run 200 $ msgBuilder+         in Ascii.fromString "there are 137 lights!" @=? msg+    ]   ]  bytesOntoRef ::@@ -335,7 +364,7 @@  instance Show AsciiByteArray where   show (AsciiByteArray b) = if Bytes.all (\w -> w >= 32 && w < 127) (Bytes.fromByteArray b)-    then Bytes.toLatinString (Bytes.fromByteArray b)+    then Latin1.toString (Bytes.fromByteArray b)     else show (show b)  instance Arbitrary Word128 where