{-# LANGUAGE DataKinds #-}
{-# LANGUAGE LambdaCase #-}

module Dormouse.Uri.Encode
  ( encodeQuery
  , encodePath
  , encodeUnless
  ) where

import Data.Char (chr)
import Data.Word (Word8)
import qualified Data.ByteString as B
import qualified Data.Text as T
import qualified Data.Text.Encoding as E
import Dormouse.Uri.Types
import Dormouse.Uri.RFC3986

-- | Percent encode a word8 as an ascii 'Bytestring'
percentEncode :: Word8 -> B.ByteString
percentEncode :: Word8 -> ByteString
percentEncode Word8
w = 
  let h :: Word8
h = Word8
w Word8 -> Word8 -> Word8
forall a. Integral a => a -> a -> a
`div` Word8
16
      l :: Word8
l = Word8
w Word8 -> Word8 -> Word8
forall a. Integral a => a -> a -> a
`mod` Word8
16 in
  [Word8] -> ByteString
B.pack [Word8
37, Word8 -> Word8
forall a. (Ord a, Num a) => a -> a
hex Word8
h, Word8 -> Word8
forall a. (Ord a, Num a) => a -> a
hex Word8
l]
  where 
    hex :: a -> a
hex a
x
     | a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
10    = a
48a -> a -> a
forall a. Num a => a -> a -> a
+a
x
     | Bool
otherwise = a
55a -> a -> a
forall a. Num a => a -> a -> a
+a
x

-- | Percent encode all chars in the supplied text except for those which satsify the supplied predicate
encodeUnless :: (Char -> Bool)  -> T.Text -> B.ByteString
encodeUnless :: (Char -> Bool) -> Text -> ByteString
encodeUnless Char -> Bool
isAllowedChar = (Word8 -> ByteString) -> ByteString -> ByteString
B.concatMap Word8 -> ByteString
pEncodeQuery (ByteString -> ByteString)
-> (Text -> ByteString) -> Text -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
E.encodeUtf8
  where
    pEncodeQuery :: Word8 -> B.ByteString
    pEncodeQuery :: Word8 -> ByteString
pEncodeQuery Word8
c
      | Char -> Bool
isAllowedChar (Int -> Char
chr (Int -> Char) -> Int -> Char
forall a b. (a -> b) -> a -> b
$ Word8 -> Int
forall a. Enum a => a -> Int
fromEnum Word8
c) = Word8 -> ByteString
B.singleton Word8
c
      | Bool
otherwise                         = Word8 -> ByteString
percentEncode Word8
c

-- | Generate an ascii `Bytestring` from a supplied Query by percent encoding all of the invalid octets
encodeQuery :: Query -> B.ByteString
encodeQuery :: Query -> ByteString
encodeQuery = ByteString -> ByteString -> ByteString
B.append ByteString
"?" (ByteString -> ByteString)
-> (Query -> ByteString) -> Query -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> ByteString
encodeUnless Char -> Bool
isQueryChar (Text -> ByteString) -> (Query -> Text) -> Query -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Query -> Text
unQuery

-- | Generate an ascii `Bytestring` from a supplied Path by percent encoding all of the invalid octets
encodePath :: Path 'Absolute -> B.ByteString
encodePath :: Path 'Absolute -> ByteString
encodePath =  ByteString -> ByteString -> ByteString
B.append ByteString
"/" (ByteString -> ByteString)
-> (Path 'Absolute -> ByteString) -> Path 'Absolute -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString] -> ByteString
B.intercalate ByteString
"/" ([ByteString] -> ByteString)
-> (Path 'Absolute -> [ByteString]) -> Path 'Absolute -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PathSegment -> ByteString) -> [PathSegment] -> [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Char -> Bool) -> Text -> ByteString
encodeUnless Char -> Bool
isPathChar (Text -> ByteString)
-> (PathSegment -> Text) -> PathSegment -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PathSegment -> Text
unPathSegment) ([PathSegment] -> [ByteString])
-> (Path 'Absolute -> [PathSegment])
-> Path 'Absolute
-> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path 'Absolute -> [PathSegment]
forall (ref :: UriReferenceType). Path ref -> [PathSegment]
unPath