-- |
--
-- Copyright:
--   This file is part of the package addy. It is subject to the license
--   terms in the LICENSE file found in the top-level directory of this
--   distribution and at:
--
--     https://code.devalot.com/open/addy
--
--   No part of this package, including this file, may be copied,
--   modified, propagated, or distributed except according to the terms
--   contained in the LICENSE file.
--
-- License: BSD-2-Clause
--
-- The module exports internal types along with their constructors.
--
-- The rendering code relies on the newtype wrappers around 'Text' to
-- keep out invalid characters.  Prefer to use the official interface
-- if possible.
module Addy.Internal.Types
  ( Error (..),
    EmailAddr (..),
    displayName,
    localPart,
    domain,
    comments,
    DisplayName (..),
    LocalPart (..),
    Domain (..),
    _Domain,
    _DomainLiteral,
    DomainName (..),
    HostName (..),
    _HostNames,
    AddressLiteral (..),
    _IpAddressLiteral,
    _TaggedAddressLiteral,
    _AddressLiteral,
    AddressTag (..),
    Literal (..),
    Comment (..),
    _Comment,
    commentLoc,
    commentContent,
    CommentLoc (..),
    CommentContent (..),
  )
where

import Control.Lens (Iso', Lens', Prism', iso, lens, prism')
import qualified Data.Text as Text
import GHC.TypeLits (KnownSymbol, Symbol, symbolVal)
import Net.IP (IP)
import Text.Show (Show (..), showParen, showString)

-- | Potential validation errors.
--
-- @since 0.1.0.0
data Error
  = -- | A component of an email address may not start with the
    -- recorded prefix text.
    InvalidPrefixError Text
  | -- | A component of an email address may not end with the recorded
    -- suffix text.
    InvalidSuffixError Text
  | -- | A component of an email address contains invalid characters.
    InvalidCharactersError Text
  | -- | A component of an email address does not meet the set length
    -- requirements.  The values in this constructor are @min@, @max@,
    -- and @actual@.
    InvalidLengthError Int Int Int
  | -- | The input to the address decoder was not a valid email
    -- address and produced the recorded error message.
    ParserFailedError Text
  deriving (Int -> Error -> ShowS
[Error] -> ShowS
Error -> String
(Int -> Error -> ShowS)
-> (Error -> String) -> ([Error] -> ShowS) -> Show Error
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Error] -> ShowS
$cshowList :: [Error] -> ShowS
show :: Error -> String
$cshow :: Error -> String
showsPrec :: Int -> Error -> ShowS
$cshowsPrec :: Int -> Error -> ShowS
Show, Error -> Error -> Bool
(Error -> Error -> Bool) -> (Error -> Error -> Bool) -> Eq Error
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Error -> Error -> Bool
$c/= :: Error -> Error -> Bool
== :: Error -> Error -> Bool
$c== :: Error -> Error -> Bool
Eq)

-- | The representation of a complete email address.
--
-- The parser preserves optional components such as the display name
-- and comments.  The rendering code can optionally include these
-- optional elements when turning the address back into 'Text'.
--
-- @since 0.1.0.0
data EmailAddr = EmailAddr
  { EmailAddr -> Maybe DisplayName
_displayName :: Maybe DisplayName,
    EmailAddr -> LocalPart
_localPart :: LocalPart,
    EmailAddr -> Domain
_domain :: Domain,
    EmailAddr -> [Comment]
_comments :: [Comment]
  }

-- | Optional display name.  Addresses in the @name-addr@ format
-- from RFC 5322 allow descriptive text to precede the address.
-- This is commonly used in email messages to list the name of the
-- address' owner.
--
-- @since 0.1.0.0
displayName :: Lens' EmailAddr (Maybe DisplayName)
displayName :: (Maybe DisplayName -> f (Maybe DisplayName))
-> EmailAddr -> f EmailAddr
displayName = (EmailAddr -> Maybe DisplayName)
-> (EmailAddr -> Maybe DisplayName -> EmailAddr)
-> Lens EmailAddr EmailAddr (Maybe DisplayName) (Maybe DisplayName)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens EmailAddr -> Maybe DisplayName
_displayName (\EmailAddr
e Maybe DisplayName
d -> EmailAddr
e {_displayName :: Maybe DisplayName
_displayName = Maybe DisplayName
d})

