{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards   #-}

module Dhall.URL where

import Data.Text (Text)

import Dhall.Syntax (Directory (..), File (..), Scheme (..), URL (..))

import qualified Network.URI.Encode as URI.Encode

renderComponent :: Text -> Text
renderComponent :: Text -> Text
renderComponent Text
component = Text
"/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
URI.Encode.encodeText Text
component

renderQuery :: Text -> Text
renderQuery :: Text -> Text
renderQuery Text
query = Text
"?" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
query

renderURL :: URL -> Text
renderURL :: URL -> Text
renderURL URL
url =
        Text
schemeText
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>  Text
authority
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>  Text
pathText
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>  Text
queryText
  where
    URL {Maybe Text
Maybe (Expr Src Import)
Text
Scheme
File
headers :: URL -> Maybe (Expr Src Import)
query :: URL -> Maybe Text
path :: URL -> File
authority :: URL -> Text
scheme :: URL -> Scheme
headers :: Maybe (Expr Src Import)
query :: Maybe Text
path :: File
scheme :: Scheme
authority :: Text
..} = URL
url

    File {Text
Directory
file :: File -> Text
directory :: File -> Directory
file :: Text
directory :: Directory
..} = File
path

    Directory {[Text]
components :: Directory -> [Text]
components :: [Text]
..} = Directory
directory

    schemeText :: Text
schemeText = case Scheme
scheme of
        Scheme
HTTP  -> Text
"http://"
        Scheme
HTTPS -> Text
"https://"

    pathText :: Text
pathText =
            (Text -> Text) -> [Text] -> Text
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Text -> Text
renderComponent ([Text] -> [Text]
forall a. [a] -> [a]
reverse [Text]
components)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>  Text -> Text
renderComponent Text
file

    queryText :: Text
queryText = (Text -> Text) -> Maybe Text -> Text
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Text -> Text
renderQuery Maybe Text
query