packages feed

base16 0.3.2.1 → 1.0

raw patch · 21 files changed

+703/−198 lines, 21 filesdep ~basedep ~bytestringdep ~deepseqsetup-changedPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base, bytestring, deepseq, primitive, text

API changes (from Hackage documentation)

+ Data.Base16.Types: assertBase16 :: a -> Base16 a
+ Data.Base16.Types: data Base16 a
+ Data.Base16.Types: extractBase16 :: Base16 a -> a
+ Data.ByteString.Base16: decodeBase16Untyped :: ByteString -> Either Text ByteString
+ Data.ByteString.Lazy.Base16: decodeBase16Untyped :: ByteString -> Either Text ByteString
+ Data.ByteString.Short.Base16: decodeBase16Untyped :: ShortByteString -> Either Text ShortByteString
+ Data.Text.Encoding.Base16: decodeBase16Untyped :: Text -> Either Text Text
+ Data.Text.Lazy.Encoding.Base16: decodeBase16Untyped :: Text -> Either Text Text
+ Data.Text.Short.Encoding.Base16: decodeBase16Untyped :: ShortText -> Either Text ShortText
- Data.ByteString.Base16: decodeBase16 :: ByteString -> Either Text ByteString
+ Data.ByteString.Base16: decodeBase16 :: Base16 ByteString -> ByteString
- Data.ByteString.Base16: decodeBase16' :: Text -> Either Text ByteString
+ Data.ByteString.Base16: decodeBase16' :: Base16 Text -> ByteString
- Data.ByteString.Base16: encodeBase16 :: ByteString -> Text
+ Data.ByteString.Base16: encodeBase16 :: ByteString -> Base16 Text
- Data.ByteString.Base16: encodeBase16' :: ByteString -> ByteString
+ Data.ByteString.Base16: encodeBase16' :: ByteString -> Base16 ByteString
- Data.ByteString.Lazy.Base16: decodeBase16 :: ByteString -> Either Text ByteString
+ Data.ByteString.Lazy.Base16: decodeBase16 :: Base16 ByteString -> ByteString
- Data.ByteString.Lazy.Base16: decodeBase16' :: Text -> Either Text ByteString
+ Data.ByteString.Lazy.Base16: decodeBase16' :: Base16 Text -> ByteString
- Data.ByteString.Lazy.Base16: encodeBase16 :: ByteString -> Text
+ Data.ByteString.Lazy.Base16: encodeBase16 :: ByteString -> Base16 Text
- Data.ByteString.Lazy.Base16: encodeBase16' :: ByteString -> ByteString
+ Data.ByteString.Lazy.Base16: encodeBase16' :: ByteString -> Base16 ByteString
- Data.ByteString.Short.Base16: decodeBase16 :: ShortByteString -> Either Text ShortByteString
+ Data.ByteString.Short.Base16: decodeBase16 :: Base16 ShortByteString -> ShortByteString
- Data.ByteString.Short.Base16: decodeBase16' :: ShortText -> Either Text ShortByteString
+ Data.ByteString.Short.Base16: decodeBase16' :: Base16 ShortText -> ShortByteString
- Data.ByteString.Short.Base16: encodeBase16 :: ShortByteString -> ShortText
+ Data.ByteString.Short.Base16: encodeBase16 :: ShortByteString -> Base16 ShortText
- Data.ByteString.Short.Base16: encodeBase16' :: ShortByteString -> ShortByteString
+ Data.ByteString.Short.Base16: encodeBase16' :: ShortByteString -> Base16 ShortByteString
- Data.Text.Encoding.Base16: decodeBase16 :: Text -> Either Text Text
+ Data.Text.Encoding.Base16: decodeBase16 :: Base16 Text -> Text
- Data.Text.Encoding.Base16: encodeBase16 :: Text -> Text
+ Data.Text.Encoding.Base16: encodeBase16 :: Text -> Base16 Text
- Data.Text.Lazy.Encoding.Base16: decodeBase16 :: Text -> Either Text Text
+ Data.Text.Lazy.Encoding.Base16: decodeBase16 :: Base16 Text -> Text
- Data.Text.Lazy.Encoding.Base16: encodeBase16 :: Text -> Text
+ Data.Text.Lazy.Encoding.Base16: encodeBase16 :: Text -> Base16 Text
- Data.Text.Short.Encoding.Base16: decodeBase16 :: ShortText -> Either Text ShortText
+ Data.Text.Short.Encoding.Base16: decodeBase16 :: Base16 ShortText -> ShortText
- Data.Text.Short.Encoding.Base16: encodeBase16 :: ShortText -> ShortText
+ Data.Text.Short.Encoding.Base16: encodeBase16 :: ShortText -> Base16 ShortText

Files

