git.iko.soy/servant
on 4ebc494 help sign in
servant/example/greet.hs
96 lines 2.5 kB history raw
1{-# LANGUAGE DataKinds #-}
2{-# LANGUAGE PolyKinds #-}
3{-# LANGUAGE TypeFamilies #-}
4{-# LANGUAGE DeriveGeneric #-}
5{-# LANGUAGE TypeOperators #-}
6{-# LANGUAGE FlexibleInstances #-}
7{-# LANGUAGE OverloadedStrings #-}
8{-# OPTIONS_GHC -fno-warn-orphans #-}
10import Control.Concurrent (forkIO, killThread)
11import Control.Monad.Trans.Either
12import Data.Aeson
13import Data.Monoid
14import Data.Proxy
15import Data.Text
16import GHC.Generics
17import Network.URI
18import Network.Wai
19import Network.Wai.Handler.Warp
21import Servant.API
22import Servant.Client
23import Servant.Docs
24import Servant.Server
26-- * Example
28data Greet = Greet { _msg :: Text }
29 deriving (Generic, Show)
31instance FromJSON Greet
32instance ToJSON Greet
34instance ToCapture (Capture "name" Text) where
35 toCapture _ = DocCapture "name" "name of the person to greet"
37instance ToParam (GetParam "capital" Bool) where
38 toParam _ =
39 DocGetParam "capital"
40 ["true", "false"]
41 "Get the greeting message in uppercase (true) or not (false). Default is false."
43instance ToSample Greet where
44 toSample Proxy = Just (encode g)
46 where g = Greet "Hello, haskeller!"
48-- API specification
49type TestApi =
50 "hello" :> Capture "name" Text :> GetParam "capital" Bool :> Get Greet
51 :<|> "greet" :> RQBody Greet :> Post Greet
53testApi :: Proxy TestApi
54testApi = Proxy
56-- Server-side handlers
57server :: Server TestApi
58server = hello :<|> greet
60 where hello name Nothing = hello name (Just False)
61 hello name (Just False) = return . Greet $ "Hello, " <> name
62 hello name (Just True) = return . Greet . toUpper $ "Hello, " <> name
64 greet = return
66-- Client-side query functions
67clientApi :: Client TestApi
68clientApi = client testApi
70getGreet :: Text -> Maybe Bool -> URI -> EitherT String IO Greet
71postGreet :: Greet -> URI -> EitherT String IO Greet
72getGreet :<|> postGreet = clientApi
74-- Turn the server into a WAI app
75test :: Application
76test = serve testApi server
78docsGreet :: API
79docsGreet = docs testApi
81-- Run the server
82runTestServer :: Port -> IO ()
83runTestServer port = run port test
85-- Run some queries against the server
86main :: IO ()
87main = do
88 tid <- forkIO $ runTestServer 8001
89 let Just uri = parseURI "http://localhost:8001"
90 print =<< runEitherT (getGreet "alp" (Just True) uri)
91 print =<< runEitherT (getGreet "alp" (Just False) uri)
92 let g = Greet "yo"
93 print =<< runEitherT (postGreet g uri)
94 killThread tid
95 putStrLn "\n---------\n"
96 printMarkdown docsGreet