-- | The 'LocalPart' of an email address usually references the
-- destination mailbox on the 'Domain' server.  However, the
-- content of the 'LocalPart' can only be understood by the
-- receiving 'Domain'.
--
-- @since 0.1.0.0
localPart :: Lens' EmailAddr LocalPart
localPart :: (LocalPart -> f LocalPart) -> EmailAddr -> f EmailAddr
localPart = (EmailAddr -> LocalPart)
-> (EmailAddr -> LocalPart -> EmailAddr)
-> Lens EmailAddr EmailAddr LocalPart LocalPart
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens EmailAddr -> LocalPart
_localPart (\EmailAddr
e LocalPart
l -> EmailAddr
e {_localPart :: LocalPart
_localPart = LocalPart
l})

-- | The 'Domain' refers to the fully-qualified domain name that
-- accepts mail for the associated 'LocalPart'.  See the
-- documentation for the 'Domain' type for more details.
--
-- @since 0.1.0.0
domain :: Lens' EmailAddr Domain
domain :: (Domain -> f Domain) -> EmailAddr -> f EmailAddr
domain = (EmailAddr -> Domain)
-> (EmailAddr -> Domain -> EmailAddr)
-> Lens EmailAddr EmailAddr Domain Domain
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens EmailAddr -> Domain
_domain (\EmailAddr
e Domain
d -> EmailAddr
e {_domain :: Domain
_domain = Domain
d})

-- | Addresses in both the @name-addr@ and @addr-spec@ formats
-- support comments.
--
-- @since 0.1.0.0
comments :: Lens' EmailAddr [Comment]
comments :: ([Comment] -> f [Comment]) -> EmailAddr -> f EmailAddr
comments = (EmailAddr -> [Comment])
-> (EmailAddr -> [Comment] -> EmailAddr)
-> Lens EmailAddr EmailAddr [Comment] [Comment]
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens EmailAddr -> [Comment]
_comments (\EmailAddr
e [Comment]
cs -> EmailAddr
e {_comments :: [Comment]
_comments = [Comment]
cs})

-- | Optional display name.  Usually this is the name of the person
-- who receives email at the associated address.
--
-- > Display Name <example@example.com>
--
-- @since 0.1.0.0
newtype DisplayName = DP
  { DisplayName -> Text
displayNameText :: Text
  }
  deriving newtype (DisplayName -> DisplayName -> Bool
(DisplayName -> DisplayName -> Bool)
-> (DisplayName -> DisplayName -> Bool) -> Eq DisplayName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DisplayName -> DisplayName -> Bool
$c/= :: DisplayName -> DisplayName -> Bool
== :: DisplayName -> DisplayName -> Bool
$c== :: DisplayName -> DisplayName -> Bool
Eq, b -> DisplayName -> DisplayName
NonEmpty DisplayName -> DisplayName
DisplayName -> DisplayName -> DisplayName
(DisplayName -> DisplayName -> DisplayName)
-> (NonEmpty DisplayName -> DisplayName)
-> (forall b. Integral b => b -> DisplayName -> DisplayName)
-> Semigroup DisplayName
forall b. Integral b => b -> DisplayName -> DisplayName
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> DisplayName -> DisplayName
$cstimes :: forall b. Integral b => b -> DisplayName -> DisplayName
sconcat :: NonEmpty DisplayName -> DisplayName
$csconcat :: NonEmpty DisplayName -> DisplayName
<> :: DisplayName -> DisplayName -> DisplayName
$c<> :: DisplayName -> DisplayName -> DisplayName
Semigroup)
  deriving (Int -> DisplayName -> ShowS
[DisplayName] -> ShowS
DisplayName -> String
(Int -> DisplayName -> ShowS)
-> (DisplayName -> String)
-> ([DisplayName] -> ShowS)
-> Show DisplayName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DisplayName] -> ShowS
$cshowList :: [DisplayName] -> ShowS
show :: DisplayName -> String
$cshow :: DisplayName -> String
showsPrec :: Int -> DisplayName -> ShowS
$cshowsPrec :: Int -> DisplayName -> ShowS
Show) via RenamedShow "DisplayName" Text

