git.iko.soy/servant
on 90ea565 help sign in
servant/example/greet.hs
105 lines 2.9 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 ToCapture (Capture "greetid" Text) where
38 toCapture _ = DocCapture "greetid" "identifier of the greet msg to remove"
40instance ToParam (QueryParam "capital" Bool) where
41 toParam _ =
42 DocQueryParam "capital"
43 ["true", "false"]
44 "Get the greeting message in uppercase (true) or not (false). Default is false."
46instance ToSample Greet where
47 toSample Proxy = Just (encode g)
49 where g = Greet "Hello, haskeller!"
51-- API specification
52type TestApi =
53 "hello" :> Capture "name" Text :> QueryParam "capital" Bool :> Get Greet
54 :<|> "greet" :> ReqBody Greet :> Post Greet
55 :<|> "delete" :> Capture "greetid" Text :> Delete
57testApi :: Proxy TestApi
58testApi = Proxy
60-- Server-side handlers
61server :: Server TestApi
62server = hello :<|> greet :<|> delete
64 where hello name Nothing = hello name (Just False)
65 hello name (Just False) = return . Greet $ "Hello, " <> name
66 hello name (Just True) = return . Greet . toUpper $ "Hello, " <> name
68 greet = return
70 delete _ = return ()
72-- Client-side query functions
73clientApi :: Client TestApi
74clientApi = client testApi
76getGreet :: Text -> Maybe Bool -> URI -> EitherT String IO Greet
77postGreet :: Greet -> URI -> EitherT String IO Greet
78deleteGreet :: Text -> URI -> EitherT String IO ()
79getGreet :<|> postGreet :<|> deleteGreet = clientApi
81-- Turn the server into a WAI app
82test :: Application
83test = serve testApi server
85-- Documentation
86docsGreet :: API
87docsGreet = docs testApi
89-- Run the server
90runTestServer :: Port -> IO ()
91runTestServer port = run port test
93-- Run some queries against the server
94main :: IO ()
95main = do
96 tid <- forkIO $ runTestServer 8001
97 let Just uri = parseURI "http://localhost:8001"
98 print =<< runEitherT (getGreet "alp" (Just True) uri)
99 print =<< runEitherT (getGreet "alp" (Just False) uri)
100 let g = Greet "yo"
101 print =<< runEitherT (postGreet g uri)
102 print =<< runEitherT (deleteGreet "blah" uri)
103 killThread tid
104 putStrLn "\n---------\n"
105 printMarkdown docsGreet