f8ea9ba8fe
This is largely Aaron Levin's work. But it was done in a merge commit,
so couldn't be cherry-picked in a sensible way. Thanks Aaron!
84 lines
2.3 KiB
Haskell
84 lines
2.3 KiB
Haskell
{-# LANGUAGE DataKinds #-}
|
|
{-# LANGUAGE DeriveGeneric #-}
|
|
{-# LANGUAGE TypeFamilies #-}
|
|
{-# LANGUAGE TypeOperators #-}
|
|
module T3 where
|
|
|
|
import Control.Monad.Trans.Except
|
|
import Data.Aeson
|
|
import Data.List
|
|
import GHC.Generics
|
|
import Network.Wai
|
|
import Servant
|
|
|
|
data Position = Position
|
|
{ x :: Int
|
|
, y :: Int
|
|
} deriving (Show, Generic)
|
|
|
|
instance FromJSON Position
|
|
instance ToJSON Position
|
|
|
|
newtype HelloMessage = HelloMessage { msg :: String }
|
|
deriving (Show, Generic)
|
|
|
|
instance FromJSON HelloMessage
|
|
instance ToJSON HelloMessage
|
|
|
|
data ClientInfo = ClientInfo
|
|
{ name :: String
|
|
, email :: String
|
|
, age :: Int
|
|
, interested_in :: [String]
|
|
} deriving (Show, Generic)
|
|
|
|
instance FromJSON ClientInfo
|
|
instance ToJSON ClientInfo
|
|
|
|
data Email = Email
|
|
{ from :: String
|
|
, to :: String
|
|
, subject :: String
|
|
, body :: String
|
|
} deriving (Show, Generic)
|
|
|
|
instance FromJSON Email
|
|
instance ToJSON Email
|
|
|
|
emailForClient :: ClientInfo -> Email
|
|
emailForClient c = Email from' to' subject' body'
|
|
|
|
where from' = "great@company.com"
|
|
to' = email c
|
|
subject' = "Hey " ++ name c ++ ", we miss you!"
|
|
body' = "Hi " ++ name c ++ ",\n\n"
|
|
++ "Since you've recently turned " ++ show (age c)
|
|
++ ", have you checked out our latest "
|
|
++ intercalate ", " (interested_in c)
|
|
++ " products? Give us a visit!"
|
|
|
|
type API = "position" :> Capture "x" Int :> Capture "y" Int :> Get '[JSON] Position
|
|
:<|> "hello" :> QueryParam "name" String :> Get '[JSON] HelloMessage
|
|
:<|> "marketing" :> ReqBody '[JSON] ClientInfo :> Post '[JSON] Email
|
|
|
|
api :: Proxy API
|
|
api = Proxy
|
|
|
|
server :: Server API
|
|
server = position
|
|
:<|> hello
|
|
:<|> marketing
|
|
|
|
where position :: Int -> Int -> ExceptT ServantErr IO Position
|
|
position x y = return (Position x y)
|
|
|
|
hello :: Maybe String -> ExceptT ServantErr IO HelloMessage
|
|
hello mname = return . HelloMessage $ case mname of
|
|
Nothing -> "Hello, anonymous coward"
|
|
Just n -> "Hello, " ++ n
|
|
|
|
marketing :: ClientInfo -> ExceptT ServantErr IO Email
|
|
marketing clientinfo = return (emailForClient clientinfo)
|
|
|
|
app :: Application
|
|
app = serve api EmptyConfig server
|