{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_HADDOCK not-home #-}

-- | Internal to the arbiter packages. Not covered by the PVP.
--
-- Text lookups for finite enums, and 'Show' rendered as text.
module Arbiter.Core.Enum
  ( enumFromText
  , enumFromTextCI
  , showText
  ) where

import Data.Text (Text, pack, toCaseFold)

-- | The enum value whose name is the given text. The label names the enum in the error.
enumFromText :: (Bounded a, Enum a) => Text -> (a -> Text) -> Text -> Either Text a
enumFromText :: forall a.
(Bounded a, Enum a) =>
Text -> (a -> Text) -> Text -> Either Text a
enumFromText = (Text -> Text) -> Text -> (a -> Text) -> Text -> Either Text a
forall a.
(Bounded a, Enum a) =>
(Text -> Text) -> Text -> (a -> Text) -> Text -> Either Text a
enumFromTextBy Text -> Text
forall a. a -> a
id

-- | 'enumFromText', ignoring case.
enumFromTextCI :: (Bounded a, Enum a) => Text -> (a -> Text) -> Text -> Either Text a
enumFromTextCI :: forall a.
(Bounded a, Enum a) =>
Text -> (a -> Text) -> Text -> Either Text a
enumFromTextCI = (Text -> Text) -> Text -> (a -> Text) -> Text -> Either Text a
forall a.
(Bounded a, Enum a) =>
(Text -> Text) -> Text -> (a -> Text) -> Text -> Either Text a
enumFromTextBy Text -> Text
toCaseFold

-- | A value's 'show' as text.
showText :: (Show a) => a -> Text
showText :: forall a. Show a => a -> Text
showText = String -> Text
pack (String -> Text) -> (a -> String) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show

enumFromTextBy :: (Bounded a, Enum a) => (Text -> Text) -> Text -> (a -> Text) -> Text -> Either Text a
enumFromTextBy :: forall a.
(Bounded a, Enum a) =>
(Text -> Text) -> Text -> (a -> Text) -> Text -> Either Text a
enumFromTextBy Text -> Text
norm Text
label a -> Text
toName Text
input =
  Either Text a -> (a -> Either Text a) -> Maybe a -> Either Text a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
    (Text -> Either Text a
forall a b. a -> Either a b
Left (Text
"unknown " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
label Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
input))
    a -> Either Text a
forall a b. b -> Either a b
Right
    (Text -> [(Text, a)] -> Maybe a
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (Text -> Text
norm Text
input) [(Text -> Text
norm (a -> Text
toName a
value), a
value) | a
value <- [a
forall a. Bounded a => a
minBound .. a
forall a. Bounded a => a
maxBound]])