EnumParser.hs

{-# LANGUAGE UndecidableInstances #-}

-- |
-- Module: Data.Env.EnumParser
-- Description: A helper type for parsing Bounded Enums.
--
-- This module provides a 'TypeParser' instance for any type that is an
-- instance of 'Enum', 'Bounded', and 'Show'.
--
-- Example usage:
--
-- > data Gender = Male | Female
-- >   deriving (Show, Eq, Enum, Bounded)
-- >   deriving TypeParser via (EnumParser Gender)
-- >
-- > parseType @Gender "Male" `shouldBe` Right Male
-- > parseType @Gender "Female" `shouldBe` Right Female
-- > parseType @Gender "Other" `shouldSatisfy` isLeft
module Data.Env.EnumParser ( EnumParser (..) ) where

import Data.Env.TypeParser ( TypeParser(..) )
import Data.List ( intercalate )
import Data.Map ( Map )
import Data.Map qualified as M

-- | A helper type for parsing Bounded Enums.
newtype EnumParser a = EnumParser a
  deriving (Show)

-- | Map from each constructor's 'Show' representation to itself.
enumMap :: forall a. (Show a, Bounded a, Enum a) => Map String a
enumMap = M.fromList [(show e, e) | e <- [minBound .. maxBound]]

instance (Enum a, Show a, Bounded a) => TypeParser (EnumParser a) where
  parseMissing :: Either String (EnumParser a)
  parseMissing = Left $ "missing required environment variable"
                     ++ "; expected one of: " ++ intercalate ", " (M.keys (enumMap @a))

  parseType :: String -> Either String (EnumParser a)
  parseType s = case M.lookup s (enumMap @a) of
    Just v  -> Right (EnumParser v)
    -- Wrapped in plain quotes rather than 'show' — 'show' escapes internal
    -- quotes/backslashes (e.g. @"has\"quote"@), which reads confusingly to a
    -- human even though the raw env var value contains no backslash at all.
    Nothing -> Left $ "invalid value \"" ++ s ++ "\""
                   ++ "; expected one of: " ++ intercalate ", " (M.keys (enumMap @a))