<commit_before>
module Handler.Mooc.Admin.ReviewRequest
    ( getAdminReviewRequestR
    , postAdminReviewRequestR
    ) where

import Data.Time.Calendar (addDays)
import Handler.Mooc.Admin
import Import
import Import.BootstrapUtil
import qualified Network.Mail.Mime as Mail

data SendReviewParams = SendReviewParams {
      expertId   :: Key User
    , onlyBefore :: UTCTime
    }

getAdminReviewRequestR :: Handler Html
getAdminReviewRequestR = do
    requireAdmin
    experts <- selectExperts
    defaultDay <- lift (getCurrentTime >>= return . addDays (-7) . utctDay)
    (reviewRequestFormWidget, _) <-
      generateFormPost $ reviewRequestForm experts defaultDay
    fullLayout Nothing "Request reviews" $ do
        setTitle "qua-kit - request reviews"
        toWidgetHead $
          [cassius|
            .form-inline
              .form-group
                display: inline-block
                margin-right: 15px
          |]
        $(widgetFile "mooc/admin/review-request")

postAdminReviewRequestR :: Handler Html
postAdminReviewRequestR = do
    requireAdmin
    experts <- selectExperts
    ((res, _), _) <- runFormPost $ reviewRequestForm experts $ ModifiedJulianDay 0
    case res of
      (FormSuccess params) -> reviewRequest params
      _ -> defaultLayout [whamlet|<p>Invalid input</p>|]


reviewRequestForm :: [Entity User] -> Day -> Html -> MForm Handler (FormResult SendReviewParams, Widget)
reviewRequestForm experts defaultDay extra = do
  let expertsList = map (\(Entity usrId ex) -> (userName ex, usrId)) experts
  (expertRes, expertView) <- mreq (bootstrapSelectFieldList expertsList) "" Nothing
  (onlyBeforeRes, onlyBeforeView) <- mreq bootstrapDayField "" $ Just defaultDay
  let toTime day = UTCTime day $ fromInteger 0
  let params = SendReviewParams <$> expertRes
                                <*> fmap toTime onlyBeforeRes
  let widget = do
        [whamlet|
          #{extra}
          ^{fvInput expertView}
          ^{fvInput onlyBeforeView}
          <input type=submit value="Send Mail" class="btn btn-default">
        |]
  return (params, widget)

reviewRequest :: SendReviewParams -> Handler Html
reviewRequest params = do
  mexpert <- runDB $ get $ expertId params
  let showErr = defaultLayout [whamlet|<p>Expert or his/her email not found</p>|]
  case mexpert of
    Nothing -> showErr
    Just expert -> case userEmail expert of
      Nothing -> showErr
      Just email -> do
        scenarios <- runDB $ selectList [
                         CurrentScenarioGrade ==. Nothing
                       , CurrentScenarioLastUpdate <. onlyBefore params
                     ] []
        if length scenarios > 0 then do
          render <- getUrlRender
          let toLink (Entity _ sc) = render $ SubmissionViewerR
                                                (currentScenarioTaskId sc)
                                                (currentScenarioAuthorId sc)
          let scLinks = intercalate "\n" $ fmap toLink scenarios
          let mailText = intercalate "\n\n" [
                             "Dear " <> userName expert
                           , "The following submissions are in need of reviewing:"
                           , scLinks
                           , "Thank you for your help!"
                           ]
          $(logDebug) mailText
          liftIO $ Mail.renderSendMail $ Mail.simpleMail'
              (Mail.Address Nothing email) --to address
              (Mail.Address (Just "ETH qua-kit") "<EMAIL>") --from
              "Please help review the following submissions" --subject
                $ fromStrict mailText
          defaultLayout [whamlet|
                           <p>Success! Email sent.
                           <p><a onclick="window.history.back()" href="#">Back
                        |]
        else
          defaultLayout [whamlet|<p>No scenarios to review. Email not sent.</p>|]

selectExperts :: Handler [Entity User]
selectExperts = runDB $
  selectList [UserRole ==. UR_EXPERT, UserEmail /<-. [Nothing]] []<commit_msg>review request: add option to send to all experts<commit_after>
module Handler.Mooc.Admin.ReviewRequest
    ( getAdminReviewRequestR
    , postAdminReviewRequestR
    ) where

import Data.Time.Calendar (addDays)
import Handler.Mooc.Admin
import Import
import Import.BootstrapUtil
import qualified Network.Mail.Mime as Mail

