git.iko.soy/servant
on bab2bc7 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.URI
19import Network.Wai
20import Network.Wai.Handler.Warp
22import Servant.API
23import Servant.Client
24import Servant.Docs
25import Servant.Server
27-- * Example
29data Greet = Greet { _msg :: Text }
30 deriving (Generic, Show)
32instance FromJSON Greet
33instance ToJSON Greet
35instance ToCapture (Capture "name" Text) where
36 toCapture _ = DocCapture "name" "name of the person to greet"
38instance ToCapture (Capture "greetid" Text) where
39 toCapture _ = DocCapture "greetid" "identifier of the greet msg to remove"
41instance ToParam (QueryParam "capital" Bool) where
42 toParam _ =
43 DocQueryParam "capital"
44 ["true", "false"]
45 "Get the greeting message in uppercase (true) or not (false). Default is false."
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 -> URI -> EitherT String IO Greet
78postGreet :: Greet -> URI -> EitherT String IO Greet
79deleteGreet :: Text -> URI -> 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 Just uri = parseURI "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