@@ -0,0 +1,80 @@
1+{-# LANGUAGE DataKinds #-}
2+{-# LANGUAGE TypeFamilies #-}
3+{-# LANGUAGE DeriveGeneric #-}
4+{-# LANGUAGE TypeOperators #-}
5+module GS3 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 Generic
18+
19+instance ToJSON Position
20+
21+newtype HelloMessage = HelloMessage { msg :: String }
22+ deriving Generic
23+
24+instance ToJSON HelloMessage
25+
26+data ClientInfo = ClientInfo
27+ { name :: String
28+ , email :: String
29+ , age :: Int
30+ , interested_in :: [String]
31+ } deriving Generic
32+
33+instance FromJSON ClientInfo
34+
35+data Email = Email
36+ { from :: String
37+ , to :: String
38+ , subject :: String
39+ , body :: String
40+ } deriving Generic
41+
42+instance ToJSON Email
43+
44+emailForClient :: ClientInfo -> Email
45+emailForClient c = Email from' to' subject' body'
46+
47+ where from' = "great@company.com"
48+ to' = email c
49+ subject' = "Hey " ++ name c ++ ", we miss you!"
50+ body' = "Hi " ++ name c ++ ",\n\n"
51+ ++ "Since you've recently turned " ++ show (age c)
52+ ++ ", have you checked out our latest "
53+ ++ intercalate ", " (interested_in c)
54+ ++ " ? Give us a visit!"
55+
56+type API = "position" :> Capture "x" Int :> Capture "y" Int :> Get '[JSON] Position
57+ :<|> "hello" :> QueryParam "name" String :> Get '[JSON] HelloMessage
58+ :<|> "marketing" :> ReqBody '[JSON] ClientInfo :> Post '[JSON] Email
59+
60+api :: Proxy API
61+api = Proxy
62+
63+server :: Server API
64+server = position
65+ :<|> hello
66+ :<|> marketing
67+
68+ where position :: Int -> Int -> EitherT Int IO Position
69+ position x y = return (Position x y)
70+
71+ hello :: Maybe String -> EitherT Int IO HelloMessage
72+ hello mname = return . HelloMessage $ case mname of
73+ Nothing -> "Hello, anonymous coward"
74+ Just n -> "Hello, " ++ n
75+
76+ marketing :: ClientInfo -> EitherT Int IO Email
77+ marketing clientinfo = return (emailForClient clientinfo)
78+
79+app :: Application
80+app = serve api server