Created
October 1, 2022 15:44
-
-
Save jship/d2237fad40cfb34166d82597735fbacf to your computer and use it in GitHub Desktop.
Example showing how to get links from a generic record-style servant API
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
{-# LANGUAGE DataKinds #-} | |
{-# LANGUAGE DerivingStrategies #-} | |
module Scratch where | |
import Data.Proxy (Proxy(..)) | |
import Servant.API ((:<|>)(..), (:>), Capture, DeleteNoContent, Get, JSON, Link, ReqBody, PutNoContent) | |
import Servant.API.Generic (GenericMode((:-)), Generic, ToServantApi, genericApi) | |
import Servant.Links (allLinks) | |
type FooAPI = ToServantApi FooRoutes | |
theFooAPI :: Proxy FooAPI | |
theFooAPI = genericApi $ Proxy @FooRoutes | |
data FooRoutes route = FooRoutes | |
{ bar :: route :- "bar" :> FooBarAPI | |
, baz :: route :- "baz" :> FooBazAPI | |
} deriving stock (Generic) | |
type FooBarAPI = ToServantApi FooBarRoutes | |
theFooBarAPI :: Proxy FooBarAPI | |
theFooBarAPI = genericApi $ Proxy @FooBarRoutes | |
data FooBarRoutes route = FooBarRoutes | |
{ getBar :: route :- Capture "barId" String :> Get '[JSON] Int | |
, updateBar :: route :- Capture "barId" String :> ReqBody '[JSON] Int :> PutNoContent | |
, deleteBar :: route :- Capture "barId" String :> DeleteNoContent | |
} deriving stock (Generic) | |
type FooBazAPI = ToServantApi FooBazRoutes | |
theFooBazAPI :: Proxy FooBazAPI | |
theFooBazAPI = genericApi $ Proxy @FooBazRoutes | |
data FooBazRoutes route = FooBazRoutes | |
{ getBaz :: route :- Capture "bazId" String :> Get '[JSON] Int | |
, deleteBaz :: route :- Capture "bazId" String :> DeleteNoContent | |
} deriving stock (Generic) | |
-- To be explicit, can include the type signatures. Or can just full-YOLO and | |
-- disable warnings about missing top-level signatures via | |
-- {-# OPTIONS_GHC -Wno-missing-signatures #-} | |
barLinks :: (String -> Link) :<|> (String -> Link) :<|> (String -> Link) | |
getBarLink :: String -> Link | |
updateBarLink :: String -> Link | |
deleteBarLink :: String -> Link | |
bazLinks :: (String -> Link) :<|> (String -> Link) | |
getBazLink :: String -> Link | |
deleteBazLink :: String -> Link | |
getBarLink :<|> updateBarLink :<|> deleteBarLink = barLinks | |
getBazLink :<|> deleteBazLink = bazLinks | |
barLinks :<|> bazLinks = allLinks theFooAPI |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment