{-# LANGUAGE UndecidableInstances #-}

-- | Typical instances for enumerated data types with textual representation
module Freckle.App.TextualEnum
  ( TextualEnum (..)
  , EnumValue (..)
  , EnumName (..)
  , enums
  , fromText
  , prop_roundTripEnumText
  ) where

import Freckle.App.Prelude

import Autodocodec
import Control.Lens hiding (elements)
import Control.Monad (mzero)
import Data.Aeson
import Data.Csv qualified as CSV
import Data.Dynamic (Typeable)
import Data.List.NonEmpty qualified as NE
import Data.OpenApi
import Data.Text.Encoding qualified as T
import Database.Persist.Sql
  ( PersistField (..)
  , PersistFieldSql (..)
  , SqlType (..)
  )
import Servant
import Test.QuickCheck (Arbitrary (..), elements)
import Web.PathPieces

class EnumValue a where
  -- | Convert a 'TextualEnum' to 'Text'
  toText :: a -> Text

class EnumName a where
  -- | Name of a 'TextualEnum', used for naming schemas
  enumName :: Proxy a -> Text

-- | Wrapper around enums
--
-- N.B. This should not be used for "enormous" enumerations. It's primary purpose
-- is to provide standard instances for discriminated-union-defined enums.
newtype TextualEnum a = TextualEnum {forall a. TextualEnum a -> a
enumValue :: a}
  deriving newtype (TextualEnum a -> TextualEnum a -> Bool
(TextualEnum a -> TextualEnum a -> Bool)
-> (TextualEnum a -> TextualEnum a -> Bool) -> Eq (TextualEnum a)
forall a. Eq a => TextualEnum a -> TextualEnum a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => TextualEnum a -> TextualEnum a -> Bool
== :: TextualEnum a -> TextualEnum a -> Bool
$c/= :: forall a. Eq a => TextualEnum a -> TextualEnum a -> Bool
/= :: TextualEnum a -> TextualEnum a -> Bool
Eq, Int -> TextualEnum a -> ShowS
[TextualEnum a] -> ShowS
TextualEnum a -> String
(Int -> TextualEnum a -> ShowS)
-> (TextualEnum a -> String)
-> ([TextualEnum a] -> ShowS)
-> Show (TextualEnum a)
forall a. Show a => Int -> TextualEnum a -> ShowS
forall a. Show a => [TextualEnum a] -> ShowS
forall a. Show a => TextualEnum a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> TextualEnum a -> ShowS
showsPrec :: Int -> TextualEnum a -> ShowS
$cshow :: forall a. Show a => TextualEnum a -> String
show :: TextualEnum a -> String
$cshowList :: forall a. Show a => [TextualEnum a] -> ShowS
showList :: [TextualEnum a] -> ShowS
Show, Eq (TextualEnum a)
Eq (TextualEnum a) =>
(TextualEnum a -> TextualEnum a -> Ordering)
-> (TextualEnum a -> TextualEnum a -> Bool)
-> (TextualEnum a -> TextualEnum a -> Bool)
-> (TextualEnum a -> TextualEnum a -> Bool)
-> (TextualEnum a -> TextualEnum a -> Bool)
-> (TextualEnum a -> TextualEnum a -> TextualEnum a)
-> (TextualEnum a -> TextualEnum a -> TextualEnum a)
-> Ord (TextualEnum a)
TextualEnum a -> TextualEnum a -> Bool
TextualEnum a -> TextualEnum a -> Ordering
TextualEnum a -> TextualEnum a -> TextualEnum a
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (TextualEnum a)
forall a. Ord a => TextualEnum a -> TextualEnum a -> Bool
forall a. Ord a => TextualEnum a -> TextualEnum a -> Ordering
forall a. Ord a => TextualEnum a -> TextualEnum a -> TextualEnum a
$ccompare :: forall a. Ord a => TextualEnum a -> TextualEnum a -> Ordering
compare :: TextualEnum a -> TextualEnum a -> Ordering
$c< :: forall a. Ord a => TextualEnum a -> TextualEnum a -> Bool
< :: TextualEnum a -> TextualEnum a -> Bool
$c<= :: forall a. Ord a => TextualEnum a -> TextualEnum a -> Bool
<= :: TextualEnum a -> TextualEnum a -> Bool
$c> :: forall a. Ord a => TextualEnum a -> TextualEnum a -> Bool
> :: TextualEnum a -> TextualEnum a -> Bool
$c>= :: forall a. Ord a => TextualEnum a -> TextualEnum a -> Bool
>= :: TextualEnum a -> TextualEnum a -> Bool
$cmax :: forall a. Ord a => TextualEnum a -> TextualEnum a -> TextualEnum a
max :: TextualEnum a -> TextualEnum a -> TextualEnum a
$cmin :: forall a. Ord a => TextualEnum a -> TextualEnum a -> TextualEnum a
min :: TextualEnum a -> TextualEnum a -> TextualEnum a
Ord, (forall x. TextualEnum a -> Rep (TextualEnum a) x)
-> (forall x. Rep (TextualEnum a) x -> TextualEnum a)
-> Generic (TextualEnum a)
forall a x. Generic a => Rep (TextualEnum a) x -> TextualEnum a
forall a x. Generic a => TextualEnum a -> Rep (TextualEnum a) x
forall x. Rep (TextualEnum a) x -> TextualEnum a
forall x. TextualEnum a -> Rep (TextualEnum a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall a x. Generic a => TextualEnum a -> Rep (TextualEnum a) x
from :: forall x. TextualEnum a -> Rep (TextualEnum a) x
$cto :: forall a x. Generic a => Rep (TextualEnum a) x -> TextualEnum a
to :: forall x. Rep (TextualEnum a) x -> TextualEnum a
Generic)

-- | All values of a 'TextualEnum'
enums :: (Bounded a, Enum a) => NonEmpty (TextualEnum a)
enums :: forall a. (Bounded a, Enum a) => NonEmpty (TextualEnum a)
enums = (a -> TextualEnum a) -> NonEmpty a -> NonEmpty (TextualEnum a)
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> TextualEnum a
forall a. a -> TextualEnum a
TextualEnum (NonEmpty a -> NonEmpty (TextualEnum a))
-> NonEmpty a -> NonEmpty (TextualEnum a)
forall a b. (a -> b) -> a -> b
$ a
forall a. Bounded a => a
minBound a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
NE.:| Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop Int
1 [a
forall a. Bounded a => a
minBound .. a
forall a. Bounded a => a
maxBound]

-- | Parse a 'TextualEnum' from 'Text'
fromText :: (EnumValue a, Bounded a, Enum a) => Text -> Maybe (TextualEnum a)
fromText :: forall a.
(EnumValue a, Bounded a, Enum a) =>
Text -> Maybe (TextualEnum a)
fromText Text
txt = (TextualEnum a -> Bool)
-> NonEmpty (TextualEnum a) -> Maybe (TextualEnum a)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
txt) (Text -> Bool) -> (TextualEnum a -> Text) -> TextualEnum a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Text
forall a. EnumValue a => a -> Text
toText (a -> Text) -> (TextualEnum a -> a) -> TextualEnum a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextualEnum a -> a
forall a. TextualEnum a -> a
enumValue) NonEmpty (TextualEnum a)
forall a. (Bounded a, Enum a) => NonEmpty (TextualEnum a)
enums

