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

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

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

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

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

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

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

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

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

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

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

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

ipV4 :: IPv4 -> TextBuilder
ipV4 :: IPv4 -> TextBuilder
ipV4 =
  Text -> TextBuilder
text (Text -> TextBuilder) -> (IPv4 -> Text) -> IPv4 -> TextBuilder
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 -> TextBuilder
ipV6 :: IPv6 -> TextBuilder
ipV6 =
  Text -> TextBuilder
text (Text -> TextBuilder) -> (IPv6 -> Text) -> IPv6 -> TextBuilder
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 -> TextBuilder
port :: Port -> TextBuilder
port =
  \case
    PresentPort Word16
value -> Word16 -> TextBuilder
forall a. Integral a => a -> TextBuilder
decimal Word16
value
    Port
MissingPort -> TextBuilder
forall a. Monoid a => a
mempty

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

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

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

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

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

-- | Apply URL-encoding to text
urlEncodedBytes :: CorePredicates.Predicate -> ByteString -> TextBuilder
urlEncodedBytes :: Predicate -> ByteString -> TextBuilder
urlEncodedBytes Predicate
unencodedPredicate =
  (TextBuilder -> Word8 -> TextBuilder)
-> TextBuilder -> ByteString -> TextBuilder
forall a. (a -> Word8 -> a) -> a -> ByteString -> a
ByteString.foldl'
    ( \TextBuilder
builder ->
        TextBuilder -> TextBuilder -> TextBuilder
forall a. Monoid a => a -> a -> a
mappend TextBuilder
builder (TextBuilder -> TextBuilder)
-> (Word8 -> TextBuilder) -> Word8 -> TextBuilder
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 Int -> TextBuilder
unicodeCodepoint (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
byte)
            else Word8 -> TextBuilder
urlEncodedByte Word8
byte
    )
    TextBuilder
forall a. Monoid a => a
mempty

-- | Apply URL-encoding to text
urlEncodedText :: CorePredicates.Predicate -> Text -> TextBuilder
urlEncodedText :: Predicate -> Text -> TextBuilder
urlEncodedText Predicate
unencodedPredicate =
  (TextBuilder -> Char -> TextBuilder)
-> TextBuilder -> Text -> TextBuilder
forall a. (a -> Char -> a) -> a -> Text -> a
C.foldl' (\TextBuilder
builder -> TextBuilder -> TextBuilder -> TextBuilder
forall a. Monoid a => a -> a -> a
mappend TextBuilder
builder (TextBuilder -> TextBuilder)
-> (Char -> TextBuilder) -> Char -> TextBuilder
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 -> TextBuilder
urlEncodedUnicodeCodePoint Predicate
unencodedPredicate (Int -> TextBuilder) -> (Char -> Int) -> Char -> TextBuilder
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) TextBuilder
forall a. Monoid a => a
mempty

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

urlEncodedByte :: Word8 -> TextBuilder
urlEncodedByte :: Word8 -> TextBuilder
urlEncodedByte Word8
x = Char -> TextBuilder
char Char
'%' TextBuilder -> TextBuilder -> TextBuilder
forall a. Semigroup a => a -> a -> a
<> Word8 -> TextBuilder
forall a. (FiniteBits a, Integral a) => a -> TextBuilder
hexadecimal Word8
x

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

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