module Iri.Rendering.TextBuilder.Internal
  ( iri,
    httpIri,
    scheme,
    hierarchy,
    authority,
    userInfo,
    host,
    regName,
    domainLabel,
    ipV4,
    ipV6,
    port,
    path,
    pathSegment,
    query,
    fragment,
  )
where

import Data.ByteString qualified as ByteString
import Data.Text qualified as C
import Data.Text.Encoding qualified as A
import Data.Text.Encoding.Error qualified as A
import Iri.CodePointPredicates.Core qualified as CorePredicates
import Iri.CodePointPredicates.Rfc3986 qualified as Rfc3986Predicates
import Iri.CodePointPredicates.Rfc3987 qualified as Rfc3987Predicates
import Iri.Data.Types
import Iri.Prelude hiding (null)
import Iri.Utf8CodePoint qualified as K
import Iri.Vector qualified as F
import Net.IPv4 qualified as D
import Net.IPv6 qualified as E
import Text.Builder

iri :: Iri -> Builder
iri :: Iri -> Builder
iri (Iri Scheme
schemeValue Hierarchy
hierarchyValue Query
queryValue Fragment
fragmentValue) =
  Scheme -> Builder
scheme Scheme
schemeValue
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
char Char
':'
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Hierarchy -> Builder
hierarchy Hierarchy
hierarchyValue
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ( Builder -> Builder -> Builder
prependIfNotNull
           (Char -> Builder
char Char
'?')
           (Query -> Builder
query Query
queryValue)
       )
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ( Builder -> Builder -> Builder
prependIfNotNull
           (Char -> Builder
char Char
'#')
           (Fragment -> Builder
fragment Fragment
fragmentValue)
       )

httpIri :: HttpIri -> Builder
httpIri :: HttpIri -> Builder
httpIri (HttpIri (Security Bool
secure) Host
hostValue Port
portValue Path
pathValue Query
queryValue Fragment
fragmentValue) =
  (if Bool
secure then String -> Builder
string String
"https://" else String -> Builder
string String
"http://")
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Host -> Builder
host Host
hostValue
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder -> Builder -> Builder
prependIfNotNull (Char -> Builder
char Char
':') (Port -> Builder
port Port
portValue)
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder -> Builder -> Builder
prependIfNotNull (Char -> Builder
char Char
'/') (Path -> Builder
path Path
pathValue)
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder -> Builder -> Builder
prependIfNotNull (Char -> Builder
char Char
'?') (Query -> Builder
query Query
queryValue)
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder -> Builder -> Builder
prependIfNotNull (Char -> Builder
char Char
'#') (Fragment -> Builder
fragment Fragment
fragmentValue)

scheme :: Scheme -> Builder
scheme :: Scheme -> Builder
scheme (Scheme ByteString
bytes) =
  Text -> Builder
text (OnDecodeError -> ByteString -> Text
A.decodeUtf8With OnDecodeError
A.lenientDecode ByteString
bytes)

hierarchy :: Hierarchy -> Builder
hierarchy :: Hierarchy -> Builder
hierarchy =
  \case
    AuthorisedHierarchy Authority
authorityValue Path
pathValue ->
      String -> Builder
string String
"//" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Authority -> Builder
authority Authority
authorityValue Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder -> Builder -> Builder
prependIfNotNull (Char -> Builder
char Char
'/') (Path -> Builder
path Path
pathValue)
    AbsoluteHierarchy Path
pathValue ->
      Char -> Builder
char Char
'/' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Path -> Builder
path Path
pathValue
    RelativeHierarchy Path
pathValue ->
      Path -> Builder
path Path
pathValue

authority :: Authority -> Builder
authority :: Authority -> Builder
authority (Authority UserInfo
userInfoValue Host
hostValue Port
portValue) =
  Builder -> Builder -> Builder
appendIfNotNull (Char -> Builder
char Char
'@') (UserInfo -> Builder
userInfo UserInfo
userInfoValue)
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Host -> Builder
host Host
hostValue
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder -> Builder -> Builder
prependIfNotNull (Char -> Builder
char Char
':') (Port -> Builder
port Port
portValue)

userInfo :: UserInfo -> Builder
userInfo :: UserInfo -> Builder
userInfo =
  \case
    PresentUserInfo (User ByteString
user) Password
password -> case Password
password of
      PresentPassword ByteString
