{-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-| Module : Headroom.Data.EnumExtra Description : Extra functionality for enum types Copyright : (c) 2019-2021 Vaclav Svejcar License : BSD-3-Clause Maintainer : vaclav.svejcar@gmail.com Stability : experimental Portability : POSIX Provides extra functionality for enum-like types, e.g. reading/writing from/to textual representation, etc. -} module Headroom.Data.EnumExtra where import RIO import qualified RIO.List as L import qualified RIO.Text as T -- | Enum data type, capable to (de)serialize itself from/to string -- representation. Can be automatically derived by /GHC/ using the -- @DeriveAnyClass@ extension. class (Bounded a, Enum a, Eq a, Ord a, Show a) => EnumExtra a where -- | Returns list of all enum values. -- -- >>> :set -XDeriveAnyClass -XTypeApplications -- >>> data Test = Foo | Bar deriving (Bounded, Enum, EnumExtra, Eq, Ord, Show) -- >>> allValues @Test -- [Foo,Bar] allValues :: [a] allValues = [a forall a. Bounded a => a minBound ..] -- | Returns all values of enum as single string, individual values separated -- with comma. -- -- >>> :set -XDeriveAnyClass -XTypeApplications -- >>> data Test = Foo | Bar deriving (Bounded, Enum, EnumExtra, Eq, Ord, Show) -- >>> allValuesToText @Test -- "Foo, Bar" allValuesToText :: Text allValuesToText = Text -> [Text] -> Text T.intercalate Text ", " ((a -> Text) -> [a] -> [Text] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap a -> Text forall a. EnumExtra a => a -> Text enumToText ([a] forall a. EnumExtra a => [a] allValues :: [a])) -- | Returns textual representation of enum value. Opposite to 'textToEnum'. -- -- >>> :set -XDeriveAnyClass -- >>> data Test = Foo | Bar deriving (Bounded, Enum, EnumExtra, Eq, Ord, Show) -- >>> enumToText Bar -- "Bar" enumToText :: a -> Text enumToText = a -> Text forall a. Show a => a -> Text tshow -- | Returns enum value from its textual representation. -- Opposite to 'enumToText'. -- -- >>> :set -XDeriveAnyClass -- >>> data Test = Foo | Bar deriving (Bounded, Enum, EnumExtra, Eq, Ord, Show) -- >>> (textToEnum "Foo") :: (Maybe Test) -- Just Foo textToEnum :: Text -> Maybe a textToEnum Text text = let enumValue :: a -> Bool enumValue a v = (Text -> Text T.toLower (Text -> Text) -> (a -> Text) -> a -> Text forall b c a. (b -> c) -> (a -> b) -> a -> c . a -> Text forall a. EnumExtra a => a -> Text enumToText (a -> Text) -> a -> Text forall a b. (a -> b) -> a -> b $ a v) Text -> Text -> Bool forall a. Eq a => a -> a -> Bool == Text -> Text T.toLower Text text in (a -> Bool) -> [a] -> Maybe a forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a L.find a -> Bool forall a. EnumExtra a => a -> Bool enumValue [a] forall a. EnumExtra a => [a] allValues