{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE AllowAmbiguousTypes #-}

module Servant.Hateoas.Resource
(
  -- * Resource
  -- ** Construction
  ToResource(..)
, ToCollection(..)

  -- ** Modification
, Resource(..), EmbeddingResource(..), CollectingResource(..)

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

-- ** Class
, Related(..)

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

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

-- | Class for resources that carry Hypermedia-Relations.
class Resource res where
  -- | Add a relation @(rel, link)@ to a resource.
  addLink :: (String, Link) -> res a -> res a

-- | Class for 'Resource's that can embed other resources.
class Resource res => EmbeddingResource res where
  -- | Embed a resource @b@ with its relation @rel@ as tuple @(rel, b)@.
  embed :: ToJSON b => (String, b) -> res a -> res a

-- | Class for 'Resource's that can collect multiple resources.
class Resource res => CollectingResource res where
  -- | Collect a resource into the collection.
  collect :: a -> res a -> res a

-- | Class for converting values of @a@ to their respective Resource-Representation.
class ToResource api res a where
  -- | Converts a value into it's Resource-Representation.
  toResource :: a -> res a
  toResource = Proxy api -> Proxy res -> a -> res a
forall {k} (api :: k) (res :: * -> *) a.
ToResource api res a =>
Proxy api -> Proxy res -> a -> res a
toResource' (forall (t :: k). Proxy t
forall {k} (t :: k). Proxy t
Proxy @api) (forall {k} (t :: k). Proxy t
forall (t :: * -> *). Proxy t
Proxy @res)

  -- | Like 'toResource' but takes proxies for ambiguity.
  toResource' :: Proxy api -> Proxy res -> a -> res a
  toResource' Proxy api
_ Proxy res
_ = forall (api :: k) (res :: * -> *) a.
ToResource api res a =>
a -> res a
forall {k} (api :: k) (res :: * -> *) a.
ToResource api res a =>
a -> res a
toResource @api @res
  {-# MINIMAL toResource | toResource' #-}

-- | Class for converting multiple values of @a@ to their respective collection-like representation.
class ToCollection api res a where
  -- | Converts many values into their Collection-Representation.
  toCollection :: Foldable f => f a -> res a
  toCollection = Proxy api -> Proxy res -> f a -> res a
forall {k} (api :: k) (res :: * -> *) a (f :: * -> *).
(ToCollection api res a, Foldable f) =>
Proxy api -> Proxy res -> f a -> res a
forall (f :: * -> *).
Foldable f =>
Proxy api -> Proxy res -> f a -> res a
toCollection' (forall (t :: k). Proxy t
forall {k} (t :: k). Proxy t
Proxy @api) (forall {k} (t :: k). Proxy t
forall (t :: * -> *). Proxy t
Proxy @res)

  -- | Like 'toCollection' but takes proxies for ambiguity.
  toCollection' :: Foldable f => Proxy api -> Proxy res -> f a -> res a
  toCollection' Proxy api
_ Proxy res
_ = forall (api :: k) (res :: * -> *) a (f :: * -> *).
(ToCollection api res a, Foldable f) =>
f a -> res a
forall {k} (api :: k) (res :: * -> *) a (f :: * -> *).
(ToCollection api res a, Foldable f) =>
f a -> res a
toCollection @api @res
  {-# MINIMAL toCollection | toCollection' #-}

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