{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE OverloadedStrings #-}

module Servant.Hateoas.Resource
(
  -- * ResourceLink
  ResourceLink(..),

  -- * Resource
  -- ** MkResource
  MkResource,

  -- ** Base Class
  Resource(..),
  addSelfRel,

  -- ** Specialized classes
  EmbeddingResource(..),
  CollectingResource(..),

  -- * Creation
  ToResource(..)
) where

import Servant
import Servant.Hateoas.RelationLink
import Data.Kind
import Data.Aeson

-- | Type family computing the Resource-Type belonging to this Content-Type.
type family MkResource ct :: (Type -> Type)

-- | Type for Hypermedia-Links.
--
data ResourceLink =
    CompleteLink Link               -- ^ A complete 'Link' with all information.
  | TemplateLink RelationLink       -- ^ A 'RelationLink' that can be used as a template for URIs.
  deriving (Int -> ResourceLink -> ShowS
[ResourceLink] -> ShowS
ResourceLink -> String
(Int -> ResourceLink -> ShowS)
-> (ResourceLink -> String)
-> ([ResourceLink] -> ShowS)
-> Show ResourceLink
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ResourceLink -> ShowS
showsPrec :: Int -> ResourceLink -> ShowS
$cshow :: ResourceLink -> String
show :: ResourceLink -> String
$cshowList :: [ResourceLink] -> ShowS
showList :: [ResourceLink] -> ShowS
Show)

instance ToJSON ResourceLink where
  toJSON :: ResourceLink -> Value
toJSON (CompleteLink Link
l) = let uri :: URI
uri = Link -> URI
linkURI Link
l in URI -> Value
forall a. ToJSON a => a -> Value
toJSON (URI -> Value) -> URI -> Value
forall a b. (a -> b) -> a -> b
$ URI
uri { uriPath = "/" <> uriPath uri }
  toJSON (TemplateLink RelationLink
l) = RelationLink -> Value
forall a. ToJSON a => a -> Value
toJSON (RelationLink -> Value) -> RelationLink -> Value
forall a b. (a -> b) -> a -> b
$ RelationLink
l { _path = "/" <> _path l }

-- | Class for resources that carry Hypermedia-Relations.
class Resource res where
  -- | Wrap a value into a 'Resource'.
  wrap :: a -> res a

  -- | Add a hypermedia relation @(rel, link)@ to a 'Resource'.
  addRel :: (String, ResourceLink) -> res a -> res a

-- | Add the self-relation to a 'Resource'.
addSelfRel :: Resource res => ResourceLink -> res a -> res a
addSelfRel :: forall (res :: * -> *) a.
Resource res =>
ResourceLink -> res a -> res a
addSelfRel ResourceLink
l = (String, ResourceLink) -> res a -> res a
forall a. (String, ResourceLink) -> res a -> res a
forall (res :: * -> *) a.
Resource res =>
(String, ResourceLink) -> res a -> res a
addRel (String
"self", ResourceLink
l)

-- | 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 e => (String, res e) -> 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.
--
-- The default implementation wraps the value into a 'Resource' without adding any further information.
-- Therefore you can derive an instance for this class.
class ToResource res a where
  -- | Describes how a value @a@ can be converted to a 'Resource'.
  toResource :: Proxy res -> a -> res a
  default toResource :: Resource res => Proxy res -> a -> res a
  toResource Proxy res
_ = a -> res a
forall a. a -> res a
forall (res :: * -> *) a. Resource res => a -> res a
wrap

instance Resource res => ToResource res [a]