-- | 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
  { Alphabet -> Int
alphaRadix :: Int,
    Alphabet -> Int
alphaHashId :: HashId,
    Alphabet -> Array Value Symbol
alphaValues :: Array Value Symbol,
    Alphabet -> Map Symbol Value
alphaSymbols :: Map Symbol Value
  }

instance Eq Alphabet where
  == :: Alphabet -> Alphabet -> Bool
(==) = Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Int -> Int -> Bool)
-> (Alphabet -> Int) -> Alphabet -> Alphabet -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Alphabet -> Int
alphaHashId

instance Ord Alphabet where
  compare :: Alphabet -> Alphabet -> Ordering
compare = Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Int -> Int -> Ordering)
-> (Alphabet -> Int) -> Alphabet -> Alphabet -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Alphabet -> Int
alphaHashId

-- | Implements https://cp-algorithms.com/string/string-hashing.html
mkHashId :: String -> Int
mkHashId :: String -> Int
mkHashId =
  (Int -> Int -> Int) -> Int -> [Int] -> Int
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\Int
term Int
acc -> (Int
term Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
acc) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
modprime) Int
0
    ([Int] -> Int) -> (String -> [Int]) -> String -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Char -> Int) -> [Int] -> String -> [Int]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Int
i Char
ch -> Int
baseprime Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^ Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
* Char -> Int
ord Char
ch) [(Int
0 :: Int) ..]
  where
    -- Should be around of characters in any given alphabet
    baseprime :: Int
baseprime = Int
53
    -- Large prime to prevent most collisions (1/modulus chance)
    modprime :: Int
modprime = Int
1_000_009

-- | Creates an Alphabet from a given String by chunking the single unicode
-- points into Symbols.
mkAlphabet :: String -> Alphabet
mkAlphabet :: String -> Alphabet
mkAlphabet String
str =
  let text :: Symbol
text = String -> Symbol
Text.pack String
str
      symbols :: [Symbol]
symbols = Int -> Symbol -> [Symbol]
Text.chunksOf Int
1 Symbol
text
      numsymbols :: Int
numsymbols = Symbol -> Int
Text.length Symbol
text
      arraybound :: Value
arraybound = Int -> Value
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Value) -> Int -> Value
forall a b. (a -> b) -> a -> b
$ Int
numsymbols Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
   in Alphabet
        { alphaRadix :: Int
alphaRadix = Int
numsymbols,
          alphaHashId :: Int
alphaHashId = String -> Int
mkHashId String
str,
          alphaValues :: Array Value Symbol
alphaValues = (Value, Value) -> [Symbol] -> Array Value Symbol
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [e] -> a i e
Array.listArray (Value
0, Value
arraybound) [Symbol]
symbols,
          alphaSymbols :: Map Symbol Value
alphaSymbols = [(Symbol, Value)] -> Map Symbol Value
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Symbol, Value)] -> Map Symbol Value)
-> [(Symbol, Value)] -> Map Symbol Value
forall a b. (a -> b) -> a -> b
$ [Symbol] -> [Value] -> [(Symbol, Value)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Symbol]
symbols [Value
0 ..]
        }

-- | /O(log n)/ Find a value from a symbol in an alphabet.
resolveValue :: Alphabet -> Symbol -> Maybe Value
resolveValue :: Alphabet -> Symbol -> Maybe Value
resolveValue Alphabet
abc Symbol
symbol = Symbol -> Map Symbol Value -> Maybe Value
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Symbol
symbol (Map Symbol Value -> Maybe Value)
-> Map Symbol Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ Alphabet -> Map Symbol Value
alphaSymbols Alphabet
abc

-- | /O(1)/ Find a symbol from a value in an alphabet.
resolveSymbol :: Alphabet -> Value -> Maybe Symbol
resolveSymbol :: Alphabet -> Value -> Maybe Symbol
resolveSymbol Alphabet
abc Value
value = Alphabet -> Array Value Symbol
alphaValues Alphabet
abc Array Value Symbol -> Value -> Maybe Symbol
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> Maybe e
!? Value
value