-- | Partly adapted from https://hackage.haskell.org/package/crockford
module Data.ULID.Base32
  ( encode
  , encodeChar
  , decode
  , decodeChar
  )
where

import Data.Char
import Data.Maybe
import Text.Read
import Data.Text as T

import Data.ULID.Digits (digits, unDigits)


-- | Decodes a Crockford base 32 encoded `Text` into an natural number,
-- if possible. Returns `Nothing` if the `Text` is not a valid encoded value.
decodePlain :: Integral i => Text -> Maybe i
decodePlain :: Text -> Maybe i
decodePlain Text
base32text = do
  [i]
numbers <- (Char -> Maybe i) -> [Char] -> Maybe [i]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Char -> Maybe i
forall i. Integral i => Char -> Maybe i
decodeChar ([Char] -> Maybe [i]) -> [Char] -> Maybe [i]
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack Text
base32text
  i -> Maybe i
forall (f :: * -> *) a. Applicative f => a -> f a
pure (i -> Maybe i) -> i -> Maybe i
forall a b. (a -> b) -> a -> b
$ i -> [i] -> i
forall n. Integral n => n -> [n] -> n
unDigits i
32 [i]
numbers


-- | Encodes an natural number into a Text,
-- using Douglas Crockford's base 32 encoding.
-- Returns `Nothing` if number is negative.
encodePlain :: Integral i => i -> Text
encodePlain :: i -> Text
encodePlain =
  [Char] -> Text