instance EnumValue a => ToJSON (TextualEnum a) where
  toJSON :: TextualEnum a -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value)
-> (TextualEnum a -> Text) -> TextualEnum a -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Text
forall a. EnumValue a => a -> Text
toText (a -> Text) -> (TextualEnum a -> a) -> TextualEnum a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextualEnum a -> a
forall a. TextualEnum a -> a
enumValue
  toEncoding :: TextualEnum a -> Encoding
toEncoding = Text -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding (Text -> Encoding)
-> (TextualEnum a -> Text) -> TextualEnum a -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Text
forall a. EnumValue a => a -> Text
toText (a -> Text) -> (TextualEnum a -> a) -> TextualEnum a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextualEnum a -> a
forall a. TextualEnum a -> a
enumValue

instance (EnumValue a, Bounded a, Enum a) => FromJSON (TextualEnum a) where
  parseJSON :: Value -> Parser (TextualEnum a)
parseJSON = String
-> (Text -> Parser (TextualEnum a))
-> Value
-> Parser (TextualEnum a)
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"TextualEnum" ((Text -> Parser (TextualEnum a))
 -> Value -> Parser (TextualEnum a))
-> (Text -> Parser (TextualEnum a))
-> Value
-> Parser (TextualEnum a)
forall a b. (a -> b) -> a -> b
$ Parser (TextualEnum a)
-> (TextualEnum a -> Parser (TextualEnum a))
-> Maybe (TextualEnum a)
-> Parser (TextualEnum a)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Parser (TextualEnum a)
forall a. Parser a
forall (m :: * -> *) a. MonadPlus m => m a
mzero TextualEnum a -> Parser (TextualEnum a)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (TextualEnum a) -> Parser (TextualEnum a))
-> (Text -> Maybe (TextualEnum a))
-> Text
-> Parser (TextualEnum a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe (TextualEnum a)
forall a.
(EnumValue a, Bounded a, Enum a) =>
Text -> Maybe (TextualEnum a)
fromText

instance (Bounded a, Enum a) => Arbitrary (TextualEnum a) where
  arbitrary :: Gen (TextualEnum a)
arbitrary = [TextualEnum a] -> Gen (TextualEnum a)
forall a. [a] -> Gen a
elements ([TextualEnum a] -> Gen (TextualEnum a))
-> [TextualEnum a] -> Gen (TextualEnum a)
forall a b. (a -> b) -> a -> b
$ NonEmpty (TextualEnum a) -> [TextualEnum a]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty (TextualEnum a)
forall a. (Bounded a, Enum a) => NonEmpty (TextualEnum a)
enums

instance (EnumValue a, Bounded a, Enum a) => PathPiece (TextualEnum a) where
  toPathPiece :: TextualEnum a -> Text
toPathPiece = Text -> Text
forall s. PathPiece s => s -> Text
toPathPiece (Text -> Text) -> (TextualEnum a -> Text) -> TextualEnum a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Text
forall a. EnumValue a => a -> Text
toText (a -> Text) -> (TextualEnum a -> a) -> TextualEnum a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextualEnum a -> a
forall a. TextualEnum a -> a
enumValue
  fromPathPiece :: Text -> Maybe (TextualEnum a)
fromPathPiece = Text -> Maybe (TextualEnum a)
forall a.
(EnumValue a, Bounded a, Enum a) =>
Text -> Maybe (TextualEnum a)
fromText

instance EnumValue a => CSV.ToField (TextualEnum a) where
  toField :: TextualEnum a -> Field
toField = Text -> Field
forall a. ToField a => a -> Field
CSV.toField (Text -> Field)
-> (TextualEnum a -> Text) -> TextualEnum a -> Field
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Text
forall a. EnumValue a => a -> Text
toText (a -> Text) -> (TextualEnum a -> a) -> TextualEnum a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextualEnum a -> a
forall a. TextualEnum a -> a
enumValue

instance (EnumValue a, Bounded a, Enum a) => CSV.FromField (TextualEnum a) where
  parseField :: Field -> Parser (TextualEnum a)
parseField = Parser (TextualEnum a)
-> (TextualEnum a -> Parser (TextualEnum a))
-> Maybe (TextualEnum a)
-> Parser (TextualEnum a)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Parser (TextualEnum a)
forall a. Parser a
forall (m :: * -> *) a. MonadPlus m => m a
mzero TextualEnum a -> Parser (TextualEnum a)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (TextualEnum a) -> Parser (TextualEnum a))
-> (Field -> Maybe (TextualEnum a))
-> Field
-> Parser (TextualEnum a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe (TextualEnum a)
forall a.
(EnumValue a, Bounded a, Enum a) =>
Text -> Maybe (TextualEnum a)
fromText (Text -> Maybe (TextualEnum a))
-> (Field -> Text) -> Field -> Maybe (TextualEnum a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Field -> Text
T.decodeUtf8

instance
  (Bounded a, Enum a, EnumValue a, Typeable a, EnumName a)
  => ToSchema (TextualEnum a)
  where
  declareNamedSchema :: Proxy (TextualEnum a) -> Declare (Definitions Schema) NamedSchema
declareNamedSchema = NamedSchema -> Declare (Definitions Schema) NamedSchema
forall a. a -> DeclareT (Definitions Schema) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NamedSchema -> Declare (Definitions Schema) NamedSchema)
-> (Proxy (TextualEnum a) -> NamedSchema)
-> Proxy (TextualEnum a)
-> Declare (Definitions Schema) NamedSchema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Text -> Schema -> NamedSchema
NamedSchema (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Proxy a -> Text
forall {k} (a :: k). EnumName a => Proxy a -> Text
enumName (Proxy a -> Text) -> Proxy a -> Text
forall a b. (a -> b) -> a -> b
$ forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a) (Schema -> NamedSchema)
-> (Proxy (TextualEnum a) -> Schema)
-> Proxy (TextualEnum a)
-> NamedSchema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy (TextualEnum a) -> Schema
enumOptions
   where
    enumOptions :: Proxy (TextualEnum a) -> Schema
enumOptions Proxy (TextualEnum a)
_ =
      Schema
forall a. Monoid a => a
mempty
        Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe OpenApiType -> Identity (Maybe OpenApiType))