-- | The name of the mailbox on the associated 'Domain'.
--
-- @since 0.1.0.0
newtype LocalPart = LP
  { LocalPart -> Text
localPartText :: Text
  }
  deriving newtype (LocalPart -> LocalPart -> Bool
(LocalPart -> LocalPart -> Bool)
-> (LocalPart -> LocalPart -> Bool) -> Eq LocalPart
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LocalPart -> LocalPart -> Bool
$c/= :: LocalPart -> LocalPart -> Bool
== :: LocalPart -> LocalPart -> Bool
$c== :: LocalPart -> LocalPart -> Bool
Eq, b -> LocalPart -> LocalPart
NonEmpty LocalPart -> LocalPart
LocalPart -> LocalPart -> LocalPart
(LocalPart -> LocalPart -> LocalPart)
-> (NonEmpty LocalPart -> LocalPart)
-> (forall b. Integral b => b -> LocalPart -> LocalPart)
-> Semigroup LocalPart
forall b. Integral b => b -> LocalPart -> LocalPart
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> LocalPart -> LocalPart
$cstimes :: forall b. Integral b => b -> LocalPart -> LocalPart
sconcat :: NonEmpty LocalPart -> LocalPart
$csconcat :: NonEmpty LocalPart -> LocalPart
<> :: LocalPart -> LocalPart -> LocalPart
$c<> :: LocalPart -> LocalPart -> LocalPart
Semigroup)
  deriving (Int -> LocalPart -> ShowS
[LocalPart] -> ShowS
LocalPart -> String
(Int -> LocalPart -> ShowS)
-> (LocalPart -> String)
-> ([LocalPart] -> ShowS)
-> Show LocalPart
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LocalPart] -> ShowS
$cshowList :: [LocalPart] -> ShowS
show :: LocalPart -> String
$cshow :: LocalPart -> String
showsPrec :: Int -> LocalPart -> ShowS
$cshowsPrec :: Int -> LocalPart -> ShowS
Show) via RenamedShow "LocalPart" Text

-- | A fully-qualified domain name /or/ an address literal.
--
-- Most email addresses use a domain name.  However, it's perfectly
-- legal to use an 'AddressLiteral' instead.
--
-- @since 0.1.0.0
data Domain
  = Domain DomainName
  | DomainLiteral AddressLiteral
  deriving (Int -> Domain -> ShowS
[Domain] -> ShowS
Domain -> String
(Int -> Domain -> ShowS)
-> (Domain -> String) -> ([Domain] -> ShowS) -> Show Domain
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Domain] -> ShowS
$cshowList :: [Domain] -> ShowS
show :: Domain -> String
$cshow :: Domain -> String
showsPrec :: Int -> Domain -> ShowS
$cshowsPrec :: Int -> Domain -> ShowS
Show, Domain -> Domain -> Bool
(Domain -> Domain -> Bool)
-> (Domain -> Domain -> Bool) -> Eq Domain
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Domain -> Domain -> Bool
$c/= :: Domain -> Domain -> Bool
== :: Domain -> Domain -> Bool
$c== :: Domain -> Domain -> Bool
Eq)

-- | Prism for working with domain names.
--
-- @since 0.1.0.0
_Domain :: Prism' Domain DomainName
_Domain :: p DomainName (f DomainName) -> p Domain (f Domain)
_Domain =
  (DomainName -> Domain)
-> (Domain -> Maybe DomainName)
-> Prism Domain Domain DomainName DomainName
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism'
    DomainName -> Domain
Domain
    ( \case
        Domain DomainName
dn -> DomainName -> Maybe DomainName
forall a. a -> Maybe a
Just DomainName
dn
        DomainLiteral {} -> Maybe DomainName
forall a. Maybe a
Nothing
    )

-- | Prism for working with domain literals.
--
-- @since 0.1.0.0
_DomainLiteral :: Prism' Domain AddressLiteral
_DomainLiteral :: p AddressLiteral (f AddressLiteral) -> p Domain (f Domain)
_DomainLiteral =
  (AddressLiteral -> Domain)
-> (Domain -> Maybe AddressLiteral)
-> Prism Domain Domain AddressLiteral AddressLiteral
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism'
    AddressLiteral -> Domain
DomainLiteral
    ( \case
        Domain {} -> Maybe AddressLiteral
forall a. Maybe a
Nothing
        DomainLiteral AddressLiteral
dl -> AddressLiteral -> Maybe AddressLiteral
forall a. a -> Maybe a
Just AddressLiteral
dl
    )

