{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}

module Handler.Hello
  ( getHelloR
  , postHelloR
  , getHelloNamedR
  ) where

import Data.Aeson (object, Value, (.=))
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import Yesod
  ( defaultLayout
  , lookupGetParam
  , provideRep
  , requireCheckJsonBody
  , selectRep
  , Html
  , TypedContent
  , whamlet
  )

import Foundation (Handler)
import qualified Model.PostHello as PostHello (name)

greet :: Text -> Handler TypedContent
greet :: Text -> Handler TypedContent
greet Text
name = forall (m :: * -> *).
MonadHandler m =>
Writer (Endo [ProvidedRep m]) () -> m TypedContent
selectRep forall a b. (a -> b) -> a -> b
$ do
  forall (m :: * -> *) a.
(Monad m, HasContentType a) =>
m a -> Writer (Endo [ProvidedRep m]) ()
provideRep Handler Value
greetJson
  forall (m :: * -> *) a.
(Monad m, HasContentType a) =>
m a -> Writer (Endo [ProvidedRep m]) ()
provideRep Handler Html
greetHtml
  where
    greeting :: Text
    greeting :: Text
greeting = Text
"Hello, " forall a. Semigroup a => a -> a -> a
<> Text
name forall a. Semigroup a => a -> a -> a
<> Text
"!"

    greetJson :: Handler Value
    greetJson :: Handler Value
greetJson = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
object [Key
"greeting" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
greeting]

    greetHtml :: Handler Html
    greetHtml :: Handler Html
greetHtml = forall site.
Yesod site =>
WidgetFor site () -> HandlerFor site Html
defaultLayout [whamlet|#{greeting}|]

getHelloR :: Handler TypedContent
getHelloR :: Handler TypedContent
getHelloR = forall (m :: * -> *). MonadHandler m => Text -> m (Maybe Text)
lookupGetParam Text
"name" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Handler TypedContent
greet forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a -> a
fromMaybe Text
"World"

postHelloR :: Handler TypedContent
postHelloR :: Handler TypedContent
postHelloR = forall (m :: * -> *) a. (MonadHandler m, FromJSON a) => m a
requireCheckJsonBody forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Handler TypedContent
greet forall b c a. (b -> c) -> (a -> b) -> a -> c
. PostHello -> Text
PostHello.name

getHelloNamedR :: Text -> Handler TypedContent
getHelloNamedR :: Text -> Handler TypedContent
getHelloNamedR = Text -> Handler TypedContent
greet