{-# OPTIONS_GHC -fno-warn-orphans #-}

module Text.Email.OrphanInstances () where

import Control.Lens
import Data.Aeson qualified as A
import Data.OpenApi
import Data.Proxy
import Data.Text qualified as T
import Text.Email.Parser
import Text.Email.Text

instance A.FromJSON EmailAddress where
  parseJSON :: Value -> Parser EmailAddress
parseJSON Value
json = do
    Text
text <- forall a. FromJSON a => Value -> Parser a
A.parseJSON @T.Text Value
json
    case Text -> Either String EmailAddress
fromText Text
text of
      Left String
err -> String -> Parser EmailAddress
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err
      Right EmailAddress
emailAddress -> EmailAddress -> Parser EmailAddress
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure EmailAddress
emailAddress

instance A.ToJSON EmailAddress where
  toJSON :: EmailAddress -> Value
toJSON = Text -> Value
A.String (Text -> Value) -> (EmailAddress -> Text) -> EmailAddress -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EmailAddress -> Text
toText

instance ToSchema EmailAddress where
  declareNamedSchema :: Proxy EmailAddress -> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy EmailAddress
Proxy =
    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)
-> NamedSchema -> Declare (Definitions Schema) NamedSchema
forall a b. (a -> b) -> a -> b
$
      Maybe Text -> Schema -> NamedSchema
NamedSchema (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"EmailAddress") (Schema -> NamedSchema) -> Schema -> NamedSchema
forall a b. (a -> b) -> a -> b
$
        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 Text -> Identity (Maybe Text)) -> Schema -> Identity Schema
forall s a. HasFormat s a => Lens' s a
Lens' Schema (Maybe Text)
format ((Maybe Text -> Identity (Maybe Text))
 -> Schema -> Identity Schema)
-> Text -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
"email"