{-# LANGUAGE QuasiQuotes #-}

module Server.Frontend.Ticker (tickerWidget, postTickerAnnounceR, postTickerDeleteR) where
import           Data.Functor           ((<&>))
import           Data.Time              (getCurrentTime)
import           Persist                (EntityField (TickerAnnouncementArchived),
                                         TickerAnnouncement (..))
import           Server.Frontend.Routes (FrontendMessage (..), Handler,
                                         Route (..), Widget)
import           Yesod


tickerAnnounceForm
  :: Maybe TickerAnnouncement
  -> Html
  -> MForm Handler (FormResult TickerAnnouncement, Widget)
tickerAnnounceForm maybeCurrent = renderDivs $ TickerAnnouncement
  <$> areq textField (fieldSettingsLabel MsgHeader)
        (maybeCurrent <&> tickerAnnouncementHeader)
  <*> fmap unTextarea (areq textareaField (fieldSettingsLabel MsgText)
        (maybeCurrent <&> (Textarea . tickerAnnouncementMessage)))
  <*> pure False
  <*> lift (liftIO getCurrentTime)

tickerWidget :: Handler Html
tickerWidget = do
  current <- runDB $ selectFirst [ TickerAnnouncementArchived ==. False ] []

  (widget, enctype) <-
    generateFormPost (tickerAnnounceForm (current <&> entityVal))

  defaultLayout [whamlet|
     <h2>_{MsgTicker}
     <form method=post action=@{TickerAnnounceR} enctype=#{enctype}>
       ^{widget}
       <button>_{MsgSubmit}
     <form method=post action=@{TickerDeleteR}>
       <button>_{Msgdelete}
  |]

postTickerAnnounceR :: Handler Html
postTickerAnnounceR = do
  current <- runDB $ selectFirst [ TickerAnnouncementArchived ==. False ] []
  ((result, widget), enctype) <-
    runFormPost (tickerAnnounceForm (current <&> entityVal))
  case result of
    FormSuccess ann -> do
      runDB $ do
        updateWhere [] [ TickerAnnouncementArchived =. True ]
        insert ann
      redirect RootR
    _ -> defaultLayout
        [whamlet|
            <p>_{MsgInvalidInput}.
            <form method=post action=@{TickerAnnounceR} enctype=#{enctype}>
                ^{widget}
                <button>_{MsgSubmit}
        |]

postTickerDeleteR :: Handler Html
postTickerDeleteR = do
  runDB $ updateWhere [] [ TickerAnnouncementArchived =. True ]
  redirect RootR