{-# LANGUAGE UndecidableInstances #-}

module Servant.Hateoas.Combinator.Title where

import Servant
import Servant.Hateoas.HasHandler
import Servant.Hateoas.RelationLink
import Servant.Hateoas.Internal.Polyvariadic
import Data.String (fromString)
import Control.Applicative ((<|>))
import GHC.TypeLits

-- | Combinator similar to 'Summary' and 'Description' but for the human readable title of the resource a 'RelationLink' refers to.
data Title (sym :: Symbol)

instance HasLink b => HasLink (Title sym :> b) where
  type MkLink (Title sym :> b) link = MkLink b link
  toLink :: forall a.
(Link -> a)
-> Proxy (Title sym :> b) -> Link -> MkLink (Title sym :> b) a
toLink Link -> a
f Proxy (Title sym :> b)
_ = (Link -> a) -> Proxy b -> Link -> MkLink b a
forall a. (Link -> a) -> Proxy b -> Link -> MkLink b a
forall {k} (endpoint :: k) a.
HasLink endpoint =>
(Link -> a) -> Proxy endpoint -> Link -> MkLink endpoint a
toLink Link -> a
f (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @b)

instance HasServer api ctx => HasServer (Title desc :> api) ctx where
  type ServerT (Title desc :> api) m = ServerT api m
  route :: forall env.
Proxy (Title desc :> api)
-> Context ctx
-> Delayed env (Server (Title desc :> api))
-> Router env
route Proxy (Title desc :> api)
_ = Proxy api
-> Context ctx
-> Delayed env (Server api)
-> Router' env RoutingApplication
forall env.
Proxy api -> Context ctx -> Delayed env (Server api) -> Router env
forall {k} (api :: k) (context :: [*]) env.
HasServer api context =>
Proxy api
-> Context context -> Delayed env (Server api) -> Router env
route (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @api)
  hoistServerWithContext :: forall (m :: * -> *) (n :: * -> *).
Proxy (Title desc :> api)
-> Proxy ctx
-> (forall x. m x -> n x)
-> ServerT (Title desc :> api) m
-> ServerT (Title desc :> api) n
hoistServerWithContext Proxy (Title desc :> api)
_ Proxy ctx
pc forall x. m x -> n x
nt ServerT (Title desc :> api) m
s = Proxy api
-> Proxy ctx
-> (forall x. m x -> n x)
-> ServerT api m
-> ServerT api n
forall {k} (api :: k) (context :: [*]) (m :: * -> *) (n :: * -> *).
HasServer api context =>
Proxy api
-> Proxy context
-> (forall x. m x -> n x)
-> ServerT api m
-> ServerT api n
forall (m :: * -> *) (n :: * -> *).
Proxy api
-> Proxy ctx
-> (forall x. m x -> n x)
-> ServerT api m
-> ServerT api n
hoistServerWithContext (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @api) Proxy ctx
pc m x -> n x
forall x. m x -> n x
nt ServerT api m
ServerT (Title desc :> api) m
s

instance HasHandler api => HasHandler (Title desc :> api) where
  getHandler :: forall (m :: * -> *).
MonadIO m =>
Proxy m
-> Proxy (Title desc :> api) -> ServerT (Title desc :> api) m
getHandler Proxy m
m Proxy (Title desc :> api)
_ = Proxy m -> Proxy api -> ServerT api m
forall {k} (api :: k) (m :: * -> *).
(HasHandler api, MonadIO m) =>
Proxy m -> Proxy api -> ServerT api m
forall (m :: * -> *).
MonadIO m =>
Proxy m -> Proxy api -> ServerT api m
getHandler Proxy m
m (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @api)

instance (KnownSymbol title, HasTemplatedLink api) => HasTemplatedLink (Title title :> api) where
  toTemplatedLink :: Proxy (Title title :> api) -> RelationLink
toTemplatedLink Proxy (Title title :> api)
_  = (\RelationLink
l -> RelationLink
l { _title = _title l <|> Just title }) (RelationLink -> RelationLink) -> RelationLink -> RelationLink
forall a b. (a -> b) -> a -> b
$ Proxy api -> RelationLink
forall {k} (endpoint :: k).
HasTemplatedLink endpoint =>
Proxy endpoint -> RelationLink
toTemplatedLink (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @api)
    where
      title :: Text
title = String -> Text
forall a. IsString a => String -> a
fromString (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Proxy title -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @title)

instance (KnownSymbol title, RightLink api) => HasRelationLink (Title title :> api) where
  toRelationLink :: Proxy (Title title :> api)
-> MkLink (Title title :> api) RelationLink
toRelationLink Proxy (Title title :> api)
_  = (\Return (MkLink api RelationLink) (IsFun (MkLink api RelationLink))
l -> Return (MkLink api RelationLink) (IsFun (MkLink api RelationLink))
l { _title = _title l <|> Just title }) (Return (MkLink api RelationLink) (IsFun (MkLink api RelationLink))
 -> RelationLink)
-> MkLink api RelationLink
-> Replace
     (MkLink api RelationLink)
     RelationLink
     (IsFun (MkLink api RelationLink))
forall f (b :: Bool) r.
(PolyvariadicComp f b, IsFun f ~ b) =>
(Return f b -> r) -> f -> Replace f r b
... Proxy api -> MkLink api RelationLink
forall {k} (endpoint :: k).
HasRelationLink endpoint =>
Proxy endpoint -> MkLink endpoint RelationLink
toRelationLink (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @api)
    where
      title :: Text
title = String -> Text
forall a. IsString a => String -> a
fromString (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Proxy title -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @title)