-- | 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