-> Schema -> Identity Schema
forall s a. HasType s a => Lens' s a
Lens' Schema (Maybe OpenApiType)
type_ ((Maybe OpenApiType -> Identity (Maybe OpenApiType))
 -> Schema -> Identity Schema)
-> OpenApiType -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ OpenApiType
OpenApiString
        Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe [Value] -> Identity (Maybe [Value]))
-> Schema -> Identity Schema
forall s a. HasEnum s a => Lens' s a
Lens' Schema (Maybe [Value])
enum_ ((Maybe [Value] -> Identity (Maybe [Value]))
 -> Schema -> Identity Schema)
-> [Value] -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ (Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value)
-> (TextualEnum a -> Text) -> TextualEnum a -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Text
forall a. EnumValue a => a -> Text
toText (a -> Text) -> (TextualEnum a -> a) -> TextualEnum a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextualEnum a -> a
forall a. TextualEnum a -> a
enumValue (TextualEnum a -> Value) -> [TextualEnum a] -> [Value]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (TextualEnum a) -> [TextualEnum a]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (forall a. (Bounded a, Enum a) => NonEmpty (TextualEnum a)
enums @a))
        Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe Value -> Identity (Maybe Value))
-> Schema -> Identity Schema
forall s a. HasExample s a => Lens' s a
Lens' Schema (Maybe Value)
example ((Maybe Value -> Identity (Maybe Value))
 -> Schema -> Identity Schema)
