servant-hateoas 0.1.1 → 0.2.0

raw patch · 8 files changed

+177/−35 lines, 8 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +10/−0
• README.md +23/−16
• servant-hateoas.cabal +4/−1
• src/Servant/Hateoas.hs +4/−2
• src/Servant/Hateoas/ContentType/Collection.hs +81/−0
• src/Servant/Hateoas/ContentType/HAL.hs +12/−6
• src/Servant/Hateoas/Example.hs +1/−1
• src/Servant/Hateoas/Resource.hs +42/−9

@@ -6,6 +6,16 @@ The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/), and this project adheres to [PVP versioning](https://pvp.haskell.org/). +## v0.2.0 _(2024-10-29)_++### Added+- Support for Content-Type `application/collection+json`+- Classes `EmbeddingResource res` & `CollectingResource res` for resource-modification++### Changed++- *(breaking change)* Renamed class `HasResource` to `Resource`, removed associated type and Content-Type param+ ## v0.1.1 _(2024-10-25)_  ### Changed

@@ -12,10 +12,11 @@ Final goal is something similar to what has been proposed [here](https://www.servant.dev/extending.html#other-directions).  ## What can we do already?-Define an instance for class `ToResource ct api a` where `ct` is the Content-Type, `a` is the datatype you want to have a resty Api for and-`api` is the type of your Servant-Api within which the resty representation of your datatype `a` lives.+Define an instance for class `ToResource api res a` where `api` is the type of your Servant-Api within which the resty representation+of your datatype `a` lives and `res` is the resource-representation to create. -When providing some extra information with an instance for `Related a` we can derive related links.+When providing some extra information with an instance for `Related a` there are stock instances which derive the links+based on the relations in your instance. ## Example ```haskell data User = User { usrId :: Int, addressId :: Int, income :: Double }@@ -33,43 +34,49 @@  type UserApi = UserGetOne :<|> UserGetAll type UserGetOne = "user" :> Capture "id" Int :> Get '[HAL JSON] (HALResource User)-type UserGetAll = "user" :> Get '[HAL JSON] (HALResource [User])+type UserGetAll = "user" :> Get '[Collection JSON] (CollectionResource User)  instance Related User where-  type IdSelName User      = "usrId"              -- This is type-safe because of using class HasField-  type GetOneApi User      = UserGetOne+  type IdSelName User = "usrId"+  type GetOneApi User = UserGetOne   type CollectionName User = "users"-  type Relations User      =-    '[ 'HRel "address" "addressId" AddressGetOne  -- Also type-safe+  type Relations User =+    '[ 'HRel "address" "addressId" AddressGetOne      ]+ ``` ```haskell->>> mimeRender (Proxy @JSON) $ toResource (Proxy @(HAL JSON)) (Proxy @CompleteApi) $ User 1 100 100000+>>> mimeRender (Proxy @(HAL JSON)) $ toResource @CompleteApi @HALResource $ User 1 42 100000 ``` ```json {   "_links": {     "address": {-      "href": "address/100"+      "href": "address/42"     },     "self": {       "href": "user/1"     }   },-  "addressId": 100,+  "addressId": 42,   "income": 100000,   "usrId": 1 } ```  ## Goals-- [x] Deriving links where possible+- [x] Deriving simple links for self and relations - [ ] Deriving links for paging, ... - [ ] Type-level rewriting of APIs like `CompleteAPI` to make API HATEOAS-compliant  ## Media-Types-Currently we only serve Content-Type `application/hal+json`.-Support for others such as `application/vnd.collection+json` or `application/vnd.amundsen-uber+json` can easily be added-with instances for `Accept` and `MimeRender`.+- [x] `application/hal+json`+- [x] `application/collection+json`+- [ ] Others: Easily extensible -Client usage with `MimeUnrender` is not yet supported but easily extensible.+Client usage with `MimeUnrender` is not yet supported.++## Contact information+Contributions, critics and bug reports are welcome!++Please feel free to contact me through GitHub.

@@ -1,11 +1,13 @@ cabal-version:           3.0 name:                    servant-hateoas-version:                 0.1.1+version:                 0.2.0 synopsis:                HATEOAS extension for servant description:             Create Resource-Representations for your types and make your API HATEOAS-compliant.   Resource construction is generic where possible and manually adjustable where required.   Currently HAL+JSON is the only supported Content-Type, work for more is in progress.   The ultimate goal is to generate an entirely HATEOAS-compliant API generically.+homepage:                https://github.com/bruderj15/servant-hateoas+bug-reports:             https://github.com/bruderj15/servant-hateoas/issues license:                 BSD-3-Clause license-file:            LICENSE author:                  Julian Bruder@@ -29,6 +31,7 @@                        , Servant.Hateoas.Some                        , Servant.Hateoas.Resource                        , Servant.Hateoas.ContentType.HAL+                       , Servant.Hateoas.ContentType.Collection      other-modules:       Servant.Hateoas.Example 

@@ -1,9 +1,11 @@ module Servant.Hateoas-( module Servant.Hateoas.ContentType.HAL+( module Servant.Hateoas.ContentType.Collection+, module Servant.Hateoas.ContentType.HAL , module Servant.Hateoas.Resource , module Servant.Hateoas.Some ) where -import Servant.Hateoas.ContentType.HAL+import Servant.Hateoas.ContentType.Collection (Collection, CollectionResource)+import Servant.Hateoas.ContentType.HAL (HAL, HALResource) import Servant.Hateoas.Resource import Servant.Hateoas.Some

@@ -0,0 +1,81 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE ViewPatterns #-}++module Servant.Hateoas.ContentType.Collection+( Collection+, CollectionResource(..)+)+where++import Servant.Hateoas.Resource+import Servant.API.ContentTypes+import qualified Network.HTTP.Media as M+import Servant.Links+import qualified Data.Foldable as Foldable+import Data.Kind+import Data.Aeson+import Data.Proxy+import GHC.Exts+import GHC.Records+import GHC.Generics++-- | Data-Kind representing Content-Types of HATEOAS collections.+--+-- Type parameter @t@ is the Mime-Type suffix in @application/vnd.collection+t@.+data Collection (t :: Type)++-- | Resource wrapper for 'Collection'.+data CollectionResource a = CollectionResource+  { href  :: Maybe Link+  , items :: [CollectionItem a]+  , links :: [(String, Link)]+  } deriving (Show, Generic)++-- | A single item inside a 'CollectionResource'.+data CollectionItem a = CollectionItem+  { item :: a+  , itemLinks :: [(String, Link)]+  } deriving (Show, Generic)++instance Resource CollectionResource where+  addLink l (CollectionResource h r ls) = CollectionResource h r (l:ls)++instance Resource CollectionItem where+  addLink l (CollectionItem i ls) = CollectionItem i (l:ls)++instance Accept (Collection JSON) where+  contentType _ = "application" M.// "vnd.collection+json"++instance ToJSON a => MimeRender (Collection JSON) (CollectionResource a) where+  mimeRender _ = encode++collectionLinks :: [(String, Link)] -> Value+collectionLinks = Array . Foldable.foldl' (\xs (rel, l) -> pure (object ["name" .= rel, "value" .= linkURI l]) <> xs) mempty++instance ToJSON a => ToJSON (CollectionItem a) where+  toJSON (CollectionItem (toJSON -> Object m) ls) = object ["data" .= itemData, "links" .= collectionLinks ls]+    where+      itemData = Array $ Foldable.foldl' (\xs (k, v) -> pure (object ["name" .= k, "value" .= v]) <> xs) mempty $ toList m+  toJSON (CollectionItem (toJSON -> v) _) = v++instance {-# OVERLAPPABLE #-} ToJSON a => ToJSON (CollectionResource a) where+  toJSON (CollectionResource mHref is ls) = object ["collection" .= collection]+    where+      collection = object $ ["version" .= ("1.0" :: String), "links" .= collectionLinks ls, "items" .= is'] <> maybe [] (pure . ("href" .=) . linkURI) mHref+      is' = Array $ Foldable.foldl' (\xs i -> pure (toJSON i) <> xs) mempty is++instance CollectingResource CollectionResource where+  collect i (CollectionResource mHref is ls) = CollectionResource mHref (CollectionItem i mempty : is) ls++instance {-# OVERLAPPABLE #-}+  ( 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+  , Resource CollectionResource+  )+  => ToCollection api CollectionResource a where+  toCollection is = CollectionResource Nothing is' mempty+    where+      is' = Foldable.foldl' (\xs x -> CollectionItem x (defaultLinks (Proxy @api) x) : xs) mempty is

@@ -35,12 +35,15 @@   , embedded :: [(String, SomeToJSON HALResource)]   } deriving (Generic) -instance HasResource (HAL t) where-  type Resource (HAL t) = HALResource+instance Resource HALResource where+  addLink l (HALResource r ls es) = HALResource r (l:ls) es  instance Accept (HAL JSON) where   contentType _ = "application" M.// "hal+json" +instance ToJSON a => MimeRender (HAL JSON) (HALResource a) where+  mimeRender _ = encode+ instance {-# OVERLAPPABLE #-} ToJSON a => ToJSON (HALResource a) where   toJSON (HALResource res ls es) = case toJSON res of     Object kvm -> Object $ (singleton "_links" ls') <> (singleton "_embedded" es') <> kvm@@ -49,7 +52,7 @@       ls' = object [fromString rel .= object ["href" .= linkURI href] | (rel, href) <- ls]       es' = object [fromString name .= toJSON e | (name, e) <- es] -instance {-# OVERLAPPING #-} (ToJSON a, Related a, KnownSymbol (CollectionName a)) => ToJSON ([HALResource a]) where+instance {-# OVERLAPPING #-} (ToJSON a, Related a, KnownSymbol (CollectionName a)) => ToJSON [HALResource a] where   toJSON xs = object ["_links" .= (mempty :: Object), "_embedded" .= es]     where       es = object $@@ -57,10 +60,13 @@         .= (Array $ Foldable.foldl' (\xs' x -> xs' <> pure (toJSON x)) mempty xs)         ] +instance EmbeddingResource HALResource where+  embed e (HALResource r ls es) = HALResource r ls $ fmap SomeToJSON e : es+ instance {-# OVERLAPPABLE #-}   ( 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-  , HasResource (HAL t)-  ) => ToResource (HAL t) api a where-  toResource _ api x = HALResource x (defaultLinks api x) mempty+  , Resource HALResource+  ) => ToResource api HALResource a where+  toResource x = HALResource x (defaultLinks (Proxy @api) x) mempty

@@ -23,7 +23,7 @@  type UserApi = UserGetOne :<|> UserGetAll type UserGetOne = "user" :> Capture "id" Int :> Get '[HAL JSON] (HALResource User)-type UserGetAll = "user" :> Get '[HAL JSON] (HALResource [User])+type UserGetAll = "user" :> Get '[Collection JSON] (CollectionResource User)  instance Related User where   type IdSelName User = "usrId"

@@ -1,11 +1,16 @@ {-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE AllowAmbiguousTypes #-}  module Servant.Hateoas.Resource (   -- * Resource-  HasResource(..)-, ToResource(..)+  -- ** Construction+  ToResource(..)+, ToCollection(..) +  -- ** Modification+, Resource(..), EmbeddingResource(..), CollectingResource(..)+ -- * Hypermedia-Relations -- ** Type , HRel(..)@@ -21,19 +26,47 @@  import Servant import Data.Kind+import Data.Aeson 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 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 HasResource ct => ToResource ct api a where+class ToResource api res a where   -- | Converts a value into it's Resource-Representation.-  toResource :: Proxy ct -> Proxy api -> a -> Resource ct a+  toResource :: a -> res a+  toResource = toResource' (Proxy @api) (Proxy @res) +  -- | Like 'toResource' but takes proxies for ambiguity.+  toResource' :: Proxy api -> Proxy res -> a -> res a+  toResource' _ _ = 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 = toCollection' (Proxy @api) (Proxy @res)++  -- | Like 'toCollection' but takes proxies for ambiguity.+  toCollection' :: Foldable f => Proxy api -> Proxy res -> f a -> res a+  toCollection' _ _ = toCollection @api @res+  {-# MINIMAL toCollection | toCollection' #-}+ -- | Data-Kind for Hypermedia-Relations. data HRel = HRel   { relName  :: Symbol       -- ^ Name of the relation@@ -78,7 +111,7 @@ relatedLinks :: forall api a. (Related a, BuildRels api (Relations a) a) => Proxy api -> a -> [(String, Link)] relatedLinks = buildRels (Proxy @(Relations a)) --- | Generates the pair (\"self\", link) where @link@ is the 'Link' to @a@ itself.+-- | 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)