servant-subscriber-0.1.0.0: test/Spec.hs

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE FlexibleContexts #-}
-- {-# LANGUAGE NoMonomorphismRestriction #-}


import Control.Monad.Except
import Data.Aeson.Compat
import Data.Aeson.Types
import Data.Attoparsec.ByteString
import Data.ByteString (ByteString)
import Data.List
import Data.Maybe
import Data.String.Conversions
import Data.Time.Calendar
import GHC.Generics
import Lucid
import Network.HTTP.Media ((//), (/:))
import Network.Wai
import Network.Wai.Handler.Warp
import Servant
import System.Directory
import Text.Blaze
import Text.Blaze.Html.Renderer.Utf8
import qualified Data.Aeson.Parser
import qualified Text.Blaze.Html

       
import Lib


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

data Position = Position
  { xCoord :: Int
  , yCoord :: Int
  } deriving (Generic, Show)

instance ToJSON Position

newtype HelloMessage = HelloMessage { msg :: String }
  deriving (Generic, Show)

instance ToJSON HelloMessage

data ClientInfo = ClientInfo
  { clientName :: String
  , clientEmail :: String
  , clientAge :: Int
  , clientInterestedIn :: [String]
  } deriving Generic

instance FromJSON ClientInfo
instance ToJSON ClientInfo

data Email = Email
  { from :: String
  , to :: String
  , subject :: String
  , body :: String
  } deriving Generic

instance ToJSON Email

emailForClient :: ClientInfo -> Email
emailForClient c = Email from' to' subject' body'

  where from'    = "great@company.com"
        to'      = clientEmail c
        subject' = "Hey " ++ clientName c ++ ", we miss you!"
        body'    = "Hi " ++ clientName c ++ ",\n\n"
                ++ "Since you've recently turned " ++ show (clientAge c)
                ++ ", have you checked out our latest "
                ++ intercalate ", " (clientInterestedIn c)
                ++ " products? Give us a visit!"

server3 :: ServerT API (ExceptT ServantErr IO)
server3 = 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)

userAPI :: Proxy API
userAPI = Proxy

app3 :: Application
app3 = serve userAPI server3


callServer3 :: forall endpoint. (GetEndpoint API endpoint (PickLeftRight endpoint API))
               => Proxy endpoint
               -> ServerT endpoint (ExceptT ServantErr IO)
callServer3 pE = callHandler (Proxy :: Proxy API) server3 pE

main :: IO ()
main = do
  -- Let's call handler by url!
  let endpoint :: Proxy ("position" :> Capture "x" Int :> Capture "y" Int :> Get '[JSON] Position)
      endpoint = Proxy
  pos <- runExceptT $ callServer3 endpoint 9 2
  print pos
  let endpoint2 :: Proxy ("hello" :> QueryParam "name" String :> Get '[JSON] HelloMessage)
      endpoint2 = Proxy
  hello <- runExceptT $ callServer3 endpoint2 $ Just "Robert"
  hello2 <- runExceptT $ callServer3 endpoint2 Nothing
  print hello
  print hello2