git.iko.soy/servant
on 21c8fcb help sign in
servant/example/greet.hs
111 lines 3.0 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 Bool something/capt:Int
60POST Bool something
61|]
63testApi :: Proxy TestApi
64testApi = Proxy
66-- Server-side handlers
67server :: Server TestApi
68server = hello :<|> greet :<|> delete
70 where hello name Nothing = hello name (Just False)
71 hello name (Just False) = return . Greet $ "Hello, " <> name
72 hello name (Just True) = return . Greet . toUpper $ "Hello, " <> name
74 greet = return
76 delete _ = return ()
78-- Client-side query functions
79clientApi :: Client TestApi
80clientApi = client testApi
82getGreet :: Text -> Maybe Bool -> URI -> EitherT String IO Greet
83postGreet :: Greet -> URI -> EitherT String IO Greet
84deleteGreet :: Text -> URI -> EitherT String IO ()
85getGreet :<|> postGreet :<|> deleteGreet = clientApi
87-- Turn the server into a WAI app
88test :: Application
89test = serve testApi server
91-- Documentation
92docsGreet :: API
93docsGreet = docs testApi
95-- Run the server
96runTestServer :: Port -> IO ()
97runTestServer port = run port test
99-- Run some queries against the server
100main :: IO ()
101main = do
102 tid <- forkIO $ runTestServer 8001
103 let Just uri = parseURI "http://localhost:8001"
104 print =<< runEitherT (getGreet "alp" (Just True) uri)
105 print =<< runEitherT (getGreet "alp" (Just False) uri)
106 let g = Greet "yo"
107 print =<< runEitherT (postGreet g uri)
108 print =<< runEitherT (deleteGreet "blah" uri)
109 killThread tid
110 putStrLn "\n---------\n"
111 printMarkdown docsGreet