git.iko.soy/servant
on 85acead help sign in
servant/example/greet.hs
106 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{-# LANGUAGE QuasiQuotes #-}
9{-# OPTIONS_GHC -fno-warn-orphans #-}
11import Control.Concurrent (forkIO, killThread)
12import Control.Monad.Trans.Either
13import Data.Aeson
14import Data.Monoid
15import Data.Proxy
16import Data.Text
17import GHC.Generics
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."
45 Normal
47instance ToSample Greet where
48 toSample Proxy = Just (encode g)
50 where g = Greet "Hello, haskeller!"
52-- API specification
53type TestApi =
54 "hello" :> Capture "name" Text :> QueryParam "capital" Bool :> Get Greet
55 :<|> "greet" :> ReqBody Greet :> Post Greet
56 :<|> "delete" :> Capture "greetid" Text :> Delete
58testApi :: Proxy TestApi
59testApi = Proxy
61-- Server-side handlers
62server :: Server TestApi
63server = hello :<|> greet :<|> delete
65 where hello name Nothing = hello name (Just False)
66 hello name (Just False) = return . Greet $ "Hello, " <> name
67 hello name (Just True) = return . Greet . toUpper $ "Hello, " <> name
69 greet = return
71 delete _ = return ()
73-- Client-side query functions
74clientApi :: Client TestApi
75clientApi = client testApi
77getGreet :: Text -> Maybe Bool -> BaseUrl -> EitherT String IO Greet
78postGreet :: Greet -> BaseUrl -> EitherT String IO Greet
79deleteGreet :: Text -> BaseUrl -> EitherT String IO ()
80getGreet :<|> postGreet :<|> deleteGreet = clientApi
82-- Turn the server into a WAI app
83test :: Application
84test = serve testApi server
86-- Documentation
87docsGreet :: API
88docsGreet = docs testApi
90-- Run the server
91runTestServer :: Port -> IO ()
92runTestServer port = run port test
94-- Run some queries against the server
95main :: IO ()
96main = do
97 tid <- forkIO $ runTestServer 8001
98 let uri = BaseUrl Http "localhost" 8001
99 print =<< runEitherT (getGreet "alp" (Just True) uri)
100 print =<< runEitherT (getGreet "alp" (Just False) uri)
101 let g = Greet "yo"
102 print =<< runEitherT (postGreet g uri)
103 print =<< runEitherT (deleteGreet "blah" uri)
104 killThread tid
105 putStrLn "\n---------\n"
106 printMarkdown docsGreet