efbe6fd · typeable/servant

809 Capture "userid" Int :> Get '[JSON] User

810

811 :<|> -- delete the user with given userid. empty response

812− Capture "userid" Int :> Delete '[] ()

812+ Capture "userid" Int :> DeleteNoContent '[JSON] NoContent

813```

814

815We can instead factor out the `userid`:

817``` haskell

818type UserAPI4 = Capture "userid" Int :>

819 ( Get '[JSON] User

820− :<|> Delete '[] ()

820+ :<|> DeleteNoContent '[JSON] NoContent

821 )

822```

823

826

827``` haskell ignore

828Server UserAPI3 = (Int -> Handler User)

829− :<|> (Int -> Handler ())

829+ :<|> (Int -> Handler NoContent)

830

831Server UserAPI4 = Int -> ( Handler User

832− :<|> Handler ()

832+ :<|> Handler NoContent

833 )

834```

835

844 where getUser :: Int -> Handler User

845 getUser _userid = error "..."

846

847− deleteUser :: Int -> Handler ()

847+ deleteUser :: Int -> Handler NoContent

848 deleteUser _userid = error "..."

849

850-- notice how getUser and deleteUser

856 where getUser :: Int -> Handler User

857 getUser = error "..."

858

859− deleteUser :: Int -> Handler ()

859+ deleteUser :: Int -> Handler NoContent

860 deleteUser = error "..."

861```

862

875-- we factor out the Request Body

876type API2 = ReqBody '[JSON] User :>

877 ( Get '[JSON] User -- just display the same user back, don't register it

878− :<|> Post '[JSON] () -- register the user. empty response

878+ :<|> PostNoContent '[JSON] NoContent -- register the user. empty response

879 )

880

881-- we factor out a Header

882type API3 = Header "Authorization" Token :>

883 ( Get '[JSON] SecretData -- get some secret data, if authorized

884− :<|> ReqBody '[JSON] SecretData :> Post '[] () -- add some secret data, if authorized

884+ :<|> ReqBody '[JSON] SecretData :> PostNoContent '[JSON] NoContent -- add some secret data, if authorized

885 )

886

887newtype Token = Token ByteString

894``` haskell

895type UsersAPI =

896 Get '[JSON] [User] -- list users

897− :<|> ReqBody '[JSON] User :> Post '[] () -- add a user

897+ :<|> ReqBody '[JSON] User :> PostNoContent '[JSON] NoContent -- add a user

898 :<|> Capture "userid" Int :>

899 ( Get '[JSON] User -- view a user

900− :<|> ReqBody '[JSON] User :> Put '[] () -- update a user

900+ :<|> ReqBody '[JSON] User :> PutNoContent '[JSON] NoContent -- update a user

901− :<|> Delete '[] () -- delete a user

901+ :<|> DeleteNoContent '[JSON] NoContent -- delete a user

902 )

903

904usersServer :: Server UsersAPI

907 where getUsers :: Handler [User]

908 getUsers = error "..."

909

910− newUser :: User -> Handler ()

910+ newUser :: User -> Handler NoContent

911 newUser = error "..."

912

913 userOperations userid =

917 viewUser :: Int -> Handler User

918 viewUser = error "..."

919

920− updateUser :: Int -> User -> Handler ()

920+ updateUser :: Int -> User -> Handler NoContent

921 updateUser = error "..."

922

923− deleteUser :: Int -> Handler ()

923+ deleteUser :: Int -> Handler NoContent

924 deleteUser = error "..."

925```

926

927``` haskell

928type ProductsAPI =

929 Get '[JSON] [Product] -- list products

930− :<|> ReqBody '[JSON] Product :> Post '[] () -- add a product

930+ :<|> ReqBody '[JSON] Product :> PostNoContent '[JSON] NoContent -- add a product

931 :<|> Capture "productid" Int :>

932 ( Get '[JSON] Product -- view a product

933− :<|> ReqBody '[JSON] Product :> Put '[] () -- update a product

933+ :<|> ReqBody '[JSON] Product :> PutNoContent '[JSON] NoContent -- update a product

934− :<|> Delete '[] () -- delete a product

934+ :<|> DeleteNoContent '[JSON] NoContent -- delete a product

935 )

936

937data Product = Product { productId :: Int }

942 where getProducts :: Handler [Product]

943 getProducts = error "..."

944

945− newProduct :: Product -> Handler ()

945+ newProduct :: Product -> Handler NoContent

946 newProduct = error "..."

947

948 productOperations productid =

952 viewProduct :: Int -> Handler Product

953 viewProduct = error "..."

954

955− updateProduct :: Int -> Product -> Handler ()

955+ updateProduct :: Int -> Product -> Handler NoContent

956 updateProduct = error "..."

957

958− deleteProduct :: Int -> Handler ()

958+ deleteProduct :: Int -> Handler NoContent

959 deleteProduct = error "..."

960```

961

975-- indexed by values of type 'i'

976type APIFor a i =

977 Get '[JSON] [a] -- list 'a's

978− :<|> ReqBody '[JSON] a :> Post '[] () -- add an 'a'

978+ :<|> ReqBody '[JSON] a :> PostNoContent '[JSON] NoContent -- add an 'a'

979 :<|> Capture "id" i :>

980 ( Get '[JSON] a -- view an 'a' given its "identifier" of type 'i'

981− :<|> ReqBody '[JSON] a :> Put '[] () -- update an 'a'

981+ :<|> ReqBody '[JSON] a :> PutNoContent '[JSON] NoContent -- update an 'a'

982− :<|> Delete '[] () -- delete an 'a'

982+ :<|> DeleteNoContent '[JSON] NoContent -- delete an 'a'

983 )

984

985-- Build the appropriate 'Server'

986-- given the handlers of the right type.

987serverFor :: Handler [a] -- handler for listing of 'a's

988− -> (a -> Handler ()) -- handler for adding an 'a'

988+ -> (a -> Handler NoContent) -- handler for adding an 'a'

989 -> (i -> Handler a) -- handler for viewing an 'a' given its identifier of type 'i'

990− -> (i -> a -> Handler ()) -- updating an 'a' with given id

990+ -> (i -> a -> Handler NoContent) -- updating an 'a' with given id

991− -> (i -> Handler ()) -- deleting an 'a' given its id

991+ -> (i -> Handler NoContent) -- deleting an 'a' given its id

992 -> Server (APIFor a i)

993serverFor = error "..."

994-- implementation left as an exercise. contact us on IRC