packages feed

basesystems (empty) → 1.0.0.0

raw patch · 9 files changed

+790/−0 lines, 9 filesdep +arraydep +basedep +bytestring

Dependencies added: array, base, bytestring, containers, text

Files

+ CHANGE_LOG.md view
@@ -0,0 +1,36 @@+Hackage [`basesystems`](http://hackage-content.haskell.org/package/basesystems)+package change log:+=====================================================================++## Version 1.0.0.0++Finally initialize git repository! 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).
+ LICENSE.txt view
@@ -0,0 +1,28 @@+BSD 3-Clause License++Copyright (c) 2026, Zoey McBride <zoeymcbride@mailbox.org>++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++1. Redistributions of source code must retain the above copyright notice, this+   list of conditions and the following disclaimer.++2. Redistributions in binary form must reproduce the above copyright notice,+   this list of conditions and the following disclaimer in the documentation+   and/or other materials provided with the distribution.++3. Neither the name of the copyright holder nor the names of its+   contributors may be used to endorse or promote products derived from+   this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"+AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,+OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,62 @@+basesystems+===========++This project code contains for Encoding/Decoding number basesystems in Haskell.+It's implemented in a strategy pattern style where `BaseSystem` is a type-class+which provides the `encoder` and `decoder` methods:++```haskell+class BaseSystem a where+  encoder :: a -> ByteString -> String+  decoder :: a -> String -> Maybe ByteString+```++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+-------++```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>+```++Coverage+--------++This project aims to eventually 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:+- base2+- base10+- base16(upper/lower)+- base32(upper/lower) w/pad + nopad+- base32hex(lower/upper) w/pad + nopad+- base58btc+- base64 w/pad + nopad+- base64url w/pad + nopad++Unit testing+------------++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).++License+-------++This project is free software and is provided under the BSD 3-clause licensing+agreement. Copyright (C) 2026 Zoey McBride <[zoeymcbride@mailbox.org](+mailto:zoeymcbride@mailbox.org)>.
+ basesystems.cabal view
@@ -0,0 +1,37 @@+cabal-version:   3.0+version:         1.0.0.0+name:            basesystems+build-type:      Simple+author:          Zoey McBride+maintainer:      zoeymcbride@mailbox.org+license:         BSD-3-Clause+license-file:    LICENSE.txt+extra-doc-files: README.md, CHANGE_LOG.md+category:        Numeric, Data, Serialization+synopsis:        Implements encoders/decoders for basesystems+description:+    This package implements these encoder and decoder methods for numeric+    basesystems and provides definitions for common basesystems like base16,+    base58btc, base64, and more.++source-repository head+  type:     git+  location: https://git.sr.ht/~z0/basesystems++library+    default-language: GHC2021+    default-extensions: StrictData+    ghc-options: -Wall -Wextra -Wno-unused-top-binds+    hs-source-dirs: basesystems+    exposed-modules:+        Data.BaseSystem,+        Data.BaseSystems,+        Data.BaseSystem.Alphabet,+        Data.BaseSystem.Alphabets,+        Data.BaseSystem.Internal,+    build-depends:+        base ^>= 4.18,+        array ^>= 0.5,+        bytestring ^>= 0.11,+        containers ^>= 0.6,+        text ^>= 1.2,
+ basesystems/Data/BaseSystem.hs view
@@ -0,0 +1,170 @@+-- | Module      : Data.BaseSystem+--   Description : Defines + implements the BaseSystem type-class+--   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,+    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++-- | 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++-- | Function signature for encoding some ByteString to String of digits.+type Encoder = ByteString -> String++-- | Function signature for decoding some String of digits to ByteString, given+-- all digits in String are valid Symbols.+type Decoder = String -> Maybe ByteString++-- | 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)]++  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++-- | 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++-- | 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++  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
+ basesystems/Data/BaseSystem/Alphabet.hs view
@@ -0,0 +1,83 @@+-- | Module      : Data.BaseSystem.Alphabet+--   Description : Functions for Alphabets on BaseSystems+--   Copyright   : Zoey McBride (c) 2026+--   License     : BSD-3-Clause+--   Maintainer  : zoeymcbride@mailbox.org+--   Stability   : experimental+--+-- Implements digit alphabets for BaseSystems.+module Data.BaseSystem.Alphabet+  ( Symbol,+    Value,+    Alphabet (alphaRadix, alphaHashId),+    mkAlphabet,+    resolveValue,+    resolveSymbol,+  )+where++import Data.Array.IArray (Array, (!?))+import Data.Array.IArray qualified as Array+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++-- | Represents a symbol to act as a digit in a numbering system.+type Symbol = Text++-- | The value of a symbol in a number system.+type Value = Integer++-- | Stores the String hash for an Alphabet. Used for comparision.+type HashId = Int++-- | Represents a two-way mapping between symbol's values and values's symbols.+data Alphabet = Alphabet+  { alphaRadix :: Int,+    alphaHashId :: HashId,+    alphaValues :: Array Value Symbol,+    alphaSymbols :: Map Symbol Value+  }++instance Eq Alphabet where+  (==) = (==) `on` alphaHashId++instance Ord Alphabet where+  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) ..]+  where+    -- Should be around of characters in any given alphabet+    baseprime = 53+    -- Large prime to prevent most collisions (1/modulus chance)+    modprime = 1_000_009++-- | 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+      numsymbols = Text.length text+      arraybound = fromIntegral $ numsymbols - 1+   in Alphabet+        { alphaRadix = numsymbols,+          alphaHashId = mkHashId str,+          alphaValues = Array.listArray (0, arraybound) symbols,+          alphaSymbols = Map.fromList $ zip symbols [0 ..]+        }++-- | /O(log n)/ Find a value from a symbol in an alphabet.+resolveValue :: Alphabet -> Symbol -> Maybe Value+resolveValue abc symbol = Map.lookup symbol $ alphaSymbols abc++-- | /O(1)/ Find a symbol from a value in an alphabet.+resolveSymbol :: Alphabet -> Value -> Maybe Symbol+resolveSymbol abc value = alphaValues abc !? value
+ basesystems/Data/BaseSystem/Alphabets.hs view
@@ -0,0 +1,83 @@+-- | 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']+      ++ ['-', '_']
+ basesystems/Data/BaseSystem/Internal.hs view
@@ -0,0 +1,140 @@+-- | Module      : Data.BaseSystem.Internal+--   Description : Provides common resources for multibase+--   Copyright   : Zoey McBride (c) 2026+--   License     : BSD-3-Clause+--   Maintainer  : zoeymcbride@mailbox.org+--   Stability   : experimental+--+-- Common data definitions and helper functions for this library.+module Data.BaseSystem.Internal+  ( -- * BaseSystem data structures+    RadixSystem (..),+    PaddingMethod (..),+    BitwiseSystem (..),++    -- * 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]+replaceNull replace xs+  | null xs = replace+  | otherwise = xs++-- | 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
+ basesystems/Data/BaseSystems.hs view
@@ -0,0 +1,151 @@+-- | 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