-- | A fully-qualified domain name which is made up of a list of
-- host names (labels) separated by dots.
--
-- @since 0.1.0.0
newtype DomainName = DN
  { DomainName -> Text
domainNameText :: Text
  }
  deriving newtype (DomainName -> DomainName -> Bool
(DomainName -> DomainName -> Bool)
-> (DomainName -> DomainName -> Bool) -> Eq DomainName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DomainName -> DomainName -> Bool
$c/= :: DomainName -> DomainName -> Bool
== :: DomainName -> DomainName -> Bool
$c== :: DomainName -> DomainName -> Bool
Eq, b -> DomainName -> DomainName
NonEmpty DomainName -> DomainName
DomainName -> DomainName -> DomainName
(DomainName -> DomainName -> DomainName)
-> (NonEmpty DomainName -> DomainName)
-> (forall b. Integral b => b -> DomainName -> DomainName)
-> Semigroup DomainName
forall b. Integral b => b -> DomainName -> DomainName
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> DomainName -> DomainName
$cstimes :: forall b. Integral b => b -> DomainName -> DomainName
sconcat :: NonEmpty DomainName -> DomainName
$csconcat :: NonEmpty DomainName -> DomainName
<> :: DomainName -> DomainName -> DomainName
$c<> :: DomainName -> DomainName -> DomainName
Semigroup)
  deriving (Int -> DomainName -> ShowS
[DomainName] -> ShowS
DomainName -> String
(Int -> DomainName -> ShowS)
-> (DomainName -> String)
-> ([DomainName] -> ShowS)
-> Show DomainName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DomainName] -> ShowS
$cshowList :: [DomainName] -> ShowS
show :: DomainName -> String
$cshow :: DomainName -> String
showsPrec :: Int -> DomainName -> ShowS
$cshowsPrec :: Int -> DomainName -> ShowS
Show) via RenamedShow "DomainName" Text

-- | The name of one host component of a domain name.
--
-- @since 0.1.0.0
newtype HostName = HN
  { HostName -> Text
hostNameText :: Text
  }
  deriving newtype (HostName -> HostName -> Bool
(HostName -> HostName -> Bool)
-> (HostName -> HostName -> Bool) -> Eq HostName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HostName -> HostName -> Bool
$c/= :: HostName -> HostName -> Bool
== :: HostName -> HostName -> Bool
$c== :: HostName -> HostName -> Bool
Eq, b -> HostName -> HostName
NonEmpty HostName -> HostName
HostName -> HostName -> HostName
(HostName -> HostName -> HostName)
-> (NonEmpty HostName -> HostName)
-> (forall b. Integral b => b -> HostName -> HostName)
-> Semigroup HostName
forall b. Integral b => b -> HostName -> HostName
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> HostName -> HostName
$cstimes :: forall b. Integral b => b -> HostName -> HostName
sconcat :: NonEmpty HostName -> HostName
$csconcat :: NonEmpty HostName -> HostName
<> :: HostName -> HostName -> HostName
$c<> :: HostName -> HostName -> HostName
Semigroup)
  deriving (Int -> HostName -> ShowS
[HostName] -> ShowS
HostName -> String
(Int -> HostName -> ShowS)
-> (HostName -> String) -> ([HostName] -> ShowS) -> Show HostName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HostName] -> ShowS
$cshowList :: [HostName] -> ShowS
show :: HostName -> String
$cshow :: HostName -> String
showsPrec :: Int -> HostName -> ShowS
$cshowsPrec :: Int -> HostName -> ShowS
Show) via RenamedShow "HostName" Text

-- | Iso for converting between domain names and a list of host names.
--
-- >>> "gmail.uk.co" ^. _DomainName._HostNames & map (review _HostName)
-- ["gmail","uk","co"]
--
-- @since 0.1.0.0
_HostNames :: Iso' DomainName [HostName]
_HostNames :: p [HostName] (f [HostName]) -> p DomainName (f DomainName)
_HostNames =
  (DomainName -> [HostName])
