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

import Essentials

import Data.Bool (not)
import HashAddressed.HashFunction (HashFunction (SHA_256))
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

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

readHashFunctionText :: Strict.Text -> Maybe HashFunction
readHashFunctionText :: Text -> Maybe HashFunction
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 HashFunction
readHashFunctionString

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

showHashFunction :: HashFunction -> String
showHashFunction :: HashFunction -> String
showHashFunction = \case
    HashFunction
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
" -_"))