CHANGELOG.md view
@@ -1,5 +1,18 @@ # Revision history for base16 +## 1.0++- Revamp api (see: [MIGRATION-1.0.md](MIGRATION-1.0.md) in the source repo)+  - Add new `Base16` opaque wrapper for encoded strings+  - Move `decode*` to `decode*Typed` for untyped bytestring values+  - Make typed decoding the default+  - Optimize loops in the typed case++- Bump lower bound on `bytestring` to `bytestring-0.11`+- Bump lower bound on `text` to `text-2.0`+- Support for all recent GHCs+- Removed support for SafeHaskell+ ## 0.3.2.1  * Add support for GHC 9.4
+ MIGRATION-1.0.md view
@@ -0,0 +1,177 @@+Migration Guide for 1.0+----++Between the last major version (0.3.2.1) and the current major epoch (1.0), many API-related constructs have changed, and I'd like to justify them here and now so that users may have an immortalized explanation for what is most likely a disruptive change to their code.++## A faster loop++First, I'd like to say that I don't *like* breaking people's code. As an author and maintainer, I try and make sure that any API breakages are justified either by a significant UX improvement, or by a measurable performance increase large enough to warrant such a breakage. As such, I believe both of these criteria are met by the 0.3.x -> 1.0 upgrade: not only is the API safer to use, but the use of type data to establish the provenance of values encoded by this library also allows the performance-sensitive loops to be much cleaner, eschewing error checking where type data suffices. To prove this point, I've benchmarked the library between these last two epochs. The benchmarks say it all (all benchmarks are done on a Thinkpad P15 Gen 2 Intel i9-11950H, 64GB DDR4, Ubuntu 22.04 with GHC 8.10.7 stock, -O2):++In `base16-0.3.2.1`:++```+benchmarking decode/25/base16-bytestring+time                 31.66 ns   (31.64 ns .. 31.69 ns)+                     1.000 R²   (1.000 R² .. 1.000 R²)+mean                 31.62 ns   (31.60 ns .. 31.67 ns)+std dev              113.1 ps   (71.94 ps .. 207.9 ps)++benchmarking decode/25/base16+time                 32.31 ns   (32.27 ns .. 32.35 ns)+                     1.000 R²   (1.000 R² .. 1.000 R²)+mean                 32.33 ns   (32.30 ns .. 32.42 ns)+std dev              178.2 ps   (84.80 ps .. 340.1 ps)++benchmarking decode/100/base16-bytestring+time                 74.31 ns   (74.27 ns .. 74.35 ns)+                     1.000 R²   (1.000 R² .. 1.000 R²)+mean                 74.37 ns   (74.34 ns .. 74.41 ns)+std dev              122.0 ps   (102.0 ps .. 147.8 ps)++benchmarking decode/100/base16+time                 83.74 ns   (83.70 ns .. 83.78 ns)+                     1.000 R²   (1.000 R² .. 1.000 R²)+mean                 83.57 ns   (83.43 ns .. 83.68 ns)+std dev              380.3 ps   (273.2 ps .. 473.3 ps)++benchmarking decode/1k/base16-bytestring+time                 582.5 ns   (582.3 ns .. 582.8 ns)+                     1.000 R²   (1.000 R² .. 1.000 R²)+mean                 582.8 ns   (582.6 ns .. 583.1 ns)+std dev              791.4 ps   (632.0 ps .. 1.101 ns)++benchmarking decode/1k/base16+time                 686.1 ns   (685.7 ns .. 686.4 ns)+                     1.000 R²   (1.000 R² .. 1.000 R²)+mean                 686.2 ns   (685.9 ns .. 686.6 ns)+std dev              1.086 ns   (910.3 ps .. 1.357 ns)++benchmarking decode/10k/base16-bytestring+time                 5.640 μs   (5.633 μs .. 5.649 μs)+                     1.000 R²   (1.000 R² .. 1.000 R²)+mean                 5.663 μs   (5.656 μs .. 5.671 μs)+std dev              25.71 ns   (21.29 ns .. 29.83 ns)++benchmarking decode/10k/base16+time                 6.628 μs   (6.609 μs .. 6.649 μs)+                     1.000 R²   (1.000 R² .. 1.000 R²)+mean                 6.614 μs   (6.609 μs .. 6.622 μs)+std dev              20.78 ns   (12.02 ns .. 37.27 ns)++benchmarking decode/100k/base16-bytestring+time                 58.41 μs   (58.38 μs .. 58.45 μs)+                     1.000 R²   (1.000 R² .. 1.000 R²)+mean                 58.41 μs   (58.38 μs .. 58.45 μs)+std dev              111.5 ns   (90.90 ns .. 152.0 ns)++benchmarking decode/100k/base16+time                 66.40 μs   (66.21 μs .. 66.64 μs)+                     1.000 R²   (1.000 R² .. 1.000 R²)+mean                 66.55 μs   (66.47 μs .. 66.62 μs)+std dev              264.0 ns   (209.8 ns .. 332.3 ns)++benchmarking decode/1mm/base16-bytestring+time                 577.4 μs   (576.6 μs .. 578.1 μs)+                     1.000 R²   (1.000 R² .. 1.000 R²)+mean                 577.0 μs   (576.5 μs .. 577.6 μs)+std dev              1.997 μs   (1.661 μs .. 2.474 μs)++benchmarking decode/1mm/base16+time                 670.9 μs   (670.3 μs .. 671.5 μs)+                     1.000 R²   (1.000 R² .. 1.000 R²)+mean                 671.1 μs   (670.7 μs .. 671.9 μs)+std dev              2.003 μs   (1.211 μs .. 3.227 μs)+```++vs in `base64-1.0.0.0`:++```+benchmarking decode/25/base16-bytestring+time                 24.29 ns   (24.27 ns .. 24.32 ns)+                     1.000 R²   (1.000 R² .. 1.000 R²)+mean                 24.27 ns   (24.24 ns .. 24.30 ns)+std dev              95.03 ps   (76.90 ps .. 125.9 ps)++benchmarking decode/25/base16+time                 25.64 ns   (25.49 ns .. 25.81 ns)+                     1.000 R²   (1.000 R² .. 1.000 R²)+mean                 25.64 ns   (25.57 ns .. 25.72 ns)+std dev              262.9 ps   (220.7 ps .. 312.9 ps)++benchmarking decode/100/base16-bytestring+time                 75.10 ns   (74.95 ns .. 75.31 ns)+                     1.000 R²   (1.000 R² .. 1.000 R²)+mean                 75.33 ns   (75.25 ns .. 75.40 ns)+std dev              267.5 ps   (202.6 ps .. 340.3 ps)++benchmarking decode/100/base16+time                 60.99 ns   (60.92 ns .. 61.05 ns)+                     1.000 R²   (1.000 R² .. 1.000 R²)+mean                 60.95 ns   (60.89 ns .. 61.03 ns)+std dev              238.1 ps   (186.6 ps .. 325.0 ps)++benchmarking decode/1k/base16-bytestring+time                 606.2 ns   (605.3 ns .. 607.4 ns)+                     1.000 R²   (1.000 R² .. 1.000 R²)+mean                 606.4 ns   (605.5 ns .. 609.2 ns)+std dev              4.832 ns   (1.865 ns .. 9.636 ns)++benchmarking decode/1k/base16+time                 472.5 ns   (472.0 ns .. 473.0 ns)+                     1.000 R²   (1.000 R² .. 1.000 R²)+mean                 471.6 ns   (471.3 ns .. 472.0 ns)+std dev              1.165 ns   (965.8 ps .. 1.434 ns)++benchmarking decode/10k/base16-bytestring+time                 5.885 μs   (5.881 μs .. 5.890 μs)+                     1.000 R²   (1.000 R² .. 1.000 R²)+mean                 5.891 μs   (5.888 μs .. 5.895 μs)+std dev              13.03 ns   (10.87 ns .. 16.58 ns)++benchmarking decode/10k/base16+time                 4.560 μs   (4.551 μs .. 4.567 μs)+                     1.000 R²   (1.000 R² .. 1.000 R²)+mean                 4.549 μs   (4.544 μs .. 4.554 μs)+std dev              16.61 ns   (14.04 ns .. 19.41 ns)++benchmarking decode/100k/base16-bytestring+time                 58.71 μs   (58.56 μs .. 58.84 μs)+                     1.000 R²   (1.000 R² .. 1.000 R²)+mean                 58.59 μs   (58.54 μs .. 58.66 μs)+std dev              201.4 ns   (163.3 ns .. 251.0 ns)++benchmarking decode/100k/base16+time                 45.74 μs   (45.69 μs .. 45.80 μs)+                     1.000 R²   (1.000 R² .. 1.000 R²)+mean                 45.72 μs   (45.67 μs .. 45.78 μs)+std dev              172.5 ns   (146.4 ns .. 209.1 ns)++benchmarking decode/1mm/base16-bytestring+time                 584.6 μs   (583.1 μs .. 586.7 μs)+                     1.000 R²   (1.000 R² .. 1.000 R²)+mean                 587.8 μs   (586.7 μs .. 589.0 μs)+std dev              3.931 μs   (3.108 μs .. 5.364 μs)++benchmarking decode/1mm/base16+time                 459.0 μs   (458.5 μs .. 459.7 μs)+                     1.000 R²   (1.000 R² .. 1.000 R²)+mean                 458.9 μs   (458.4 μs .. 459.5 μs)+std dev              1.839 μs   (1.355 μs .. 2.951 μs)+```++Benchmarks are included in this repo for you to reproduce these results on your own. You can see a parity in the `encode` step between the previous library iterations and the new epoch, with a *marked* improvement in decode speed (up to 25% faster on average between the old and new versions in the optimal case, and up to 40% in the suboptimal case) which justifies the performance aspect to me. Without deferring to pipelining instructions, hex encoding can only get so fast. In the future, this change also opens the library up to an optimal SIMD implementations.++## A sounder api++Second, I do not believe that these changes are unsound or overburdensome to the point that a migration to the new paradigm would be untenable. While it may be inconvenient to unwrap `Base16` types, in the `encode` case (all one must do is call `extractBase16` to extract the value from its wrapper, all caveats implied), and in the case of `decode`, an untyped variant is supplied, and is semantically consistent with the old behavior (the loop is the same). Hence, a migration is fairly easy to sketch out:++```+"encodeBase16'" -> "extractBase16 . encodeBase16'"+"encodeBase16" -> "extractBase16 . encodeBase16"+"decodebase16" -> "decodeBase16Untyped"+"decodeBase16Unpadded" -> "decodeBase16UnpaddedUntyped"+"decodeBase16Padded" -> "decodeBase16PaddedUntyped"+"decodeBase16W*With" -> "decodeBase16*WithUntyped"+```++And that is all. In order to make use of the new loops, one must only `assertBase16` and proceed with using `decodeBase16` as usual in order to decode. You'll note that an untyped `encodeBase16` is not supplied, and this is due to the fact that it's trivial to extract a `Base16` encoded value once you have it. However, I want to encourage people to use the new API, so I have only supplied a decode with error checking in the untyped case, because sometimes we deal with other people's data and cannot establish provenance. In the encode case, I would rather keep that provenance a part of the API, and the user may opt to strip that data upon sending to others or around their systems. It's not my problem at that point!
README.md view
@@ -1,6 +1,6 @@ # Base16 -![Build Status](https://github.com/emilypi/base16/workflows/Haskell-CI/badge.svg)+![Build Status](https://github.com/emilypi/base16/workflows/ci/badge.svg) [![Hackage](https://img.shields.io/hackage/v/base16.svg)](https://hackage.haskell.org/package/base16)  RFC 4648-compliant Base16 encoding and decoding.
− Setup.hs
@@ -1,2 +0,0 @@-import Distribution.Simple-main = defaultMain
base16.cabal view
@@ -1,6 +1,6 @@ cabal-version:   3.0 name:            base16-version:         0.3.2.1+version:         1.0 synopsis:        Fast RFC 4648-compliant Base16 encoding description:   RFC 4648-compliant Base16 encodings and decodings.@@ -12,18 +12,20 @@ license-file:    LICENSE author:          Emily Pillmore maintainer:      emilypi@cohomolo.gy-copyright:       (c) 2020-2022 Emily Pillmore+copyright:       (c) 2020-2023 Emily Pillmore category:        Data build-type:      Simple extra-doc-files:   CHANGELOG.md   README.md+  MIGRATION-1.0.md  tested-with:   GHC ==8.10.7    || ==9.0.2    || ==9.2.5-   || ==9.4.3+   || ==9.4.5+   || ==9.6.2  source-repository head   type:     git@@ -31,6 +33,7 @@  library   exposed-modules:+    Data.Base16.Types     Data.ByteString.Base16     Data.ByteString.Lazy.Base16     Data.ByteString.Short.Base16@@ -40,40 +43,41 @@     Data.Text.Short.Encoding.Base16    other-modules:+    Data.Base16.Types.Internal     Data.ByteString.Base16.Internal.Head     Data.ByteString.Base16.Internal.Utils     Data.ByteString.Base16.Internal.W16.Loop     Data.ByteString.Base16.Internal.W16.ShortLoop    build-depends:-      base        >=4.14 && <4.18-    , bytestring  >=0.10 && <0.12-    , deepseq     ^>=1.4-    , primitive   >=0.6  && <0.8-    , text        ^>=1.2 || ^>= 2.0+      base        >=4.14 && <4.19+    , bytestring  ^>=0.11+    , deepseq     ^>=1.4.4.0+    , primitive   >=0.6  && <0.9+    , text        ^>= 2.0     , text-short  ^>=0.1    hs-source-dirs:   src   default-language: Haskell2010   ghc-options:      -Wall -test-suite tasty+test-suite base16-tests   other-modules:    Internal   default-language: Haskell2010   type:             exitcode-stdio-1.0   hs-source-dirs:   test   main-is:          Main.hs   build-depends:-      base               >=4.14 && <4.18+      base               >=4.14 && <4.19     , base16     , base16-bytestring  >=1.0-    , bytestring+    , bytestring         ^>=0.11     , QuickCheck     , random-bytestring     , tasty     , tasty-hunit     , tasty-quickcheck-    , text+    , text               ^>=2.0     , text-short  benchmark bench@@ -82,11 +86,11 @@   hs-source-dirs:   benchmarks   main-is:          Base16Bench.hs   build-depends:-      base               >=4.14 && <4.18+      base               >=4.14 && <4.19     , base16     , base16-bytestring  >=1.0-    , bytestring+    , bytestring         ^>=0.11     , criterion     , deepseq     , random-bytestring-    , text+    , text               ^>=2.0
benchmarks/Base16Bench.hs view
@@ -7,6 +7,7 @@ import Criterion import Criterion.Main +import Data.Base16.Types import Data.ByteString import Data.ByteString.Short import "base16" Data.ByteString.Base16 as B16@@ -55,33 +56,39 @@       bgroup "decode"       [ bgroup "25"         [ bench "base16-short" $ whnf BS16.decodeBase16 bs25L-        , bench "base16-bytestring" $ whnf Bos.decode bs25+        , bench "base16-bytestring" $ whnf Bos.decode $ extractBase16 bs25         , bench "base16" $ whnf B16.decodeBase16 bs25+        , bench "base16-untyped" $ whnf B16.decodeBase16Untyped $ extractBase16 bs25         ]       , bgroup "100"         [ bench "base16-short" $ whnf BS16.decodeBase16 bs100L-        , bench "base16-bytestring" $ whnf Bos.decode bs100+        , bench "base16-bytestring" $ whnf Bos.decode $ extractBase16 bs100         , bench "base16" $ whnf B16.decodeBase16 bs100+        , bench "base16-untyped" $ whnf B16.decodeBase16Untyped $ extractBase16 bs100         ]       , bgroup "1k"         [ bench "base16-short" $ whnf BS16.decodeBase16 bs1kL-        , bench "base16-bytestring" $ whnf Bos.decode bs1k+        , bench "base16-bytestring" $ whnf Bos.decode $ extractBase16 bs1k         , bench "base16" $ whnf B16.decodeBase16 bs1k+        , bench "base16-untyped" $ whnf B16.decodeBase16Untyped $ extractBase16 bs1k         ]       , bgroup "10k"         [ bench "base16-short" $ whnf BS16.decodeBase16 bs10kL-        , bench "base16-bytestring" $ whnf Bos.decode bs10k+        , bench "base16-bytestring" $ whnf Bos.decode $ extractBase16 bs10k         , bench "base16" $ whnf B16.decodeBase16 bs10k+        , bench "base16-untyped" $ whnf B16.decodeBase16Untyped $ extractBase16 bs10k         ]       , bgroup "100k"         [ bench "base16-short" $ whnf BS16.decodeBase16 bs100kL-        , bench "base16-bytestring" $ whnf Bos.decode bs100k+        , bench "base16-bytestring" $ whnf Bos.decode $ extractBase16 bs100k         , bench "base16" $ whnf B16.decodeBase16 bs100k+        , bench "base16-untyped" $ whnf B16.decodeBase16Untyped $ extractBase16 bs100k         ]       , bgroup "1mm"         [ bench "base16-short" $ whnf BS16.decodeBase16 bs1mmL-        , bench "base16-bytestring" $ whnf Bos.decode bs1mm+        , bench "base16-bytestring" $ whnf Bos.decode $ extractBase16 bs1mm         , bench "base16" $ whnf B16.decodeBase16 bs1mm+        , bench "base16-untyped" $ whnf B16.decodeBase16Untyped $ extractBase16 bs1mm         ]       ]     ]@@ -96,10 +103,11 @@       return ((a,b,c,d,e,f),(toShort a,toShort b,toShort c,toShort d,toShort e,toShort f))      bs' = do+      let k = fmap toShort       a <- B16.encodeBase16' <$> random 25       b <- B16.encodeBase16' <$> random 100       c <- B16.encodeBase16' <$> random 1000       d <- B16.encodeBase16' <$> random 10000       e <- B16.encodeBase16' <$> random 100000       f <- B16.encodeBase16' <$> random 1000000-      return ((a,b,c,d,e,f),(toShort a,toShort b,toShort c,toShort d,toShort e,toShort f))+      return ((a,b,c,d,e,f),(k a,k b,k c,k d,k e,k f))
+ src/Data/Base16/Types.hs view
@@ -0,0 +1,42 @@+{-# language ExplicitNamespaces #-}+-- |+-- Module       : Data.ByteString.Base16.Types+-- Copyright    : (c) 2019-2022 Emily Pillmore+-- License      : BSD-style+--+-- Maintainer   : Emily Pillmore <emilypi@cohomolo.gy>,+--                sofia-m-a <https://github.com/sofia-m-a>+-- Stability    : stable+-- Portability  : non-portable+--+-- This module contains the 'Base16' type definition, 'Alphabet'+-- datatype, alphabet constraints, and various quality of life+-- combinators for working with 'Base16'-wrapped data.+--+module Data.Base16.Types+( type Base16+, assertBase16+, extractBase16+) where+++import Data.Base16.Types.Internal (Base16(..))++-- | Assert the provenance of a value.+--+-- /Warning/: This is a blind assertion that a particular+-- value is base16 encoded in some alphabet. If you are not+-- sure of the provenance of the value, you may experience+-- odd behavior when attempting to decode. Use at your own+-- risk. If I see any issues logged on this project from+-- negligent use of this, Sofia and I will smite you.+--+assertBase16 :: a -> Base16 a+assertBase16 = Base16+{-# inline assertBase16 #-}++-- | Forget that a particular value is Base16-encoded+--+extractBase16 :: Base16 a -> a+extractBase16 (Base16 a) = a+{-# inline extractBase16 #-}
+ src/Data/Base16/Types/Internal.hs view
@@ -0,0 +1,56 @@+-- |+-- Module       : Data.ByteString.Base16.Types.Internal+-- Copyright    : (c) 2019-2022 Emily Pillmore+-- License      : BSD-style+--+-- Maintainer   : Emily Pillmore <emilypi@cohomolo.gy>,+--                sofia-m-a <https://github.com/sofia-m-a>+-- Stability    : stable+-- Portability  : non-portable+--+-- This module contains the 'Base16' newtype.+--+module Data.Base16.Types.Internal+( Base16(..)+) where+++import Control.DeepSeq++import Data.Functor.Classes++-- | Wraps a value, asserting that it is or is intended to be+-- in a particular kind of Base16 encoding use 'extractBase16'+-- to extract the value, and 'assertBase16' to tag a value+-- as base16-encoded+--+newtype Base16 a = Base16 a++instance Eq a => Eq (Base16 a) where+  Base16 a == Base16 b = a == b++instance Eq1 Base16 where+  liftEq f (Base16 a) (Base16 b) = f a b++instance Ord a => Ord (Base16 a) where+  compare (Base16 a) (Base16 b) = compare a b++instance Ord1 Base16 where+  liftCompare f (Base16 a) (Base16 b) = f a b++instance Functor Base16 where+  fmap f (Base16 a) = Base16 (f a)++instance Applicative Base16 where+  pure = Base16+  Base16 f <*> Base16 a = Base16 (f a)++instance Monad Base16 where+  return = pure+  Base16 a >>= k = k a++instance Show a => Show (Base16 a) where+  show (Base16 a) = show a++instance NFData a => NFData (Base16 a) where+  rnf (Base16 a) = rnf a
src/Data/ByteString/Base16.hs view
@@ -1,8 +1,7 @@ {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE Trustworthy #-} -- | -- Module       : Data.ByteString.Base16--- Copyright    : (c) 2020 Emily Pillmore+-- Copyright    : (c) 2020-2023 Emily Pillmore -- License      : BSD-style -- -- Maintainer   : Emily Pillmore <emilypi@cohomolo.gy>@@ -19,6 +18,7 @@ , encodeBase16' , decodeBase16 , decodeBase16'+, decodeBase16Untyped , decodeBase16Lenient , isBase16 , isValidBase16@@ -27,14 +27,20 @@  import Prelude hiding (all, elem) +import Data.Base16.Types import Data.ByteString (ByteString, all, elem) import Data.ByteString.Base16.Internal.Head import Data.Either import Data.Text (Text) import qualified Data.Text.Encoding as T +-- $setup+--+-- >>> import Data.Base16.Types+-- >>> :set -XOverloadedStrings+-- --- | Encode a 'ByteString' value as Base16 'Text' with padding.+-- | Encode a 'ByteString' value as Base16 'Text' -- -- See: <https://tools.ietf.org/html/rfc4648#section-8 RFC-4648 section 8> --@@ -43,11 +49,11 @@ -- >>> encodeBase16 "Sun" -- "53756e" ---encodeBase16 :: ByteString -> Text-encodeBase16 = T.decodeUtf8 . encodeBase16'+encodeBase16 :: ByteString -> Base16 Text+encodeBase16 = fmap T.decodeUtf8 . encodeBase16' {-# INLINE encodeBase16 #-} --- | Encode a 'ByteString' value as a Base16 'ByteString'  value with padding.+-- | Encode a 'ByteString' value as a Base16 'ByteString' value -- -- See: <https://tools.ietf.org/html/rfc4648#section-8 RFC-4648 section 8> --@@ -56,8 +62,8 @@ -- >>> encodeBase16' "Sun" -- "53756e" ---encodeBase16' :: ByteString -> ByteString-encodeBase16' = encodeBase16_+encodeBase16' :: ByteString -> Base16 ByteString+encodeBase16' = assertBase16 . encodeBase16_ {-# INLINE encodeBase16' #-}  -- | Decode a Base16-encoded 'ByteString' value.@@ -66,14 +72,11 @@ -- -- === __Examples__: ----- >>> decodeBase16 "53756e"--- Right "Sun"------ >>> decodeBase16 "6x"--- Left "invalid character at offset: 1"+-- >>> decodeBase16 $ assertBase16 "53756e"+-- "Sun" ---decodeBase16 :: ByteString -> Either Text ByteString-decodeBase16 = decodeBase16_+decodeBase16 :: Base16 ByteString -> ByteString+decodeBase16 = decodeBase16Typed_ {-# INLINE decodeBase16 #-}  -- | Decode Base16 'Text'.@@ -82,15 +85,28 @@ -- -- === __Examples__: ----- >>> decodeBase16' "53756e"+-- >>> decodeBase16' $ assertBase16 "53756e"+-- "Sun"+--+decodeBase16' :: Base16 Text -> ByteString+decodeBase16' = decodeBase16Typed_ . fmap T.encodeUtf8+{-# INLINE decodeBase16' #-}++-- | Decode an untyped Base16-encoded 'ByteString' value with error-checking.+--+-- See: <https://tools.ietf.org/html/rfc4648#section-8 RFC-4648 section 8>+--+-- === __Examples__:+--+-- >>> decodeBase16Untyped "53756e" -- Right "Sun" ----- >>> decodeBase16' "6x"+-- >>> decodeBase16Untyped "6x" -- Left "invalid character at offset: 1" ---decodeBase16' :: Text -> Either Text ByteString-decodeBase16' = decodeBase16 . T.encodeUtf8-{-# INLINE decodeBase16' #-}+decodeBase16Untyped :: ByteString -> Either Text ByteString+decodeBase16Untyped = decodeBase16_+{-# INLINE decodeBase16Untyped #-}  -- | Decode a Base16-encoded 'ByteString' value leniently, using a -- strategy that never fails@@ -109,7 +125,7 @@ decodeBase16Lenient = decodeBase16Lenient_ {-# INLINE decodeBase16Lenient #-} --- | Tell whether a 'ByteString' value is base16 encoded.+-- | Tell whether an untyped 'ByteString' value is base16 encoded. -- -- === __Examples__: --@@ -120,10 +136,10 @@ -- True -- isBase16 :: ByteString -> Bool-isBase16 bs = isValidBase16 bs && isRight (decodeBase16 bs)+isBase16 bs = isValidBase16 bs && isRight (decodeBase16Untyped bs) {-# INLINE isBase16 #-} --- | Tell whether a 'ByteString' value is a valid Base16 format.+-- | Tell whether an untyped 'ByteString' value is a valid Base16 format. -- -- This will not tell you whether or not this is a correct Base16 representation, -- only that it conforms to the correct alphabet. To check whether it is a true@@ -138,5 +154,5 @@ -- True -- isValidBase16 :: ByteString -> Bool-isValidBase16 = all (flip elem "0123456789abcdefABCDEF")+isValidBase16 = all (`elem` "0123456789abcdefABCDEF") {-# INLINE isValidBase16 #-}
src/Data/ByteString/Base16/Internal/Head.hs view
@@ -1,20 +1,19 @@ {-# LANGUAGE BangPatterns #-}-{-# LANGUAGE CPP #-} {-# LANGUAGE MagicHash #-}-{-# LANGUAGE MultiWayIf #-} {-# LANGUAGE OverloadedStrings #-} module Data.ByteString.Base16.Internal.Head ( encodeBase16_ , decodeBase16_+, decodeBase16Typed_ , decodeBase16Lenient_ , encodeBase16Short_ , decodeBase16Short_+, decodeBase16ShortTyped_ , decodeBase16ShortLenient_ ) where  -#include "MachDeps.h"-+import Data.Base16.Types.Internal (Base16(..)) import qualified Data.ByteString as BS (empty) import Data.ByteString.Internal import qualified Data.ByteString.Short as SBS (empty)@@ -37,19 +36,19 @@ -- | Head of the base16 encoding loop - marshal data, assemble loops -- encodeBase16_ :: ByteString -> ByteString-encodeBase16_ (PS !sfp !soff !slen) =+encodeBase16_ (PS sfp soff slen) =     unsafeCreate dlen $ \dptr ->-      withForeignPtr sfp $ \sptr ->+      withForeignPtr sfp $ \sptr -> do         innerLoop-          (castPtr dptr)-          (castPtr (plusPtr sptr soff))-          (plusPtr sptr (soff + slen))+          dptr+          (plusPtr sptr soff)+          (plusPtr sptr $ slen + soff)   where     !dlen = 2 * slen {-# INLINE encodeBase16_ #-}  decodeBase16_ :: ByteString -> Either Text ByteString-decodeBase16_ (PS !sfp !soff !slen)+decodeBase16_ (PS sfp soff slen)   | slen == 0 = Right BS.empty   | r /= 0 = Left "invalid bytestring size"   | otherwise = unsafeDupablePerformIO $ do@@ -60,17 +59,28 @@           dfp           dptr           (plusPtr sptr soff)-          (plusPtr sptr (soff + slen))-          0+          (plusPtr sptr $ slen + soff)+          q   where     !q = slen `quot` 2     !r = slen `rem` 2 {-# INLINE decodeBase16_ #-} +decodeBase16Typed_ :: Base16 ByteString -> ByteString+decodeBase16Typed_ (Base16 (PS sfp soff slen)) =+  unsafeCreate q $ \dptr ->+    withForeignPtr sfp $ \sptr ->+      decodeLoopTyped+        dptr+        (plusPtr sptr soff)+        (plusPtr sptr $ slen + soff)+  where+    !q = slen `quot` 2+{-# INLINE decodeBase16Typed_ #-}+ decodeBase16Lenient_ :: ByteString -> ByteString-decodeBase16Lenient_ (PS !sfp !soff !slen)-  | slen == 0 = BS.empty-  | otherwise = unsafeDupablePerformIO $ do+decodeBase16Lenient_ (PS sfp soff slen) =+  unsafeDupablePerformIO $ do     dfp <- mallocPlainForeignPtrBytes q     withForeignPtr dfp $ \dptr ->       withForeignPtr sfp $ \sptr ->@@ -78,7 +88,7 @@           dfp           dptr           (plusPtr sptr soff)-          (plusPtr sptr (soff + slen))+          (plusPtr sptr $ slen + soff)           0   where     !q = slen `quot` 2@@ -109,6 +119,16 @@     !q = l `quot` 2     !r = l `rem` 2 {-# INLINE decodeBase16Short_ #-}++decodeBase16ShortTyped_ :: Base16 ShortByteString -> ShortByteString+decodeBase16ShortTyped_ (Base16 (SBS !ba#)) = runDecodeST' $ do+    dst <- newByteArray q+    Short.decodeLoopTyped l dst (MutableByteArray (unsafeCoerce# ba#))+  where+    !l = I# (sizeofByteArray# ba#)+    !q = l `quot` 2+{-# INLINE decodeBase16ShortTyped_ #-}+  decodeBase16ShortLenient_ :: ShortByteString -> ShortByteString decodeBase16ShortLenient_ (SBS !ba#)
src/Data/ByteString/Base16/Internal/Utils.hs view
@@ -7,6 +7,7 @@ , reChunk , runShortST , runDecodeST+, runDecodeST' ) where  @@ -71,3 +72,12 @@     }   } {-# INLINE runDecodeST #-}++runDecodeST'+    :: (forall s. ST s ByteArray)+    -> ShortByteString+runDecodeST' dec = runRW# $ \s0 -> case dec of+  { ST g -> case g s0 of+      (# _, ByteArray r #) -> SBS r+  }+{-# inline runDecodeST' #-}
src/Data/ByteString/Base16/Internal/W16/Loop.hs view
@@ -18,6 +18,7 @@ module Data.ByteString.Base16.Internal.W16.Loop ( innerLoop , decodeLoop+, decodeLoopTyped , lenientLoop ) where @@ -55,7 +56,6 @@         poke (plusPtr dst 1) (aix (t .&. 0x0f) hex)          go (plusPtr dst 2) (plusPtr src 1)-{-# INLINE innerLoop #-}  -- | Hex decoding loop optimized for 16-bit architectures --@@ -66,7 +66,7 @@   -> Ptr Word8   -> Int   -> IO (Either Text ByteString)-decodeLoop !dfp !dptr !sptr !end !nn = go dptr sptr nn+decodeLoop !dfp !dptr !sptr !end !l = go dptr sptr   where     err !src = return . Left . T.pack       $ "invalid character at offset: "@@ -76,8 +76,8 @@      !hi = "\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x10\x20\x30\x40\x50\x60\x70\x80\x90\xff\xff\xff\xff\xff\xff\xff\xa0\xb0\xc0\xd0\xe0\xf0\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xa0\xb0\xc0\xd0\xe0\xf0\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"# -    go !dst !src !n-      | src == end = return (Right (PS dfp 0 n))+    go !dst !src+      | src == end = return $ Right (PS dfp 0 l)       | otherwise = do         !x <- peek @Word8 src         !y <- peek @Word8 (plusPtr src 1)@@ -89,8 +89,34 @@           | b == 0xff -> err (plusPtr src 1)           | otherwise -> do             poke dst (a .|. b)-            go (plusPtr dst 1) (plusPtr src 2) (n + 1)+            go (plusPtr dst 1) (plusPtr src 2) {-# INLINE decodeLoop #-}++-- | Hex decoding loop optimized for 16-bit architectures+--+decodeLoopTyped+  :: Ptr Word8+  -> Ptr Word8+  -> Ptr Word8+  -> IO ()+decodeLoopTyped !dptr !sptr !end = go dptr sptr+  where+    !lo = "\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x01\x02\x03\x04\x05\x06\x07\x08\x09\xff\xff\xff\xff\xff\xff\xff\x0a\x0b\x0c\x0d\x0e\x0f\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0a\x0b\x0c\x0d\x0e\x0f\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"#++    !hi = "\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x10\x20\x30\x40\x50\x60\x70\x80\x90\xff\xff\xff\xff\xff\xff\xff\xa0\xb0\xc0\xd0\xe0\xf0\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xa0\xb0\xc0\xd0\xe0\xf0\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"#++    go !dst !src+      | src == end = return ()+      | otherwise = do+        !x <- peek @Word8 src+        !y <- peek @Word8 (plusPtr src 1)++        let !a = aix x hi+            !b = aix y lo++        poke dst (a .|. b)+        go (plusPtr dst 1) (plusPtr src 2)+{-# INLINE decodeLoopTyped #-}   -- | Lenient lazy hex decoding loop optimized for 16-bit architectures.
src/Data/ByteString/Base16/Internal/W16/ShortLoop.hs view
@@ -5,6 +5,7 @@ module Data.ByteString.Base16.Internal.W16.ShortLoop ( innerLoop , decodeLoop+, decodeLoopTyped , lenientLoop ) where @@ -67,6 +68,31 @@             writeByteArray dst doff (a .|. b)             go (doff + 1) (soff + 2) {-# inline decodeLoop #-}++decodeLoopTyped+    :: Int+    -> MutableByteArray s+    -> MutableByteArray s+    -> ST s ByteArray+decodeLoopTyped !slen !dst !src = go (0 :: Int) (0 :: Int)+  where+    !lo = "\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x01\x02\x03\x04\x05\x06\x07\x08\x09\xff\xff\xff\xff\xff\xff\xff\x0a\x0b\x0c\x0d\x0e\x0f\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0a\x0b\x0c\x0d\x0e\x0f\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"#++    !hi = "\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x10\x20\x30\x40\x50\x60\x70\x80\x90\xff\xff\xff\xff\xff\xff\xff\xa0\xb0\xc0\xd0\xe0\xf0\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xa0\xb0\xc0\xd0\xe0\xf0\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"#++    go !doff !soff+      | soff == slen = unsafeFreezeByteArray dst+      | otherwise = do+        x <- readByteArray src soff+        y <- readByteArray src (soff + 1)++        let !a = aix x hi+            !b = aix y lo++        writeByteArray dst doff (a .|. b)+        go (doff + 1) (soff + 2)+{-# inline decodeLoopTyped #-}+  lenientLoop     :: Int
src/Data/ByteString/Lazy/Base16.hs view
@@ -1,8 +1,7 @@ {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE Trustworthy #-} -- | -- Module       : Data.ByteString.Lazy.Base16--- Copyright    : (c) 2020 Emily Pillmore+-- Copyright    : (c) 2020-2023 Emily Pillmore -- License      : BSD-style -- -- Maintainer   : Emily Pillmore <emilypi@cohomolo.gy>@@ -19,6 +18,7 @@ , encodeBase16' , decodeBase16 , decodeBase16'+, decodeBase16Untyped , decodeBase16Lenient , isBase16 , isValidBase16@@ -28,6 +28,7 @@  import Prelude hiding (all, elem) +import Data.Base16.Types import qualified Data.ByteString as B import Data.ByteString.Lazy (all, elem, fromChunks, toChunks) import Data.ByteString.Lazy.Internal (ByteString(..))@@ -38,8 +39,13 @@ import qualified Data.Text as T import qualified Data.Text.Lazy.Encoding as TL +-- $setup+--+-- >>> import Data.Base16.Types+-- >>> :set -XOverloadedStrings+-- --- | Encode a lazy 'ByteString' value as Base16 'Text' with padding.+-- | Encode a lazy 'ByteString' value as Base16 'Text' -- -- See: <https://tools.ietf.org/html/rfc4648#section-8 RFC-4648 section 8> --@@ -48,11 +54,11 @@ -- >>> encodeBase16 "Sun" -- "53756e" ---encodeBase16 :: ByteString -> Text-encodeBase16 = TL.decodeUtf8 . encodeBase16'+encodeBase16 :: ByteString -> Base16 Text+encodeBase16 = fmap TL.decodeUtf8 . encodeBase16' {-# INLINE encodeBase16 #-} --- | Encode a lazy 'ByteString' value as a Base16 'ByteString'  value with padding.+-- | Encode a lazy 'ByteString' value as a Base16 'ByteString' value -- -- See: <https://tools.ietf.org/html/rfc4648#section-8 RFC-4648 section 8> --@@ -61,45 +67,61 @@ -- >>> encodeBase16' "Sun" -- "53756e" ---encodeBase16' :: ByteString -> ByteString-encodeBase16' Empty = Empty-encodeBase16' (Chunk b bs) = Chunk (B16.encodeBase16_ b) (encodeBase16' bs)+encodeBase16' :: ByteString -> Base16 ByteString+encodeBase16' bs = assertBase16 $ case bs of+    Empty -> Empty+    Chunk b bs' -> Chunk (B16.encodeBase16_ b) (extractBase16 $ encodeBase16' bs') {-# INLINE encodeBase16' #-} --- | Decode a padded Base16-encoded lazy 'ByteString' value.+-- | Decode a Base16-encoded lazy 'ByteString' value. -- -- See: <https://tools.ietf.org/html/rfc4648#section-8 RFC-4648 section 8> -- -- === __Examples__: ----- >>> decodeBase16 "53756e"--- Right "Sun"------ >>> decodeBase16 "6x"--- Left "invalid character at offset: 1"+-- >>> decodeBase16 $ assertBase16 "53756e"+-- "Sun" ---decodeBase16 :: ByteString -> Either T.Text ByteString-decodeBase16 Empty = Right Empty-decodeBase16 (Chunk b bs) = Chunk <$> B16.decodeBase16_ b <*> decodeBase16 bs+decodeBase16 :: Base16 ByteString -> ByteString+decodeBase16 bs = case extractBase16 bs of+    Empty -> Empty+    Chunk b bs' -> Chunk+      (B16.decodeBase16Typed_ (assertBase16 b))+      (decodeBase16 $ assertBase16 bs') {-# INLINE decodeBase16 #-} --- | Decode Base16 'Text'.+-- | Decode a Base16-encoded 'Text' value. -- -- See: <https://tools.ietf.org/html/rfc4648#section-8 RFC-4648 section 8> -- -- === __Examples__: ----- >>> decodeBase16' "53756e"+-- >>> decodeBase16' $ assertBase16 "53756e"+-- "Sun"+--+decodeBase16' :: Base16 Text -> ByteString+decodeBase16' = decodeBase16 . fmap TL.encodeUtf8+{-# INLINE decodeBase16' #-}++-- | Decode an untyped Base16-encoded lazy 'ByteString' value.+--+-- See: <https://tools.ietf.org/html/rfc4648#section-8 RFC-4648 section 8>+--+-- === __Examples__:+--+-- >>> decodeBase16Untyped "53756e" -- Right "Sun" ----- >>> decodeBase16' "6x"+-- >>> decodeBase16Untyped "6x" -- Left "invalid character at offset: 1" ---decodeBase16' :: Text -> Either T.Text ByteString-decodeBase16' = decodeBase16 . TL.encodeUtf8-{-# INLINE decodeBase16' #-}+decodeBase16Untyped :: ByteString -> Either T.Text ByteString+decodeBase16Untyped Empty = Right Empty+decodeBase16Untyped (Chunk b bs) = Chunk <$> B16.decodeBase16_ b <*> decodeBase16Untyped bs+{-# INLINE decodeBase16Untyped #-} --- | Decode a Base16-encoded 'ByteString' value leniently, using a++-- | Decode an untyped Base16-encoded 'ByteString' value leniently, using a -- strategy that never fails -- -- N.B.: this is not RFC 4648-compliant. It may give you garbage if you're not careful!@@ -120,7 +142,7 @@   . toChunks {-# INLINE decodeBase16Lenient #-} --- | Tell whether a lazy 'ByteString' value is base16 encoded.+-- | Tell whether an untyped lazy 'ByteString' value is base16 encoded. -- -- === __Examples__: --@@ -131,10 +153,10 @@ -- True -- isBase16 :: ByteString -> Bool-isBase16 bs = isValidBase16 bs && isRight (decodeBase16 bs)+isBase16 bs = isValidBase16 bs && isRight (decodeBase16Untyped bs) {-# INLINE isBase16 #-} --- | Tell whether a lazy 'ByteString' value is a valid Base16 format.+-- | Tell whether an untyped lazy 'ByteString' value is a valid Base16 format. -- -- This will not tell you whether or not this is a correct Base16 representation, -- only that it conforms to the correct alphabet. To check whether it is a true@@ -149,5 +171,5 @@ -- True -- isValidBase16 :: ByteString -> Bool-isValidBase16 = all (flip elem "0123456789abcdefABCDEF")+isValidBase16 = all (`elem` "0123456789abcdefABCDEF") {-# INLINE isValidBase16 #-}
src/Data/ByteString/Short/Base16.hs view
@@ -1,8 +1,6 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE Trustworthy #-} -- | -- Module       : Data.ByteString.Short.Base16--- Copyright    : (c) 2020 Emily Pillmore+-- Copyright    : (c) 2020-2023 Emily Pillmore -- License      : BSD-style -- -- Maintainer   : Emily Pillmore <emilypi@cohomolo.gy>@@ -19,12 +17,14 @@ , encodeBase16' , decodeBase16 , decodeBase16'+, decodeBase16Untyped , decodeBase16Lenient , isBase16 , isValidBase16 ) where  +import Data.Base16.Types import Data.ByteString.Short import Data.ByteString.Base16.Internal.Head import qualified Data.ByteString.Base16 as B16@@ -32,8 +32,13 @@ import Data.Text.Short import Data.Text.Short.Unsafe +-- $setup+--+-- >>> import Data.Base16.Types+-- >>> :set -XOverloadedStrings+-- --- | Encode a 'ShortByteString' value as Base16 'ShortText' with padding.+-- | Encode a 'ShortByteString' value as Base16 'ShortText' -- -- See: <https://tools.ietf.org/html/rfc4648#section-8 RFC-4648 section 8> --@@ -44,11 +49,11 @@ -- -- @since 0.3.0.0 ---encodeBase16 :: ShortByteString -> ShortText-encodeBase16 = fromShortByteStringUnsafe . encodeBase16'+encodeBase16 :: ShortByteString -> Base16 ShortText+encodeBase16 = fmap fromShortByteStringUnsafe . encodeBase16' {-# INLINE encodeBase16 #-} --- | Encode a 'ShortByteString' value as a Base16 'ShortByteString'  value with padding.+-- | Encode a 'ShortByteString' value as a Base16 'ShortByteString'  value -- -- See: <https://tools.ietf.org/html/rfc4648#section-8 RFC-4648 section 8> --@@ -57,8 +62,8 @@ -- >>> encodeBase16' "Sun" -- "53756e" ---encodeBase16' :: ShortByteString -> ShortByteString-encodeBase16' = encodeBase16Short_+encodeBase16' :: ShortByteString -> Base16 ShortByteString+encodeBase16' = assertBase16 . encodeBase16Short_ {-# INLINE encodeBase16' #-}  -- | Decode a Base16-encoded 'ShortByteString' value.@@ -67,33 +72,43 @@ -- -- === __Examples__: ----- >>> decodeBase16 "53756e"--- Right "Sun"------ >>> decodeBase16 "6x"--- Left "invalid character at offset: 1"+-- >>> decodeBase16 $ assertBase16 "53756e"+-- "Sun" ---decodeBase16 :: ShortByteString -> Either Text ShortByteString-decodeBase16 = decodeBase16Short_+decodeBase16 :: Base16 ShortByteString -> ShortByteString+decodeBase16 = decodeBase16ShortTyped_ {-# INLINE decodeBase16 #-} --- | Decode Base16 'Text'.+-- | Decode Base16-encoded 'ShortText' value. -- -- See: <https://tools.ietf.org/html/rfc4648#section-8 RFC-4648 section 8> -- -- === __Examples__: ----- >>> decodeBase16' "53756e"+-- >>> decodeBase16' $ assertBase16 "53756e"+-- "Sun"+--+decodeBase16' :: Base16 ShortText -> ShortByteString+decodeBase16' = decodeBase16 . fmap toShortByteString+{-# INLINE decodeBase16' #-}++-- | Decode an untyped Base16-encoded 'ByteString' value with error-checking.+--+-- See: <https://tools.ietf.org/html/rfc4648#section-8 RFC-4648 section 8>+--+-- === __Examples__:+--+-- >>> decodeBase16Untyped "53756e" -- Right "Sun" ----- >>> decodeBase16' "6x"+-- >>> decodeBase16Untyped "6x" -- Left "invalid character at offset: 1" ---decodeBase16' :: ShortText -> Either Text ShortByteString-decodeBase16' = decodeBase16 . toShortByteString-{-# INLINE decodeBase16' #-}+decodeBase16Untyped :: ShortByteString -> Either Text ShortByteString+decodeBase16Untyped = decodeBase16Short_+{-# INLINE decodeBase16Untyped #-} --- | Decode a Base16-encoded 'ShortByteString' value leniently, using a+-- | Decode an untyped Base16-encoded 'ShortByteString' value leniently, using a -- strategy that never fails -- -- N.B.: this is not RFC 4648-compliant@@ -111,7 +126,7 @@ decodeBase16Lenient = decodeBase16ShortLenient_ {-# INLINE decodeBase16Lenient #-} --- | Tell whether a 'ShortByteString' value is base16 encoded.+-- | Tell whether an untyped 'ShortByteString' value is base16 encoded. -- -- === __Examples__: --@@ -125,7 +140,7 @@ isBase16 = B16.isBase16 . fromShort {-# INLINE isBase16 #-} --- | Tell whether a 'ShortByteString' value is a valid Base16 format.+-- | Tell whether an untyped 'ShortByteString' value is a valid Base16 format. -- -- This will not tell you whether or not this is a correct Base16 representation, -- only that it conforms to the correct alphabet. To check whether it is a true
src/Data/Text/Encoding/Base16.hs view
@@ -1,7 +1,6 @@-{-# LANGUAGE Safe #-} -- | -- Module       : Data.Text.Encoding.Base16--- Copyright    : (c) 2020 Emily Pillmore+-- Copyright    : (c) 2020-2023 Emily Pillmore -- License      : BSD-style -- -- Maintainer   : Emily Pillmore <emilypi@cohomolo.gy>@@ -16,6 +15,7 @@ module Data.Text.Encoding.Base16 ( encodeBase16 , decodeBase16+, decodeBase16Untyped , decodeBase16With , decodeBase16Lenient , isBase16@@ -23,14 +23,19 @@ ) where  +import Data.Base16.Types import Data.Bifunctor (first) import Data.ByteString (ByteString) import qualified Data.ByteString.Base16 as B16 import Data.Text (Text)-import qualified Data.Text as T import Data.Text.Encoding.Base16.Error (Base16Error(..)) import qualified Data.Text.Encoding as T +-- $setup+--+-- >>> import Data.Base16.Types+-- >>> :set -XOverloadedStrings+--  -- | Encode a 'Text' value in Base16 with padding. --@@ -41,7 +46,7 @@ -- >>> encodeBase16 "Sun" -- "53756e" ---encodeBase16 :: Text -> Text+encodeBase16 :: Text -> Base16 Text encodeBase16 = B16.encodeBase16 . T.encodeUtf8 {-# INLINE encodeBase16 #-} @@ -51,17 +56,30 @@ -- -- === __Examples__: ----- >>> decodeBase16 "53756e"+-- >>> decodeBase16 $ assertBase16 "53756e"+-- "Sun"+--+decodeBase16 :: Base16 Text -> Text+decodeBase16 = T.decodeUtf8 . B16.decodeBase16 . fmap T.encodeUtf8+{-# INLINE decodeBase16 #-}++-- | Decode an untyped Base16-encoded 'Text' value.+--+-- See: <https://tools.ietf.org/html/rfc4648#section-8 RFC-4648 section 8>+--+-- === __Examples__:+--+-- >>> decodeBase16Untyped "53756e" -- Right "Sun" ----- >>> decodeBase16 "6x"+-- >>> decodeBase16Untyped "6x" -- Left "invalid character at offset: 1" ---decodeBase16 :: Text -> Either T.Text Text-decodeBase16 = fmap T.decodeLatin1 . B16.decodeBase16 . T.encodeUtf8-{-# INLINE decodeBase16 #-}+decodeBase16Untyped :: Text -> Either Text Text+decodeBase16Untyped = fmap T.decodeUtf8 . B16.decodeBase16Untyped . T.encodeUtf8+{-# INLINE decodeBase16Untyped #-} --- | Attempt to decode a 'Text' value as Base16, converting from+-- | Attempt to decode an untyped 'Text' value as Base16, converting from -- 'ByteString' to 'Text' according to some encoding function. In practice, -- This is something like 'decodeUtf8'', which may produce an error. --@@ -82,12 +100,12 @@     -> ByteString       -- ^ Input to decode     -> Either (Base16Error err) Text-decodeBase16With f t = case B16.decodeBase16 t of-  Left de -> Left $ DecodeError de-  Right a -> first ConversionError (f a)+decodeBase16With f t = case B16.decodeBase16Untyped t of+    Left de -> Left $ DecodeError de+    Right a -> first ConversionError (f a) {-# INLINE decodeBase16With #-} --- | Decode a Base16-encoded 'Text' value leniently, using a+-- | Decode an untyped Base16-encoded 'Text' value leniently, using a -- strategy that never fails, catching unicode exceptions raised in the -- process of converting to text values. --@@ -102,7 +120,7 @@ -- "f" -- decodeBase16Lenient :: Text -> Text-decodeBase16Lenient = T.decodeLatin1 . B16.decodeBase16Lenient . T.encodeUtf8+decodeBase16Lenient = T.decodeUtf8 . B16.decodeBase16Lenient . T.encodeUtf8 {-# INLINE decodeBase16Lenient #-}  -- | Tell whether a 'Text' value is Base16-encoded.
src/Data/Text/Encoding/Base16/Error.hs view
@@ -1,8 +1,7 @@ {-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE Safe #-} -- | -- Module       : Data.Text.Encoding.Base16.Error--- Copyright    : (c) 2019 Emily Pillmore+-- Copyright    : (c) 2019-2023 Emily Pillmore -- License      : BSD-style -- -- Maintainer   : Emily Pillmore <emilypi@cohomolo.gy>
src/Data/Text/Lazy/Encoding/Base16.hs view
@@ -1,7 +1,6 @@-{-# LANGUAGE Safe #-} -- | -- Module       : Data.Text.Encoding.Base16.Lazy--- Copyright    : (c) 2020 Emily Pillmore+-- Copyright    : (c) 2020-2023 Emily Pillmore -- License      : BSD-style -- -- Maintainer   : Emily Pillmore <emilypi@cohomolo.gy>@@ -16,6 +15,7 @@ module Data.Text.Lazy.Encoding.Base16 ( encodeBase16 , decodeBase16+, decodeBase16Untyped , decodeBase16With , decodeBase16Lenient , isBase16@@ -23,6 +23,7 @@ ) where  +import Data.Base16.Types import Data.Bifunctor (first) import Data.ByteString.Lazy (ByteString) import qualified Data.ByteString.Lazy.Base16 as B16L@@ -31,6 +32,11 @@ import Data.Text.Lazy (Text) import qualified Data.Text.Lazy.Encoding as TL +-- $setup+--+-- >>> import Data.Base16.Types+-- >>> :set -XOverloadedStrings+--  -- | Encode a lazy 'Text' value in Base16 with padding. --@@ -41,7 +47,7 @@ -- >>> encodeBase16 "Sun" -- "53756e" ---encodeBase16 :: Text -> Text+encodeBase16 :: Text -> Base16 Text encodeBase16 = B16L.encodeBase16 . TL.encodeUtf8 {-# INLINE encodeBase16 #-} @@ -51,17 +57,30 @@ -- -- === __Examples__: ----- >>> decodeBase16 "53756e"+-- >>> decodeBase16 $ assertBase16 "53756e"+-- "Sun"+--+decodeBase16 :: Base16 Text -> Text+decodeBase16 = TL.decodeUtf8 . B16L.decodeBase16 . fmap TL.encodeUtf8+{-# INLINE decodeBase16 #-}++-- | Decode an untyped Base16-encoded lazy 'Text' value.+--+-- See: <https://tools.ietf.org/html/rfc4648#section-8 RFC-4648 section 8>+--+-- === __Examples__:+--+-- >>> decodeBase16Untyped "53756e" -- Right "Sun" ----- >>> decodeBase16 "6x"+-- >>> decodeBase16Untyped "6x" -- Left "invalid character at offset: 1" ---decodeBase16 :: Text -> Either T.Text Text-decodeBase16 = fmap TL.decodeLatin1 . B16L.decodeBase16 . TL.encodeUtf8-{-# INLINE decodeBase16 #-}+decodeBase16Untyped :: Text -> Either T.Text Text+decodeBase16Untyped = fmap TL.decodeUtf8 . B16L.decodeBase16Untyped . TL.encodeUtf8+{-# INLINE decodeBase16Untyped #-} --- | Attempt to decode a lazy 'Text' value as Base16, converting from+-- | Attempt to decode an untyped lazy 'Text' value as Base16, converting from -- 'ByteString' to 'Text' according to some encoding function. In practice, -- This is something like 'decodeUtf8'', which may produce an error. --@@ -80,9 +99,9 @@     -> ByteString       -- ^ Input to decode     -> Either (Base16Error err) Text-decodeBase16With f t = case B16L.decodeBase16 t of-  Left de -> Left $ DecodeError de-  Right a -> first ConversionError (f a)+decodeBase16With f t = case B16L.decodeBase16Untyped t of+    Left de -> Left $ DecodeError de+    Right a -> first ConversionError $ f a {-# INLINE decodeBase16With #-}  -- | Decode a Base16-encoded lazy 'Text' value leniently, using a@@ -103,7 +122,7 @@ -- "f" -- decodeBase16Lenient :: Text -> Text-decodeBase16Lenient = TL.decodeLatin1 . B16L.decodeBase16Lenient . TL.encodeUtf8+decodeBase16Lenient = TL.decodeUtf8 . B16L.decodeBase16Lenient . TL.encodeUtf8 {-# INLINE decodeBase16Lenient #-}  -- | Tell whether a lazy 'Text' value is Base16-encoded.
src/Data/Text/Short/Encoding/Base16.hs view
@@ -1,7 +1,6 @@-{-# LANGUAGE Trustworthy #-} -- | -- Module       : Data.Text.Short.Encoding.Base16--- Copyright    : (c) 2020 Emily Pillmore+-- Copyright    : (c) 2020-2023 Emily Pillmore -- License      : BSD-style -- -- Maintainer   : Emily Pillmore <emilypi@cohomolo.gy>@@ -16,6 +15,7 @@ module Data.Text.Short.Encoding.Base16 ( encodeBase16 , decodeBase16+, decodeBase16Untyped , decodeBase16With , decodeBase16Lenient , isBase16@@ -23,6 +23,7 @@ ) where  +import Data.Base16.Types import Data.Bifunctor (first) import qualified Data.ByteString.Base16 as B16 import Data.ByteString.Short@@ -32,6 +33,11 @@ import Data.Text.Short import Data.Text.Short.Unsafe +-- $setup+--+-- >>> import Data.Base16.Types+-- >>> :set -XOverloadedStrings+--  -- | Encode a 'ShortText' value in Base16 with padding. --@@ -42,29 +48,45 @@ -- >>> encodeBase16 "Sun" -- "53756e" ---encodeBase16 :: ShortText -> ShortText+encodeBase16 :: ShortText -> Base16 ShortText encodeBase16 = BS16.encodeBase16 . toShortByteString {-# INLINE encodeBase16 #-} + -- | Decode a Base16-encoded 'ShortText' value. -- -- See: <https://tools.ietf.org/html/rfc4648#section-8 RFC-4648 section 8> -- -- === __Examples__: ----- >>> decodeBase16 "53756e"+-- >>> decodeBase16 $ assertBase16 "53756e"+-- "Sun"+--+decodeBase16 :: Base16 ShortText -> ShortText+decodeBase16 =  fromShortByteStringUnsafe+  . BS16.decodeBase16+  . fmap toShortByteString+{-# INLINE decodeBase16 #-}++-- | Decode an untyped Base16-encoded 'ShortText' value.+--+-- See: <https://tools.ietf.org/html/rfc4648#section-8 RFC-4648 section 8>+--+-- === __Examples__:+--+-- >>> decodeBase16Untyped "53756e" -- Right "Sun" ----- >>> decodeBase16 "6x"+-- >>> decodeBase16Untyped "6x" -- Left "invalid character at offset: 1" ---decodeBase16 :: ShortText -> Either Text ShortText-decodeBase16 =  fmap fromShortByteStringUnsafe-  . BS16.decodeBase16+decodeBase16Untyped :: ShortText -> Either Text ShortText+decodeBase16Untyped =  fmap fromShortByteStringUnsafe+  . BS16.decodeBase16Untyped   . toShortByteString-{-# INLINE decodeBase16 #-}+{-# INLINE decodeBase16Untyped #-} --- | Attempt to decode a 'ShortText' value as Base16, converting from+-- | Attempt to decode an untyped 'ShortText' value as Base16, converting from -- 'ByteString' to 'ShortText' according to some encoding function. In practice, -- This is something like 'decodeUtf8'', which may produce an error. --@@ -85,12 +107,12 @@     -> ShortByteString       -- ^ Input to decode     -> Either (Base16Error err) ShortText-decodeBase16With f t = case BS16.decodeBase16 t of-  Left de -> Left $ DecodeError de-  Right a -> first ConversionError (f a)+decodeBase16With f t = case BS16.decodeBase16Untyped t of+    Left de -> Left $ DecodeError de+    Right a -> first ConversionError $ f a {-# INLINE decodeBase16With #-} --- | Decode a Base16-encoded 'ShortText' value leniently, using a+-- | Decode an untyped Base16-encoded 'ShortText' value leniently, using a -- strategy that never fails, catching unicode exceptions raised in the -- process of converting to text values. --
test/Internal.hs view
@@ -1,14 +1,12 @@ {-# LANGUAGE AllowAmbiguousTypes #-}-{-# LANGUAGE BangPatterns #-} {-# LANGUAGE DataKinds #-}-{-# LANGUAGE EmptyDataDecls #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE PackageImports #-} {-# OPTIONS_GHC -fno-warn-orphans #-} -- | -- Module       : Main--- Copyright    : (c) 2020 Emily Pillmore+-- Copyright    : (c) 2020-2023 Emily Pillmore -- License      : BSD-style -- -- Maintainer   : Emily Pillmore <emilypi@cohomolo.gy>@@ -20,6 +18,7 @@ module Internal where  +import Data.Base16.Types import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as BS8 import qualified Data.ByteString.Lazy as LBS@@ -84,7 +83,8 @@   where    label :: String-  encode :: bs -> bs+  encode :: bs -> Base16 bs+  decodeTyped :: Base16 bs -> bs   decode :: bs -> Either Text bs   lenient :: bs -> bs @@ -97,7 +97,8 @@   label = "ByteString"    encode = B16.encodeBase16'-  decode = B16.decodeBase16+  decodeTyped = B16.decodeBase16+  decode = B16.decodeBase16Untyped   lenient = B16.decodeBase16Lenient   correct = B16.isBase16   validate = B16.isValidBase16@@ -107,7 +108,8 @@   label = "Lazy ByteString"    encode = LB16.encodeBase16'-  decode = LB16.decodeBase16+  decodeTyped = LB16.decodeBase16+  decode = LB16.decodeBase16Untyped   lenient = LB16.decodeBase16Lenient   correct = LB16.isBase16   validate = LB16.isValidBase16@@ -117,7 +119,8 @@   label = "Short ByteString"    encode = SB16.encodeBase16'-  decode = SB16.decodeBase16+  decodeTyped = SB16.decodeBase16+  decode = SB16.decodeBase16Untyped   lenient = SB16.decodeBase16Lenient   correct = SB16.isBase16   validate = SB16.isValidBase16@@ -127,7 +130,8 @@   label = "Text"    encode = T16.encodeBase16-  decode = T16.decodeBase16+  decodeTyped = T16.decodeBase16+  decode = T16.decodeBase16Untyped   lenient = T16.decodeBase16Lenient   correct = T16.isBase16   validate = T16.isValidBase16@@ -137,7 +141,8 @@   label = "Lazy Text"    encode = TL16.encodeBase16-  decode = TL16.decodeBase16+  decodeTyped = TL16.decodeBase16+  decode = TL16.decodeBase16Untyped   lenient = TL16.decodeBase16Lenient   correct = TL16.isBase16   validate = TL16.isValidBase16@@ -147,7 +152,8 @@   label = "Short Text"    encode = TS16.encodeBase16-  decode = TS16.decodeBase16+  decodeTyped = TS16.decodeBase16+  decode = TS16.decodeBase16Untyped   lenient = TS16.decodeBase16Lenient   correct = TS16.isBase16   validate = TS16.isValidBase16@@ -192,12 +198,12 @@     coarbitrary = coarbitrary . SBS.unpack  instance Arbitrary T.Text where-    arbitrary = T.pack <$> arbitrary-    shrink xs = T.pack <$> shrink (T.unpack xs)+    arbitrary = T.pack . getUnicodeString <$> arbitrary+    shrink xs = T.pack . getUnicodeString <$> shrink (UnicodeString $ T.unpack xs)  instance Arbitrary TL.Text where-    arbitrary = TL.pack <$> arbitrary-    shrink xs = TL.pack <$> shrink (TL.unpack xs)+    arbitrary = TL.pack . getUnicodeString <$> arbitrary+    shrink xs = TL.pack . getUnicodeString <$> shrink (UnicodeString $ TL.unpack xs)  instance CoArbitrary T.Text where     coarbitrary = coarbitrary . T.unpack@@ -207,7 +213,7 @@  instance Arbitrary TS.ShortText where   arbitrary = TS.fromText <$> arbitrary-  shrink xs = fmap TS.fromText $ shrink (TS.toText xs)+  shrink xs = TS.fromText <$> shrink (TS.toText xs)  instance CoArbitrary TS.ShortText where   coarbitrary = coarbitrary . TS.toText
test/Main.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE MultiWayIf #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PackageImports #-} {-# LANGUAGE AllowAmbiguousTypes #-}@@ -6,7 +5,7 @@ {-# LANGUAGE TypeApplications #-} -- | -- Module       : Main--- Copyright    : (c) 2020 Emily Pillmore+-- Copyright    : (c) 2020-2023 Emily Pillmore -- License      : BSD-style -- -- Maintainer   : Emily Pillmore <emilypi@cohomolo.gy>@@ -21,6 +20,7 @@ ) where  +import Data.Base16.Types import Data.Bifunctor (second) import qualified Data.ByteString as BS import Data.ByteString.Internal (c2w)@@ -109,7 +109,7 @@ mkPropTree :: forall a b proxy. Harness a b => proxy a -> TestTree mkPropTree = mkTests "Property Tests"   [ prop_roundtrip-  , prop_correctness+  , prop_untyped_correctness   , const prop_bos_coherence   ] @@ -146,18 +146,21 @@  prop_roundtrip :: forall a b proxy. Harness a b => proxy a -> TestTree prop_roundtrip _ = testGroup "prop_roundtrip"-  [ testProperty "prop_std_roundtrip" $ \(bs :: b) ->-      Right (encode bs) == decode (encode (encode bs))+  [ testProperty "prop_std_roundtrip_typed" $ \(bs :: b) ->+      bs == decodeTyped (encode bs)+  , testProperty "prop_std_roundtrip_untyped" $ \(bs :: b) ->+      Right bs+        == decode (extractBase16 $ encode bs)   , testProperty "prop_std_lenient_roundtrip" $ \(bs :: b) ->-      encode bs == lenient (encode (encode bs))+      bs == lenient (extractBase16 $ encode bs)   ] -prop_correctness :: forall a b proxy. Harness a b => proxy a -> TestTree-prop_correctness _ = testGroup "prop_validity"+prop_untyped_correctness :: forall a b proxy. Harness a b => proxy a -> TestTree+prop_untyped_correctness _ = testGroup "prop_validity"   [ testProperty "prop_std_valid" $ \(bs :: b) ->-    validate (encode bs)+    validate (extractBase16 $ encode bs)   , testProperty "prop_std_correct" $ \(bs :: b) ->-    correct (encode bs)+    correct (extractBase16 $ encode bs)   ]  -- | just a sanity check against `base16-bytestring`@@ -165,8 +168,9 @@ prop_bos_coherence :: TestTree prop_bos_coherence = testGroup "prop_bos_coherence"   [ testProperty "prop_std_bos_coherence" $ \bs ->-      Right bs == B16.decodeBase16 (B16.encodeBase16' bs)+      Right bs == B16.decodeBase16Untyped (extractBase16 $ B16.encodeBase16' bs)       && Right bs == Bos.decode (Bos.encode bs)+      && bs == B16.decodeBase16 (B16.encodeBase16' bs)   ]  -- ---------------------------------------------------------------- --@@ -205,12 +209,16 @@   where     testCaseB16 s t =       testCaseSteps (show $ if s == "" then "empty" else s) $ \step -> do+         step "encode is sound"-        lower t @=? encode @a s+        lower t @=? extractBase16 (encode @a s)          step "decode is sound"-        Right s @=? decode (encode s)+        s @=? decodeTyped (assertBase16 t) +        step "decodeUntyped is sound"+        Right s @=? decode (extractBase16 $ encode s)+ -- | Unit test trees for the `decode*With` family of text-valued functions -- decodeWithVectors@@ -233,7 +241,7 @@         Left (DecodeError _) -> return ()         _ -> assertFailure "decoding phase"     , testCase "decodeWith valid utf8 inputs on decodeUtf8" $ do-      case decodeWith_ @a utf8 (encode @t "\1079743") of+      case decodeWith_ @a utf8 (extractBase16 $ encode @t "\1079743") of         Left (ConversionError _) -> return ()         _ -> assertFailure "conversion phase"     ]@@ -258,7 +266,7 @@   where     testCaseB16 s t =       testCaseSteps (show $ if s == "" then "empty" else s) $ \step -> do-        let t0 = decode (encode @a s)+        let t0 = decode (extractBase16 $ encode @a s)             t1 = lenient @a t          step "compare decoding"