-> ([HostName] -> DomainName)
-> Iso DomainName DomainName [HostName] [HostName]
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso
    (DomainName -> Text
domainNameText (DomainName -> Text)
-> (Text -> [HostName]) -> DomainName -> [HostName]
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Text -> Text -> [Text]
Text.splitOn Text
"." (Text -> [Text]) -> ([Text] -> [HostName]) -> Text -> [HostName]
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (Text -> HostName) -> [Text] -> [HostName]
forall a b. (a -> b) -> [a] -> [b]
map Text -> HostName
HN)
    ((HostName -> Text) -> [HostName] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map HostName -> Text
hostNameText ([HostName] -> [Text])
-> ([Text] -> DomainName) -> [HostName] -> DomainName
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Text -> [Text] -> Text
Text.intercalate Text
"." ([Text] -> Text) -> (Text -> DomainName) -> [Text] -> DomainName
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Text -> DomainName
DN)

-- | Address literals can be used instead of a domain name to direct
-- mail to a specific IP address or other tagged address type.
--
-- Example email addresses with address literals:
--
-- > example@[127.0.0.1]
-- > example@[IPv6:1111:2222:3333:4444:5555:6666:7777]
-- > example@[Just-some-text]
--
-- @since 0.1.0.0
data AddressLiteral
  = -- | A literal IP address as defined in RFC 5321 §4.1.3.  The
    -- address can be in many formats so it is presented here in its
    -- parsed form.
    IpAddressLiteral IP
  | -- | RFC 5321 also defines a /general address literal/ where a
    -- /standardized tag/ precedes the address itself.  The only
    -- information provided about the standardized tag is:
    --
    -- > Standardized-tag MUST be specified in a
    -- > Standards-Track RFC and registered with IANA
    TaggedAddressLiteral AddressTag Literal
  | -- | RFC 5322 defines a @domain-literal@ as (roughly) a span of
    -- characters that are allowed in a domain name.  The
    -- interpretation of those characters is left to \"separate
    -- documents\" such as RFC 5321.
    --
    -- If an address literal cannot be parsed in one of the proceeding
    -- formats it is encoded as a 'Literal' value.
    AddressLiteral Literal
  deriving (Int -> AddressLiteral -> ShowS
[AddressLiteral] -> ShowS
AddressLiteral -> String
(Int -> AddressLiteral -> ShowS)
-> (AddressLiteral -> String)
-> ([AddressLiteral] -> ShowS)
-> Show AddressLiteral
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AddressLiteral] -> ShowS
$cshowList :: [AddressLiteral] -> ShowS
show :: AddressLiteral -> String
$cshow :: AddressLiteral -> String
showsPrec :: Int -> AddressLiteral -> ShowS
$cshowsPrec :: Int -> AddressLiteral -> ShowS
Show, AddressLiteral -> AddressLiteral -> Bool
(AddressLiteral -> AddressLiteral -> Bool)
-> (AddressLiteral -> AddressLiteral -> Bool) -> Eq AddressLiteral
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AddressLiteral -> AddressLiteral -> Bool
$c/= :: AddressLiteral -> AddressLiteral -> Bool
== :: AddressLiteral -> AddressLiteral -> Bool
$c== :: AddressLiteral -> AddressLiteral -> Bool
Eq)

-- | Prism for working with IP address literals.
--
-- @since 0.1.0.0
_IpAddressLiteral :: Prism' AddressLiteral IP
_IpAddressLiteral :: p IP (f IP) -> p AddressLiteral (f AddressLiteral)
_IpAddressLiteral =
  (IP -> AddressLiteral)
-> (AddressLiteral -> Maybe IP)
-> Prism AddressLiteral AddressLiteral IP IP
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism'
    IP -> AddressLiteral
IpAddressLiteral
    ( \case
        IpAddressLiteral IP
ip -> IP -> Maybe IP
forall a. a -> Maybe a
Just IP
ip
        TaggedAddressLiteral {} -> Maybe IP
forall a. Maybe a
Nothing
        AddressLiteral {} -> Maybe IP
forall a. Maybe a
Nothing
    )

-- | Prism for working with tagged address literals.
--
-- @since 0.1.0.0
_TaggedAddressLiteral :: Prism' AddressLiteral (AddressTag, Literal)
_TaggedAddressLiteral :: p (AddressTag, Literal) (f (AddressTag, Literal))
-> p AddressLiteral (f AddressLiteral)
_TaggedAddressLiteral =
  ((AddressTag, Literal) -> AddressLiteral)