-> Value -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ (Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value)
-> (TextualEnum a -> Text) -> TextualEnum a -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Text
forall a. EnumValue a => a -> Text
toText (a -> Text) -> (TextualEnum a -> a) -> TextualEnum a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextualEnum a -> a
forall a. TextualEnum a -> a
enumValue (TextualEnum a -> Value) -> TextualEnum a -> Value
forall a b. (a -> b) -> a -> b
$ NonEmpty (TextualEnum a) -> TextualEnum a
forall a. NonEmpty a -> a
NE.head (forall a. (Bounded a, Enum a) => NonEmpty (TextualEnum a)
enums @a))

instance (Bounded a, Enum a, EnumValue a) => ToParamSchema (TextualEnum a) where
  toParamSchema :: Proxy (TextualEnum a) -> Schema
toParamSchema Proxy (TextualEnum a)
_ =
    Schema
forall a. Monoid a => a
mempty
      Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe OpenApiType -> Identity (Maybe OpenApiType))
-> Schema -> Identity Schema
forall s a. HasType s a => Lens' s a
Lens' Schema (Maybe OpenApiType)
type_ ((Maybe OpenApiType -> Identity (Maybe OpenApiType))
 -> Schema -> Identity Schema)
-> OpenApiType -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ OpenApiType
OpenApiString
      Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe [Value] -> Identity (Maybe [Value]))
