{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE BlockArguments #-}

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 hiding ((==.), (=.), update)
import Database.Esqueleto.Experimental hiding ((<&>))


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 $ selectOne do
    ann <- from (table @TickerAnnouncement)
    where_ (ann ^. TickerAnnouncementArchived ==. val False)
    pure ann

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

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

postTickerAnnounceR :: Handler Html
postTickerAnnounceR = do
  current <- runDB $ selectOne do
    ann <- from (table @TickerAnnouncement)
    where_ (ann ^. TickerAnnouncementArchived ==. val False)
    pure ann

  ((result, widget), enctype) <-
    runFormPost (tickerAnnounceForm (fmap entityVal current))

  case result of
    FormSuccess ann -> do
      runDB do
        update \t ->
          set t [ TickerAnnouncementArchived =. val 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 $ update \t ->
    set t [TickerAnnouncementArchived =. val True]
  redirect RootR