-> (AddressLiteral -> Maybe (AddressTag, Literal))
-> Prism
     AddressLiteral
     AddressLiteral
     (AddressTag, Literal)
     (AddressTag, Literal)
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism'
    ((AddressTag -> Literal -> AddressLiteral)
-> (AddressTag, Literal) -> AddressLiteral
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry AddressTag -> Literal -> AddressLiteral
TaggedAddressLiteral)
    ( \case
        IpAddressLiteral {} -> Maybe (AddressTag, Literal)
forall a. Maybe a
Nothing
        TaggedAddressLiteral AddressTag
tag Literal
body -> (AddressTag, Literal) -> Maybe (AddressTag, Literal)
forall a. a -> Maybe a
Just (AddressTag
tag, Literal
body)
        AddressLiteral {} -> Maybe (AddressTag, Literal)
forall a. Maybe a
Nothing
    )

-- | Prism for working with address literals.
--
-- @since 0.1.0.0
_AddressLiteral :: Prism' AddressLiteral Literal
_AddressLiteral :: p Literal (f Literal) -> p AddressLiteral (f AddressLiteral)
_AddressLiteral =
  (Literal -> AddressLiteral)
-> (AddressLiteral -> Maybe Literal)
-> Prism AddressLiteral AddressLiteral Literal Literal
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism'
    Literal -> AddressLiteral
AddressLiteral
    ( \case
        IpAddressLiteral {} -> Maybe Literal
forall a. Maybe a
Nothing
        TaggedAddressLiteral {} -> Maybe Literal
forall a. Maybe a
Nothing
        AddressLiteral Literal
lit -> Literal -> Maybe Literal
forall a. a -> Maybe a
Just Literal
lit
    )

-- | A tag that can be used with a 'TaggedAddressLiteral'.
--
-- @since 0.1.0.0
newtype AddressTag = AT
  { AddressTag -> Text
addressTagText :: Text
  }
  deriving newtype (AddressTag -> AddressTag -> Bool
(AddressTag -> AddressTag -> Bool)
-> (AddressTag -> AddressTag -> Bool) -> Eq AddressTag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AddressTag -> AddressTag -> Bool
$c/= :: AddressTag -> AddressTag -> Bool
== :: AddressTag -> AddressTag -> Bool
$c== :: AddressTag -> AddressTag -> Bool
Eq, b -> AddressTag -> AddressTag
NonEmpty AddressTag -> AddressTag
AddressTag -> AddressTag -> AddressTag
(AddressTag -> AddressTag -> AddressTag)
-> (NonEmpty AddressTag -> AddressTag)
-> (forall b. Integral b => b -> AddressTag -> AddressTag)
-> Semigroup AddressTag
forall b. Integral b => b -> AddressTag -> AddressTag
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> AddressTag -> AddressTag
$cstimes :: forall b. Integral b => b -> AddressTag -> AddressTag
sconcat :: NonEmpty AddressTag -> AddressTag
$csconcat :: NonEmpty AddressTag -> AddressTag
<> :: AddressTag -> AddressTag -> AddressTag
$c<> :: AddressTag -> AddressTag -> AddressTag
Semigroup)
  deriving (Int -> AddressTag -> ShowS
[AddressTag] -> ShowS
AddressTag -> String
(Int -> AddressTag -> ShowS)
-> (AddressTag -> String)
-> ([AddressTag] -> ShowS)
-> Show AddressTag
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AddressTag] -> ShowS
$cshowList :: [AddressTag] -> ShowS
show :: AddressTag -> String
$cshow :: AddressTag -> String
showsPrec :: Int -> AddressTag -> ShowS
$cshowsPrec :: Int -> AddressTag -> ShowS
Show) via RenamedShow "AddressTag" Text