-> Schema -> Identity Schema
forall s a. HasEnum s a => Lens' s a
Lens' Schema (Maybe [Value])
enum_ ((Maybe [Value] -> Identity (Maybe [Value]))
 -> Schema -> Identity Schema)
-> [Value] -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ (Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value)
-> (TextualEnum a -> Text) -> TextualEnum a -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Text
forall a. EnumValue a => a -> Text
toText (a -> Text) -> (TextualEnum a -> a) -> TextualEnum a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextualEnum a -> a
forall a. TextualEnum a -> a
enumValue (TextualEnum a -> Value) -> [TextualEnum a] -> [Value]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (TextualEnum a) -> [TextualEnum a]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (forall a. (Bounded a, Enum a) => NonEmpty (TextualEnum a)
enums @a))
      Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe Value -> Identity (Maybe Value))
-> Schema -> Identity Schema
forall s a. HasExample s a => Lens' s a
Lens' Schema (Maybe Value)
example ((Maybe Value -> Identity (Maybe Value))
 -> Schema -> Identity Schema)
-> Value -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ (Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value)
-> (TextualEnum a -> Text) -> TextualEnum a -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Text
forall a. EnumValue a => a -> Text
toText (a -> Text) -> (TextualEnum a -> a) -> TextualEnum a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextualEnum a -> a
forall a. TextualEnum a -> a
enumValue (TextualEnum a -> Value) -> TextualEnum a -> Value
forall a b. (a -> b) -> a -> b
$ NonEmpty (TextualEnum a) -> TextualEnum a
forall a. NonEmpty a -> a
NE.head (forall a. (Bounded a, Enum a) => NonEmpty (TextualEnum a)
enums @a))

instance (Bounded a, Enum a, EnumValue a, Eq a) => HasCodec (TextualEnum a) where
  codec :: JSONCodec (TextualEnum a)
