{-# LANGUAGE UndecidableInstances #-}

module Servant.Hateoas.Resource
(
  -- * Resource
  HasResource(..)
, ToResource(..)

-- * Hypermedia-Relations
-- ** Type
, HRel(..)

-- ** Class
, Related(..)

-- ** Construction
, BuildRels(..)
, selfLink, relatedLinks, defaultLinks
)
where

import Servant
import Data.Kind
import GHC.TypeLits
import GHC.Records

-- | Class that indicates that a Content-Type has a specific Resource-Representation.
class HasResource ct where
  -- | Associated type for this Content-Type
  type Resource ct :: Type -> Type

-- | Class for converting values of @a@ to their respective Resource-Representation.
class HasResource ct => ToResource ct api a where
  -- | Converts a value into it's Resource-Representation.
  toResource :: Proxy ct -> Proxy api -> a -> Resource ct a

-- | Data-Kind for Hypermedia-Relations.
data HRel = HRel
  { HRel -> Symbol
relName  :: Symbol       -- ^ Name of the relation
  , HRel -> Symbol
selName  :: Symbol       -- ^ Record selectors field name
  , HRel -> *
endpoint :: Type         -- ^ Servant-Endpoint to use for retrieving one value for relation @relName@
  }

-- | Types that have Hypermedia-Relations.
class Related a where
  -- | Name of the record selector that holds the resources identifier
  type IdSelName a      :: Symbol
  -- | Servant-Endpoint for retrieving one @a@ by its identifier
  type GetOneApi a      :: Type
  -- | Name for collected values
  type CollectionName a :: Symbol
  type CollectionName a = "items"
  -- | List of all relations @a@ has
  type Relations a      :: [HRel]

-- | Class for deriving Hypermedia-Relations for types.
type BuildRels :: Type -> [HRel] -> Type -> Constraint
class BuildRels api rs a where
  buildRels :: Proxy rs -> Proxy api -> a -> [(String, Link)]

instance BuildRels api '[] a where
  buildRels :: Proxy '[] -> Proxy api -> a -> [(String, Link)]
buildRels Proxy '[]
_ Proxy api
_ a
_ = []

instance
  ( KnownSymbol relName
  , HasField selName a id
  , HasLink endpoint
  , IsElem endpoint api
  , MkLink endpoint Link ~ (id -> Link)
  , BuildRels api rs a
  ) => BuildRels api (('HRel relName selName endpoint) ': rs) a where
  buildRels :: Proxy ('HRel relName selName endpoint : rs)
-> Proxy api -> a -> [(String, Link)]
buildRels Proxy ('HRel relName selName endpoint : rs)
_ Proxy api
api a
x = (String, Link)
l (String, Link) -> [(String, Link)] -> [(String, Link)]
forall a. a -> [a] -> [a]
: Proxy rs -> Proxy api -> a -> [(String, Link)]
forall api (rs :: [HRel]) a.
BuildRels api rs a =>
Proxy rs -> Proxy api -> a -> [(String, Link)]
buildRels (forall (t :: [HRel]). Proxy t
forall {k} (t :: k). Proxy t
Proxy @rs) Proxy api
api a
x
    where
      mkLink :: MkLink endpoint Link
mkLink = Proxy api -> Proxy endpoint -> MkLink endpoint Link
forall endpoint api.
(IsElem endpoint api, HasLink endpoint) =>
Proxy api -> Proxy endpoint -> MkLink endpoint Link
safeLink Proxy api
api (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @endpoint)
      l :: (String, Link)
l = (Proxy relName -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @relName), MkLink endpoint Link
id -> Link
mkLink (id -> Link) -> id -> Link
forall a b. (a -> b) -> a -> b
$ forall {k} (x :: k) r a. HasField x r a => r -> a
forall (x :: Symbol) r a. HasField x r a => r -> a
getField @selName a
x)

-- | Generates pairs @(rel, link)@ for all related resources as defined with 'Relations'.
relatedLinks :: forall api a. (Related a, BuildRels api (Relations a) a) => Proxy api -> a -> [(String, Link)]
relatedLinks :: forall api a.
(Related a, BuildRels api (Relations a) a) =>
Proxy api -> a -> [(String, Link)]
relatedLinks = Proxy (Relations a) -> Proxy api -> a -> [(String, Link)]
forall api (rs :: [HRel]) a.
BuildRels api rs a =>
Proxy rs -> Proxy api -> a -> [(String, Link)]
buildRels (forall (t :: [HRel]). Proxy t
forall {k} (t :: k). Proxy t
Proxy @(Relations a))

-- | Generates the pair (\"self\", link) where @link@ is the 'Link' to @a@ itself.
selfLink :: forall api a id.
  ( Related a, HasField (IdSelName a) a id
  , IsElem (GetOneApi a) api, HasLink (GetOneApi a)
  , MkLink (GetOneApi a) Link ~ (id -> Link)
  ) => Proxy api -> a -> (String, Link)
selfLink :: forall api a id.
(Related a, HasField (IdSelName a) a id, IsElem (GetOneApi a) api,
 HasLink (GetOneApi a), MkLink (GetOneApi a) Link ~ (id -> Link)) =>
Proxy api -> a -> (String, Link)
selfLink Proxy api
api a
x = (String
"self", MkLink (GetOneApi a) Link
id -> Link
mkSelf (id -> Link) -> id -> Link
forall a b. (a -> b) -> a -> b
$ forall {k} (x :: k) r a. HasField x r a => r -> a
forall (x :: Symbol) r a. HasField x r a => r -> a
getField @(IdSelName a) a
x)
  where
    mkSelf :: MkLink (GetOneApi a) Link
mkSelf = Proxy api -> Proxy (GetOneApi a) -> MkLink (GetOneApi a) Link
forall endpoint api.
(IsElem endpoint api, HasLink endpoint) =>
Proxy api -> Proxy endpoint -> MkLink endpoint Link
safeLink Proxy api
api (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(GetOneApi a))

-- | Generate Hypermedia-Links by default.
--
-- @
-- defaultLinks api x = selfLink api x : relatedLinks api x
-- @
defaultLinks :: forall api a id.
  ( Related a, HasField (IdSelName a) a id, IsElem (GetOneApi a) api
  , HasLink (GetOneApi a), MkLink (GetOneApi a) Link ~ (id -> Link)
  , BuildRels api (Relations a) a
  ) => Proxy api -> a -> [(String, Link)]
defaultLinks :: forall api a id.
(Related a, HasField (IdSelName a) a id, IsElem (GetOneApi a) api,
 HasLink (GetOneApi a), MkLink (GetOneApi a) Link ~ (id -> Link),
 BuildRels api (Relations a) a) =>
Proxy api -> a -> [(String, Link)]
defaultLinks Proxy api
api a
x = Proxy api -> a -> (String, Link)
forall api a id.
(Related a, HasField (IdSelName a) a id, IsElem (GetOneApi a) api,
 HasLink (GetOneApi a), MkLink (GetOneApi a) Link ~ (id -> Link)) =>
Proxy api -> a -> (String, Link)
selfLink Proxy api
api a
x (String, Link) -> [(String, Link)] -> [(String, Link)]
forall a. a -> [a] -> [a]
: Proxy api -> a -> [(String, Link)]
forall api a.
(Related a, BuildRels api (Relations a) a) =>
Proxy api -> a -> [(String, Link)]
relatedLinks Proxy api
api a
x