-- | A literal address that can be used with a 'TaggedAddressLiteral'
-- or 'AddressLiteral'.
--
-- @since 0.1.0.0
newtype Literal = Lit
  { Literal -> Text
literalText :: Text
  }
  deriving newtype (Literal -> Literal -> Bool
(Literal -> Literal -> Bool)
-> (Literal -> Literal -> Bool) -> Eq Literal
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Literal -> Literal -> Bool
$c/= :: Literal -> Literal -> Bool
== :: Literal -> Literal -> Bool
$c== :: Literal -> Literal -> Bool
Eq, b -> Literal -> Literal
NonEmpty Literal -> Literal
Literal -> Literal -> Literal
(Literal -> Literal -> Literal)
-> (NonEmpty Literal -> Literal)
-> (forall b. Integral b => b -> Literal -> Literal)
-> Semigroup Literal
forall b. Integral b => b -> Literal -> Literal
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> Literal -> Literal
$cstimes :: forall b. Integral b => b -> Literal -> Literal
sconcat :: NonEmpty Literal -> Literal
$csconcat :: NonEmpty Literal -> Literal
<> :: Literal -> Literal -> Literal
$c<> :: Literal -> Literal -> Literal
Semigroup)
  deriving (Int -> Literal -> ShowS
[Literal] -> ShowS
Literal -> String
(Int -> Literal -> ShowS)
-> (Literal -> String) -> ([Literal] -> ShowS) -> Show Literal
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Literal] -> ShowS
$cshowList :: [Literal] -> ShowS
show :: Literal -> String
$cshow :: Literal -> String
showsPrec :: Int -> Literal -> ShowS
$cshowsPrec :: Int -> Literal -> ShowS
Show) via RenamedShow "Literal" Text

-- | A comment which may appear in an email address in a specific
-- location.
--
-- @since 0.1.0.0
data Comment = Comment CommentLoc CommentContent
  deriving (Int -> Comment -> ShowS
[Comment] -> ShowS
Comment -> String
(Int -> Comment -> ShowS)
-> (Comment -> String) -> ([Comment] -> ShowS) -> Show Comment
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Comment] -> ShowS
$cshowList :: [Comment] -> ShowS
show :: Comment -> String
$cshow :: Comment -> String
showsPrec :: Int -> Comment -> ShowS
$cshowsPrec :: Int -> Comment -> ShowS
Show, Comment -> Comment -> Bool
(Comment -> Comment -> Bool)
-> (Comment -> Comment -> Bool) -> Eq Comment
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Comment -> Comment -> Bool
$c/= :: Comment -> Comment -> Bool
== :: Comment -> Comment -> Bool
$c== :: Comment -> Comment -> Bool
Eq)

-- | Prism for working with a 'Comment'.
--
-- @since 0.1.0.0
_Comment :: Prism' Comment (CommentLoc, CommentContent)
_Comment :: p (CommentLoc, CommentContent) (f (CommentLoc, CommentContent))
-> p Comment (f Comment)
_Comment =
  ((CommentLoc, CommentContent) -> Comment)
-> (Comment -> Maybe (CommentLoc, CommentContent))
-> Prism
     Comment
     Comment
     (CommentLoc, CommentContent)
     (CommentLoc, CommentContent)
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism'
    ((CommentLoc -> CommentContent -> Comment)
-> (CommentLoc, CommentContent) -> Comment
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry CommentLoc -> CommentContent -> Comment
Comment)
    (\(Comment CommentLoc
loc CommentContent
cc) -> (CommentLoc, CommentContent) -> Maybe (CommentLoc, CommentContent)
forall a. a -> Maybe a
Just (CommentLoc
loc, CommentContent
cc))

-- | Lens for working with comment locations.
--
-- @since 0.1.0.0
commentLoc :: Lens' Comment CommentLoc
commentLoc :: (CommentLoc -> f CommentLoc) -> Comment -> f Comment
commentLoc =
  (Comment -> CommentLoc)
-> (Comment -> CommentLoc -> Comment)
-> Lens Comment Comment CommentLoc CommentLoc
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens
    (\(Comment CommentLoc
loc CommentContent
_) -> CommentLoc
loc)
    (\(Comment CommentLoc
_ CommentContent
cc) CommentLoc
loc -> CommentLoc -> CommentContent -> Comment
Comment CommentLoc
loc CommentContent
cc)

-- | Lens for working with comment contents.
--
-- @since 0.1.0.0
commentContent :: Lens' Comment CommentContent
commentContent :: (CommentContent -> f CommentContent) -> Comment -> f Comment
commentContent =
  (Comment -> CommentContent)
