-- |Render requests in various ways
module Web.Route.Invertible.Render
  ( renderRequestBuilder
  , renderUrlRequestBuilder
  , renderHamletUrl
  ) where

import           Control.Arrow (second)
import qualified Data.ByteString.Lazy as BSL
import qualified Data.ByteString.Builder as B
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
import           Network.HTTP.Types.URI (Query, encodePathSegments, renderQueryBuilder, simpleQueryToQuery, queryTextToQuery)

import Web.Route.Invertible.Request
import Web.Route.Invertible.Query
import Web.Route.Invertible.Route

-- |This renders a request along with additional query parameters as @[//host][/path][?query]@.
-- Each component is included only if it's specified by the route.
renderRequestBuilder :: Request -> Query -> B.Builder
renderRequestBuilder :: Request -> Query -> Builder
renderRequestBuilder Request
r Query
q =
     [ByteString] -> Builder
bh (Request -> [ByteString]
requestHost Request
r)
  Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Text] -> Builder
bp (Request -> [Text]
requestPath Request
r)
  Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Bool -> Query -> Builder
renderQueryBuilder Bool
True ((SimpleQuery -> Query
simpleQueryToQuery (SimpleQuery -> Query) -> SimpleQuery -> Query
forall a b. (a -> b) -> a -> b
$ QueryParams -> SimpleQuery
paramsQuerySimple (QueryParams -> SimpleQuery) -> QueryParams -> SimpleQuery
forall a b. (a -> b) -> a -> b
$ Request -> QueryParams
requestQuery Request
r) Query -> Query -> Query
forall a. [a] -> [a] -> [a]
++ Query
q)
  where
  bh :: [ByteString] -> Builder
bh [] = Builder
forall a. Monoid a => a
mempty
  bh [ByteString
x] = Builder
sl Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
sl Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
B.byteString ByteString
x
  bh (ByteString
x:[ByteString]
l) = [ByteString] -> Builder
bh [ByteString]
l Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
B.char8 Char
'.' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
B.byteString ByteString
x
  bp :: [Text] -> Builder
bp [] = Builder
sl
  bp [Text]
p = [Text] -> Builder
encodePathSegments [Text]
p
  sl :: Builder
sl = Char -> Builder
B.char8 Char
'/'

-- |This renders a request along with additional query parameters as @scheme:[//host][/path][?query]@.
-- It's roughly equivalent to rendering the 'Web.Route.Invertible.URI.requestURI'.
renderUrlRequestBuilder :: Request -> Query -> B.Builder
renderUrlRequestBuilder :: Request -> Query -> Builder
renderUrlRequestBuilder Request
r Query
q =
  String -> Builder
B.string8 (if Request -> Bool
requestSecure Request
r then String
"https:" else String
"http:") Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Request -> Query -> Builder
renderRequestBuilder Request
r Query
q

-- |A 'Text.Hamlet.Render' function, suitable for passing to a @'Text.Hamlet.HtmlUrl' (RouteAction a b, a)@ template.
renderHamletUrl :: BoundRoute -> [(T.Text, T.Text)] -> T.Text
renderHamletUrl :: BoundRoute -> [(Text, Text)] -> Text
renderHamletUrl (Route a
r :? a
a) [(Text, Text)]
q = ByteString -> Text
TE.decodeUtf8 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BSL.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Builder -> ByteString
B.toLazyByteString
  (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$ Request -> Query -> Builder
renderRequestBuilder (Route a -> a -> Request
forall a. Route a -> a -> Request
requestRoute Route a
r a
a) (Query -> Builder) -> Query -> Builder
forall a b. (a -> b) -> a -> b
$ QueryText -> Query
queryTextToQuery (QueryText -> Query) -> QueryText -> Query
forall a b. (a -> b) -> a -> b
$ ((Text, Text) -> (Text, Maybe Text)) -> [(Text, Text)] -> QueryText
forall a b. (a -> b) -> [a] -> [b]
map ((Text -> Maybe Text) -> (Text, Text) -> (Text, Maybe Text)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second Text -> Maybe Text
forall a. a -> Maybe a
Just) [(Text, Text)]
q