module HashAddressed.App.HashFunction.Naming
  (
    HashFunctionName (..),
    readHashFunctionText,
    readHashFunctionString,
    showHashFunction,
    normalizeHashFunction,
    hashFunctions,
    resolveHashFunction,
  )
  where

import Essentials

import Data.Bool (not)
import HashAddressed.HashFunction (HashFunction)
import Prelude (String)

import qualified Data.Char as Char
import qualified Data.List as List
import qualified Data.Text as Strict
import qualified Data.Text as Strict.Text
import qualified HashAddressed.HashFunction as Hash

data HashFunctionName = SHA_256
    deriving HashFunctionName -> HashFunctionName -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HashFunctionName -> HashFunctionName -> Bool
$c/= :: HashFunctionName -> HashFunctionName -> Bool
== :: HashFunctionName -> HashFunctionName -> Bool
$c== :: HashFunctionName -> HashFunctionName -> Bool
Eq

resolveHashFunction :: HashFunctionName -> HashFunction
resolveHashFunction :: HashFunctionName -> HashFunction
resolveHashFunction = \case
    HashFunctionName
SHA_256 -> HashFunction
Hash.sha256

hashFunctions :: [(String, HashFunctionName)]
hashFunctions :: [(String, HashFunctionName)]
hashFunctions = [(HashFunctionName -> String
showHashFunction HashFunctionName
SHA_256, HashFunctionName
SHA_256)]

readHashFunctionText :: Strict.Text -> Maybe HashFunctionName
readHashFunctionText :: Text -> Maybe HashFunctionName
readHashFunctionText = Text -> String
Strict.Text.unpack forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> String -> Maybe HashFunctionName
readHashFunctionString

readHashFunctionString :: String -> Maybe HashFunctionName
readHashFunctionString :: String -> Maybe HashFunctionName
readHashFunctionString String
x = forall a b. Eq a => a -> [(a, b)] -> Maybe b
List.lookup String
x [(String, HashFunctionName)]
hashFunctions

showHashFunction :: HashFunctionName -> String
showHashFunction :: HashFunctionName -> String
showHashFunction = \case
    HashFunctionName
SHA_256 -> String
"sha256"

normalizeHashFunction :: String -> String
normalizeHashFunction :: String -> String
normalizeHashFunction =
    forall a b. (a -> b) -> [a] -> [b]
List.map Char -> Char
Char.toLower forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. (a -> Bool) -> [a] -> [a]
List.filter (\Char
x -> Bool -> Bool
not (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
List.elem Char
x String
" -_"))