git.iko.soy/servant
on dacea01 help sign in
servant/example/greet.hs
105 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
25import Servant.Common.BaseUrl
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 = Just $ Greet "Hello, haskeller!"
51-- API specification
52type TestApi =
53 "hello" :> Capture "name" Text :> QueryParam "capital" Bool :> Get Greet
54 :<|> "greet" :> ReqBody Greet :> Post Greet
55 :<|> "delete" :> Capture "greetid" Text :> Delete
57testApi :: Proxy TestApi
58testApi = Proxy
60-- Server-side handlers
61server :: Server TestApi
62server = hello :<|> greet :<|> delete
64 where hello name Nothing = hello name (Just False)
65 hello name (Just False) = return . Greet $ "Hello, " <> name
66 hello name (Just True) = return . Greet . toUpper $ "Hello, " <> name
68 greet = return
70 delete _ = return ()
72-- Client-side query functions
73clientApi :: Client TestApi
74clientApi = client testApi
76getGreet :: Text -> Maybe Bool -> BaseUrl -> EitherT String IO Greet
77postGreet :: Greet -> BaseUrl -> EitherT String IO Greet
78deleteGreet :: Text -> BaseUrl -> EitherT String IO ()
79getGreet :<|> postGreet :<|> deleteGreet = clientApi
81-- Turn the server into a WAI app
82test :: Application
83test = serve testApi server
85-- Documentation
86docsGreet :: API
87docsGreet = docs testApi
89-- Run the server
90runTestServer :: Port -> IO ()
91runTestServer port = run port test
93-- Run some queries against the server
94main :: IO ()
95main = do
96 tid <- forkIO $ runTestServer 8001
97 let uri = BaseUrl Http "localhost" 8001
98 print =<< runEitherT (getGreet "alp" (Just True) uri)
99 print =<< runEitherT (getGreet "alp" (Just False) uri)
100 let g = Greet "yo"
101 print =<< runEitherT (postGreet g uri)
102 print =<< runEitherT (deleteGreet "blah" uri)
103 killThread tid
104 putStrLn "\n---------\n"
105 putStrLn $ markdown docsGreet