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

module Data.Locator.Latin25 (
    Latin25 (..),
    toLatin25,
    fromLatin25,
    hashStringToLatin25,
) where

import Prelude hiding (toInteger)

import Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as S
import Numeric (showIntAtBase)

import Data.Locator.Common
import Data.Locator.Hashes (padWithZeros)

{- |
A symbol set with twenty-five visually distinct characters.

These are not protected against similar pronounciations; if you need to
read your identifiers /aloud/ use 'English16' instead.
-}

{-

    --  | Two       -- Obvious conflict with Z
    --  | Five      -- Obvious conflict with S
    --  | Six       -- Too close to G
    --  | Bravo     -- Too close to 8
    --  | Delta     -- Shape of D too close to O
    --  | Foxtrot   -- Excluded because too close to E
    --  | India     -- Too close to 1 and J
    --  | Oscar     -- Obvious conflict with 0
    --  | Quebec    -- The tail on Q is too easy to miss, thereby colliding with O/0
    --  | Romeo     -- Dropped in favour of P
    --  | Uniform   -- Too close to V

-}
data Latin25
    = -- | @\'0\'@ /0th/
      Zero'
    | -- | @\'1\'@ /1st/
      One'
    | -- | @\'3\'@ /2nd/
      Three'
    | -- | @\'4\'@ /3rd/
      Four'
    | -- | @\'7\'@ /4th/
      Seven'
    | -- | @\'8\'@ /5th/
      Eight'
    | -- | @\'9\'@ /6th/
      Nine'
    | -- | @\'A\'@ /7th/
      Alpha'
    | -- | @\'C\'@ /8th/
      Charlie'
    | -- | @\'E\'@ /9th/
      Echo'
    | -- | @\'G\'@ /10th/
      Golf'
    | -- | @\'H\'@ /11th/
      Hotel'
    | -- | @\'J\'@ /12th/
      Juliet'
    | -- | @\'K\'@ /13th/
      Kilo'
    | -- | @\'L\'@ /14th/
      Lima'
    | -- | @\'M\'@ /15th/
      Mike'
    | -- | @\'N\'@ /16th/
      November'
    | -- | @\'P\'@ /17th/
      Papa'
    | -- | @\'S\'@ /18th/
      Sierra'
    | -- | @\'T\'@ /19th/
      Tango'
    | -- | @\'V\'@ /20th/
      Victor'
    | -- | @\'W\'@ /21st/
      Whiskey'
    | -- | @\'X\'@ /22nd/
      XRay'
    | -- | @\'Y\'@ /23rd/
      Yankee'
    | -- | @\'Z\'@ /24th/
      Zulu'
    deriving (Latin25 -> Latin25 -> Bool
(Latin25 -> Latin25 -> Bool)
-> (Latin25 -> Latin25 -> Bool) -> Eq Latin25
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Latin25 -> Latin25 -> Bool
== :: Latin25 -> Latin25 -> Bool
$c/= :: Latin25 -> Latin25 -> Bool
/= :: Latin25 -> Latin25 -> Bool
Eq, Eq Latin25
Eq Latin25 =>
(Latin25 -> Latin25 -> Ordering)
-> (Latin25 -> Latin25 -> Bool)
-> (Latin25 -> Latin25 -> Bool)
-> (Latin25 -> Latin25 -> Bool)
-> (Latin25 -> Latin25 -> Bool)
-> (Latin25 -> Latin25 -> Latin25)
-> (Latin25 -> Latin25 -> Latin25)
-> Ord Latin25
Latin25 -> Latin25 -> Bool
Latin25 -> Latin25 -> Ordering
Latin25 -> Latin25 -> Latin25
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Latin25 -> Latin25 -> Ordering
compare :: Latin25 -> Latin25 -> Ordering
$c< :: Latin25 -> Latin25 -> Bool
< :: Latin25 -> Latin25 -> Bool
$c<= :: Latin25 -> Latin25 -> Bool
<= :: Latin25 -> Latin25 -> Bool
$c> :: Latin25 -> Latin25 -> Bool
> :: Latin25 -> Latin25 -> Bool
$c>= :: Latin25 -> Latin25 -> Bool
>= :: Latin25 -> Latin25 -> Bool
$cmax :: Latin25 -> Latin25 -> Latin25
max :: Latin25 -> Latin25 -> Latin25
$cmin :: Latin25 -> Latin25 -> Latin25
min :: Latin25 -> Latin25 -> Latin25
Ord, Int -> Latin25
Latin25 -> Int
Latin25 -> [Latin25]
Latin25 -> Latin25
Latin25 -> Latin25 -> [Latin25]
Latin25 -> Latin25 -> Latin25 -> [Latin25]
(Latin25 -> Latin25)
-> (Latin25 -> Latin25)
-> (Int -> Latin25)
-> (Latin25 -> Int)
-> (Latin25 -> [Latin25])
-> (Latin25 -> Latin25 -> [Latin25])
-> (Latin25 -> Latin25 -> [Latin25])
-> (Latin25 -> Latin25 -> Latin25 -> [Latin25])
-> Enum Latin25
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Latin25 -> Latin25
succ :: Latin25 -> Latin25
$cpred :: Latin25 -> Latin25
pred :: Latin25 -> Latin25
$ctoEnum :: Int -> Latin25
toEnum :: Int -> Latin25
$cfromEnum :: Latin25 -> Int
fromEnum :: Latin25 -> Int
$cenumFrom :: Latin25 -> [Latin25]
enumFrom :: Latin25 -> [Latin25]
$cenumFromThen :: Latin25 -> Latin25 -> [Latin25]
enumFromThen :: Latin25 -> Latin25 -> [Latin25]
$cenumFromTo :: Latin25 -> Latin25 -> [Latin25]
enumFromTo :: Latin25 -> Latin25 -> [Latin25]
$cenumFromThenTo :: Latin25 -> Latin25 -> Latin25 -> [Latin25]
enumFromThenTo :: Latin25 -> Latin25 -> Latin25 -> [Latin25]
Enum, Latin25
Latin25 -> Latin25 -> Bounded Latin25
forall a. a -> a -> Bounded a
$cminBound :: Latin25
minBound :: Latin25
$cmaxBound :: Latin25
maxBound :: Latin25
Bounded)

