servant/servant-examples/getting-started/GS3.hs

85 lines
2.2 KiB
Haskell
Raw Normal View History

2015-05-05 22:54:55 +02:00
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TypeOperators #-}
module GS3 where
import Control.Monad.Trans.Either
import Data.Aeson
import Data.List
import GHC.Generics
import Network.Wai
import Servant
data Position = Position
{ x :: Int
, y :: Int
2015-05-07 17:48:21 +02:00
} deriving (Show, Generic)
2015-05-05 22:54:55 +02:00
2015-05-07 17:48:21 +02:00
instance FromJSON Position
2015-05-05 22:54:55 +02:00
instance ToJSON Position
newtype HelloMessage = HelloMessage { msg :: String }
2015-05-07 17:48:21 +02:00
deriving (Show, Generic)
2015-05-05 22:54:55 +02:00
2015-05-07 17:48:21 +02:00
instance FromJSON HelloMessage
2015-05-05 22:54:55 +02:00
instance ToJSON HelloMessage
data ClientInfo = ClientInfo
{ name :: String
, email :: String
, age :: Int
, interested_in :: [String]
2015-05-07 17:48:21 +02:00
} deriving (Show, Generic)
2015-05-05 22:54:55 +02:00
instance FromJSON ClientInfo
2015-05-07 17:48:21 +02:00
instance ToJSON ClientInfo
2015-05-05 22:54:55 +02:00
data Email = Email
{ from :: String
, to :: String
, subject :: String
, body :: String
2015-05-07 17:48:21 +02:00
} deriving (Show, Generic)
2015-05-05 22:54:55 +02:00
2015-05-07 17:48:21 +02:00
instance FromJSON Email
2015-05-05 22:54:55 +02:00
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)
2015-05-06 00:20:54 +02:00
++ " products? Give us a visit!"
2015-05-05 22:54:55 +02:00
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
2015-05-06 00:20:54 +02:00
where position :: Int -> Int -> EitherT ServantErr IO Position
2015-05-05 22:54:55 +02:00
position x y = return (Position x y)
2015-05-06 00:20:54 +02:00
hello :: Maybe String -> EitherT ServantErr IO HelloMessage
2015-05-05 22:54:55 +02:00
hello mname = return . HelloMessage $ case mname of
Nothing -> "Hello, anonymous coward"
Just n -> "Hello, " ++ n
2015-05-06 00:20:54 +02:00
marketing :: ClientInfo -> EitherT ServantErr IO Email
2015-05-05 22:54:55 +02:00
marketing clientinfo = return (emailForClient clientinfo)
app :: Application
app = serve api server