-- |
--
-- 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
--
-- Internal functions representing character classes in email
-- addresses.
--
-- Obsolete characters are only supported in
-- 'Addy.Internal.Parser.Lenient' mode and are filtered out after
-- parsing.
module Addy.Internal.Char
  ( utf8NonAscii,
    obsNoWsCtl,
    wsp,
    vchar,
    atext,
    dtext,
    ctext,
    ctextObs,
    qtext,
    qtextObs,
    quotedPair,
    quotedPairObs,
  )
where

import Data.Char

-- | Is a character in the @UTF8-non-ascii@ class from RFC 6532?
--
-- @since 0.1.0.0
utf8NonAscii :: Char -> Bool
utf8NonAscii :: Char -> Bool
utf8NonAscii Char
c = Char -> Int
ord Char
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0xc2 Bool -> Bool -> Bool
&& Char -> Bool
isPrint Char
c

-- | Obsolete control characters.
--
-- > obs-NO-WS-CTL   =   %d1-8 /            ; US-ASCII control
-- >                     %d11 /             ;  characters that do not
-- >                     %d12 /             ;  include the carriage
-- >                     %d14-31 /          ;  return, line feed, and
-- >                     %d127              ;  white space characters
--
-- @since 0.1.0.0
obsNoWsCtl :: Char -> Bool
obsNoWsCtl :: Char -> Bool
obsNoWsCtl = Char -> Int
ord (Char -> Int) -> (Int -> Bool) -> Char -> Bool
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Int -> Bool
forall a. (Ord a, Num a) => a -> Bool
go
  where
    go :: a -> Bool
go a
n =
      (a
n a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
1 Bool -> Bool -> Bool
&& a
n a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
8)
        Bool -> Bool -> Bool
|| a
n a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
11
        Bool -> Bool -> Bool
|| a
n a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
12
        Bool -> Bool -> Bool
|| (a
n a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
14 Bool -> Bool -> Bool
&& a
n a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
31)
        Bool -> Bool -> Bool
|| a
n a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
127

-- | Whitepace.
--
-- @since 0.1.0.0
wsp :: Char -> Bool
wsp :: Char -> Bool
wsp Char
c = Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\t'

-- | RFC 5234: Visible character.
--
-- > VCHAR          =  %x21-7E
-- >                        ; visible (printing) characters
--
--  RFC 6532 §3.2
--
-- > VCHAR   =/  UTF8-non-ascii
--
-- @since 0.1.0.0
vchar :: Char -> Bool
vchar :: Char -> Bool
vchar Char
c = Int -> Bool
forall a. (Ord a, Num a) => a -> Bool
vchar' (Char -> Int
ord Char
c) Bool -> Bool -> Bool
|| Char -> Bool
utf8NonAscii Char
c
  where
    vchar' :: a -> Bool
vchar' a
n = a
n a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
0x21 Bool -> Bool -> Bool
&& a
n a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
0x7e

-- | RFC 5322 §3.2.3
--
-- > atext =   ALPHA / DIGIT /    ; Printable US-ASCII
-- >           "!" / "#" /        ;  characters not including
-- >           "$" / "%" /        ;  specials.  Used for atoms.
-- >           "&" / "'" /
-- >           "*" / "+" /
-- >           "-" / "/" /
-- >           "=" / "?" /
-- >           "^" / "_" /
-- >           "`" / "{" /
-- >           "|" / "}" /
-- >           "~"
--
--  RFC 6532 §3.2
--
-- > atext =/  UTF8-non-ascii
--
-- @since 0.1.0.0
atext :: Char -> Bool
atext :: Char -> Bool
atext Char
c =
  Char -> Bool
isAlphaNum Char
c
    Bool -> Bool -> Bool
|| Char -> Bool
utf8NonAscii Char
c
    Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'!'
    Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'#'
    Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'$'
    Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'%'
    Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'&'
    Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\''
    Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'*'
    Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'+'
    Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-'
    Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/'
    Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'='
    Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'?'
    Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'^'
    Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_'
    Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'`'
    Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'{'
    Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'|'
    Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'}'
    Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'~'