instance Locator Latin25 where
    locatorToDigit :: Latin25 -> Char
locatorToDigit Latin25
x =
        case Latin25
x of
            Latin25
Zero' -> Char
'0'
            Latin25
One' -> Char
'1'
            Latin25
Three' -> Char
'3'
            Latin25
Four' -> Char
'4'
            Latin25
Seven' -> Char
'7'
            Latin25
Eight' -> Char
'8'
            Latin25
Nine' -> Char
'9'
            Latin25
Alpha' -> Char
'A'
            Latin25
Charlie' -> Char
'C'
            Latin25
Echo' -> Char
'E'
            Latin25
Golf' -> Char
'G'
            Latin25
Hotel' -> Char
'H'
            Latin25
Juliet' -> Char
'J'
            Latin25
Kilo' -> Char
'K'
            Latin25
Lima' -> Char
'L'
            Latin25
Mike' -> Char
'M'
            Latin25
November' -> Char
'N'
            Latin25
Papa' -> Char
'P'
            Latin25
Sierra' -> Char
'S'
            Latin25
Tango' -> Char
'T'
            Latin25
Victor' -> Char
'V'
            Latin25
Whiskey' -> Char
'W'
            Latin25
XRay' -> Char
'X'
            Latin25
Yankee' -> Char
'Y'
            Latin25
Zulu' -> Char
'Z'

    digitToLocator :: Char -> Latin25
    digitToLocator :: Char -> Latin25
digitToLocator Char
c =
        case Char
c of
            Char
'0' -> Latin25
Zero'
            Char
