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
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
'/'
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
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