{-# LANGUAGE ConstraintKinds   #-}
{-# LANGUAGE OverloadedStrings #-}

-- | Some helper functions for creating values in
-- [lucid](https://hackage.haskell.org/package/lucid) DSLs that work
-- with [servant](https://hackage.haskell.org/package/servant).
module Lucid.Servant (
    safeHref_,
    safeAbsHref_,
    safeRelHref_,
    linkHref_,
    linkAbsHref_,
    linkRelHref_,
    ) where

import           Data.Proxy
                 (Proxy)
import           Data.Semigroup
                 ((<>))
import qualified Data.Text           as T
import           Lucid
                 (Attribute)
import           Lucid.Html5
                 (href_)
import           Servant.API
                 (toUrlPiece)
import           Servant.Links
                 (HasLink, IsElem, Link, MkLink, safeLink')

-- | 'safeLink' variant which creates lucid's 'Attribute' given base url.
--
-- >>> type API = "path" :> Get '[JSON] Int
-- >>> let api = Proxy :: Proxy API
--
-- >>> safeHref_ "" api api
-- Attribute "href" "path"
--
-- >>> safeHref_ "/" api api
-- Attribute "href" "/path"
--
-- >>> safeHref_ "http://example.com" api api
-- Attribute "href" "http://example.com/path"
--
-- >>> safeHref_ "http://example.com/" api api
-- Attribute "href" "http://example.com/path"
--
safeHref_
    :: (IsElem endpoint api, HasLink endpoint)
    => T.Text
    -> Proxy api -> Proxy endpoint -> MkLink endpoint Attribute
safeHref_ :: Text -> Proxy api -> Proxy endpoint -> MkLink endpoint Attribute
safeHref_ = (Link -> Attribute)
-> Proxy api -> Proxy endpoint -> MkLink endpoint Attribute
forall endpoint api a.
(IsElem endpoint api, HasLink endpoint) =>
(Link -> a) -> Proxy api -> Proxy endpoint -> MkLink endpoint a
safeLink' ((Link -> Attribute)
 -> Proxy api -> Proxy endpoint -> MkLink endpoint Attribute)
-> (Text -> Link -> Attribute)
-> Text
-> Proxy api
-> Proxy endpoint
-> MkLink endpoint Attribute
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Link -> Attribute
linkHref_

-- | @'safeLink' "/"@
safeAbsHref_
    :: (IsElem endpoint api, HasLink endpoint)
    => Proxy api -> Proxy endpoint -> MkLink endpoint Attribute
safeAbsHref_ :: Proxy api -> Proxy endpoint -> MkLink endpoint Attribute
safeAbsHref_ = (Link -> Attribute)
-> Proxy api -> Proxy endpoint -> MkLink endpoint Attribute
forall endpoint api a.
(IsElem endpoint api, HasLink endpoint) =>
(Link -> a) -> Proxy api -> Proxy endpoint -> MkLink endpoint a
safeLink' Link -> Attribute
linkAbsHref_

-- | @'safeLink' ""@
safeRelHref_
    :: (IsElem endpoint api, HasLink endpoint)
    => Proxy api -> Proxy endpoint -> MkLink endpoint Attribute
safeRelHref_ :: Proxy api -> Proxy endpoint -> MkLink endpoint Attribute
safeRelHref_ = (Link -> Attribute)
-> Proxy api -> Proxy endpoint -> MkLink endpoint Attribute
forall endpoint api a.
(IsElem endpoint api, HasLink endpoint) =>
(Link -> a) -> Proxy api -> Proxy endpoint -> MkLink endpoint a
safeLink' Link -> Attribute
linkRelHref_

-- | Create an `href` attribute from a 'Link', with given base url.
--
-- "servant" ensures that any 'Link' is valid within an API.
-- This function ensures it is possible to navigate to that endpoint from
-- a page which shares a root with that API.
linkHref_ :: T.Text -> Link -> Attribute
linkHref_ :: Text -> Link -> Attribute
linkHref_ Text
burl = Text -> Attribute
href_ (Text -> Attribute) -> (Link -> Text) -> Link -> Attribute
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
burl Text -> Text -> Text
<+>) (Text -> Text) -> (Link -> Text) -> Link -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Link -> Text
forall a. ToHttpApiData a => a -> Text
toUrlPiece

-- | Create an `href` attribute from a 'Link', with leading '/'.
--
-- "servant" ensures that any 'Link' is valid within an API.
-- This function ensures it is possible to navigate to that endpoint from
-- a page which shares a root with that API.
linkAbsHref_ :: Link -> Attribute
linkAbsHref_ :: Link -> Attribute
linkAbsHref_ = Text -> Link -> Attribute
linkHref_ Text
"/"

-- | Create an `href` attribute from a 'Link', as a relative link.
--
-- "servant" ensures that any 'Link' is valid within an API.
-- Use this function if a relative link (no leading '/') is required.
linkRelHref_ :: Link -> Attribute
linkRelHref_ :: Link -> Attribute
linkRelHref_ = Text -> Attribute
href_ (Text -> Attribute) -> (Link -> Text) -> Link -> Attribute
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Link -> Text
forall a. ToHttpApiData a => a -> Text
toUrlPiece

(<+>) :: T.Text -> T.Text -> T.Text
Text
burl <+> :: Text -> Text -> Text
<+> Text
path
    | Text -> Bool
T.null Text
burl        = Text
path
    | Text -> Char
T.last Text
burl Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/' = Text
burl Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
path
    | Bool
otherwise          = Text
burl Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
path

-- $setup
--
-- >>> :set -XOverloadedStrings -XDataKinds -XTypeOperators
-- >>> import Servant.API
-- >>> import Data.Proxy (Proxy (..))
--