git.iko.soy/servant
on bfb64cd help sign in
servant/servant-examples/tutorial/T3.hs
84 lines 2.3 kB history raw
1{-# LANGUAGE DataKinds #-}
2{-# LANGUAGE DeriveGeneric #-}
3{-# LANGUAGE TypeFamilies #-}
4{-# LANGUAGE TypeOperators #-}
5module T3 where
7import Control.Monad.Trans.Except
8import Data.Aeson
9import Data.List
10import GHC.Generics
11import Network.Wai
12import Servant
14data Position = Position
15 { x :: Int
16 , y :: Int
17 } deriving (Show, Generic)
19instance FromJSON Position
20instance ToJSON Position
22newtype HelloMessage = HelloMessage { msg :: String }
23 deriving (Show, Generic)
25instance FromJSON HelloMessage
26instance ToJSON HelloMessage
28data ClientInfo = ClientInfo
29 { name :: String
30 , email :: String
31 , age :: Int
32 , interested_in :: [String]
33 } deriving (Show, Generic)
35instance FromJSON ClientInfo
36instance ToJSON ClientInfo
38data Email = Email
39 { from :: String
40 , to :: String
41 , subject :: String
42 , body :: String
43 } deriving (Show, Generic)
45instance FromJSON Email
46instance ToJSON Email
48emailForClient :: ClientInfo -> Email
49emailForClient c = Email from' to' subject' body'
51 where from' = "great@company.com"
52 to' = email c
53 subject' = "Hey " ++ name c ++ ", we miss you!"
54 body' = "Hi " ++ name c ++ ",\n\n"
55 ++ "Since you've recently turned " ++ show (age c)
56 ++ ", have you checked out our latest "
57 ++ intercalate ", " (interested_in c)
58 ++ " products? Give us a visit!"
60type API = "position" :> Capture "x" Int :> Capture "y" Int :> Get '[JSON] Position
61 :<|> "hello" :> QueryParam "name" String :> Get '[JSON] HelloMessage
62 :<|> "marketing" :> ReqBody '[JSON] ClientInfo :> Post '[JSON] Email
64api :: Proxy API
65api = Proxy
67server :: Server API
68server = position
69 :<|> hello
70 :<|> marketing
72 where position :: Int -> Int -> ExceptT ServantErr IO Position
73 position x y = return (Position x y)
75 hello :: Maybe String -> ExceptT ServantErr IO HelloMessage
76 hello mname = return . HelloMessage $ case mname of
77 Nothing -> "Hello, anonymous coward"
78 Just n -> "Hello, " ++ n
80 marketing :: ClientInfo -> ExceptT ServantErr IO Email
81 marketing clientinfo = return (emailForClient clientinfo)
83app :: Application
84app = serve api server