password -> ByteString -> Builder
userInfoComponent ByteString
user Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
char Char
':' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
userInfoComponent ByteString
password
      Password
MissingPassword -> ByteString -> Builder
userInfoComponent ByteString
user
    UserInfo
MissingUserInfo -> Builder
forall a. Monoid a => a
mempty

userInfoComponent :: ByteString -> Builder
userInfoComponent :: ByteString -> Builder
userInfoComponent =
  Predicate -> Predicate -> ByteString -> Builder
urlEncodedBytesOrText Predicate
Rfc3987Predicates.unencodedUserInfoComponent Predicate
Rfc3986Predicates.unencodedUserInfoComponent

host :: Host -> Builder
host :: Host -> Builder
host =
  \case
    NamedHost RegName
value -> RegName -> Builder
regName RegName
value
    IpV4Host IPv4
value -> IPv4 -> Builder
ipV4 IPv4
value
    IpV6Host IPv6
value -> IPv6 -> Builder
ipV6 IPv6
value

regName :: RegName -> Builder
regName :: RegName -> Builder
regName (RegName Vector DomainLabel
vector) =
  (DomainLabel -> Builder)
-> Builder -> Vector DomainLabel -> Builder
forall monoid element.
Monoid monoid =>
(element -> monoid) -> monoid -> Vector element -> monoid
F.intercalate DomainLabel -> Builder
domainLabel (Char -> Builder
char Char
'.') Vector DomainLabel
vector

domainLabel :: DomainLabel -> Builder
domainLabel :: DomainLabel -> Builder
domainLabel (DomainLabel Text
x) =
  Text -> Builder
text Text
x

ipV4 :: IPv4 -> Builder
ipV4 :: IPv4 -> Builder
ipV4 =
  Text -> Builder
text (Text -> Builder) -> (IPv4 -> Text) -> IPv4 -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. IPv4 -> Text
D.encode

ipV6 :: IPv6 -> Builder
ipV6 :: IPv6 -> Builder
ipV6 =
  Text -> Builder
text (Text -> Builder) -> (IPv6 -> Text) -> IPv6 -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. IPv6 -> Text
E.encode

port :: Port -> Builder
port :: Port -> Builder
port =
  \case
    PresentPort Word16
value -> Word16 -> Builder
forall a. Integral a => a -> Builder
unsignedDecimal Word16
value
    Port
MissingPort -> Builder
forall a. Monoid a => a
mempty

path :: Path -> Builder
path :: Path -> Builder
path (Path Vector PathSegment
pathSegmentVector) =
  (PathSegment -> Builder)
-> Builder -> Vector PathSegment -> Builder
forall monoid element.
Monoid monoid =>
(element -> monoid) -> monoid -> Vector element -> monoid
F.intercalate PathSegment -> Builder
pathSegment (Char -> Builder
char Char
'/') Vector PathSegment
pathSegmentVector

pathSegment :: PathSegment -> Builder
pathSegment :: PathSegment -> Builder
pathSegment (PathSegment ByteString
value) =
  Predicate -> Predicate -> ByteString -> Builder
urlEncodedBytesOrText Predicate
Rfc3987Predicates.unencodedPathSegment Predicate
Rfc3986Predicates.unencodedPathSegment ByteString
value

query :: Query -> Builder
query :: Query -> Builder
query (Query ByteString
value) =
  Predicate -> Predicate -> ByteString -> Builder
urlEncodedBytesOrText Predicate
Rfc3987Predicates.unencodedQuery Predicate
Rfc3986Predicates.unencodedQuery ByteString
value

fragment :: Fragment -> Builder
fragment :: Fragment -> Builder
fragment (Fragment ByteString
value) =
  Predicate -> Predicate -> ByteString -> Builder
urlEncodedBytesOrText Predicate
Rfc3987Predicates.unencodedFragment Predicate
Rfc3986Predicates.unencodedFragment ByteString
value

urlEncodedBytesOrText :: CorePredicates.Predicate -> CorePredicates.Predicate -> ByteString -> Builder
urlEncodedBytesOrText :: Predicate -> Predicate -> ByteString -> Builder
urlEncodedBytesOrText Predicate
unencodedPredicate1 Predicate
unencodedPredicate2 ByteString
bytes =
  case ByteString -> Either UnicodeException Text
A.decodeUtf8' ByteString
bytes of
    Right Text