-> (Comment -> CommentContent -> Comment)
-> Lens Comment Comment CommentContent CommentContent
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens
    (\(Comment CommentLoc
_ CommentContent
cc) -> CommentContent
cc)
    (\(Comment CommentLoc
loc CommentContent
_) CommentContent
cc -> CommentLoc -> CommentContent -> Comment
Comment CommentLoc
loc CommentContent
cc)

-- | The location where a comment was parsed or where it should be
-- rendered.
--
-- @since 0.1.0.0
data CommentLoc
  = -- | Just before the 'DisplayName'.
    BeforeDisplayName
  | -- | Just after the 'DisplayName' but before the address.
    AfterDisplayName
  | -- | Before the 'LocalPart' of the address.
    BeforeLocalPart
  | -- | After the 'Domain'.
    AfterDomain
  | -- | After the complete address.
    AfterAddress
  deriving (Int -> CommentLoc -> ShowS
[CommentLoc] -> ShowS
CommentLoc -> String
(Int -> CommentLoc -> ShowS)
-> (CommentLoc -> String)
-> ([CommentLoc] -> ShowS)
-> Show CommentLoc
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CommentLoc] -> ShowS
$cshowList :: [CommentLoc] -> ShowS
show :: CommentLoc -> String
$cshow :: CommentLoc -> String
showsPrec :: Int -> CommentLoc -> ShowS
$cshowsPrec :: Int -> CommentLoc -> ShowS
Show, CommentLoc -> CommentLoc -> Bool
(CommentLoc -> CommentLoc -> Bool)
-> (CommentLoc -> CommentLoc -> Bool) -> Eq CommentLoc
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CommentLoc -> CommentLoc -> Bool
$c/= :: CommentLoc -> CommentLoc -> Bool
== :: CommentLoc -> CommentLoc -> Bool
$c== :: CommentLoc -> CommentLoc -> Bool
Eq)

-- | Text that can appear in a comment.
--
-- @since 0.1.0.0
newtype CommentContent = CC
  { CommentContent -> Text
commentContentText :: Text
  }
  deriving newtype (CommentContent -> CommentContent -> Bool
(CommentContent -> CommentContent -> Bool)
-> (CommentContent -> CommentContent -> Bool) -> Eq CommentContent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CommentContent -> CommentContent -> Bool
$c/= :: CommentContent -> CommentContent -> Bool
== :: CommentContent -> CommentContent -> Bool
$c== :: CommentContent -> CommentContent -> Bool
Eq, b -> CommentContent -> CommentContent
NonEmpty CommentContent -> CommentContent
CommentContent -> CommentContent -> CommentContent
(CommentContent -> CommentContent -> CommentContent)
-> (NonEmpty CommentContent -> CommentContent)
-> (forall b. Integral b => b -> CommentContent -> CommentContent)
-> Semigroup CommentContent
forall b. Integral b => b -> CommentContent -> CommentContent
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> CommentContent -> CommentContent
$cstimes :: forall b. Integral b => b -> CommentContent -> CommentContent
sconcat :: NonEmpty CommentContent -> CommentContent
$csconcat :: NonEmpty CommentContent -> CommentContent
<> :: CommentContent -> CommentContent -> CommentContent
$c<> :: CommentContent -> CommentContent -> CommentContent
Semigroup)
  deriving (Int -> CommentContent -> ShowS
[CommentContent] -> ShowS
CommentContent -> String
(Int -> CommentContent -> ShowS)
-> (CommentContent -> String)
-> ([CommentContent] -> ShowS)
-> Show CommentContent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CommentContent] -> ShowS
$cshowList :: [CommentContent] -> ShowS
show :: CommentContent -> String
$cshow :: CommentContent -> String
showsPrec :: Int -> CommentContent -> ShowS
$cshowsPrec :: Int -> CommentContent -> ShowS
Show) via RenamedShow "CommentContent" Text

-- | Newtype wrapper for deriving 'Show' instances that lie about the
-- name of the constructor.
newtype RenamedShow (n :: Symbol) a = RS a

instance (Show a, KnownSymbol n) => Show (RenamedShow n a) where
  showsPrec :: Int -> RenamedShow n a -> ShowS
showsPrec Int
d (RS a
x) =
    Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
      String -> ShowS
showString (Proxy n -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy n
forall k (t :: k). Proxy t
Proxy :: Proxy n) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" ")
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d a
x