-- | RFC 5322 @dtext@.
--
-- > dtext           =   %d33-90 /          ; Printable US-ASCII
-- >                     %d94-126 /         ;  characters not including
-- >                     obs-dtext          ;  "[", "]", or "\"
-- > obs-dtext       =   obs-NO-WS-CTL / quoted-pair
--
--  RFC 6532 §3.2
--
-- > dtext   =/  UTF8-non-ascii
-- @since 0.1.0.0
dtext :: Char -> Bool
dtext :: Char -> Bool
dtext Char
c = Int -> Bool
forall a. (Ord a, Num a) => a -> Bool
asciidtext (Char -> Int
ord Char
c) Bool -> Bool -> Bool
|| Char -> Bool
utf8NonAscii Char
c
  where
    asciidtext :: a -> Bool
asciidtext a
n =
      (a
n a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
33 Bool -> Bool -> Bool
&& a
n a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
90)
        Bool -> Bool -> Bool
|| (a
n a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
94 Bool -> Bool -> Bool
&& a
n a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
126)

-- | RFC 5322 @ctext@.
--
-- > ctext           =   %d33-39 /          ; Printable US-ASCII
-- >                     %d42-91 /          ;  characters not including
-- >                     %d93-126 /         ;  "(", ")", or "\"
-- >                     obs-ctext
-- >
-- > obs-ctext       =   obs-NO-WS-CTL
--
-- RFC 6532 §3.2
--
-- > ctext   =/  UTF8-non-ascii
--
-- @since 0.1.0.0
ctext :: Char -> Bool
ctext :: Char -> Bool
ctext Char
c = Int -> Bool
forall a. (Ord a, Num a) => a -> Bool
asciictext (Char -> Int
ord Char
c) Bool -> Bool -> Bool
|| Char -> Bool
utf8NonAscii Char
c
  where
    asciictext :: a -> Bool
asciictext a
n =
      (a
n a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
33 Bool -> Bool -> Bool
&& a
n a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
39)
        Bool -> Bool -> Bool
|| (a
n a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
42 Bool -> Bool -> Bool
&& a
n a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
91)
        Bool -> Bool -> Bool
|| (a
n a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
93 Bool -> Bool -> Bool
&& a
n a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
126)

-- | Obsolete @ctext@.
--
-- > obs-ctext = obs-NO-WS-CTL
--
-- @since 0.1.0.0
ctextObs :: Char -> Bool
ctextObs :: Char -> Bool
ctextObs = Char -> Bool
obsNoWsCtl

-- | Characters that can appear in a quoted string.
--
-- RFC 5322 §3.2.4:
--
-- > qtext =   %d33 /             ; Printable US-ASCII
-- >           %d35-91 /          ;  characters not including
-- >           %d93-126 /         ;  "\" or the quote character
-- >           obs-qtext
--
-- RFC 6532 §3.2:
--
-- > qtext =/ UTF8-non-ascii
-- @since 0.1.0.0
qtext :: Char -> Bool
qtext :: Char -> Bool
qtext Char
c = Int -> Bool
forall a. (Num a, Ord a) => a -> Bool
asciiqtext (Char -> Int
ord Char
c) Bool -> Bool -> Bool
|| Char -> Bool
utf8NonAscii Char
c
  where
    asciiqtext :: a -> Bool
asciiqtext a
n =
      a
n a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
33
        Bool -> Bool -> Bool
|| (a
n a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
35 Bool -> Bool -> Bool
&& a
n a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
91)
        Bool -> Bool -> Bool
|| (a
n a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
93 Bool -> Bool -> Bool
&& a
n a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
126)

-- | Obsolete @qtext@.
--
-- > obs-qtext = obs-NO-WS-CTL
--
-- @since 0.1.0.0
qtextObs :: Char -> Bool
qtextObs :: Char -> Bool
qtextObs = Char -> Bool
obsNoWsCtl

-- | Characters that can follow a backslash.
--
-- > quoted-pair     =   ("\" (VCHAR / WSP)) / obs-qp
--
-- @since 0.1.0.0
quotedPair :: Char -> Bool
quotedPair :: Char -> Bool
quotedPair Char
c = Char -> Bool
vchar Char
c Bool -> Bool -> Bool
|| Char -> Bool
wsp Char
c

-- | Obsolete characters that can be escaped with a backslash.
--
-- > obs-qp          =   "\" (%d0 / obs-NO-WS-CTL / LF / CR)
--
-- @since 0.1.0.0
quotedPairObs :: Char -> Bool
quotedPairObs :: Char -> Bool
quotedPairObs Char
c =
  Char -> Bool
obsNoWsCtl Char
c
    Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\r'
    Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n'
    Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\0'