text -> Predicate -> Text -> Builder
urlEncodedText Predicate
unencodedPredicate1 Text
text
    Left UnicodeException
_ -> Predicate -> ByteString -> Builder
urlEncodedBytes Predicate
unencodedPredicate2 ByteString
bytes

-- | Apply URL-encoding to text
urlEncodedBytes :: CorePredicates.Predicate -> ByteString -> Builder
urlEncodedBytes :: Predicate -> ByteString -> Builder
urlEncodedBytes Predicate
unencodedPredicate =
  (Builder -> Word8 -> Builder) -> Builder -> ByteString -> Builder
forall a. (a -> Word8 -> a) -> a -> ByteString -> a
ByteString.foldl'
    ( \Builder
builder ->
        Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
mappend Builder
builder (Builder -> Builder) -> (Word8 -> Builder) -> Word8 -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. \Word8
byte ->
          if Predicate
unencodedPredicate (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
byte)
            then Word8 -> Builder
utf8CodeUnits1 Word8
byte
            else Word8 -> Builder
urlEncodedByte Word8
byte
    )
    Builder
forall a. Monoid a => a
mempty

-- | Apply URL-encoding to text
urlEncodedText :: CorePredicates.Predicate -> Text -> Builder
urlEncodedText :: Predicate -> Text -> Builder
urlEncodedText Predicate
unencodedPredicate =
  (Builder -> Char -> Builder) -> Builder -> Text -> Builder
forall a. (a -> Char -> a) -> a -> Text -> a
C.foldl' (\Builder
builder -> Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
mappend Builder
builder (Builder -> Builder) -> (Char -> Builder) -> Char -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Predicate -> Int -> Builder
urlEncodedUnicodeCodePoint Predicate
unencodedPredicate (Int -> Builder) -> (Char -> Int) -> Char -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Char -> Int
ord) Builder
forall a. Monoid a => a
mempty

urlEncodedUnicodeCodePoint :: CorePredicates.Predicate -> Int -> Builder
urlEncodedUnicodeCodePoint :: Predicate -> Int -> Builder
urlEncodedUnicodeCodePoint Predicate
unencodedPredicate Int
codePoint =
  if Predicate
unencodedPredicate Int
codePoint
    then Int -> Builder
unicodeCodePoint Int
codePoint
    else
      Int -> Utf8CodePoint
K.unicodeCodePoint
        Int
codePoint
        (\Word8
b1 -> Word8 -> Builder
urlEncodedByte Word8
b1)
        (\Word8
b1 Word8
b2 -> Word8 -> Builder
urlEncodedByte Word8
b1 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word8 -> Builder
urlEncodedByte Word8
b2)
        (\Word8
b1 Word8
b2 Word8
b3 -> Word8 -> Builder
urlEncodedByte Word8
b1 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word8 -> Builder
urlEncodedByte Word8
b2 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word8 -> Builder
urlEncodedByte Word8
b3)
        (\Word8
b1 Word8
b2 Word8
b3 Word8
b4 -> Word8 -> Builder
urlEncodedByte Word8
b1 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word8 -> Builder
urlEncodedByte Word8
b2 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word8 -> Builder
urlEncodedByte Word8
b3 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word8 -> Builder
urlEncodedByte Word8
b4)

urlEncodedByte :: Word8 -> Builder
urlEncodedByte :: Word8 -> Builder
urlEncodedByte Word8
x =
  case Word8 -> Word8 -> (Word8, Word8)
forall a. Integral a => a -> a -> (a, a)
divMod Word8
x Word8
16 of
    (Word8
d1, Word8
d2) -> Char -> Builder
char Char
'%' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word8 -> Builder
forall a. Integral a => a -> Builder
hexadecimalDigit Word8
d1 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word8 -> Builder
forall a. Integral a => a -> Builder
hexadecimalDigit Word8
d2

prependIfNotNull :: Builder -> Builder -> Builder
prependIfNotNull :: Builder -> Builder -> Builder
prependIfNotNull Builder
prepended Builder
it =
  if Builder -> Bool
null Builder
it
    then Builder
forall a. Monoid a => a
mempty
    else Builder
prepended Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
it

appendIfNotNull :: Builder -> Builder -> Builder
appendIfNotNull :: Builder -> Builder -> Builder
appendIfNotNull Builder
appended Builder
it =
  if Builder -> Bool
null Builder
it
    then Builder
forall a. Monoid a => a
mempty
    else Builder
it Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
appended