'1' -> Latin25
One'
            Char
'3' -> Latin25
Three'
            Char
'4' -> Latin25
Four'
            Char
'7' -> Latin25
Seven'
            Char
'8' -> Latin25
Eight'
            Char
'9' -> Latin25
Nine'
            Char
'A' -> Latin25
Alpha'
            Char
'C' -> Latin25
Charlie'
            Char
'E' -> Latin25
Echo'
            Char
'G' -> Latin25
Golf'
            Char
'H' -> Latin25
Hotel'
            Char
'J' -> Latin25
Juliet'
            Char
'K' -> Latin25
Kilo'
            Char
'L' -> Latin25
Lima'
            Char
'M' -> Latin25
Mike'
            Char
'N' -> Latin25
November'
            Char
'P' -> Latin25
Papa'
            Char
'S' -> Latin25
Sierra'
            Char
'T' -> Latin25
Tango'
            Char
'W' -> Latin25
Whiskey'
            Char
'V' -> Latin25
Victor'
            Char
'X' -> Latin25
XRay'
            Char
'Y' -> Latin25
Yankee'
            Char
'Z' -> Latin25
Zulu'
            Char
_ -> [Char] -> Latin25
forall a. HasCallStack => [Char] -> a
error [Char]
"Illegal digit"

instance Show Latin25 where
    show :: Latin25 -> [Char]
show Latin25
x = [Char
c]
      where
        c :: Char
c = Latin25 -> Char
forall α. Locator α => α -> Char
locatorToDigit Latin25
x

--

{- |
Given a number, convert it to a string in the Latin25 base 25 symbol
alphabet. This is useful for primary keys and object identifiers that you
need to scan for in log output, for example.
-}
toLatin25 :: Int -> String
toLatin25 :: Int -> [Char]
toLatin25 Int
x =
    Int -> (Int -> Char) -> Int -> ShowS
forall a. Integral a => a -> (Int -> Char) -> a -> ShowS
showIntAtBase Int
25 (Latin25 -> Int -> Char
forall α. Locator α => α -> Int -> Char
represent Latin25
Zulu') Int
x [Char]
""

--

-- | Given a number encoded in Locator16, convert it back to an integer.
fromLatin25 :: String -> Int
fromLatin25 :: [Char] -> Int
fromLatin25 [Char]
ss =
    (Int -> Char -> Int) -> Int -> [Char] -> Int
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (Latin25 -> Int -> Char -> Int
forall α. Locator α => α -> Int -> Char -> Int
multiply Latin25
Zulu') Int
0 [Char]
ss

--

{- |
Take an arbitrary sequence of bytes, hash it with SHA1, then format as a
short @limit@-long Latin25 string.

>>> hashStringToLatin25 5 "You'll get used to it. Or, you'll have a psychotic episode"
SG8XP

17 characters is the widest hash you can request.
-}
hashStringToLatin25 :: Int -> ByteString -> ByteString
hashStringToLatin25 :: Int -> ByteString -> ByteString
hashStringToLatin25 Int
limit ByteString
s'
    | Int
limit Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
17 = [Char] -> ByteString
forall a. HasCallStack => [Char] -> a
error [Char]
"Can only request a maximum width of 17, sorry"
    | Bool
otherwise =
        let s :: [Char]
s = ByteString -> [Char]
S.unpack ByteString
s'
            n :: Int
n = [Char] -> Int
digest [Char]
s -- SHA1 hash
            r :: Int
r = Int -> Int -> Int
forall a. Integral a => a -> a -> a
mod Int
n Int
upperBound -- trim to specified number of base 25 chars
            x :: [Char]
x = Int -> [Char]
toLatin25 Int
r -- express in Latin25
            b' :: ByteString
b' = [Char] -> ByteString
S.pack (Int -> ShowS
padWithZeros Int
limit [Char]
x)
         in ByteString
b'
  where
    upperBound :: Int
upperBound = Int
25 Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^ Int
limit