T.pack ([Char] -> Text) -> (i -> [Char]) -> i -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (i -> Char) -> [i] -> [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap i -> Char
forall i. Integral i => i -> Char
encodeChar ([i] -> [Char]) -> (i -> [i]) -> i -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> i -> [i]
forall n. Integral n => n -> n -> [n]
digits i
32


-- | Decode a character to its corresponding integer
decodeChar :: Integral i => Char -> Maybe i
decodeChar :: Char -> Maybe i
decodeChar Char
c = case Char -> Char
Data.Char.toUpper Char
c of
    Char
'0' -> i -> Maybe i
forall a. a -> Maybe a
Just i
0
    Char
'O' -> i -> Maybe i
forall a. a -> Maybe a
Just i
0
    Char
'1' -> i -> Maybe i
forall a. a -> Maybe a
Just i
1
    Char
'I' -> i -> Maybe i
forall a. a -> Maybe a
Just i
1
    Char
'L' -> i -> Maybe i
forall a. a -> Maybe a
Just i
1
    Char
'2' -> i -> Maybe i
forall a. a -> Maybe a
Just i
2
    Char
'3' -> i -> Maybe i
forall a. a -> Maybe a
Just i
3
    Char
'4' -> i -> Maybe i
forall a. a -> Maybe a
Just i
4
    Char
'5' -> i -> Maybe i
forall a. a -> Maybe a
Just i
5
    Char
'6' -> i -> Maybe i
forall a. a -> Maybe a
Just i
6
    Char
'7' -> i -> Maybe i
forall a. a -> Maybe a
Just i
7
    Char
'8' -> i -> Maybe i
forall a. a -> Maybe a
Just i
8
    Char
'9' -> i -> Maybe i
forall a. a -> Maybe a
Just i
9
    Char
'A' -> i -> Maybe i
forall a. a -> Maybe a
Just i
10
    Char
'B' -> i -> Maybe i
forall a. a -> Maybe a
Just i
11
    Char
'C' -> i -> Maybe i
forall a. a -> Maybe a
Just i
12
    Char
'D' -> i -> Maybe i
forall a. a -> Maybe a
Just i
13
    Char
'E' -> i -> Maybe i
forall a. a -> Maybe a
Just i
14
    Char
'F' -> i -> Maybe i
forall a. a -> Maybe a
Just i
15
    Char
'G' -> i -> Maybe i
forall a. a -> Maybe a
Just i
16
    Char
'H' -> i -> Maybe i
forall a. a -> Maybe a
Just i
17
    Char
'J' -> i -> Maybe i
forall a. a -> Maybe a
Just i
18
    Char
'K' -> i -> Maybe i
forall a. a -> Maybe a
Just i
19
    Char
'M' -> i -> Maybe i
forall a. a -> Maybe a
Just i
20
    Char
'N' -> i -> Maybe i
forall a. a -> Maybe a
Just i
21
    Char
'P' -> i -> Maybe i
forall a. a -> Maybe a
Just i
22
    Char
'Q' -> i -> Maybe i
forall a. a -> Maybe a
Just i
23
    Char
'R' -> i -> Maybe i
forall a. a -> Maybe a
Just i
24
    Char
'S' -> i -> Maybe i
forall a. a -> Maybe a
Just i
25
    Char
'T' -> i -> Maybe i
forall a. a -> Maybe a
Just i
26
    Char
'V' -> i -> Maybe i
forall a. a -> Maybe a
Just i
27
    Char
'W' -> i -> Maybe i
forall a. a -> Maybe a
Just i
28
    Char
'X' -> i -> Maybe i
forall a. a -> Maybe a
Just i
29
    Char
'Y' -> i -> Maybe i
forall a. a -> Maybe a
Just i
30
    Char
'Z' -> i -> Maybe i
forall a. a -> Maybe a
Just i
31
    Char
_ -> Maybe i
forall a. Maybe a
Nothing


-- | Encode an integer to its corresponding character
encodeChar :: Integral i => i -> Char
encodeChar :: i -> Char
encodeChar i
i = case i
i of
    i
0  -> Char
'0'
    i
1  -> Char
'1'
    i
2  -> Char
'2'
    i
3  -> Char
'3'
    i
4  -> Char
'4'
    i
5  -> Char
'5'
    i
6  -> Char
'6'
    i
7  -> Char
'7'
    i
8  -> Char
'8'
    i
9  -> Char
'9'
    i
10 -> Char
'A'
    i
11 -> Char
'B'
    i
12 -> Char
'C'
    i
13 -> Char
'D'
    i
14 -> Char
'E'
    i
15 -> Char
'F'
    i
16 -> Char
'G'
    i
17 -> Char
'H'
    i
18 -> Char
'J'
    i
19 -> Char
'K'
    i
20 -> Char
'M'
    i
21 -> Char
'N'
    i
22 -> Char
'P'
    i
23 -> Char
'Q'
    i
24 -> Char
'R'
    i
25 -> Char
'S'
    i
26 -> Char
'T'
    i
27 -> Char
'V'
    i
28 -> Char
'W'
    i
29 -> Char
'X'
    i
30 -> Char
'Y'
    i
31 -> Char
'Z'
    i
_  -> Char
'0'


-- | Source: https://stackoverflow.com/a/29153602
-- The safety for m > length was removed, because that should never happen.
-- If it does, it should crash.
leftpad :: Int -> Text -> Text
leftpad :: Int -> Text -> Text
leftpad Int
m Text
xs =
  Int -> Text -> Text
T.replicate (Int
m Int -> Int -> Int
forall a. Num a => a -> a -> a
- Text -> Int
T.length Text
xs) Text
"0" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
xs


-- | Converts all negative numbers to 0
clampZero :: Integral i => i -> i
clampZero :: i -> i
clampZero i
x =
  if i
x i -> i -> Bool
forall a. Ord a => a -> a -> Bool
< i
0
  then i
0
  else i
x


-- | >>> encode 5 123
-- "0003V"
--
-- | >>> encode (-5) (-123)
-- ""
encode
  :: Integral i
  => Int  -- ^ Overall length of resulting Text
  -> i  -- ^ Natural number to encode
  -> Text  -- ^ 0 padded, Douglas Crockford's base 32 encoded Text
encode :: Int -> i -> Text
encode Int
width =
  Int -> Text -> Text
leftpad (Int -> Int
forall i. Integral i => i -> i
clampZero Int
width) (Text -> Text) -> (i -> Text) -> i -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> Text
forall i. Integral i => i -> Text
encodePlain (i -> Text) -> (i -> i) -> i -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> i
forall i. Integral i => i -> i
clampZero


-- | >>> decode 5 "0003V"
-- [(123,"")]
decode
  :: Integral i
  => Int  -- ^ Overall length of input Text
  -> Text  -- ^ Base 32 encoded Text
  -> [(i, Text)]  -- ^ List of possible parses
decode :: Int -> Text -> [(i, Text)]
decode Int
width Text
str  | Text -> Int
T.length Text
str Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
width   = let
                      (Text
crock, Text
remainder) = Int -> Text -> (Text, Text)
T.splitAt Int
width Text
str
                    in case Text -> Maybe i
forall i. Integral i => Text -> Maybe i
decodePlain Text
crock of
                        Maybe i
Nothing -> []
                        Just i
c  -> [(i
c, Text
remainder)]
                  | Bool
otherwise             = []