git.iko.soy/servant
on fd636ea help sign in
servant/example/greet.hs
107 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."
46 Normal
48instance ToSample Greet where
49 toSample Proxy = Just (encode g)
51 where g = Greet "Hello, haskeller!"
53-- API specification
54type TestApi =
55 "hello" :> Capture "name" Text :> QueryParam "capital" Bool :> Get Greet
56 :<|> "greet" :> ReqBody Greet :> Post Greet
57 :<|> "delete" :> Capture "greetid" Text :> Delete
59testApi :: Proxy TestApi
60testApi = Proxy
62-- Server-side handlers
63server :: Server TestApi
64server = hello :<|> greet :<|> delete
66 where hello name Nothing = hello name (Just False)
67 hello name (Just False) = return . Greet $ "Hello, " <> name
68 hello name (Just True) = return . Greet . toUpper $ "Hello, " <> name
70 greet = return
72 delete _ = return ()
74-- Client-side query functions
75clientApi :: Client TestApi
76clientApi = client testApi
78getGreet :: Text -> Maybe Bool -> URIAuth -> EitherT String IO Greet
79postGreet :: Greet -> URIAuth -> EitherT String IO Greet
80deleteGreet :: Text -> URIAuth -> EitherT String IO ()
81getGreet :<|> postGreet :<|> deleteGreet = clientApi
83-- Turn the server into a WAI app
84test :: Application
85test = serve testApi server
87-- Documentation
88docsGreet :: API
89docsGreet = docs testApi
91-- Run the server
92runTestServer :: Port -> IO ()
93runTestServer port = run port test
95-- Run some queries against the server
96main :: IO ()
97main = do
98 tid <- forkIO $ runTestServer 8001
99 let uri = mkHost "localhost" 8001
100 print =<< runEitherT (getGreet "alp" (Just True) uri)
101 print =<< runEitherT (getGreet "alp" (Just False) uri)
102 let g = Greet "yo"
103 print =<< runEitherT (postGreet g uri)
104 print =<< runEitherT (deleteGreet "blah" uri)
105 killThread tid
106 putStrLn "\n---------\n"
107 printMarkdown docsGreet