{-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-| Module : Headroom.Data.EnumExtra Description : Extra functionality for enum types Copyright : (c) 2019-2020 Vaclav Svejcar License : BSD-3-Clause Maintainer : vaclav.svejcar@gmail.com Stability : experimental Portability : POSIX Provides extended 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 = [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 = T.intercalate ", " (fmap enumToText (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 = 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 = let enumValue v = (T.toLower . enumToText $ v) == T.toLower text in L.find enumValue allValues