-- | 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.
    RadixSystem -> String
radixShow :: String,
    -- | Alphabet for the base system.
    RadixSystem -> Alphabet
radixAlpha :: Alphabet
  }

instance Show RadixSystem where
  show :: RadixSystem -> String
show = RadixSystem -> String
radixShow

-- | Implements padding for encoding BitwiseSystem.
data PaddingMethod = PaddingMethod
  { -- | Gives the char to use as padding.
    PaddingMethod -> Char
paddingChar :: Char,
    -- | Provides the callback to resolve the padding from # of bytes.
    PaddingMethod -> Int -> String
paddingResolve :: Int -> String
  }

-- | Implements BaseSystem over series of bit groups.
data BitwiseSystem = BitwiseSystem
  { -- | String used to implement instance of Show.
    BitwiseSystem -> String
bitwiseShow :: String,
    -- | Base system alphabet.
    BitwiseSystem -> Alphabet
bitwiseAlpha :: Alphabet,
    -- | # of bits per symbol
    BitwiseSystem -> Int
bitwiseSymBits :: Int,
    -- | # of bytes to be processed into symbols in encoding.
    BitwiseSystem -> Int
bitwiseGroupBytes :: Int,
    -- | # of bytes forming a group to find padding in decoding.
    BitwiseSystem -> Int
bitwiseGroupSymbols :: Int,
    -- | Gives the method for padding.
    BitwiseSystem -> Maybe PaddingMethod
bitwisePadMethod :: Maybe PaddingMethod
  }

instance Show BitwiseSystem where
  show :: BitwiseSystem -> String
show = BitwiseSystem -> String
bitwiseShow

-- | Return the the first param if the second param is empty.
{-# INLINE replaceNull #-}
replaceNull :: [a] -> [a] -> [a]
replaceNull :: forall a. [a] -> [a] -> [a]
replaceNull [a]
replace [a]
xs
  | [a] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
xs = [a]
replace
  | Bool
otherwise = [a]
xs

-- | Wraps iterate to compose with an intermediary type constructor.
iterateInit :: (b -> b) -> (a -> b) -> a -> [b]
iterateInit :: forall b a. (b -> b) -> (a -> b) -> a -> [b]
iterateInit b -> b
f a -> b
iterinit = Int -> [b] -> [b]
forall a. Int -> [a] -> [a]
drop Int
1 ([b] -> [b]) -> (a -> [b]) -> a -> [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b -> b) -> b -> [b]
forall a. (a -> a) -> a -> [a]
iterate b -> b
f (b -> [b]) -> (a -> b) -> a -> [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
iterinit

-- | Builds an Integer from ByteString.
bytesToInteger :: ByteString -> Integer
bytesToInteger :: ByteString -> Integer
bytesToInteger =
  (Integer -> Word8 -> Integer) -> Integer -> ByteString -> Integer
forall a. (a -> Word8 -> a) -> a -> ByteString -> a
Bytes.foldl' (\Integer
acc Word8
x -> (Integer
acc Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
.<<. Int
8) Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.|. Word8 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
x) Integer
0
    (ByteString -> Integer)
-> (ByteString -> ByteString) -> ByteString -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Bool) -> ByteString -> ByteString
Bytes.dropWhile (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
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 :: 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 :: Integer -> Integer
maskbyte = (Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.&. Integer
0xFF)
      shiftbyte :: Integer -> Integer
shiftbyte = (Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
.>>. Int
8)
   in [Word8] -> ByteString
Bytes.pack
        ([Word8] -> ByteString)
-> (Integer -> [Word8]) -> Integer -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> [Word8] -> [Word8]
forall a. [a] -> [a] -> [a]
replaceNull [Word8
0]
        ([Word8] -> [Word8]) -> (Integer -> [Word8]) -> Integer -> [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> [Word8]
forall a. [a] -> [a]
reverse
        ([Word8] -> [Word8]) -> (Integer -> [Word8]) -> Integer -> [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Integer, Integer) -> Word8) -> [(Integer, Integer)] -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map (\(Integer
_, Integer
byte) -> Integer -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
byte)
        ([(Integer, Integer)] -> [Word8])
-> (Integer -> [(Integer, Integer)]) -> Integer -> [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Integer, Integer) -> Bool)
-> [(Integer, Integer)] -> [(Integer, Integer)]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (\(Integer
rest, Integer
byte) -> Integer
rest Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0 Bool -> Bool -> Bool
|| Integer
byte Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0)
        ([(Integer, Integer)] -> [(Integer, Integer)])
-> (Integer -> [(Integer, Integer)])
-> Integer
-> [(Integer, Integer)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Integer, Integer) -> (Integer, Integer))
-> (Integer -> (Integer, Integer))
-> Integer
-> [(Integer, Integer)]
forall b a. (b -> b) -> (a -> b) -> a -> [b]
iterateInit (\(Integer
input, Integer
_) -> (Integer -> Integer
shiftbyte Integer
input, Integer -> Integer
maskbyte Integer
input)) (,Integer
0)

-- | Checks if an Integral a fits within a BitwiseSystem's group.
{-# INLINE fitsGroup #-}
fitsGroup :: Int -> ByteString -> Integer -> Bool
fitsGroup :: Int -> ByteString -> Integer -> Bool
fitsGroup Int
groupsize ByteString
groupbytes Integer
groupbits =
  ByteString -> Int
Bytes.length ByteString
groupbytes Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
groupsize
    Bool -> Bool -> Bool
&& Integer
minInt Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
groupbits
    Bool -> Bool -> Bool
&& Integer
groupbits Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
maxInt
  where
    minInt :: Integer
minInt = Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
forall a. Bounded a => a
minBound :: Int)
    maxInt :: Integer
maxInt = Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
forall a. Bounded a => a
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 :: FinalizeBits -> Text -> DecoderBuilder -> Maybe ByteString
binaryDecoder FinalizeBits
finalize Text
text DecoderBuilder
builder
  | Text -> Bool
Text.null Text
text = Maybe ByteString
forall a. Maybe a
Nothing
  | Bool
otherwise =
      (Integer -> ByteString) -> Maybe Integer -> Maybe ByteString
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Integer -> ByteString
packInteger (Integer -> ByteString)
-> (Integer -> Integer) -> Integer -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Integer
applyFinalize)
        (Maybe Integer -> Maybe ByteString)
-> ([Text] -> Maybe Integer) -> [Text] -> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DecoderBuilder -> Integer -> [Text] -> Maybe Integer
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM DecoderBuilder
builder Integer
0
        ([Text] -> Maybe ByteString) -> [Text] -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ Int -> Text -> [Text]
Text.chunksOf Int
1 Text
text
  where
    -- If finalize exists, apply it, otherwise return the unchanged value.
    applyFinalize :: Integer -> Integer
applyFinalize Integer
value = Integer -> Maybe Integer -> Integer
forall a. a -> Maybe a -> a
fromMaybe Integer
value (Maybe Integer -> Integer) -> Maybe Integer -> Integer
forall a b. (a -> b) -> a -> b
$ FinalizeBits
finalize FinalizeBits -> Maybe Integer -> Maybe Integer
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
value