module Web.Hyperbole.Data.URI
  ( -- * URI
    URI (..)
  , URIAuth (..)
  , uri

    -- ** Path
  , Path (..)
  , Segment
  , path
  , parseURIReference
  , pathUri
  , uriToText
  , pathToText

    -- ** Query String
  , queryString
  , parseQuery
  , queryInsert
  , renderQuery
  , Query
  , QueryItem
  , (./.)
  , (.?.)
  , cleanSegment
  , Endpoint (..)
  )
where

import Data.ByteString (ByteString)
import Data.String (IsString (..))
import Data.String.Conversions (cs)
import Data.Text (Text)
import Data.Text qualified as T
import GHC.Exts (IsList (..))
import Network.HTTP.Types (Query, QueryItem, parseQuery, renderQuery)
import Network.URI (URI (..), URIAuth (..), parseURIReference, uriToString)
import Network.URI qualified as Network
import Network.URI.Static (uri)
import System.FilePath (normalise, (</>))


-- Constructors ------------------------------------------
-- see `uri` for static URIs

-- Operators -----------------------------------------------

-- maybe lets not care about leading slashes at all until rendering
(./.) :: URI -> Path -> URI
URI
u ./. :: URI -> Path -> URI
./. Path
p =
  URI
u{Network.uriPath = addLeadingSlash $ normalise (u.uriPath </> newPath)}
 where
  newPath :: FilePath
newPath = Text -> FilePath
forall a b. ConvertibleStrings a b => a -> b
cs (Text -> FilePath) -> Text -> FilePath
forall a b. (a -> b) -> a -> b
$ Bool -> Path -> Text
pathToText Bool
False Path
p

  addLeadingSlash :: FilePath -> FilePath
addLeadingSlash FilePath
pth =
    case Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
take Int
1 FilePath
pth of
      FilePath
"/" -> FilePath
pth
      FilePath
_ -> Char
'/' Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
: FilePath
pth


infixl 5 ./.


(.?.) :: URI -> QueryItem -> URI
URI
u .?. :: URI -> QueryItem -> URI
.?. (ByteString
k, Maybe ByteString
mv) = URI
u{uriQuery = queryInsert k mv u.uriQuery}


-- Query ---------------------------------------------------

type QueryString = String


queryInsert :: ByteString -> Maybe ByteString -> QueryString -> QueryString
queryInsert :: ByteString -> Maybe ByteString -> FilePath -> FilePath
queryInsert ByteString
k Maybe ByteString
mv FilePath
s =
  [QueryItem] -> FilePath
queryString ([QueryItem] -> FilePath) -> [QueryItem] -> FilePath
forall a b. (a -> b) -> a -> b
$ ByteString -> [QueryItem]
parseQuery (FilePath -> ByteString
forall a b. ConvertibleStrings a b => a -> b
cs FilePath
s) [QueryItem] -> [QueryItem] -> [QueryItem]
forall a. Semigroup a => a -> a -> a
<> [(ByteString
k, Maybe ByteString
mv)]


queryString :: [(ByteString, Maybe ByteString)] -> QueryString
queryString :: [QueryItem] -> FilePath
queryString = ByteString -> FilePath
forall a b. ConvertibleStrings a b => a -> b
cs (ByteString -> FilePath)
-> ([QueryItem] -> ByteString) -> [QueryItem] -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> [QueryItem] -> ByteString
renderQuery Bool
True


-- Path -----------------------------------------------------

newtype Path = Path {Path -> [Text]
segments :: [Segment]}
  deriving (Int -> Path -> FilePath -> FilePath
[Path] -> FilePath -> FilePath
Path -> FilePath
(Int -> Path -> FilePath -> FilePath)
-> (Path -> FilePath)
-> ([Path] -> FilePath -> FilePath)
-> Show Path
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
$cshowsPrec :: Int -> Path -> FilePath -> FilePath
showsPrec :: Int -> Path -> FilePath -> FilePath
$cshow :: Path -> FilePath
show :: Path -> FilePath
$cshowList :: [Path] -> FilePath -> FilePath
showList :: [Path] -> FilePath -> FilePath
Show, Path -> Path -> Bool
(Path -> Path -> Bool) -> (Path -> Path -> Bool) -> Eq Path
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Path -> Path -> Bool
== :: Path -> Path -> Bool
$c/= :: Path -> Path -> Bool
/= :: Path -> Path -> Bool
Eq)
instance IsList Path where
  type Item Path = Segment
  fromList :: [Item Path] -> Path
fromList = [Text] -> Path
Path ([Text] -> Path) -> ([Text] -> [Text]) -> [Text] -> Path
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
T.null)
  toList :: Path -> [Item Path]
toList Path
p = Path
p.segments
instance IsString Path where
  fromString :: FilePath -> Path
fromString = Text -> Path
path (Text -> Path) -> (FilePath -> Text) -> FilePath -> Path
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
forall a b. ConvertibleStrings a b => a -> b
cs


type Segment = Text


cleanSegment :: Segment -> Segment
cleanSegment :: Text -> Text
cleanSegment = (Char -> Bool) -> Text -> Text
T.dropWhileEnd (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/') (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Text
T.dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/')


path :: Text -> Path
path :: Text -> Path
path Text
p =
  [Item Path] -> Path
forall l. IsList l => [Item l] -> l
fromList ([Item Path] -> Path) -> [Item Path] -> Path
forall a b. (a -> b) -> a -> b
$ HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
T.splitOn Text
"/" (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> Text
T.dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/') Text
p


pathUri :: Path -> URI
pathUri :: Path -> URI
pathUri Path
p =
  URI
    { uriPath :: FilePath
uriPath = Text -> FilePath
forall a b. ConvertibleStrings a b => a -> b
cs (Text -> FilePath) -> Text -> FilePath
forall a b. (a -> b) -> a -> b
$ Bool -> Path -> Text
pathToText Bool
True Path
p
    , uriScheme :: FilePath
uriScheme = FilePath
forall a. Monoid a => a
mempty
    , uriAuthority :: Maybe URIAuth
uriAuthority = Maybe URIAuth
forall a. Maybe a
Nothing
    , uriQuery :: FilePath
uriQuery = FilePath
forall a. Monoid a => a
mempty
    , uriFragment :: FilePath
uriFragment = FilePath
forall a. Monoid a => a
mempty
    }


uriToText :: URI -> Text
uriToText :: URI -> Text
uriToText URI
u = FilePath -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ (FilePath -> FilePath) -> URI -> FilePath -> FilePath
uriToString FilePath -> FilePath
forall a. a -> a
id URI
u FilePath
""


pathToText :: Bool -> Path -> Text
pathToText :: Bool -> Path -> Text
pathToText Bool
isRoot Path
p =
  Text
pathPrefix Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
"/" ((Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Text
cleanSegment Path
p.segments)
 where
  pathPrefix :: Text
  pathPrefix :: Text
pathPrefix =
    if Bool
isRoot then Text
"/" else Text
""


-- | A URI with a phantom type to distinguish different endpoints
newtype Endpoint a = Endpoint {forall {k} (a :: k). Endpoint a -> URI
uri :: URI}