basesystems 1.0.0.1 → 1.1.0.0

raw patch · 14 files changed

+1092/−657 lines, 14 filesdep ~bytestringdep ~containersdep ~textPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: bytestring, containers, text

API changes (from Hackage documentation)

Files

• CHANGELOG.md +97/−0
• CHANGE_LOG.md +0/−50
• README.md +69/−40
• basesystems.cabal +32/−44
• basesystems/Data/BaseSystem.hs +31/−154
• basesystems/Data/BaseSystem/Alphabet.hs +113/−19
• basesystems/Data/BaseSystem/Alphabets.hs +0/−83
• basesystems/Data/BaseSystem/BinaryTranscoder.hs +238/−0
• basesystems/Data/BaseSystem/DigitSystem.hs +191/−0
• basesystems/Data/BaseSystem/DigitTranscoder.hs +226/−0
• basesystems/Data/BaseSystem/Internal.hs +1/−116
• basesystems/Data/BaseSystem/Lazy.hs +47/−0
• basesystems/Data/BaseSystem/Strict.hs +47/−0
• basesystems/Data/BaseSystems.hs +0/−151

@@ -0,0 +1,97 @@+[`basesystems`](http://hackage-content.haskell.org/package/basesystems)+change log:+===========++Major release 1.1+-----------------++## Version 1.1.0.0 (05-17-2026)++### Cabal+- Upgrade major versions for `text` and `containers` versions.+- Add `tested-with` line for GHC 9.6.7.+- Remove the `Dev` flag.++### Builds / CI+- Use `ghcup` to install the correct Haskell tooling instead of outdated+`cabal-install` package in all CI scripts.+- Combine documentation generation and packaging into a single script that+uploads everything to a candidate hackage page.+- Add script for running the `ipfshs` unit testing package for basesystems.++### `Data.BaseSystem` module changes+- Both `encoder` and `decoder` now use `ShortByteString` as input/output instead+of `ByteString`. Also `encoder` and `decoder` now use `Text` as input/output+data instead of `String`.++### `Data.BaseSystem.Alphabet` module changes+- This module now exports the defined `Alphabet` structs.+- Alpha.Symbol is now a plain `Char`.+- Alpha.Value is now `Word32`.++### New modules+- `Data.BaseSystem.Strict` is where the basesystem encoders and decoders+used for strict `ByteString` typed data got moved to.+- `Data.BaseSystem.Lazy` provides basesystem encoders and decoders for+`LazyByteString` data.+- `Data.BaseSystem.DigitSystem` now provides the instances for used for+`BaseSystem`.+- `Data.BaseSystem.BinaryTranscoder` provides a unified type-class interface for+working with bytestring data and converting to and from bit data for numeric+values. This module is likely to become its own package in the future.+- `Data.BaseSystem.DigitTranscoder` provides generic encoders and decoders for+`BinaryTranscoder` derivied types.++### Deleted modules+- `Data.BaseSystems` got replaced by `Data.BaseSystem.DigitSystem`.+- `Data.BaseSystem.Alphabets` got merged with `Data.BaseSystem.Alphabet`.++Major release 1.0+-----------------++## Version 1.0.0.1 (04-01-2026)++This version aims to fix the issues with the hackage page and provide CI via+sourcehut builds.++- Set correct PVP bounds for cabal dependencies.+- Added CI/CD for builds.sr.ht:+  * Add `.builds/nudge-parents.yml` to automatically update this submodule in+  other sourcehut repositories.+  * Add `.builds/upload-candidate-docs.yml` to generate and upload documentation+  to Hackage.+  * Add `.builds/upload-candidate-package.yml` to generate and upload a package+  candidate to Hackage.++## Version 1.0.0.0 (03-12-2026)++Finally initialize this package! This version introduces the package to the+Hackage repository and the provides an interface for encoding/decoding digit+strings in several common numeric basesystems. Namely, this version provides+the following modules for processing this data:++### `Data.BaseSystem`++Provides the type-class for `BaseSystem` and the `encoder` and `decoder` methods+and generic implementations for 2 kinds of basesystems:++- `RadixSystem` for typical basesystems such as base10+- `BitwiseSystem` for special basesystems such as base64 and base32++### `Data.BaseSystems`:++Defines common basesystems using the definitions found in+`Data.BaseSystem.Alphabets`. See the project source code for the names of+currently provided implementations.++### Other modules:++- `Data.BaseSystem.Alphabet` data structure definition for basesystem digit+  alphabets and methods for querying alphabet information.+- `Data.BaseSystem.Alphabets` definitions for specific digit alphabets for+  implementing basesystems.+- `Data.BaseSystem.Internal` provides useful methods used across modules. For+  example the `packInteger` and `bytesToInteger` provides ways to convert+  Integers to ByteString and vice-versa, which is handy for GHCi and unit+  tests (so that we don't have to write numbers as ByteStrings before using the+  encoders or decoders).

@@ -1,50 +0,0 @@-[`basesystems`](http://hackage-content.haskell.org/package/basesystems)-change log:-===============================================================================--## Version 1.0.0.1 (04-01-2026)--This version aims to fix the issues with the hackage page and provide CI via-sourcehut builds.--- Set correct PVP bounds for cabal dependencies.-- Added CI/CD for builds.sr.ht:-  * Add `.builds/nudge-parents.yml` to automatically update this submodule in-  other sourcehut repositories.-  * Add `.builds/upload-candidate-docs.yml` to generate and upload documentation-  to Hackage.-  * Add `.builds/upload-candidate-package.yml` to generate and upload a package-  candidate to Hackage.--## Version 1.0.0.0 (03-12-2026)--Finally initialize this package! This version introduces the package to the-Hackage repository and the provides an interface for encoding/decoding digit-strings in several common numeric basesystems. Namely, this version provides-the following modules for processing this data:--### `Data.BaseSystem`--Provides the type-class for `BaseSystem` and the `encoder` and `decoder` methods-and generic implementations for 2 kinds of basesystems:--- `RadixSystem` for typical basesystems such as base10-- `BitwiseSystem` for special basesystems such as base64 and base32--### `Data.BaseSystems`:--Defines common basesystems using the definitions found in-`Data.BaseSystem.Alphabets`. See the project source code for the names of-currently provided implementations.--### Other modules:--- `Data.BaseSystem.Alphabet` data structure definition for basesystem digit-  alphabets and methods for querying alphabet information.-- `Data.BaseSystem.Alphabets` definitions for specific digit alphabets for-  implementing basesystems.-- `Data.BaseSystem.Internal` provides useful methods used across modules. For-  example the `packInteger` and `bytesToInteger` provides ways to convert-  Integers to ByteString and vice-versa, which is handy for GHCi and unit-  tests (so that we don't have to write numbers as ByteStrings before using the-  encoders or decoders).

@@ -1,39 +1,37 @@-basesystems-===========+basesystems [![hackage.haskell.org](+https://img.shields.io/badge/hackage%2Ehaskell%2Eorg-5C5181?logo=haskell)](+https://hackage.haskell.org/package/basesystems)[![builds.sr.ht status](+https://builds.sr.ht/~z0/basesystems/commits/main/basesystem-testing.yml.svg)](+https://builds.sr.ht/~z0/basesystems/commits/main/basesystem-testing.yml?)+------------------------------------------------ -This project code contains for Encoding/Decoding number basesystems in Haskell.+This project contains code for encoding/decoding numeric basesystems in Haskell. It's implemented in a strategy pattern style where `BaseSystem` is a type-class-which provides the `encoder` and `decoder` methods:+which provides the `encoder` and `decoder` methods on, for instance,+`ShortByteString`, in `Data.BaseSystem`:  ```haskell class BaseSystem a where-  encoder :: a -> ByteString -> String-  decoder :: a -> String -> Maybe ByteString+  encoder :: a -> ShortByteString -> String+  decoder :: a -> String -> Maybe ShortByteString ``` -Then we define data structure representations for `a` and implement each-method with the data from `a`. For instance, this is how the implementations-of base64 and base10 are distinguished.--Example--------+The library creates more `BaseSystem` classes with methods on normal+`ByteString` in `Data.BaseSystem.Strict` and `LazyByteString`+in `Data.BaseSystem.Lazy`. The basesystems passed as `a` to `encoder` and+`decoder` are defined in `Data.BaseSystem.DigitSystem`. See the [*example*](+#example). -```haskell-ghci> import Data.BaseSystem-ghci> import Data.BaseSystems-ghci> import Data.BaseSystem.Internal (packInteger)-ghci>-ghci> encoder base10 (packInteger 123) -- "123"-ghci> decoder base10 "123"             -- Just <123 as binary in ByteString>-ghci> encoder base64 (packInteger 123) -- "ew=="-ghci> decoder base64 "ew=="            -- Just <123 as binary in ByteString>-```+`basesystems` is a part of the [ipfshs](https://git.sr.ht/~z0/ipfshs) project+which contains [testing via sourcehut builds](+https://builds.sr.ht/~z0/basesystems/commits/main/basesystem-testing.yml) and a+[bug ticket tracker](https://todo.sr.ht/~z0/ipfshs).  Coverage -------- -This project aims to eventually implement most if not all of the-[mulitbase specification's basesytems list](+Eventually, This project aims to implement most if not all of the [mulitbase+specification's basesytems list]( https://github.com/multiformats/multibase?tab=readme-ov-file#multibase-table).  Currently, the following basesystems are supported:@@ -46,25 +44,56 @@ - base64 w/pad + nopad - base64url w/pad + nopad -Unit testing-------------+Example+------- -Since these functions can have such a large amount of inputs/outputs + possible-edge cases, we generate test sets in bulk from scripts in the python folder to-JSON format. Code for running tests can be found at the [main ipfshs repo](-https://git.sr.ht/~z0/ipfshs).+For an example of using `basesystems`, we can do the following in GHCI: -Reporting bugs---------------+Set `OverloadedStrings` so strings can act as Text data and import the needed+functions. Then import the basesystem functions and `packValue` from+`Data.BaseSystem.BinaryTranscoder` to convert a number value directly into+bytes. -Bugs can be reported to the ipfshs [ticket tracker](-https://todo.sr.ht/~z0/ipfshs).+```haskell+λ> {-# LANGUAGE OverloadedStrings #-}+λ> import Data.BaseSystem (encoder, decoder)+λ> import Data.BaseSystem.DigitSystem (base2, base10, base16lower, base32lower)+λ> import Data.BaseSystem.BinaryTranscoder (packValue)+``` -License--------+This shows how we can take the binary value of `123` and display it in various+number systems. -This project is free software and is provided under the BSD 3-clause licensing-agreement.+```haskell+λ> :t encoder+encoder :: BaseSystem a => a -> ShortByteString -> Text+λ> :t decoder+decoder :: BaseSystem a => a -> Text -> Maybe ShortByteString+λ> encoder base2 $ packValue (123 :: Int)+"1111011"+λ> encoder base16lower $ packValue (123 :: Int)+"7b"+λ> encoder base32lower $ packValue (123 :: Int)+"pm======"+``` -Copyright (C) 2026 Zoey McBride-<[zoeymcbride@mailbox.org](mailto:zoeymcbride@mailbox.org)>+We can also use encoders and decoders to translate one numeric representation to+another.++```haskell+λ> encoder base10 <$> decoder base2 "1111011"+Just "123"+λ> encoder base10 <$> decoder base16lower "7b"+Just "123"+λ> encoder base10 <$> decoder base32lower "pm======"+Just "123"+```++Licensing+---------++The `basesystems` project and its modules are free software and licensed under+the BSD 3-clause license. See [LICENSE.txt](LICENSE.txt).++Copyright © 2026 Zoey McBride | [zoeymcbride@mailbox.org](+mailto:zoeymcbride@mailbox.org)

@@ -1,5 +1,5 @@ cabal-version: 3.0-version:       1.0.0.1+version:       1.1.0.0 name:          basesystems build-type:    Simple author:        Zoey McBride@@ -14,10 +14,13 @@     base64, and more. extra-doc-files:     README.md-    CHANGE_LOG.md+    CHANGELOG.md+tested-with:+    GHC == 9.6.7+ source-repository head {-  type:     git-  location: https://git.sr.ht/~z0/basesystems+    type:     git+    location: https://git.sr.ht/~z0/basesystems }  -- | Sets flag for CI build toggle@@ -27,65 +30,50 @@     Manual: True } --- | Sets flag for developer build toggle-flag Dev {-    Description: Developer build options-    Default: False-    Manual: True+common HaskellConfig {+    hs-source-dirs: basesystems+    default-extensions: StrictData+    default-language: GHC2021 } --- | These dependency versions are known to be compatable with mfmts common Depends {     build-depends:         base >= 4.18 && < 5,         array ^>= 0.5,-        bytestring ^>= 0.11,-        containers ^>= 0.6,-        text ^>= 2.0+        bytestring >= 0.12 && < 0.13,+        containers >= 0.7 && < 8,+        text >=2.1 && < 2.2 } --- | DefaultBuild: strict compilation + optimize for executable speed-common DefaultBuild {+common BuildUser {     import: Depends     ghc-options: -Wall -Wextra -Wno-unused-top-binds } --- | CIBuild: strict compilation + optimize for compile time-common CIBuild {+common BuildCI {     import: Depends     ghc-options: -Wall -Wextra -Werror -Wno-unused-top-binds } --- | Configures the Dev flag-common DevBuild {-    import: Depends-    ghc-options: -Wall -Wextra -Wno-unused-top-binds-}---- | Configures basesystems library {-    default-extensions: StrictData-    default-language: GHC2021-    if flag(Dev) {-        import: DevBuild-    }-    elif flag(CI) {-        import: CIBuild-    }-    else {-        import: DefaultBuild-    }+    import: HaskellConfig+    if flag(CI) { import: BuildCI }+    else { import: BuildUser }     exposed-modules:-        -- * Defines basesystem interface+        -- * BaseSystems for ShortByteStrings         Data.BaseSystem,-        -- * Defines basesystem implmentors-        Data.BaseSystems,-        -- * Defines alphabet interface+        -- * BaseSystems for LazyByteStrings+        Data.BaseSystem.Lazy,+        -- * BaseSystems for Strict ByteStrings+        Data.BaseSystem.Strict,+        -- * Defines Alphabet type + instances         Data.BaseSystem.Alphabet,-        -- * Defines alphabet implmentors-        Data.BaseSystem.Alphabets,-        -- * Provides common types and functions+        -- * Data instances for working with strings of digits+        Data.BaseSystem.DigitSystem,+        -- * Interface for decoding strings of numbers into binary data.+        Data.BaseSystem.DigitTranscoder,+        -- * Interface for transcoding bitstreams+        Data.BaseSystem.BinaryTranscoder,+        -- * Provides utility functions         Data.BaseSystem.Internal,-    hs-source-dirs:-        basesystems }

@@ -1,170 +1,47 @@ -- | Module      : Data.BaseSystem---   Description : Defines + implements the BaseSystem type-class+--   Description : Implements BaseSystems for ShortByteString. --   Copyright   : Zoey McBride (c) 2026 --   License     : BSD-3-Clause --   Maintainer  : zoeymcbride@mailbox.org --   Stability   : experimental------ This file provides methods for encoding/decoding binary data to/from strings--- of digits in some basesystem. Digits can represent a sum of value placements--- (RadixSystem, eg: binary, base10) *OR* a concatination of fixed-width bit--- groups (BitwiseSystem, eg: base64, base32). module Data.BaseSystem-  ( Encoder,-    Decoder,+  ( -- * BaseSystems on ShortByteString.     BaseSystem (encoder, decoder),-  )-where -import Data.BaseSystem.Alphabet (Alphabet, alphaRadix)-import Data.BaseSystem.Alphabet qualified as Alpha-import Data.BaseSystem.Internal-import Data.Bits ((.&.), (.<<.), (.>>.), (.|.))-import Data.ByteString (ByteString)-import Data.ByteString qualified as Bytes-import Data.Maybe (fromJust, fromMaybe)-import Data.Text qualified as Text+    -- * Function signatures aliases.+    Encoder,+    Decoder, --- | Type-class (interface) for implementing encode/decode functionality for--- some data structure w/ Alphabet `a`.-class BaseSystem a where-  encoder :: a -> Encoder-  decoder :: a -> Decoder+    -- * ByteString implementation for this file.+    ByteStr,+  )+where --- | Function signature for encoding some ByteString to String of digits.-type Encoder = ByteString -> String+import Data.BaseSystem.DigitSystem (BitwiseDigits, RadixDigits)+import Data.BaseSystem.DigitTranscoder qualified as DXC+import Data.ByteString.Short (ShortByteString (ShortByteString))+import Data.Text (Text) --- | Function signature for decoding some String of digits to ByteString, given--- all digits in String are valid Symbols.-type Decoder = String -> Maybe ByteString+-- | Sets the bytestring type to use in this file.+type ByteStr = ShortByteString --- | Implements BaseSystem for number systems built by modular arithmetic w/ the--- radix.-instance BaseSystem RadixSystem where-  encoder :: RadixSystem -> ByteString -> String-  encoder (RadixSystem _ abc) =-    let radix = fromIntegral $ alphaRadix abc-     in concatMap Text.unpack-          . divModSymbols-          . takeWhile divModContinue-          . iterateInit (\(num, _) -> num `divMod` radix) mkDivMod-          . bytesToInteger-    where-      -- Initial value to iterate on divMod.-      mkDivMod numerator = (numerator, 0)-      -- Predicates divMod iteration results.-      divModContinue (nextinput, curresult) = nextinput > 0 || curresult > 0-      -- Resolves the symbols from the result of iterating divMod.-      divModSymbols =-        reverse-          . fromJust-          . mapM (\(_, digit) -> Alpha.resolveSymbol abc digit)-          . replaceNull [(undefined, 0)]+-- | Alias for curried encoder method.+type Encoder = ByteStr -> Text -  decoder :: RadixSystem -> String -> Maybe ByteString-  decoder (RadixSystem _ abc) str =-    let radix = fromIntegral $ alphaRadix abc-     in binaryDecoder Nothing (Text.pack str) $-          \curvalue symbol -> do-            value <- Alpha.resolveValue abc symbol-            return $ curvalue * radix + value+-- | Alias for curried decoder method.+type Decoder = Text -> Maybe ByteStr --- | Resolves symbols from Alphabet for a BitwiseSystem's encoder. Partitions--- a ByteString into N sized bitgroups where N is the bitwidth of the Alphabet's--- radix. *IMPORTANT*: this function requires the groupsize to be a multiple of--- two because it generates a mask from subtracting it by 1.-groupSymbols :: Alphabet -> Int -> Int -> ByteString -> [Alpha.Symbol]-groupSymbols abc symbits groupsize groupbytes =-  let groupint =-        case bytesToInteger groupbytes of-          groupnum-            | fitsGroup groupsize groupbytes groupnum -> fromIntegral groupnum-            | otherwise -> error "invalid group size"-   in -- Crash if the implementation isn't complete-      fromJust-        -- Extract the value from the shift and resolve its symbol.-        . mapM (Alpha.resolveSymbol abc . valueExtract . nextInt groupint)-        -- Take all non-zero shifts.-        . takeWhile (>= 0)-        -- Generate a list of shift values from the # bits in groupbytes.-        $ iterateInit shiftValue mkBitLength groupbytes-  where-    -- Gets the next int to extract group.-    nextInt groupint shift = groupint .>>. shift-    -- Extracts the first group from LSB from an Int.-    valueExtract int = fromIntegral $ int .&. (alphaRadix abc - 1)-    -- Finds the length in bits of a ByteString.-    mkBitLength bstr = fromIntegral $ 8 * Bytes.length bstr-    -- Gives the current shift value in iteration.-    shiftValue bitstotal = bitstotal - symbits+-- | Configures the BaseSystem for this file's ByteType.+class BaseSystem a where+  encoder :: a -> ByteStr -> Text+  decoder :: a -> Text -> Maybe ByteStr --- | Implements encoder/decoder for a BitwiseSystem.-instance BaseSystem BitwiseSystem where-  encoder :: BitwiseSystem -> ByteString -> String-  encoder (BitwiseSystem _ abc symbits groupbytes _ padmethod) input =-    let -- Total # of bytes from input.-        bytestotal = Bytes.length input-        -- Total # of bits from input.-        bitstotal = fromIntegral (8 * bytestotal) :: Double-        -- Actual # of symbols for the # of bits in bytes.-        numsymbols = ceiling (bitstotal / fromIntegral symbits)-        -- Minimum # of symbols to put in the resulting string.-        putsymbols = max 2 numsymbols-        -- Result from applying the padding method to the # of bytes.-        padapply = paddingResolve <$> padmethod <*> Just bytestotal-     in (++ fromMaybe "" padapply)-          . take putsymbols-          . concatMap (\(group, _) -> groupString group)-          . takeWhile (\(group, _) -> Bytes.length group > 0)-          . iterateInit (\(_, rest) -> Bytes.splitAt groupbytes rest) mkSplit-          $ minimalBytes bytestotal-    where-      -- Inits the iteration for Bytes.splitAt.-      mkSplit initial = (Bytes.empty, initial)-      -- Creates a string of symbols from a ByteString splitAt.-      groupString =-        Text.unpack . Text.concat . groupSymbols abc symbits groupbytes-      -- Gives the minimal amount of bytes to produce a correct encoding.-      {-# INLINE minimalBytes #-}-      minimalBytes bytestotal-        | bytestotal == 0 = Bytes.pack [0, 0]-        | bytestotal == 1 = Bytes.snoc input 0-        | bytesmodulus /= 0 = Bytes.append input $ Bytes.replicate zeros 0-        | otherwise = input-        where-          bytesmodulus = bytestotal `mod` groupbytes-          zeros = groupbytes - bytesmodulus+-- | BaseSystem for ShortByteString.+instance BaseSystem RadixDigits where+  encoder = DXC.digitEncoder+  decoder = DXC.digitDecoder -  decoder :: BitwiseSystem -> String -> Maybe ByteString-  decoder (BitwiseSystem _ abc symbits _ groupsyms pm) str =-    let -- Gives just padding char if not nothing.-        padchar = paddingChar <$> pm-        -- Creates symbol from maybe padding char.-        padsymbol = Text.singleton <$> padchar-        -- Removes the trailing padding chars from the Text of str.-        nopad = Text.dropWhileEnd (\sym -> Just sym == padchar) $ Text.pack str-        -- Gives the total available characters.-        totalsyms = Text.length nopad-        -- Finds the needs # of symbols for the final padding chars.-        needsyms = groupsyms - (totalsyms `mod` groupsyms)-        -- Gives the number of bits to correct for missing final padding chars.-        needbits = needsyms * symbits-        -- Offset to Integer to byte-align the bits in the final ByteString.-        bytealign = 8 * ceiling (fromIntegral needbits / 8 :: Double)-     in binaryDecoder (finalizeBits needsyms bytealign) nopad $-          \curvalue symbol -> do-            value <- Alpha.resolveValue abc symbol-            return $-              if Just symbol /= padsymbol-                then (curvalue .<<. symbits) .|. value-                else curvalue .<<. symbits-    where-      -- Finds the value for the expected amount of padding regardless if the-      -- BaseSystem has a PaddingMethod or not.-      {-# INLINE finalizeBits #-}-      finalizeBits needsyms align-        -- If the # of Symbols in last group is the groupsyms size, pass-        | needsyms == groupsyms = Nothing-        -- Find the needed # of bits and align the output to first byte.-        | otherwise = Just $ \finalvalue ->-            finalvalue .<<. (symbits * needsyms) .>>. align+-- | BaseSystem for ShortByteString.+instance BaseSystem BitwiseDigits where+  encoder = DXC.digitEncoder+  decoder = DXC.digitDecoder

@@ -7,29 +7,52 @@ -- -- Implements digit alphabets for BaseSystems. module Data.BaseSystem.Alphabet-  ( Symbol,+  ( -- * Symbolic representation of a value+    Symbol,++    -- * The value that's given to each digit     Value,++    -- * Abstract Alphabet and functions     Alphabet (alphaRadix, alphaHashId),     mkAlphabet,     resolveValue,     resolveSymbol,++    -- * Available Alphabets+    binary,+    decimal,+    hexlower,+    hexupper,+    btc58,+    b32lower,+    b32upper,+    b32hexlower,+    b32hexupper,+    b64,+    b64url,   ) where -import Data.Array.IArray (Array, (!?)) import Data.Array.IArray qualified as Array+import Data.Array.Unboxed (UArray, (!?)) import Data.Char (ord) import Data.Function (on) import Data.Map.Strict (Map) import Data.Map.Strict qualified as Map import Data.Text (Text) import Data.Text qualified as Text+import Data.Word (Word32) +-- TODO: Another module for alphabets with symbols of multiple unicode code+-- points should be made. Then a DigitSystem can be built off that for+-- basesystems of multipoint symbols.+ -- | Represents a symbol to act as a digit in a numbering system.-type Symbol = Text+type Symbol = Char  -- | The value of a symbol in a number system.-type Value = Integer+type Value = Word32  -- | Stores the String hash for an Alphabet. Used for comparision. type HashId = Int@@ -38,7 +61,7 @@ data Alphabet = Alphabet   { alphaRadix :: Int,     alphaHashId :: HashId,-    alphaValues :: Array Value Symbol,+    alphaValues :: UArray Value Symbol,     alphaSymbols :: Map Symbol Value   } @@ -49,28 +72,29 @@   compare = compare `on` alphaHashId  -- | Implements https://cp-algorithms.com/string/string-hashing.html-mkHashId :: String -> Int-mkHashId =-  foldr (\term acc -> (term + acc) `mod` modprime) 0-    . zipWith (\i ch -> baseprime ^ i * ord ch) [(0 :: Int) ..]+mkHashId :: Text -> HashId+mkHashId = snd . Text.foldr buildPolynomial (0 :: Integer, 0 :: HashId)   where     -- Should be around of characters in any given alphabet     baseprime = 53-    -- Large prime to prevent most collisions (1/modulus chance)+    -- Large prime to prevent most collisions (1/modprime chance)     modprime = 1_000_009+    -- Produces the term for a given character+    buildPolynomial ch (expvalue, polysum) =+      let term = baseprime ^ expvalue * ord ch+          next = polysum + term+       in (expvalue + 1, next `mod` modprime) --- | Creates an Alphabet from a given String by chunking the single unicode--- points into Symbols.-mkAlphabet :: String -> Alphabet-mkAlphabet str =-  let text = Text.pack str-      symbols = Text.chunksOf 1 text+-- | Creates an Alphabet from Text using its Chars as Symbols.+mkAlphabet :: Text -> Alphabet+mkAlphabet text =+  let symbols = Text.unpack text       numsymbols = Text.length text-      arraybound = fromIntegral $ numsymbols - 1+      maxdigit = fromIntegral $ numsymbols - 1    in Alphabet         { alphaRadix = numsymbols,-          alphaHashId = mkHashId str,-          alphaValues = Array.listArray (0, arraybound) symbols,+          alphaHashId = mkHashId text,+          alphaValues = Array.listArray (0, maxdigit) symbols,           alphaSymbols = Map.fromList $ zip symbols [0 ..]         } @@ -81,3 +105,73 @@ -- | /O(1)/ Find a symbol from a value in an alphabet. resolveSymbol :: Alphabet -> Value -> Maybe Symbol resolveSymbol abc value = alphaValues abc !? value++-- | Constructs an Alphabet from a list of digit symbol strings.+mk :: [[Char]] -> Alphabet+mk = mkAlphabet . Text.pack . concat++-- | Defines base 2.+binary :: Alphabet+binary = mk ["01"]++-- | Defines base 10.+decimal :: Alphabet+decimal = mk ["0", ['1' .. '9']]++-- | Defines base 16 upper-case.+hexupper :: Alphabet+hexupper = mk ["0", ['1' .. '9'], ['A' .. 'F']]++-- | Defines base 16 lower-case.+hexlower :: Alphabet+hexlower = mk ["0", ['1' .. '9'], ['a' .. 'f']]++-- | Defines base 58, bitcoin variant.+btc58 :: Alphabet+btc58 =+  mk+    [ ['1' .. '9'],+      ['A' .. 'H'],+      ['J' .. 'N'],+      ['P' .. 'Z'],+      ['a' .. 'k'],+      ['m' .. 'z']+    ]++-- | Defines base32, upper-case.+b32upper :: Alphabet+b32upper = mk [['A' .. 'Z'], ['2' .. '7']]++-- | Defines base32, lower-case.+b32lower :: Alphabet+b32lower = mk [['a' .. 'z'], ['2' .. '7']]++-- | Defines base32 hexadecimal, upper-case.+b32hexupper :: Alphabet+b32hexupper = mk ["0", ['1' .. '9'], ['A' .. 'V']]++-- | Defines base32 hexadecimal, lower-case.+b32hexlower :: Alphabet+b32hexlower = mk ["0", ['1' .. '9'], ['a' .. 'v']]++-- | Defines default base64 with + and /.+b64 :: Alphabet+b64 =+  mk+    [ ['A' .. 'Z'],+      ['a' .. 'z'],+      "0",+      ['1' .. '9'],+      ['+', '/']+    ]++-- | Defines URL-safe base64 with - and _.+b64url :: Alphabet+b64url =+  mk+    [ ['A' .. 'Z'],+      ['a' .. 'z'],+      "0",+      ['1' .. '9'],+      ['-', '_']+    ]

@@ -1,83 +0,0 @@--- | Module      : Data.BaseSystem.Alphabets---   Description : Provides alphabets for common base-encodings---   Copyright   : Zoey McBride (c) 2026---   License     : BSD-3-Clause---   Maintainer  : zoeymcbride@mailbox.org---   Stability   : experimental------ Defines common Alphabets for BaseSystems.-module Data.BaseSystem.Alphabets-  ( binary,-    decimal,-    hexlower,-    hexupper,-    btc58,-    b32lower,-    b32upper,-    b32hexlower,-    b32hexupper,-    b64,-    b64url,-  )-where--import Data.BaseSystem.Alphabet---- | Represents base2.-binary :: Alphabet-binary = mkAlphabet "01"---- | Represents base10.-decimal :: Alphabet-decimal = mkAlphabet $ '0' : ['1' .. '9']---- | Represents base16 w/ upper case A-F.-hexupper :: Alphabet-hexupper = mkAlphabet $ ['0'] ++ ['1' .. '9'] ++ ['A' .. 'F']---- | Represents base16 w/ lower case a-f.-hexlower :: Alphabet-hexlower = mkAlphabet $ ['0'] ++ ['1' .. '9'] ++ ['a' .. 'f']---- | Represents Bitcoin's base58.-btc58 :: Alphabet-btc58 =-  mkAlphabet $-    ['1' .. '9']-      ++ ['A' .. 'H']-      ++ ['J' .. 'N']-      ++ ['P' .. 'Z']-      ++ ['a' .. 'k']-      ++ ['m' .. 'z']--b32lower :: Alphabet-b32lower = mkAlphabet $ ['a' .. 'z'] ++ ['2' .. '7']--b32upper :: Alphabet-b32upper = mkAlphabet $ ['A' .. 'Z'] ++ ['2' .. '7']--b32hexupper :: Alphabet-b32hexupper = mkAlphabet $ ['0'] ++ ['1' .. '9'] ++ ['A' .. 'V']--b32hexlower :: Alphabet-b32hexlower = mkAlphabet $ ['0'] ++ ['1' .. '9'] ++ ['a' .. 'v']---- | Represents base64 w/o padding implemented.-b64 :: Alphabet-b64 =-  mkAlphabet $-    ['A' .. 'Z']-      ++ ['a' .. 'z']-      ++ ['0']-      ++ ['1' .. '9']-      ++ ['+', '/']---- | Represents base64 w/o padding implemented.-b64url :: Alphabet-b64url =-  mkAlphabet $-    ['A' .. 'Z']-      ++ ['a' .. 'z']-      ++ ['0']-      ++ ['1' .. '9']-      ++ ['-', '_']

@@ -0,0 +1,238 @@+-- | Module      : Data.BaseSystem.BinaryTranscoder+--   Description : Interfaces for transcoding numeric binary data.+--   Copyright   : Zoey McBride (c) 2026+--   License     : BSD-3-Clause+--   Maintainer  : zoeymcbride@mailbox.org+--   Stability   : experimental+module Data.BaseSystem.BinaryTranscoder+  ( -- * Interface for implementing generic binary decoders+    BinaryTranscoder (..),++    -- * Converts streams of bytes into editable bits+    BitSet,+  )+where++import Data.BaseSystem.Internal+import Data.Bits (Bits, (.&.), (.<<.), (.>>.), (.|.))+import Data.ByteString (ByteString)+import Data.ByteString qualified as Bytes+import Data.ByteString.Builder (Builder)+import Data.ByteString.Builder qualified as Builder+import Data.ByteString.Lazy (LazyByteString)+import Data.ByteString.Lazy qualified as LBS+import Data.ByteString.Short (ShortByteString)+import Data.ByteString.Short qualified as SBS+import Data.Word (Word8)++-- | Storage for data with bitwise operations.+type BitSet = Integer++-- | Class of functions for working on binary transcoder streams, that is+-- streams of bytes that we can easily turn into a bitset, and can partition+-- into smaller streams for extracting and parsing data.+class (Monoid bxc) => BinaryTranscoder bxc where+  -- This defines basic methods that all BinaryTranscoders share.+  {-# MINIMAL+    lengthBytes,+    unpackValue,+    serializeValue,+    packBytes,+    unpackBytes,+    pushByte,+    pushByteEnd,+    takeBytes,+    takeBytesEnd,+    dropBytes,+    dropBytesEnd,+    splitAtByte,+    spanBytes,+    spanBytesEnd,+    replicateByte+    #-}++  -- | Gives back the length in bytes of the Transcoder data.+  lengthBytes :: bxc -> Int++  -- | Unpacks transcoder data as BitSet, ie, an infinite bitarray.+  unpackValue :: bxc -> BitSet++  -- | Places the contents of the transcoder into a ByteString Builder.+  serializeValue :: bxc -> Builder++  -- | Packs Word8 values into transcoder data `bxc`.+  packBytes :: [Word8] -> bxc++  -- | Unpacks transcoder data into a list of bytes.+  unpackBytes :: bxc -> [Word8]++  -- | Prepends a byte value to the top of the transcoder data.+  pushByte :: bxc -> Word8 -> bxc++  -- | Appends the byte value to the end of the transcoder data.+  pushByteEnd :: bxc -> Word8 -> bxc++  -- | Takes a subsection of bytes from the beginning of the transcoder data.+  takeBytes :: Int -> bxc -> bxc++  -- | Removes bytes from the beginning of transcoder data.+  dropBytes :: Int -> bxc -> bxc++  -- | Removes bytes from the end of transcoder data.+  takeBytesEnd :: Int -> bxc -> bxc++  -- | Removes bytes from the end of transcoder data.+  dropBytesEnd :: Int -> bxc -> bxc++  -- | Parititions the binary data at the nth byte.+  splitAtByte :: Int -> bxc -> (bxc, bxc)++  -- | Repeats a byte value in binary data.+  replicateByte :: Int -> Word8 -> bxc++  -- | Splits byte values based on the first false result from the predicate.+  spanBytes :: (Word8 -> Bool) -> bxc -> (bxc, bxc)++  -- | Implements `takeWhile` for byte data in binary transcoder.+  takeWhileBytes :: (Word8 -> Bool) -> bxc -> bxc+  takeWhileBytes f = fst . spanBytesEnd f++  -- | Implements `dropWhile` for byte data in binary transcoder.+  dropWhileBytes :: (Word8 -> Bool) -> bxc -> bxc+  dropWhileBytes f = snd . spanBytesEnd f++  -- | Splits the list while the element predicate holds staring from the left+  -- side.+  spanBytesEnd :: (Word8 -> Bool) -> bxc -> (bxc, bxc)++  -- | Implements `takeWhileEnd` for byte data in binary transcoder.+  takeWhileBytesEnd :: (Word8 -> Bool) -> bxc -> bxc+  takeWhileBytesEnd f = snd . spanBytesEnd f++  -- | Implements `dropWhileEnd` for byte data in binary transcoder.+  dropWhileBytesEnd :: (Word8 -> Bool) -> bxc -> bxc+  dropWhileBytesEnd f = fst . spanBytesEnd f++  -- | Represents empty binary transcoder data.+  empty :: bxc+  empty = mempty++  -- | Appends the contents of two binary transcoders.+  append :: bxc -> bxc -> bxc+  append = mappend++  -- | Creates a binary transcoder from a single byte.+  {-# INLINE singleton #-}+  singleton :: Word8 -> bxc+  singleton w8 = packBytes [w8]++  -- | Returns True if the binary transcoder data is empty.+  {-# INLINE null #-}+  null :: bxc -> Bool+  null bxc = lengthBytes bxc == 0++  -- | Returns the first byte removed from the transcoder data, if available.+  {-# INLINE uncons #-}+  uncons :: bxc -> Maybe (Word8, bxc)+  uncons bxc =+    let (start, rest) = splitAtByte 1 bxc+     in case unpackBytes start of+          [top] -> Just (top, rest)+          _ -> Nothing++  -- | Returns the last byte removed from the transcoder data, if available.+  {-# INLINE usnoc #-}+  usnoc :: bxc -> Maybe (bxc, Word8)+  usnoc bxc =+    let offset = lengthBytes bxc - 1+        (rest, taken) = splitAtByte offset bxc+     in case unpackBytes taken of+          [final] -> Just (rest, final)+          _ -> Nothing++  -- | Packs a bit string value into some bytes data `bxc`.+  packValue :: (Integral b, Bits b) => b -> bxc+  packValue intdata =+    -- This code can be optimized; if we precalculate the length of the BitSet+    -- in bits we can mask from the other direction using left shifts, and+    -- remove the call to reverse, maybe we can even use a list comprehension to+    -- build in place for Bytes.packBytes+    packBytes+      . replaceNull [0]+      . reverse+      . map (\(_, byte) -> fromIntegral byte)+      . takeWhile (\(rest, byte) -> rest > 0 || byte > 0)+      $ iterateInit (\(input, _) -> extractByte input) (,0) intdata+    where+      -- Gets the byte from LSB in input and shifts the value 8 bits.+      extractByte input = (input .>>. 8, input .&. 0xFF)++-- | Implements binary decoder for Bytestrings, best for constant values that+-- exist for the lifetime of the program.+-- https://hackage-content.haskell.org/package/bytestring-0.12.2.0/docs/Data-ByteString.html#g:2+instance BinaryTranscoder ByteString where+  lengthBytes = Bytes.length+  packBytes = Bytes.pack+  serializeValue = Builder.byteString+  unpackBytes = Bytes.unpack+  pushByte = flip Bytes.cons+  pushByteEnd = Bytes.snoc+  takeBytes = Bytes.take+  takeBytesEnd = Bytes.takeEnd+  dropBytes = Bytes.drop+  dropBytesEnd = Bytes.dropEnd+  spanBytes = Bytes.span+  spanBytesEnd = Bytes.spanEnd+  splitAtByte = Bytes.splitAt+  replicateByte k = Bytes.replicate $ fromIntegral k+  unpackValue = unpackValue . LBS.fromStrict++-- TODO: we can improve the proformance of unpackBits by examining the current+-- bytestring, and loading a range of 1-8 bytes to OR simulaneously++-- | Implements binary decoder for LazyByteString, best for very large data sets+-- that can be loaded in and out of memory on demand.+-- https://hackage-content.haskell.org/package/bytestring-0.12.2.0/docs/Data-ByteString-Lazy.html+instance BinaryTranscoder LazyByteString where+  lengthBytes = fromIntegral . LBS.length+  packBytes = LBS.pack+  unpackBytes = LBS.unpack+  serializeValue = Builder.lazyByteString+  pushByte = flip LBS.cons+  pushByteEnd = LBS.snoc+  takeBytes k = LBS.take $ fromIntegral k+  takeBytesEnd k = LBS.takeEnd $ fromIntegral k+  dropBytes k = LBS.drop $ fromIntegral k+  dropBytesEnd k = LBS.dropEnd $ fromIntegral k+  spanBytes = LBS.span+  spanBytesEnd = LBS.spanEnd+  splitAtByte k = LBS.splitAt $ fromIntegral k+  replicateByte k = LBS.replicate $ fromIntegral k+  unpackValue =+    -- From LSB to MSB, OR the current byte and shift the total bits.+    LBS.foldl' (\bits byte -> (bits .<<. 8) .|. fromIntegral byte) 0+      . LBS.dropWhile (== 0)++-- | Implements binary decoder for ShortByteString, best for compact data that+-- doesn't exist long in memory. Notably, it packs better in memory than normal+-- ByteString (prone to Heap Fragmentation).+-- https://hackage-content.haskell.org/package/bytestring-0.12.2.0/docs/Data-ByteString-Short.html#g:1+instance BinaryTranscoder ShortByteString where+  lengthBytes = SBS.length+  packBytes = SBS.pack+  unpackBytes = SBS.unpack+  serializeValue = Builder.shortByteString+  pushByte = flip SBS.cons+  pushByteEnd = SBS.snoc+  takeBytes = SBS.take+  takeBytesEnd = SBS.takeEnd+  dropBytes = SBS.drop+  dropBytesEnd = SBS.dropEnd+  spanBytes = SBS.span+  spanBytesEnd = SBS.spanEnd+  splitAtByte = SBS.splitAt+  replicateByte k = SBS.replicate $ fromIntegral k+  unpackValue =+    -- From LSB to MSB, OR the current byte and shift the total bits.+    SBS.foldl' (\bits byte -> (bits .<<. 8) .|. fromIntegral byte) 0+      . SBS.dropWhile (== 0)

@@ -0,0 +1,191 @@+-- | Module      : Data.BaseSystem.DigitSystem+--   Description : Implements DigitSystems for DigitTranscoders+--   Copyright   : Zoey McBride (c) 2026+--   License     : BSD-3-Clause+--   Maintainer  : zoeymcbride@mailbox.org+--   Stability   : experimental+module Data.BaseSystem.DigitSystem+  ( -- * Abstract DigitSystems data types+    RadixDigits (RadixDigits),+    BitwiseDigits (BitwiseDigits),++    -- * Data member of BitwiseDigits. Determines how to post process encodings.+    PaddingMethod (paddingChar, paddingResolve),++    -- * Concrete instances of DigitSystems+    base2,+    base10,+    base16lower,+    base16upper,+    base32lower,+    base32lowerNP,+    base32upper,+    base32upperNP,+    base32hexlower,+    base32hexlowerNP,+    base32hexupper,+    base32hexupperNP,+    base58btc,+    base64,+    base64NP,+    base64url,+    base64urlNP,+  )+where++import Data.BaseSystem.Alphabet (Alphabet)+import Data.BaseSystem.Alphabet qualified as ABCs+import Data.Text (Text)+import Data.Text qualified as Text++-- | Implements BaseSystem over base radix modulus.+data RadixDigits = RadixDigits+  { -- | Used to implement instance of Show.+    radixShow :: String,+    -- | Alphabet for the base system.+    radixAlpha :: Alphabet+  }++instance Show RadixDigits where+  show = radixShow++-- | Implements padding for encoding BitwiseDigits.+data PaddingMethod = PaddingMethod+  { -- | Gives the char to use as padding.+    paddingChar :: Char,+    -- | Provides the callback to resolve the padding from # of bytes.+    paddingResolve :: Int -> Text+  }++-- | Implements BaseSystem over series of bit groups.+data BitwiseDigits = BitwiseDigits+  { -- | String used to implement instance of Show.+    bitwiseShow :: String,+    -- | Base system alphabet.+    bitwiseAlpha :: Alphabet,+    -- | # of bits per symbol+    bitwiseSymBits :: Int,+    -- | # of bytes to be processed into symbols in encoding.+    bitwiseGroupBytes :: Int,+    -- | # of bytes forming a group to find padding in decoding.+    bitwiseGroupSymbols :: Int,+    -- | Gives the method for padding.+    bitwisePadMethod :: Maybe PaddingMethod+  }++instance Show BitwiseDigits where+  show = bitwiseShow++-- | Provides methods for building a base32 system, with an option to toggle+-- padding.+mkBaseSystem32 :: String -> Maybe Char -> Alphabet -> BitwiseDigits+mkBaseSystem32 name padchar abc =+  BitwiseDigits name abc symbits groupbytes groupsymbols $+    PaddingMethod <*> padImpl <$> padchar+  where+    groupbytes = 5+    groupsymbols = 8+    symbits = 5+    padImpl padding bytestotal+      | bytestotal > 5 = padImpl padding $ bytestotal `mod` symbits+      | bytestotal == 4 = Text.singleton padding+      | bytestotal == 3 = Text.pack (replicate 3 padding)+      | bytestotal == 2 = Text.pack (replicate 4 padding)+      | bytestotal == 1 = Text.pack (replicate 6 padding)+      | otherwise = Text.empty++-- | Provides methods for building a base64 system, with an option to toggle+-- padding.+mkBaseSystem64 :: String -> Maybe Char -> Alphabet -> BitwiseDigits+mkBaseSystem64 name padchar abc =+  BitwiseDigits name abc symbits groupbytes groupsymbols $+    PaddingMethod <*> padImpl <$> padchar+  where+    groupbytes = 3+    groupsymbols = 4+    symbits = 6+    padImpl padding bytestotal+      | bytestotal > 3 = padImpl padding $ bytestotal `mod` groupbytes+      | bytestotal == 2 = Text.singleton padding+      | bytestotal == 1 = Text.pack [padding, padding]+      | otherwise = Text.empty++-- | Defines the BaseSystem for binary.+base2 :: RadixDigits+base2 = RadixDigits "base2" ABCs.binary++-- | Defines base10 as RadixDigits.+base10 :: RadixDigits+base10 = RadixDigits "base10" ABCs.decimal++-- | Defines Bitcoin's base58 implementation.+base58btc :: RadixDigits+base58btc = RadixDigits "base58btc" ABCs.btc58++-- | Defines uppercase hexidecimal on BitwiseDigits.+base16upper :: RadixDigits+base16upper = RadixDigits "base16upper" ABCs.hexupper++-- | Defines lowercase hexadecimal on BitwiseDigits.+base16lower :: RadixDigits+base16lower = RadixDigits "base16lower" ABCs.hexlower++-- | Defines lowercase base32 from RFC4648, with padding.+-- https://datatracker.ietf.org/doc/html/rfc4648.html#section-6+base32lower :: BitwiseDigits+base32lower = mkBaseSystem32 "base32lower" (Just '=') ABCs.b32lower++-- | Defines lowercase base32 from RFC4648. No padding!+-- https://datatracker.ietf.org/doc/html/rfc4648.html#section-6+base32lowerNP :: BitwiseDigits+base32lowerNP = mkBaseSystem32 "base32lowerNP" Nothing ABCs.b32lower++-- | Defines uppercase base32 from RFC4648, with padding.+-- https://datatracker.ietf.org/doc/html/rfc4648.html#section-6+base32upper :: BitwiseDigits+base32upper = mkBaseSystem32 "base32upper" (Just '=') ABCs.b32upper++-- | Defines uppercase base32 from RFC4648. No padding!+-- https://datatracker.ietf.org/doc/html/rfc4648.html#section-6+base32upperNP :: BitwiseDigits+base32upperNP = mkBaseSystem32 "base32upperNP" Nothing ABCs.b32upper++-- | Defines lowercase base32 from RFC4648, extended hex version, with padding.+-- https://datatracker.ietf.org/doc/html/rfc4648.html#section-7+base32hexlower :: BitwiseDigits+base32hexlower = mkBaseSystem32 "base32hexlower" (Just '=') ABCs.b32hexlower++-- | Defines lowercase base32 from RFC4648, extended hex version. No padding!+-- https://datatracker.ietf.org/doc/html/rfc4648.html#section-7+base32hexlowerNP :: BitwiseDigits+base32hexlowerNP = mkBaseSystem32 "base32hexlowerNP" Nothing ABCs.b32hexlower++-- | Defines lowercase base32 from RFC4648, extended hex version, with padding.+-- https://datatracker.ietf.org/doc/html/rfc4648.html#section-7+base32hexupper :: BitwiseDigits+base32hexupper = mkBaseSystem32 "base32hexupper" (Just '=') ABCs.b32hexupper++-- | Defines uppercase base32 from RFC4648, extended hex version. No padding!+-- https://datatracker.ietf.org/doc/html/rfc4648.html#section-7+base32hexupperNP :: BitwiseDigits+base32hexupperNP = mkBaseSystem32 "base32hexupperNP" Nothing ABCs.b32hexupper++-- | Defines base64 from RFC4648, with padding.+-- https://datatracker.ietf.org/doc/html/rfc4648.html#section-4+base64 :: BitwiseDigits+base64 = mkBaseSystem64 "base64" (Just '=') ABCs.b64++-- | Defines base64 from RFC4648. No padding!+-- https://datatracker.ietf.org/doc/html/rfc4648.html#section-4+base64NP :: BitwiseDigits+base64NP = mkBaseSystem64 "base64NP" Nothing ABCs.b64++-- | Defines URL safe base64 from RFC4648, with padding.+-- https://datatracker.ietf.org/doc/html/rfc4648.html#section-5+base64url :: BitwiseDigits+base64url = mkBaseSystem64 "base64url" (Just '=') ABCs.b64url++-- | Defines URL safe base64 from RFC4648. No padding!+-- https://datatracker.ietf.org/doc/html/rfc4648.html#section-5+base64urlNP :: BitwiseDigits+base64urlNP = mkBaseSystem64 "base64urlNP" Nothing ABCs.b64url

@@ -0,0 +1,226 @@+-- | Module      : Data.BaseSystem.DigitTranscoder+--   Description : Implements BaseSystems for strict ByteStrings.+--   Copyright   : Zoey McBride (c) 2026+--   License     : BSD-3-Clause+--   Maintainer  : zoeymcbride@mailbox.org+--   Stability   : experimental+module Data.BaseSystem.DigitTranscoder+  ( DigitTranscoder (digitEncoder, digitDecoder),+    Encoder,+    Decoder,+  )+where++import Control.Monad (foldM)+import Data.BaseSystem.Alphabet (Alphabet)+import Data.BaseSystem.Alphabet qualified as Alpha+import Data.BaseSystem.BinaryTranscoder (BinaryTranscoder, BitSet)+import Data.BaseSystem.BinaryTranscoder qualified as BXC+import Data.BaseSystem.DigitSystem+import Data.BaseSystem.Internal+import Data.Bits ((.&.), (.<<.), (.>>.), (.|.))+import Data.Maybe (fromJust, fromMaybe)+import Data.Text (Text)+import Data.Text qualified as Text++-- | Functor applies when in context of a BaseSystem decoder implementation that+-- requires modifications to the entire bitset before converting to ByteString.+type FinalizeContext = Maybe (BitSet -> BitSet)++-- | Builds symbols from a number in decoding.+-- https://en.wikipedia.org/wiki/Finite-state_machine#Mathematical_model+type DeltaFunction = BitSet -> Alpha.Symbol -> Maybe BitSet++-- | Using a transition function `delta`, build an BitSet into bytes data+-- `bxc`, and use a final BitSet context to align the BitSet's bit contents.+{-# INLINE binaryDecoder #-}+binaryDecoder ::+  (BinaryTranscoder bxc) =>+  Text ->+  FinalizeContext ->+  DeltaFunction ->+  Maybe bxc+binaryDecoder text finalize delta+  | Text.null text = Nothing+  | otherwise = do+      -- For each symbol, build the bitvalue using the delta function if the+      -- symbol is valid.+      bitvalue <- foldM delta 0 $ Text.unpack text+      -- Apply the finalizer to the bits and put it into a transcoder+      return $ BXC.packValue (applyFinalize bitvalue)+  where+    -- If finalize exists, apply it, otherwise return the unchanged value.+    applyFinalize value = fromMaybe value $ finalize <*> Just value++-- | Type alias for curried DigitTranscoder digitEncoder function.+type Encoder t = t -> Text++-- | Type alias for curried DigitTranscoder digitDecoder function.+type Decoder t = Text -> Maybe t++-- | Type-class (interface) for implementing encode/decode functionality for+-- some data structure w/ Alphabet `a`.+class (BinaryTranscoder t) => DigitTranscoder a t where+  -- | Method signature for encoding some ByteString to String of digits.+  digitEncoder :: a -> t -> Text++  -- | Method signature for decoding some String of digits to ByteString, given+  -- all digits in String are valid Symbols.+  digitDecoder :: a -> Text -> Maybe t++-- | Implements BaseSystem for number systems built by modular arithmetic w/ the+-- radix.+instance (BinaryTranscoder t) => DigitTranscoder RadixDigits t where+  -- Encodes the value by converting the ByteString to Integer and repeatedly+  -- applying `divMod` until the quotient is zero.+  digitEncoder (RadixDigits _ abc) =+    let radix = fromIntegral $ Alpha.alphaRadix abc+     in Text.pack+          . divModSymbols+          . takeWhile divModContinue+          . iterateInit (\(num, _) -> num `divMod` radix) mkDivMod+          . BXC.unpackValue+    where+      -- Initial value to iterate on divMod.+      mkDivMod numerator = (numerator, 0)+      -- Predicates divMod iteration results.+      divModContinue (nextinput, curresult) = nextinput > 0 || curresult > 0+      -- Resolves the symbols from the result of iterating divMod.+      divModSymbols =+        reverse+          . fromJust+          . mapM (\(_, digit) -> Alpha.resolveSymbol abc $ fromIntegral digit)+          . replaceNull [(undefined, 0)]++  -- Decodes the value by multiplying the radix with the current integer state+  -- and adding the value. That value is decode directly, no finalization+  -- needed.+  digitDecoder (RadixDigits _ abc) text =+    let radix = fromIntegral $ Alpha.alphaRadix abc+     in binaryDecoder text Nothing $+          \curvalue symbol -> do+            value <- fromIntegral <$> Alpha.resolveValue abc symbol+            return $+              curvalue * radix + value++-- | Implements encoder/decoder for a BitwiseDigits.+instance (BinaryTranscoder t) => DigitTranscoder BitwiseDigits t where+  -- Encodes the input bytes by grouping into `groupsize` sized windows, then+  -- batch resolving the String of Symbols from each group, then resolve the+  -- correct padding chars from the number of bytes and append that to the+  -- encoder result.+  digitEncoder (BitwiseDigits _ abc symbits groupsize _ padmethod) input =+    let -- Total # of bytes from input.+        bytestotal = BXC.lengthBytes input+        -- Total # of bits from input.+        bitstotal = fromIntegral (8 * bytestotal) :: Double+        -- Actual # of symbols for the # of bits in bytes.+        numsymbols = ceiling (bitstotal / fromIntegral symbits)+        -- Minimum # of symbols to put in the resulting string.+        putsymbols = max 2 numsymbols+     in paddingAppend (fromIntegral bytestotal)+          . take putsymbols+          . concatMap groupSyms+          . takeWhile (\(group, _) -> BXC.lengthBytes group > 0)+          . iterateInit (\(_, rest) -> BXC.splitAtByte groupsize rest) mkSplit+          $ minimalBytes bytestotal+    where+      -- Inits the iteration for Bytes.splitAt.+      mkSplit initial = (BXC.empty, initial)+      -- Gives the minimal amount of bytes to produce a correct encoding. It's+      -- here to maintain compatablity with other encoders.+      {-# INLINE minimalBytes #-}+      minimalBytes bytestotal+        | bytestotal == 0 = BXC.packBytes [0, 0]+        | bytestotal == 1 = BXC.pushByteEnd input 0+        | bytesmodulus /= 0 = BXC.append input (BXC.replicateByte zeros 0)+        | otherwise = input+        where+          bytesmodulus = fromIntegral (bytestotal `mod` fromIntegral groupsize)+          zeros = groupsize - bytesmodulus+      -- Gets the symbols for the byte group.+      groupSyms (group, _) = groupSymbols abc group groupsize symbits+      -- Appends the padding chars to the end of a list of symbols, when the+      -- padding method exists and gives back a string for the bytestotal+      paddingAppend bytestotal syms =+        let padapply = paddingResolve <$> padmethod <*> Just bytestotal+         in Text.append (Text.pack syms) (fromMaybe Text.empty padapply)++  -- Decodes the text by filtering out padding resolving each symbol and then+  -- shifting the value by the #bits per symbol and ORing the value in place.+  -- Finally, it needs to be aligned to the top of byte in memory so the value+  -- is represented correctly.+  digitDecoder (BitwiseDigits _ abc symbits _ groupsyms padmethod) text =+    let -- Gives just padding char if not nothing.+        padsym = paddingChar <$> padmethod+        -- Removes the trailing padding chars from the Text of str.+        notrailing = Text.dropWhileEnd (\sym -> Just sym == padsym) text+        -- Gives the total available characters.+        totalsyms = Text.length notrailing+        -- Finds the needs # of symbols for the final padding chars.+        needsyms = groupsyms - (totalsyms `mod` groupsyms)+     in binaryDecoder notrailing (finalizeBits needsyms) $+          \curvalue symbol ->+            if Just symbol == padsym+              -- When the symbol is the padding char, shift an empty value+              then return (curvalue .<<. symbits)+              -- Otherwise put the value in place+              else do+                value <- fromIntegral <$> Alpha.resolveValue abc symbol+                return $ (curvalue .<<. symbits) .|. value+    where+      -- Finds the value for the expected amount of padding regardless if the+      -- BaseSystem has a PaddingMethod or not.+      {-# INLINE finalizeBits #-}+      finalizeBits needsyms+        -- If the # of Symbols in last group is the groupsyms size, pass+        | needsyms == groupsyms = Nothing+        -- Find the needed # of bits and align the output to first byte.+        | otherwise = Just $ \final -> final .<<. needbits .>>. pagealign+        where+          -- Gives the number of bits to correct in missing final padding chars.+          needbits = needsyms * symbits+          -- Offset to Integer to align the bits in the final ByteString at the+          -- start of a byte in memory.+          pagealign = 8 * ceiling (fromIntegral needbits / 8 :: Double)++-- | Resolves symbols from Alphabet for a BitwiseSystem's encoder. Partitions+-- a ByteString into N sized bitgroups where N is the bitwidth of the+-- Alphabet's radix. *IMPORTANT*: this function requires the groupsize to be+-- a multiple of two because it generates a mask from subtracting it by 1.+groupSymbols ::+  (BinaryTranscoder bxc) => Alphabet -> bxc -> Int -> Int -> [Alpha.Symbol]+groupSymbols abc grouping groupsize symbits =+  let groupint =+        case BXC.unpackValue grouping of+          bits+            | fitsBitGroup groupsize grouping bits -> fromIntegral bits+            | otherwise -> error "invalid group size"+   in -- Crash if the implementation isn't complete+      fromJust+        -- Extract the value from the shift and resolve its symbol.+        . mapM (Alpha.resolveSymbol abc . valueExtract . nextInt groupint)+        -- Take all non-zero shifts.+        . takeWhile (>= 0)+        -- Generate a list of shift values from the # bits in groupbytes.+        $ iterateInit shiftValue mkBitLength grouping+  where+    -- Gets the next int to extract group.+    nextInt groupint shift = groupint .>>. shift+    -- Extracts the first group from LSB from an Int.+    valueExtract int = fromIntegral $ int .&. (Alpha.alphaRadix abc - 1)+    -- Finds the length in bits of a ByteString.+    mkBitLength bstr = fromIntegral $ 8 * BXC.lengthBytes bstr+    -- Gives the current shift value in iteration.+    shiftValue bitstotal = bitstotal - symbits++-- Checks if an Integral a fits within a BitwiseSystem's group.+{-# INLINE fitsBitGroup #-}+fitsBitGroup :: (BinaryTranscoder bxc, Integral i) => Int -> bxc -> i -> Bool+fitsBitGroup groupsize bxcdata groupbits =+  BXC.lengthBytes bxcdata <= fromIntegral groupsize+    && minInt <= groupbits+    && groupbits <= maxInt+  where+    minInt = fromIntegral (minBound :: Int)+    maxInt = fromIntegral (maxBound :: Int)

@@ -7,73 +7,12 @@ -- -- Common data definitions and helper functions for this library. module Data.BaseSystem.Internal-  ( -- * BaseSystem data structures-    RadixSystem (..),-    PaddingMethod (..),-    BitwiseSystem (..),--    -- * List utilities+  ( -- * List utilities     replaceNull,     iterateInit,--    -- * ByteString utilities-    bytesToInteger,-    packInteger,-    fitsGroup,--    -- * Decoder implementations-    binaryDecoder,   ) where -import Control.Monad (foldM)-import Data.BaseSystem.Alphabet (Alphabet)-import Data.BaseSystem.Alphabet qualified as Alpha-import Data.Bits ((.&.), (.<<.), (.>>.), (.|.))-import Data.ByteString (ByteString)-import Data.ByteString qualified as Bytes-import Data.Maybe (fromMaybe)-import Data.Text (Text)-import Data.Text qualified as Text---- | Implements BaseSystem over base radix modulus.-data RadixSystem = RadixSystem-  { -- | Used to implement instance of Show.-    radixShow :: String,-    -- | Alphabet for the base system.-    radixAlpha :: Alphabet-  }--instance Show RadixSystem where-  show = radixShow---- | Implements padding for encoding BitwiseSystem.-data PaddingMethod = PaddingMethod-  { -- | Gives the char to use as padding.-    paddingChar :: Char,-    -- | Provides the callback to resolve the padding from # of bytes.-    paddingResolve :: Int -> String-  }---- | Implements BaseSystem over series of bit groups.-data BitwiseSystem = BitwiseSystem-  { -- | String used to implement instance of Show.-    bitwiseShow :: String,-    -- | Base system alphabet.-    bitwiseAlpha :: Alphabet,-    -- | # of bits per symbol-    bitwiseSymBits :: Int,-    -- | # of bytes to be processed into symbols in encoding.-    bitwiseGroupBytes :: Int,-    -- | # of bytes forming a group to find padding in decoding.-    bitwiseGroupSymbols :: Int,-    -- | Gives the method for padding.-    bitwisePadMethod :: Maybe PaddingMethod-  }--instance Show BitwiseSystem where-  show = bitwiseShow- -- | Return the the first param if the second param is empty. {-# INLINE replaceNull #-} replaceNull :: [a] -> [a] -> [a]@@ -84,57 +23,3 @@ -- | Wraps iterate to compose with an intermediary type constructor. iterateInit :: (b -> b) -> (a -> b) -> a -> [b] iterateInit f iterinit = drop 1 . iterate f . iterinit---- | Builds an Integer from ByteString.-bytesToInteger :: ByteString -> Integer-bytesToInteger =-  Bytes.foldl' (\acc x -> (acc .<<. 8) .|. fromIntegral x) 0-    . Bytes.dropWhile (== 0)---- | Encode an Integer's numeric value in a ByteString as raw base2 binary--- values from the the Integer's bit values.-packInteger :: Integer -> ByteString-packInteger =-  -- This code can be optimized; if we precalculate the length of the integer-  -- in bits we can mask from the other direction using left shifts, and remove-  -- the call to reverse, maybe we can even use a list comprehension to build-  -- in place for Bytes.pack-  let maskbyte = (.&. 0xFF)-      shiftbyte = (.>>. 8)-   in Bytes.pack-        . replaceNull [0]-        . reverse-        . map (\(_, byte) -> fromIntegral byte)-        . takeWhile (\(rest, byte) -> rest > 0 || byte > 0)-        . iterateInit (\(input, _) -> (shiftbyte input, maskbyte input)) (,0)---- | Checks if an Integral a fits within a BitwiseSystem's group.-{-# INLINE fitsGroup #-}-fitsGroup :: Int -> ByteString -> Integer -> Bool-fitsGroup groupsize groupbytes groupbits =-  Bytes.length groupbytes <= groupsize-    && minInt <= groupbits-    && groupbits <= maxInt-  where-    minInt = fromIntegral (minBound :: Int)-    maxInt = fromIntegral (maxBound :: Int)---- | Function to cleanup data in decoding.-type FinalizeBits = Maybe (Integer -> Integer)---- Builds symbols from a number in decoding.-type DecoderBuilder = Integer -> Alpha.Symbol -> Maybe Integer---- | Provides generic structure for decoding symbols into binary data--- ByteString.-{-# INLINE binaryDecoder #-}-binaryDecoder :: FinalizeBits -> Text -> DecoderBuilder -> Maybe ByteString-binaryDecoder finalize text builder-  | Text.null text = Nothing-  | otherwise =-      fmap (packInteger . applyFinalize)-        . foldM builder 0-        $ Text.chunksOf 1 text-  where-    -- If finalize exists, apply it, otherwise return the unchanged value.-    applyFinalize value = fromMaybe value $ finalize <*> Just value

@@ -0,0 +1,47 @@+-- | Module      : Data.BaseSystem.Lazy+--   Description : Implements BaseSystems for LazyByteString.+--   Copyright   : Zoey McBride (c) 2026+--   License     : BSD-3-Clause+--   Maintainer  : zoeymcbride@mailbox.org+--   Stability   : experimental+module Data.BaseSystem.Lazy+  ( -- * BaseSystems on LazyByteString.+    BaseSystem (encoder, decoder),++    -- * Function signatures aliases.+    Encoder,+    Decoder,++    -- * ByteString implementation for this file.+    ByteStr,+  )+where++import Data.BaseSystem.DigitSystem (BitwiseDigits, RadixDigits)+import Data.BaseSystem.DigitTranscoder qualified as DXC+import Data.ByteString.Lazy (LazyByteString)+import Data.Text (Text)++-- | Sets the bytestring type to use in this file.+type ByteStr = LazyByteString++-- | Alias for curried encoder method.+type Encoder = ByteStr -> Text++-- | Alias for curried decoder method.+type Decoder = Text -> Maybe ByteStr++-- | Configures the BaseSystem for this file's ByteType.+class BaseSystem a where+  encoder :: a -> ByteStr -> Text+  decoder :: a -> Text -> Maybe ByteStr++-- | BaseSystem for LazyByteString.+instance BaseSystem RadixDigits where+  encoder = DXC.digitEncoder+  decoder = DXC.digitDecoder++-- | BaseSystem for LazyByteString.+instance BaseSystem BitwiseDigits where+  encoder = DXC.digitEncoder+  decoder = DXC.digitDecoder

@@ -0,0 +1,47 @@+-- | Module      : Data.BaseSystem.Strict+--   Description : Implements BaseSystems for strict ByteStrings.+--   Copyright   : Zoey McBride (c) 2026+--   License     : BSD-3-Clause+--   Maintainer  : zoeymcbride@mailbox.org+--   Stability   : experimental+module Data.BaseSystem.Strict+  ( -- * BaseSystems on ByteString+    BaseSystem (encoder, decoder),++    -- * Function signatures aliases.+    Encoder,+    Decoder,++    -- * ByteString implementation for this file+    ByteStr,+  )+where++import Data.BaseSystem.DigitSystem (BitwiseDigits, RadixDigits)+import Data.BaseSystem.DigitTranscoder qualified as DXC+import Data.ByteString (ByteString)+import Data.Text (Text)++-- | Sets the bytestring type to use in this file.+type ByteStr = ByteString++-- | Alias for curried encoder method.+type Encoder = ByteStr -> Text++-- | Alias for curried decoder method.+type Decoder = Text -> Maybe ByteStr++-- | Configures the BaseSystem for this file's ByteType.+class BaseSystem a where+  encoder :: a -> ByteStr -> Text+  decoder :: a -> Text -> Maybe ByteStr++-- | BaseSystem for ByteString.+instance BaseSystem RadixDigits where+  encoder = DXC.digitEncoder+  decoder = DXC.digitDecoder++-- | BaseSystem for ByteString.+instance BaseSystem BitwiseDigits where+  encoder = DXC.digitEncoder+  decoder = DXC.digitDecoder

@@ -1,151 +0,0 @@--- | Module      : Data.BaseSystems---   Description : Provides default implementations for BaseSystem---   Copyright   : Zoey McBride (c) 2026---   License     : BSD-3-Clause---   Maintainer  : zoeymcbride@mailbox.org---   Stability   : experimental------ This file provides common implementations for BaseSystem. These can be used--- by calling either `encoder <basename>` or `decoder <basename>`.-module Data.BaseSystems-  ( base2,-    base10,-    base16lower,-    base16upper,-    base32lower,-    base32lowerNP,-    base32upper,-    base32upperNP,-    base32hexlower,-    base32hexlowerNP,-    base32hexupper,-    base32hexupperNP,-    base58btc,-    base64,-    base64NP,-    base64url,-    base64urlNP,-  )-where--import Data.BaseSystem.Alphabet (Alphabet)-import Data.BaseSystem.Alphabets qualified as ABCs-import Data.BaseSystem.Internal---- | Provides methods for building a base32 system, with an option to toggle--- padding.-mkBaseSystem32 :: String -> Maybe Char -> Alphabet -> BitwiseSystem-mkBaseSystem32 name padchar abc =-  BitwiseSystem name abc symbits groupbytes groupsymbols $-    PaddingMethod <*> padImpl <$> padchar-  where-    groupbytes = 5-    groupsymbols = 8-    symbits = 5-    padImpl padding bytestotal-      | bytestotal > 5 = padImpl padding $ bytestotal `mod` symbits-      | bytestotal == 4 = [padding]-      | bytestotal == 3 = replicate 3 padding-      | bytestotal == 2 = replicate 4 padding-      | bytestotal == 1 = replicate 6 padding-      | otherwise = []---- | Provides methods for building a base64 system, with an option to toggle--- padding.-mkBaseSystem64 :: String -> Maybe Char -> Alphabet -> BitwiseSystem-mkBaseSystem64 name padchar abc =-  BitwiseSystem name abc symbits groupbytes groupsymbols $-    PaddingMethod <*> padImpl <$> padchar-  where-    groupbytes = 3-    groupsymbols = 4-    symbits = 6-    padImpl padding bytestotal-      | bytestotal > 3 = padImpl padding $ bytestotal `mod` groupbytes-      | bytestotal == 2 = [padding]-      | bytestotal == 1 = [padding, padding]-      | otherwise = []---- | Defines the BaseSystem for binary. This could be a BitwiseSystem, but we--- would have to support multiple character ABCs.Symbols; currently we can't--- do this, because it depends on Text.chunksOf 1 to tokenize the utf8 codes.-base2 :: RadixSystem-base2 = RadixSystem "base2" ABCs.binary---- | Defines base10 as RadixSystem.-base10 :: RadixSystem-base10 = RadixSystem "base10" ABCs.decimal---- | Defines Bitcoin's base58 implementation. Flickr apparently has one too.-base58btc :: RadixSystem-base58btc = RadixSystem "base58btc" ABCs.btc58---- | Defines uppercase hexidecimal on BitwiseSystem. Orignally, this was on--- RadixSystem, but I believe BitwiseSystem can become the more optimized--- implementation. Either works.-base16upper :: RadixSystem-base16upper = RadixSystem "base16upper" ABCs.hexupper---- | Defines lowercase hexadecimal on BitwiseSystem.-base16lower :: RadixSystem-base16lower = RadixSystem "base16lower" ABCs.hexlower---- | Defines lowercase base32 from RFC4648, with padding.--- https://datatracker.ietf.org/doc/html/rfc4648.html#section-6-base32lower :: BitwiseSystem-base32lower = mkBaseSystem32 "base32lower" (Just '=') ABCs.b32lower---- | Defines lowercase base32 from RFC4648. No padding!--- https://datatracker.ietf.org/doc/html/rfc4648.html#section-6-base32lowerNP :: BitwiseSystem-base32lowerNP = mkBaseSystem32 "base32lowerNP" Nothing ABCs.b32lower---- | Defines uppercase base32 from RFC4648, with padding.--- https://datatracker.ietf.org/doc/html/rfc4648.html#section-6-base32upper :: BitwiseSystem-base32upper = mkBaseSystem32 "base32upper" (Just '=') ABCs.b32upper---- | Defines uppercase base32 from RFC4648. No padding!--- https://datatracker.ietf.org/doc/html/rfc4648.html#section-6-base32upperNP :: BitwiseSystem-base32upperNP = mkBaseSystem32 "base32upperNP" Nothing ABCs.b32upper---- | Defines lowercase base32 from RFC4648, extended hex version, with padding.--- https://datatracker.ietf.org/doc/html/rfc4648.html#section-7-base32hexlower :: BitwiseSystem-base32hexlower = mkBaseSystem32 "base32hexlower" (Just '=') ABCs.b32hexlower---- | Defines lowercase base32 from RFC4648, extended hex version. No padding!--- https://datatracker.ietf.org/doc/html/rfc4648.html#section-7-base32hexlowerNP :: BitwiseSystem-base32hexlowerNP = mkBaseSystem32 "base32hexlowerNP" Nothing ABCs.b32hexlower---- | Defines lowercase base32 from RFC4648, extended hex version, with padding.--- https://datatracker.ietf.org/doc/html/rfc4648.html#section-7-base32hexupper :: BitwiseSystem-base32hexupper = mkBaseSystem32 "base32hexupper" (Just '=') ABCs.b32hexupper---- | Defines uppercase base32 from RFC4648, extended hex version. No padding!--- https://datatracker.ietf.org/doc/html/rfc4648.html#section-7-base32hexupperNP :: BitwiseSystem-base32hexupperNP = mkBaseSystem32 "base32hexupperNP" Nothing ABCs.b32hexupper---- | Defines base64 from RFC4648, with padding.--- https://datatracker.ietf.org/doc/html/rfc4648.html#section-4-base64 :: BitwiseSystem-base64 = mkBaseSystem64 "base64" (Just '=') ABCs.b64---- | Defines base64 from RFC4648. No padding!--- https://datatracker.ietf.org/doc/html/rfc4648.html#section-4-base64NP :: BitwiseSystem-base64NP = mkBaseSystem64 "base64NP" Nothing ABCs.b64---- | Defines URL safe base64 from RFC4648, with padding.--- https://datatracker.ietf.org/doc/html/rfc4648.html#section-5-base64url :: BitwiseSystem-base64url = mkBaseSystem64 "base64url" (Just '=') ABCs.b64url---- | Defines URL safe base64 from RFC4648. No padding!--- https://datatracker.ietf.org/doc/html/rfc4648.html#section-5-base64urlNP :: BitwiseSystem-base64urlNP = mkBaseSystem64 "base64urlNP" Nothing ABCs.b64url