data SendReviewParams = SendReviewParams {
      mexpertId  :: Maybe (Key User)
    , onlyBefore :: UTCTime
    }

getAdminReviewRequestR :: Handler Html
getAdminReviewRequestR = do
    requireAdmin
    experts <- selectExperts
    defaultDay <- lift (getCurrentTime >>= return . addDays (-7) . utctDay)
    (reviewRequestFormWidget, _) <-
      generateFormPost $ reviewRequestForm experts defaultDay
    fullLayout Nothing "Request reviews" $ do
        setTitle "qua-kit - request reviews"
        toWidgetHead $
          [cassius|
            .form-inline
              .form-group
                display: inline-block
                margin-right: 15px
          |]
        $(widgetFile "mooc/admin/review-request")

postAdminReviewRequestR :: Handler Html
postAdminReviewRequestR = do
    requireAdmin
    experts <- selectExperts
    ((res, _), _) <- runFormPost $ reviewRequestForm experts $ ModifiedJulianDay 0
    case res of
      (FormSuccess params) -> reviewRequest params
      _ -> defaultLayout [whamlet|<p>Invalid input</p>|]


reviewRequestForm :: [Entity User] -> Day -> Html
                  -> MForm Handler (FormResult SendReviewParams, Widget)
reviewRequestForm experts defaultDay extra = do
  let expertsList = ("All experts", Nothing) :
        map (\(Entity usrId ex) -> (userName ex, Just usrId)) experts
  (expertRes, expertView) <- mreq (bootstrapSelectFieldList expertsList) "" Nothing
  (onlyBeforeRes, onlyBeforeView) <- mreq bootstrapDayField "" $ Just defaultDay
  let toTime day = UTCTime day $ fromInteger 0
  let params = SendReviewParams <$> expertRes
                                <*> fmap toTime onlyBeforeRes
  let widget = do
        [whamlet|
          #{extra}
          ^{fvInput expertView}
          ^{fvInput onlyBeforeView}
          <input type=submit value="Send Mail" class="btn btn-default">
        |]
  return (params, widget)

reviewRequest :: SendReviewParams -> Handler Html
reviewRequest params = do
  scenarios <- runDB $ selectList [
                   CurrentScenarioGrade ==. Nothing
                 , CurrentScenarioLastUpdate <. onlyBefore params
               ] []
  statusTxt <-
    if length scenarios > 0 then do
      render <- getUrlRender
      let toLink (Entity _ sc) = render $ SubmissionViewerR
                                            (currentScenarioTaskId sc)
                                            (currentScenarioAuthorId sc)
      let scLinks = fmap toLink scenarios
      case mexpertId params of
        Just expertId -> do
          mexpert <- runDB $ get expertId
          case mexpert of
            Just expert -> do
              sendReviewRequestMail scLinks expert
              return "Email sent..."
            Nothing -> return "Expert not found"
        Nothing -> do
          experts <- selectExperts
          _ <- forM experts $ \(Entity _ ex) -> sendReviewRequestMail scLinks ex
          return "Emails sent..."
    else
      return "No scenarios to review. Email not sent."
  let statusTxt' = statusTxt::Text
  defaultLayout [whamlet|
                   <p>#{ statusTxt' }
                   <p><a onclick="window.history.back()" href="#">Back
                |]

sendReviewRequestMail :: [Text] -> User -> Handler ()
sendReviewRequestMail scLinks expert =
  case userEmail expert of
    Just email -> do
      let mailText = intercalate "\n\n" [
                         "Dear " <> userName expert
                       , "The following submissions are in need of reviewing:"
                       , intercalate "\n" scLinks
                       , "Thank you for your help!"
                       ]
      $(logDebug) mailText
      liftIO $ Mail.renderSendMail $ Mail.simpleMail'
          (Mail.Address Nothing email) --to address
          (Mail.Address (Just "ETH qua-kit") "<EMAIL>") --from
          "Please help review the following submissions" --subject
            $ fromStrict mailText
    Nothing -> return ()

selectExperts :: Handler [Entity User]
selectExperts = runDB $
  selectList [UserRole ==. UR_EXPERT, UserEmail /<-. [Nothing]] []
{'fraction_non_alphanumeric': 0.08669904062537014, 'fraction_numerical': 0.0014212957479568873, 'mean_word_length': 2.067199418815837, 'pattern_counts': {'":': 0, '<': 54, '<?xml version=': 0, '>': 60, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 12, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '1561379', 'n_tokens_mistral': 2263, 'n_tokens_neox': 2168, 'n_words': 652}