servant/servant-server/example/greet.hs

104 lines
2.9 KiB
Haskell
Raw Normal View History

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
import Prelude ()
import Prelude.Compat
import Data.Aeson
import Data.Proxy
import Data.Text
import GHC.Generics
import Network.Wai
import Network.Wai.Handler.Warp
import Servant
import Servant.Server.Generic ()
2014-12-10 16:10:57 +01:00
-- * Example
-- | A greet message data type
2015-01-13 20:40:41 +01:00
newtype Greet = Greet { _msg :: Text }
2014-12-10 16:10:57 +01:00
deriving (Generic, Show)
instance FromJSON Greet
instance ToJSON Greet
-- API specification
type TestApi' =
2014-12-10 16:10:57 +01:00
-- GET /hello/:name?capital={true, false} returns a Greet as JSON
2015-01-13 20:40:41 +01:00
"hello" :> Capture "name" Text :> QueryParam "capital" Bool :> Get '[JSON] Greet
2014-12-10 16:10:57 +01:00
-- POST /greet with a Greet as JSON in the request body,
-- returns a Greet as JSON
2015-01-13 20:40:41 +01:00
:<|> "greet" :> ReqBody '[JSON] Greet :> Post '[JSON] Greet
2014-12-10 16:10:57 +01:00
-- DELETE /greet/:greetid
:<|> "greet" :> Capture "greetid" Text :> Delete '[JSON] NoContent
2014-12-10 16:10:57 +01:00
:<|> NamedRoutes OtherRoutes
type TestApi =
TestApi'
:<|> "redirect" :> Capture "redirectValue" Int :> RedirectOf TestApi'
data OtherRoutes mode = OtherRoutes
{ version :: mode :- Get '[JSON] Int
, bye :: mode :- "bye" :> Capture "name" Text :> Get '[JSON] Text
}
deriving Generic
2014-12-10 16:10:57 +01:00
testApi :: Proxy TestApi
testApi = Proxy
-- Server-side handlers.
--
-- There's one handler per endpoint, which, just like in the type
-- that represents the API, are glued together using :<|>.
--
-- Each handler runs in the 'Handler' monad.
2014-12-10 16:10:57 +01:00
server :: Server TestApi
server = (helloH :<|> postGreetH :<|> deleteGreetH :<|> otherRoutes) :<|> redirect
where otherRoutes = OtherRoutes {..}
bye name = pure $ "Bye, " <> name <> " !"
version = pure 42
2014-12-10 16:10:57 +01:00
helloH name Nothing = helloH name (Just False)
2014-12-10 16:10:57 +01:00
helloH name (Just False) = return . Greet $ "Hello, " <> name
helloH name (Just True) = return . Greet . toUpper $ "Hello, " <> name
postGreetH greet = return greet
deleteGreetH _ = return NoContent
2014-12-10 16:10:57 +01:00
redirect 42 = pure $
RedirectOf (Proxy @("hello" :> Capture "name" Text :> QueryParam "capital" Bool :> Get '[JSON] Greet))
(\buildPath -> buildPath "Nicolas" (Just True))
-- Fail in any other case
redirect _ = throwError err500
2014-12-10 16:10:57 +01:00
-- Turn the server into a WAI app. 'serve' is provided by servant,
-- more precisely by the Servant.Server module.
test :: Application
test = serve testApi server
2014-12-10 16:10:57 +01:00
-- Run the server.
--
-- 'run' comes from Network.Wai.Handler.Warp
runTestServer :: Port -> IO ()
runTestServer port = run port test
-- Put this all to work!
main :: IO ()
main = runTestServer 8001