{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

module Data.Locator.Common (
    Locator (..),
    represent,
    value,
    toLocatorUnique,
    multiply,
    fromLocator,
    concatToInteger,
    digest,
) where

import Prelude hiding (toInteger)

import Crypto.Hash as Crypto
import qualified Data.ByteArray as B
import qualified Data.ByteString.Char8 as S
import Data.List (mapAccumL)
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Word

class (Ord α, Enum α, Bounded α) => Locator α where
    locatorToDigit :: α -> Char
    digitToLocator :: Char -> α

represent :: Locator α => α -> Int -> Char
represent :: forall α. Locator α => α -> Int -> Char
represent (α
_ :: α) Int
n =
    α -> Char
forall α. Locator α => α -> Char
locatorToDigit (α -> Char) -> α -> Char
forall a b. (a -> b) -> a -> b
$ (Int -> α
forall a. Enum a => Int -> a
toEnum Int
n :: α)

{-
value :: Locator α => α -> Char -> Int
value c (_ :: α) =
    fromEnum $ (digitToLocator c :: α)
-}

value :: Locator α => α -> Char -> Int
value :: forall α. Locator α => α -> Char -> Int
value (α
_ :: α) Char
c =
    α -> Int
forall a. Enum a => a -> Int
fromEnum (α -> Int) -> α -> Int
forall a b. (a -> b) -> a -> b
$ (Char -> α
forall α. Locator α => Char -> α
digitToLocator Char
c :: α)

--

{- |
Represent a number in Locator16a format. This uses the Locator16 symbol
set, and additionally specifies that no symbol can be repeated. The /a/ in
Locator16a represents that this transformation is done on the cheap; when
converting if we end up with \'9\' \'9\' we simply pick the subsequent digit
in the enum, in this case getting you \'9\' \'K\'.

Note that the transformation is /not/ reversible. A number like @4369@
(which is @0x1111@, incidentally) encodes as @12C4@. So do @4370@, @4371@,
and @4372@. The point is not uniqueness, but readibility in adverse
conditions. So while you can count locators, they don't map continuously to
base10 integers.

The first argument is the number of digits you'd like in the locator; if the
number passed in is less than 16^limit, then the result will be padded.

>>> toLocator16a 6 4369
12C40F
-}
toLocatorUnique :: Locator α => Int -> Int -> α -> String
toLocatorUnique :: forall α. Locator α => Int -> Int -> α -> String
toLocatorUnique Int
limit Int
n (α
_ :: α) =
    let n' :: Int
n' = Int -> Int
forall a. Num a => a -> a
abs Int
n
        ls :: [α]
ls = Int -> [α] -> [α]
Locator α => Int -> [α] -> [α]
convert Int
n' (Int -> α -> [α]
forall a. Int -> a -> [a]
replicate Int
limit (forall a. Bounded a => a
minBound @α))
        (Set α
_, [α]
us) = (Set α -> α -> (Set α, α)) -> Set α -> [α] -> (Set α, [α])
forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumL Set α -> α -> (Set α, α)
Locator α => Set α -> α -> (Set α, α)
uniq Set α
forall a. Set a
Set.empty [α]
ls
     in (α -> Char) -> [α] -> String
forall a b. (a -> b) -> [a] -> [b]
map α -> Char
forall α. Locator α => α -> Char
locatorToDigit (Int -> [α] -> [α]
forall a. Int -> [a] -> [a]
take Int
limit [α]
us)
  where
    convert :: Locator α => Int -> [α] -> [α]
    convert :: Locator α => Int -> [α] -> [α]
convert Int
0 [α]
xs = [α]
xs
    convert Int
i [α]
xs =
        let (Int
d, Int
r) = Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
divMod Int
i Int
16
            x :: α
x = Int -> α
forall a. Enum a => Int -> a
toEnum Int
r
         in Int -> [α] -> [α]
Locator α => Int -> [α] -> [α]
convert Int
d (α
x α -> [α] -> [α]
forall a. a -> [a] -> [a]
: [α]
xs)

    uniq :: Locator α => Set α -> α -> (Set α, α)
    uniq :: Locator α => Set α -> α -> (Set α, α)
uniq Set α
s α
x =
        if α -> Set α -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member α
x Set α
s
            then Set α -> α -> (Set α, α)
Locator α => Set α -> α -> (Set α, α)
uniq Set α
s (α -> α
Locator α => α -> α
subsequent α
x)
            else (α -> Set α -> Set α
forall a. Ord a => a -> Set a -> Set a
Set.insert α
x Set α
s, α
x)

    subsequent :: Locator α => α -> α
    subsequent :: Locator α => α -> α
subsequent α
x =
        if α
x α -> α -> Bool
forall a. Eq a => a -> a -> Bool
== α
forall a. Bounded a => a
maxBound
            then α
forall a. Bounded a => a
minBound
            else α -> α
forall a. Enum a => a -> a
succ α
x

multiply :: Locator α => α -> Int -> Char -> Int
multiply :: forall α. Locator α => α -> Int -> Char -> Int
multiply (α
locator :: a) Int
acc Char
c =
    let base :: Int
base = α -> Int
forall a. Enum a => a -> Int
fromEnum (forall a. Bounded a => a
maxBound @a) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
     in (Int
acc Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
base) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (α -> Char -> Int
forall α. Locator α => α -> Char -> Int
value α
locator Char
c)

--

-- | Given a number encoded as a Locator, convert it back to an integer.
fromLocator :: Locator α => α -> String -> Int
fromLocator :: forall α. Locator α => α -> String -> Int
fromLocator α
locator String
ss =
    (Int -> Char -> Int) -> Int -> String -> Int
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (α -> Int -> Char -> Int
forall α. Locator α => α -> Int -> Char -> Int
multiply α
locator) Int
0 String
ss

--
-- Given a string, convert it into a N character hash.
--
concatToInteger :: [Word8] -> Int
concatToInteger :: [Word8] -> Int
concatToInteger [Word8]
bytes =
    (Int -> Word8 -> Int) -> Int -> [Word8] -> Int
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Int -> Word8 -> Int
forall {a} {a}. (Integral a, Num a) => a -> a -> a
fn Int
0 [Word8]
bytes
  where
    fn :: a -> a -> a
fn a
acc a
b = (a
acc a -> a -> a
forall a. Num a => a -> a -> a
* a
256) a -> a -> a
forall a. Num a => a -> a -> a
+ (a -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
b)

digest :: String -> Int
digest :: String -> Int
digest String
ws =
    Int
i
  where
    i :: Int
i = [Word8] -> Int
concatToInteger [Word8]
h
    h :: [Word8]
h = Digest SHA1 -> [Word8]
forall a. ByteArrayAccess a => a -> [Word8]
B.unpack Digest SHA1
h'
    h' :: Digest SHA1
h' = ByteString -> Digest SHA1
forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
ba -> Digest a
Crypto.hash ByteString
x' :: Crypto.Digest Crypto.SHA1
    x' :: ByteString
x' = String -> ByteString
S.pack String
ws