git.iko.soy/servant
on 4ebd52b help sign in
servant/example/greet.hs
112 lines 3.1 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
58type TestApi2 = [sitemap|
59GET hello/name:Text/?capital:Bool () -> Greet
60POST greet Greet -> Greet
61DELETE delete/greetid:Text ()
62|]
64testApi :: Proxy TestApi
65testApi = Proxy
67-- Server-side handlers
68server :: Server TestApi
69server = hello :<|> greet :<|> delete
71 where hello name Nothing = hello name (Just False)
72 hello name (Just False) = return . Greet $ "Hello, " <> name
73 hello name (Just True) = return . Greet . toUpper $ "Hello, " <> name
75 greet = return
77 delete _ = return ()
79-- Client-side query functions
80clientApi :: Client TestApi
81clientApi = client testApi
83getGreet :: Text -> Maybe Bool -> URI -> EitherT String IO Greet
84postGreet :: Greet -> URI -> EitherT String IO Greet
85deleteGreet :: Text -> URI -> EitherT String IO ()
86getGreet :<|> postGreet :<|> deleteGreet = clientApi
88-- Turn the server into a WAI app
89test :: Application
90test = serve testApi server
92-- Documentation
93docsGreet :: API
94docsGreet = docs testApi
96-- Run the server
97runTestServer :: Port -> IO ()
98runTestServer port = run port test
100-- Run some queries against the server
101main :: IO ()
102main = do
103 tid <- forkIO $ runTestServer 8001
104 let Just uri = parseURI "http://localhost:8001"
105 print =<< runEitherT (getGreet "alp" (Just True) uri)
106 print =<< runEitherT (getGreet "alp" (Just False) uri)
107 let g = Greet "yo"
108 print =<< runEitherT (postGreet g uri)
109 print =<< runEitherT (deleteGreet "blah" uri)
110 killThread tid
111 putStrLn "\n---------\n"
112 printMarkdown docsGreet