@@ -0,0 +1,84 @@
1+{-# LANGUAGE DataKinds #-}
2+{-# LANGUAGE TypeFamilies #-}
3+{-# LANGUAGE DeriveGeneric #-}
4+{-# LANGUAGE TypeOperators #-}
5+module T3 where
6+
7+import Control.Monad.Trans.Either
8+import Data.Aeson
9+import Data.List
10+import GHC.Generics
11+import Network.Wai
12+import Servant
13+
14+data Position = Position
15+ { x :: Int
16+ , y :: Int
17+ } deriving (Show, Generic)
18+
19+instance FromJSON Position
20+instance ToJSON Position
21+
22+newtype HelloMessage = HelloMessage { msg :: String }
23+ deriving (Show, Generic)
24+
25+instance FromJSON HelloMessage
26+instance ToJSON HelloMessage
27+
28+data ClientInfo = ClientInfo
29+ { name :: String
30+ , email :: String
31+ , age :: Int
32+ , interested_in :: [String]
33+ } deriving (Show, Generic)
34+
35+instance FromJSON ClientInfo
36+instance ToJSON ClientInfo
37+
38+data Email = Email
39+ { from :: String
40+ , to :: String
41+ , subject :: String
42+ , body :: String
43+ } deriving (Show, Generic)
44+
45+instance FromJSON Email
46+instance ToJSON Email
47+
48+emailForClient :: ClientInfo -> Email
49+emailForClient c = Email from' to' subject' body'
50+
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!"
59+
60+type 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
63+
64+api :: Proxy API
65+api = Proxy
66+
67+server :: Server API
68+server = position
69+ :<|> hello
70+ :<|> marketing
71+
72+ where position :: Int -> Int -> EitherT ServantErr IO Position
73+ position x y = return (Position x y)
74+
75+ hello :: Maybe String -> EitherT ServantErr IO HelloMessage
76+ hello mname = return . HelloMessage $ case mname of
77+ Nothing -> "Hello, anonymous coward"
78+ Just n -> "Hello, " ++ n
79+
80+ marketing :: ClientInfo -> EitherT ServantErr IO Email
81+ marketing clientinfo = return (emailForClient clientinfo)
82+
83+app :: Application
84+app = serve api server