{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DerivingStrategies #-}

module Servant.Hateoas.Example where

import Servant.Hateoas
import Servant
import Data.Aeson
import GHC.Generics

data User = User { User -> Int
usrId :: Int, User -> Int
addressId :: Int, User -> Double
income :: Double }
  deriving stock ((forall x. User -> Rep User x)
-> (forall x. Rep User x -> User) -> Generic User
forall x. Rep User x -> User
forall x. User -> Rep User x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. User -> Rep User x
from :: forall x. User -> Rep User x
$cto :: forall x. Rep User x -> User
to :: forall x. Rep User x -> User
Generic, Int -> User -> ShowS
[User] -> ShowS
User -> String
(Int -> User -> ShowS)
-> (User -> String) -> ([User] -> ShowS) -> Show User
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> User -> ShowS
showsPrec :: Int -> User -> ShowS
$cshow :: User -> String
show :: User -> String
$cshowList :: [User] -> ShowS
showList :: [User] -> ShowS
Show, User -> User -> Bool
(User -> User -> Bool) -> (User -> User -> Bool) -> Eq User
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: User -> User -> Bool
== :: User -> User -> Bool
$c/= :: User -> User -> Bool
/= :: User -> User -> Bool
Eq, Eq User
Eq User =>
(User -> User -> Ordering)
-> (User -> User -> Bool)
-> (User -> User -> Bool)
-> (User -> User -> Bool)
-> (User -> User -> Bool)
-> (User -> User -> User)
-> (User -> User -> User)
-> Ord User
User -> User -> Bool
User -> User -> Ordering
User -> User -> User
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: User -> User -> Ordering
compare :: User -> User -> Ordering
$c< :: User -> User -> Bool
< :: User -> User -> Bool
$c<= :: User -> User -> Bool
<= :: User -> User -> Bool
$c> :: User -> User -> Bool
> :: User -> User -> Bool
$c>= :: User -> User -> Bool
>= :: User -> User -> Bool
$cmax :: User -> User -> User
max :: User -> User -> User
$cmin :: User -> User -> User
min :: User -> User -> User
Ord)
  deriving anyclass ([User] -> Value
[User] -> Encoding
User -> Bool
User -> Value
User -> Encoding
(User -> Value)
-> (User -> Encoding)
-> ([User] -> Value)
-> ([User] -> Encoding)
-> (User -> Bool)
-> ToJSON User
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: User -> Value
toJSON :: User -> Value
$ctoEncoding :: User -> Encoding
toEncoding :: User -> Encoding
$ctoJSONList :: [User] -> Value
toJSONList :: [User] -> Value
$ctoEncodingList :: [User] -> Encoding
toEncodingList :: [User] -> Encoding
$comitField :: User -> Bool
omitField :: User -> Bool
ToJSON)

data Address = Address { Address -> Int
addrId :: Int, Address -> String
street :: String, Address -> String
city :: String }
  deriving stock ((forall x. Address -> Rep Address x)
-> (forall x. Rep Address x -> Address) -> Generic Address
forall x. Rep Address x -> Address
forall x. Address -> Rep Address x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Address -> Rep Address x
from :: forall x. Address -> Rep Address x
$cto :: forall x. Rep Address x -> Address
to :: forall x. Rep Address x -> Address
Generic, Int -> Address -> ShowS
[Address] -> ShowS
Address -> String
(Int -> Address -> ShowS)
-> (Address -> String) -> ([Address] -> ShowS) -> Show Address
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Address -> ShowS
showsPrec :: Int -> Address -> ShowS
$cshow :: Address -> String
show :: Address -> String
$cshowList :: [Address] -> ShowS
showList :: [Address] -> ShowS
Show, Address -> Address -> Bool
(Address -> Address -> Bool)
-> (Address -> Address -> Bool) -> Eq Address
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Address -> Address -> Bool
== :: Address -> Address -> Bool
$c/= :: Address -> Address -> Bool
/= :: Address -> Address -> Bool
Eq, Eq Address
Eq Address =>
(Address -> Address -> Ordering)
-> (Address -> Address -> Bool)
-> (Address -> Address -> Bool)
-> (Address -> Address -> Bool)
-> (Address -> Address -> Bool)
-> (Address -> Address -> Address)
-> (Address -> Address -> Address)
-> Ord Address
Address -> Address -> Bool
Address -> Address -> Ordering
Address -> Address -> Address
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Address -> Address -> Ordering
compare :: Address -> Address -> Ordering
$c< :: Address -> Address -> Bool
< :: Address -> Address -> Bool
$c<= :: Address -> Address -> Bool
<= :: Address -> Address -> Bool
$c> :: Address -> Address -> Bool
> :: Address -> Address -> Bool
$c>= :: Address -> Address -> Bool
>= :: Address -> Address -> Bool
$cmax :: Address -> Address -> Address
max :: Address -> Address -> Address
$cmin :: Address -> Address -> Address
min :: Address -> Address -> Address
Ord)
  deriving anyclass ([Address] -> Value
[Address] -> Encoding
Address -> Bool
Address -> Value
Address -> Encoding
(Address -> Value)
-> (Address -> Encoding)
-> ([Address] -> Value)
-> ([Address] -> Encoding)
-> (Address -> Bool)
-> ToJSON Address
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: Address -> Value
toJSON :: Address -> Value
$ctoEncoding :: Address -> Encoding
toEncoding :: Address -> Encoding
$ctoJSONList :: [Address] -> Value
toJSONList :: [Address] -> Value
$ctoEncodingList :: [Address] -> Encoding
toEncodingList :: [Address] -> Encoding
$comitField :: Address -> Bool
omitField :: Address -> Bool
ToJSON, ToResource res)

instance Resource res => ToResource res User where
  toResource :: Proxy res -> User -> res User
toResource Proxy res
_ User
usr = (String, ResourceLink) -> res User -> res User
forall a. (String, ResourceLink) -> res a -> res a
forall (res :: * -> *) a.
Resource res =>
(String, ResourceLink) -> res a -> res a
addRel (String
"address", Link -> ResourceLink
CompleteLink (Link -> ResourceLink) -> Link -> ResourceLink
forall a b. (a -> b) -> a -> b
$ Int -> Link
mkAddrLink (Int -> Link) -> Int -> Link
forall a b. (a -> b) -> a -> b
$ User -> Int
addressId User
usr) (res User -> res User) -> res User -> res User
forall a b. (a -> b) -> a -> b
$ User -> res User
forall a. a -> res a
forall (res :: * -> *) a. Resource res => a -> res a
wrap User
usr
    where
      mkAddrLink :: MkLink
  ("api"
   :> ("address" :> (Capture' '[] "id" Int :> Get '[JSON] Address)))
  Link
mkAddrLink = Proxy
  ("api"
   :> ("address" :> (Capture' '[] "id" Int :> Get '[JSON] Address)))
-> Proxy
     ("api"
      :> ("address" :> (Capture' '[] "id" Int :> Get '[JSON] Address)))
-> MkLink
     ("api"
      :> ("address" :> (Capture' '[] "id" Int :> Get '[JSON] Address)))
     Link
forall endpoint api.
(IsElem endpoint api, HasLink endpoint) =>
Proxy api -> Proxy endpoint -> MkLink endpoint Link
safeLink (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @AddressGetOne) (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @AddressGetOne)

type Api = UserApi :<|> AddressApi

type UserApi = UserGetOne :<|> UserGetAll :<|> UserGetAllCool
type UserGetOne     = "api" :> "user" :> Capture "id" Int :> Get '[JSON] User
type UserGetAll     = "api" :> "user" :> Get '[JSON] [User]
type UserGetAllCool = "api" :> "user" :> "cool-guys" :> Get '[JSON] [User]

type AddressApi = AddressGetOne
type AddressGetOne = "api" :> "address" :> Capture "id" Int :> Get '[JSON] Address

instance HasHandler UserGetOne where
  getHandler :: forall (m :: * -> *).
MonadIO m =>
Proxy m
-> Proxy
     ("api" :> ("user" :> (Capture' '[] "id" Int :> Get '[JSON] User)))
-> ServerT
     ("api" :> ("user" :> (Capture' '[] "id" Int :> Get '[JSON] User)))
     m
getHandler Proxy m
_ Proxy
  ("api" :> ("user" :> (Capture' '[] "id" Int :> Get '[JSON] User)))
_ = \Int
uId -> User -> m User
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (User -> m User) -> User -> m User
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Double -> User
User Int
uId Int
1 Double
1000

instance HasHandler UserGetAll where
  getHandler :: forall (m :: * -> *).
MonadIO m =>
Proxy m -> Proxy UserGetAll -> ServerT UserGetAll m
getHandler Proxy m
_ Proxy UserGetAll
_ = [User] -> m [User]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return [Int -> Int -> Double -> User
User Int
1 Int
1 Double
1000, Int -> Int -> Double -> User
User Int
2 Int
2 Double
2000, Int -> Int -> Double -> User
User Int
42 Int
3 Double
3000]

instance HasHandler UserGetAllCool where
  getHandler :: forall (m :: * -> *).
MonadIO m =>
Proxy m -> Proxy UserGetAllCool -> ServerT UserGetAllCool m
getHandler Proxy m
_ Proxy UserGetAllCool
_ = [User] -> m [User]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return [Int -> Int -> Double -> User
User Int
42 Int
3 Double
3000]

instance HasHandler AddressGetOne where
  getHandler :: forall (m :: * -> *).
MonadIO m =>
Proxy m
-> Proxy
     ("api"
      :> ("address" :> (Capture' '[] "id" Int :> Get '[JSON] Address)))
-> ServerT
     ("api"
      :> ("address" :> (Capture' '[] "id" Int :> Get '[JSON] Address)))
     m
getHandler Proxy m
_ Proxy
  ("api"
   :> ("address" :> (Capture' '[] "id" Int :> Get '[JSON] Address)))
_ = \Int
aId -> Address -> m Address
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Address -> m Address) -> Address -> m Address
forall a b. (a -> b) -> a -> b
$ Int -> String -> String -> Address
Address Int
aId String
"Foo St" String
"BarBaz"

userApiServer :: Server UserApi
userApiServer :: Server UserApi
userApiServer = Proxy Handler -> Proxy UserApi -> Server UserApi
forall {k} (api :: k) (m :: * -> *).
(HasHandler api, MonadIO m) =>
Proxy m -> Proxy api -> ServerT api m
forall (m :: * -> *).
MonadIO m =>
Proxy m -> Proxy UserApi -> ServerT UserApi m
getHandler (forall {k} (t :: k). Proxy t
forall (t :: * -> *). Proxy t
Proxy @Handler) (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @UserApi)

layerServer :: Server (Resourcify (MkLayers Api) (HAL JSON))
layerServer :: Server (Resourcify (MkLayers Api) (HAL JSON))
layerServer = Proxy Handler
-> Proxy (HAL JSON)
-> Proxy
     '[ 'Layer
          '[Sym "api", Sym "address"]
          '[Capture' '[] "id" Int]
          GetIntermediate,
        'Layer
          '[Sym "api", Sym "user"]
          '[Capture' '[] "id" Int, Sym "cool-guys"]
          GetIntermediate,
        'Layer
          '[Sym "api"]
          '[Sym "user", Sym "user", Sym "address"]
          GetIntermediate,
        'Layer '[] '[Sym "api", Sym "api", Sym "api"] GetIntermediate]
-> ServerT
     (Resourcify
        '[ 'Layer
             '[Sym "api", Sym "address"]
             '[Capture' '[] "id" Int]
             GetIntermediate,
           'Layer
             '[Sym "api", Sym "user"]
             '[Capture' '[] "id" Int, Sym "cool-guys"]
             GetIntermediate,
           'Layer
             '[Sym "api"]
             '[Sym "user", Sym "user", Sym "address"]
             GetIntermediate,
           'Layer '[] '[Sym "api", Sym "api", Sym "api"] GetIntermediate]
        (HAL JSON))
     Handler
forall {k} (api :: k) (m :: * -> *) ct.
(HasResourceServer api m ct, MonadIO m) =>
Proxy m -> Proxy ct -> Proxy api -> ServerT (Resourcify api ct) m
getResourceServer (forall {k} (t :: k). Proxy t
forall (t :: * -> *). Proxy t
Proxy @Handler) (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(HAL JSON)) (forall (t :: [Layer]). Proxy t
forall {k} (t :: k). Proxy t
Proxy @(MkLayers Api))

layerApp :: Application
layerApp :: Application
layerApp = Proxy
  '[ 'Layer
       '[Sym "api", Sym "address"]
       '[Capture' '[] "id" Int]
       (Verb 'GET 200 '[HAL JSON] (HALResource Intermediate)),
     'Layer
       '[Sym "api", Sym "user"]
       '[Capture' '[] "id" Int, Sym "cool-guys"]
       (Verb 'GET 200 '[HAL JSON] (HALResource Intermediate)),
     'Layer
       '[Sym "api"]
       '[Sym "user", Sym "user", Sym "address"]
       (Verb 'GET 200 '[HAL JSON] (HALResource Intermediate)),
     'Layer
       '[]
       '[Sym "api", Sym "api", Sym "api"]
       (Verb 'GET 200 '[HAL JSON] (HALResource Intermediate))]
-> Server
     '[ 'Layer
          '[Sym "api", Sym "address"]
          '[Capture' '[] "id" Int]
          (Verb 'GET 200 '[HAL JSON] (HALResource Intermediate)),
        'Layer
          '[Sym "api", Sym "user"]
          '[Capture' '[] "id" Int, Sym "cool-guys"]
          (Verb 'GET 200 '[HAL JSON] (HALResource Intermediate)),
        'Layer
          '[Sym "api"]
          '[Sym "user", Sym "user", Sym "address"]
          (Verb 'GET 200 '[HAL JSON] (HALResource Intermediate)),
        'Layer
          '[]
          '[Sym "api", Sym "api", Sym "api"]
          (Verb 'GET 200 '[HAL JSON] (HALResource Intermediate))]
-> Application
forall {k} (api :: k).
HasServer api '[] =>
Proxy api -> Server api -> Application
serve (forall (t :: [Layer]). Proxy t
forall {k} (t :: k). Proxy t
Proxy @((Resourcify (MkLayers Api)) (HAL JSON))) Server
  '[ 'Layer
       '[Sym "api", Sym "address"]
       '[Capture' '[] "id" Int]
       (Verb 'GET 200 '[HAL JSON] (HALResource Intermediate)),
     'Layer
       '[Sym "api", Sym "user"]
       '[Capture' '[] "id" Int, Sym "cool-guys"]
       (Verb 'GET 200 '[HAL JSON] (HALResource Intermediate)),
     'Layer
       '[Sym "api"]
       '[Sym "user", Sym "user", Sym "address"]
       (Verb 'GET 200 '[HAL JSON] (HALResource Intermediate)),
     'Layer
       '[]
       '[Sym "api", Sym "api", Sym "api"]
       (Verb 'GET 200 '[HAL JSON] (HALResource Intermediate))]
Server (Resourcify (MkLayers Api) (HAL JSON))
layerServer

apiServer :: Server (Resourcify Api (HAL JSON))
apiServer :: Server (Resourcify Api (HAL JSON))
apiServer = Proxy Handler
-> Proxy (HAL JSON)
-> Proxy Api
-> Server (Resourcify Api (HAL JSON))
forall {k} (api :: k) (m :: * -> *) ct.
(HasResourceServer api m ct, MonadIO m) =>
Proxy m -> Proxy ct -> Proxy api -> ServerT (Resourcify api ct) m
getResourceServer (forall {k} (t :: k). Proxy t
forall (t :: * -> *). Proxy t
Proxy @Handler) (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(HAL JSON)) (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @Api)

apiApp :: Application
apiApp :: Application
apiApp = Proxy
  ((("api"
     :> ("user"
         :> (Capture' '[] "id" Int
             :> Verb 'GET 200 '[HAL JSON] (HALResource User))))
    :<|> (("api"
           :> ("user" :> Verb 'GET 200 '[HAL JSON] (HALResource [User])))
          :<|> ("api"
                :> ("user"
                    :> ("cool-guys"
                        :> Verb 'GET 200 '[HAL JSON] (HALResource [User]))))))
   :<|> ("api"
         :> ("address"
             :> (Capture' '[] "id" Int
                 :> Verb 'GET 200 '[HAL JSON] (HALResource Address)))))
-> Server
     ((("api"
        :> ("user"
            :> (Capture' '[] "id" Int
                :> Verb 'GET 200 '[HAL JSON] (HALResource User))))
       :<|> (("api"
              :> ("user" :> Verb 'GET 200 '[HAL JSON] (HALResource [User])))
             :<|> ("api"
                   :> ("user"
                       :> ("cool-guys"
                           :> Verb 'GET 200 '[HAL JSON] (HALResource [User]))))))
      :<|> ("api"
            :> ("address"
                :> (Capture' '[] "id" Int
                    :> Verb 'GET 200 '[HAL JSON] (HALResource Address)))))
-> Application
forall {k} (api :: k).
HasServer api '[] =>
Proxy api -> Server api -> Application
serve (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @((Resourcify Api) (HAL JSON))) Server
  ((("api"
     :> ("user"
         :> (Capture' '[] "id" Int
             :> Verb 'GET 200 '[HAL JSON] (HALResource User))))
    :<|> (("api"
           :> ("user" :> Verb 'GET 200 '[HAL JSON] (HALResource [User])))
          :<|> ("api"
                :> ("user"
                    :> ("cool-guys"
                        :> Verb 'GET 200 '[HAL JSON] (HALResource [User]))))))
   :<|> ("api"
         :> ("address"
             :> (Capture' '[] "id" Int
                 :> Verb 'GET 200 '[HAL JSON] (HALResource Address)))))
Server (Resourcify Api (HAL JSON))
apiServer