codec = NonEmpty (TextualEnum a, Text) -> JSONCodec (TextualEnum a)
forall constant.
Eq constant =>
NonEmpty (constant, Text) -> JSONCodec constant
stringConstCodec (NonEmpty (TextualEnum a, Text) -> JSONCodec (TextualEnum a))
-> NonEmpty (TextualEnum a, Text) -> JSONCodec (TextualEnum a)
forall a b. (a -> b) -> a -> b
$ (TextualEnum a -> TextualEnum a
forall a. a -> a
id (TextualEnum a -> TextualEnum a)
-> (TextualEnum a -> Text)
-> TextualEnum a
-> (TextualEnum a, Text)
forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (a -> Text
forall a. EnumValue a => a -> Text
toText (a -> Text) -> (TextualEnum a -> a) -> TextualEnum a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextualEnum a -> a
forall a. TextualEnum a -> a
enumValue)) (TextualEnum a -> (TextualEnum a, Text))
-> NonEmpty (TextualEnum a) -> NonEmpty (TextualEnum a, Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. (Bounded a, Enum a) => NonEmpty (TextualEnum a)
enums @a

instance (Bounded a, Enum a, EnumValue a) => PersistField (TextualEnum a) where
  toPersistValue :: TextualEnum a -> PersistValue
toPersistValue = Text -> PersistValue
forall a. PersistField a => a -> PersistValue
toPersistValue (Text -> PersistValue)
-> (TextualEnum a -> Text) -> TextualEnum a -> PersistValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Text
forall a. EnumValue a => a -> Text
toText (a -> Text) -> (TextualEnum a -> a) -> TextualEnum a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextualEnum a -> a
forall a. TextualEnum a -> a
enumValue
  fromPersistValue :: PersistValue -> Either Text (TextualEnum a)
fromPersistValue =
    Either Text (TextualEnum a)
-> (TextualEnum a -> Either Text (TextualEnum a))
-> Maybe (TextualEnum a)
-> Either Text (TextualEnum a)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text -> Either Text (TextualEnum a)
forall a b. a -> Either a b
Left Text
"Not member of enumeration") TextualEnum a -> Either Text (TextualEnum a)
forall a b. b -> Either a b
Right (Maybe (TextualEnum a) -> Either Text (TextualEnum a))
-> (Text -> Maybe (TextualEnum a))
-> Text
-> Either Text (TextualEnum a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe (TextualEnum a)
forall a.
(EnumValue a, Bounded a, Enum a) =>
Text -> Maybe (TextualEnum a)
fromText (Text -> Either Text (TextualEnum a))
-> (PersistValue -> Either Text Text)
-> PersistValue
-> Either Text (TextualEnum a)
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< PersistValue -> Either Text Text
forall a. PersistField a => PersistValue -> Either Text a
fromPersistValue

instance (Bounded a, Enum a, EnumValue a) => PersistFieldSql (TextualEnum a) where
  sqlType :: Proxy (TextualEnum a) -> SqlType
sqlType Proxy (TextualEnum a)
_ = SqlType
SqlString

instance (Bounded a, Enum a, EnumValue a) => FromHttpApiData (TextualEnum a) where
  parseUrlPiece :: Text -> Either Text (TextualEnum a)
parseUrlPiece =
    Either Text (TextualEnum a)
-> (TextualEnum a -> Either Text (TextualEnum a))
-> Maybe (TextualEnum a)
-> Either Text (TextualEnum a)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text -> Either Text (TextualEnum a)
forall a b. a -> Either a b
Left Text
"Not member of enumeration") TextualEnum a -> Either Text (TextualEnum a)
forall a b. b -> Either a b
Right (Maybe (TextualEnum a) -> Either Text (TextualEnum a))
-> (Text -> Maybe (TextualEnum a))
-> Text
-> Either Text (TextualEnum a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe (TextualEnum a)
forall a.
(EnumValue a, Bounded a, Enum a) =>
Text -> Maybe (TextualEnum a)
fromText

instance EnumValue a => ToHttpApiData (TextualEnum a) where
  toUrlPiece :: TextualEnum a -> Text
toUrlPiece = a -> Text
forall a. EnumValue a => a -> Text
toText (a -> Text) -> (TextualEnum a -> a) -> TextualEnum a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextualEnum a -> a
forall a. TextualEnum a -> a
enumValue

-- | Test that enum instances are coherent
prop_roundTripEnumText
  :: (Bounded a, Enum a, EnumValue a, Eq a) => TextualEnum a -> Bool
prop_roundTripEnumText :: forall a.
(Bounded a, Enum a, EnumValue a, Eq a) =>
TextualEnum a -> Bool
prop_roundTripEnumText TextualEnum a
a = Text -> Maybe (TextualEnum a)
forall a.
(EnumValue a, Bounded a, Enum a) =>
Text -> Maybe (TextualEnum a)
fromText (a -> Text
forall a. EnumValue a => a -> Text
toText (a -> Text) -> a -> Text
forall a b. (a -> b) -> a -> b
$ TextualEnum a -> a
forall a. TextualEnum a -> a
enumValue TextualEnum a
a) Maybe (TextualEnum a) -> Maybe (TextualEnum a) -> Bool
forall a. Eq a => a -> a -> Bool
== TextualEnum a -> Maybe (TextualEnum a)
forall a. a -> Maybe a
Just TextualEnum a
a