module Data.String.NewBase60
  ( numToSxg,
    sxgToNum,
  )
where

import Data.Array (Array, listArray, (!))
import Data.Char (ord)
import Data.List (foldl')
import Data.Maybe (catMaybes, mapMaybe)

lookupArray :: Array Integer Char
lookupArray :: Array Integer Char
lookupArray = (Integer, Integer) -> [Char] -> Array Integer Char
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Integer
0, Integer
59) [Char]
"0123456789ABCDEFGHJKLMNPQRSTUVWXYZ_abcdefghijkmnopqrstuvwxyz"

-- | Convert a number into its New Base 60 representation.
--
-- For more information, see [this link](http://tantek.pbworks.com/w/page/19402946/NewBase60).
numToSxg :: Integer -> String
numToSxg :: Integer -> [Char]
numToSxg Integer
0 = [Char]
"0"
numToSxg Integer
n = [Char] -> Integer -> [Char]
convert [Char]
"" Integer
n
  where
    convert :: [Char] -> Integer -> [Char]
convert [Char]
s Integer
0 = [Char]
s
    convert [Char]
s Integer
n =
      let digit :: Integer
digit = Integer
n Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
60
          ch :: Char
ch = Array Integer Char
lookupArray Array Integer Char -> Integer -> Char
forall i e. Ix i => Array i e -> i -> e
! Integer
digit
       in [Char] -> Integer -> [Char]
convert (Char
ch Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char]
s) (Integer
n Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer
60)

-- | Convert a New Base 60-encoded number into an Integer.
--
-- Valid New Base 60 characters are alphanumeric or underscores (that is, they
-- individually match the regex `[a-zA-Z0-9_]`). Invalid characters will be treated as if
-- they did not exist. Empty strings will evaluate to 0.
--
-- If the resulting value is larger than 2<sup>128</sup>, then this function will return `None`.
--
-- For more information, see [this link](http://tantek.pbworks.com/w/page/19402946/NewBase60).
sxgToNum :: String -> Integer
sxgToNum :: [Char] -> Integer
sxgToNum [Char]
chs =
  (Integer -> Integer -> Integer) -> Integer -> [Integer] -> Integer
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Integer
n Integer
digit -> Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
60 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
digit) (Integer
0 :: Integer) ([Integer] -> Integer) -> [Integer] -> Integer
forall a b. (a -> b) -> a -> b
$
    (Int -> Integer) -> [Int] -> [Integer]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Integer
forall a. Integral a => a -> Integer
toInteger ([Int] -> [Integer]) -> [Int] -> [Integer]
forall a b. (a -> b) -> a -> b
$ (Char -> Maybe Int) -> [Char] -> [Int]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Char -> Maybe Int
convertDigit [Char]
chs
  where
    convertDigit :: Char -> Maybe Int
convertDigit Char
c
      | Char
'0' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'9' = Int -> Maybe Int
forall a. a -> Maybe a
Just (Char -> Int
ord Char
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'0')
      | Char
'A' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'H' = Int -> Maybe Int
forall a. a -> Maybe a
Just (Char -> Int
ord Char
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'A' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
10)
      | Char
'J' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'N' = Int -> Maybe Int
forall a. a -> Maybe a
Just (Char -> Int
ord Char
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'J' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
18)
      | Char
'P' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'Z' = Int -> Maybe Int
forall a. a -> Maybe a
Just (Char -> Int
ord Char
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'P' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
23)
      | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_' = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
34 -- typo capital I, lowercase l to 1
      | Char
'a' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'k' = Int -> Maybe Int
forall a. a -> Maybe a
Just (Char -> Int
ord Char
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'a' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
35)
      | Char
'm' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'z' = Int -> Maybe Int
forall a. a -> Maybe a
Just (Char -> Int
ord Char
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'm' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
46)
      | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'I' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'l' = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
1 -- error correct typo capital O to 0
      | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'O' = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
0 -- skip invalid chars
      | Bool
otherwise = Maybe Int
forall a. Maybe a
Nothing