diff --git a/build.sh b/build.sh index 13a8b2490..962ccc1ee 100755 --- a/build.sh +++ b/build.sh @@ -1,4 +1,4 @@ #!/usr/bin/env bash -exec -- stack build --fast --flag uniworx:library-only --flag uniworx:dev +exec -- stack build --fast --flag uniworx:-library-only --flag uniworx:dev echo Build task completed. diff --git a/db.sh b/db.sh index 8861a2ac4..b05463c3a 100755 --- a/db.sh +++ b/db.sh @@ -1,4 +1,4 @@ #!/usr/bin/env bash # Options: see /test/Database.hs (Main) -stack build --fast --flag uniworx:library-only --flag uniworx:dev +stack build --fast --flag uniworx:-library-only --flag uniworx:dev stack exec uniworxdb -- $@ diff --git a/hlint.sh b/hlint.sh new file mode 100755 index 000000000..0dbb0fa1b --- /dev/null +++ b/hlint.sh @@ -0,0 +1,3 @@ +#!/usr/bin/env bash + +exec -- ./test.sh uniworx:test:hlint diff --git a/messages/frontend/de.msg b/messages/frontend/de.msg new file mode 100644 index 000000000..f01c31640 --- /dev/null +++ b/messages/frontend/de.msg @@ -0,0 +1,4 @@ +FilesSelected: Dateien ausgewählt +SelectFile: Datei auswählen +SelectFiles: Datei(en) auswählen +AsyncFormFailure: Da ist etwas schief gelaufen, das tut uns Leid. Falls das erneut passiert schicke uns gerne eine kurze Beschreibung dieses Ereignisses über das Hilfe-Widget rechts oben. Vielen Dank für deine Hilfe! \ No newline at end of file diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg index 71ac1bcd6..44fad53b3 100644 --- a/messages/uniworx/de.msg +++ b/messages/uniworx/de.msg @@ -159,21 +159,21 @@ SheetInvisibleUntil date@Text: Dieses Übungsblatt ist für Teilnehmer momentan SheetName: Name SheetDescription: Hinweise für Teilnehmer SheetGroup: Gruppenabgabe -SheetVisibleFrom: Sichtbar ab -SheetVisibleFromTip: Ohne Datum wird das Blatt nie sichtbar, z.B. weil es noch nicht fertig ist -SheetActiveFrom: Aktiv ab -SheetActiveFromTip: Abgabe und Download der Aufgabenstellung ist erst ab diesem Datum möglich -SheetActiveTo: Abgabefrist +SheetVisibleFrom: Sichtbar für Teilnehmer ab +SheetVisibleFromTip: Ohne Datum nie sichtbar und keine Abgabe möglich; nur für unfertige Blätter leer lassen, deren Fristen/Bewertung sich noch ändern kann +SheetActiveFrom: Beginn Abgabezeitraum +SheetActiveFromTip: Download der Aufgabenstellung erst ab diesem Datum möglich +SheetActiveTo: Ende Abgabezeitraum SheetHintFromTip: Ohne Datum nie für Teilnehmer sichtbar, Korrektoren können diese Dateien immer herunterladen SheetSolutionFromTip: Ohne Datum nie für Teilnehmer sichtbar, Korrektoren können diese Dateien immer herunterladen SheetMarkingTip: Hinweise zur Korrektur, sichtbar nur für Korrektoren SheetPseudonym: Persönliches Abgabe-Pseudonym SheetGeneratePseudonym: Generieren -SheetErrVisibility: Sichtbarkeit muss vor Beginn der Abgabefrist liegen -SheetErrDeadlineEarly: Ende der Abgabefrist muss nach deren Beginn liegen -SheetErrHintEarly: Hinweise dürfen erst nach Beginn der Abgabefrist herausgegeben werden -SheetErrSolutionEarly: Die Lösung sollte erst nach Ende der Abgabefrist herausgegeben werden +SheetErrVisibility: "Beginn Abgabezeitraum" muss nach "Sichbar für Teilnehmer ab" liegen +SheetErrDeadlineEarly: "Ende Abgabezeitraum" muss nach "Beginn Abzeitraum" liegen +SheetErrHintEarly: Hinweise dürfen erst nach Beginn des Abgabezeitraums herausgegeben werden +SheetErrSolutionEarly: Lösungen dürfen erst nach Ende der Abgabezeitraums herausgegeben werden Deadline: Abgabe @@ -244,7 +244,7 @@ AddCorrector: Zusätzlicher Korrektor CorrectorExists email@UserEmail: #{email} ist bereits als Korrektor eingetragen SheetCorrectorsTitle tid@TermId ssh@SchoolId csh@CourseShorthand sheetName@SheetName: Korrektoren für #{display tid}-#{display ssh}-#{csh} #{sheetName} CountTutProp: Tutorien zählen gegen Proportion -AutoAssignCorrs: Korrekturen am Ende der Abgabefrist automatisch zuteilen +AutoAssignCorrs: Korrekturen nach Ablauf des Abgabezeitraums automatisch zuteilen Corrector: Korrektor Correctors: Korrektoren CorState: Status @@ -254,7 +254,7 @@ CorByProportionOnly proportion@Rational: #{display proportion} Anteile CorByProportionIncludingTutorial proportion@Rational: #{display proportion} Anteile - Tutorium CorByProportionExcludingTutorial proportion@Rational: #{display proportion} Anteile + Tutorium -RowCount count@Int64: #{display count} #{pluralDE count "Eintrag" "Einträge"} insgesamt +RowCount count@Int64: #{display count} #{pluralDE count "Eintrag" "Einträge"} nach Filter DeleteRow: Zeile entfernen ProportionNegative: Anteile dürfen nicht negativ sein CorrectorUpdated: Korrektor erfolgreich aktualisiert @@ -294,7 +294,10 @@ Settings: Individuelle Benutzereinstellungen SettingsUpdate: Einstellungen wurden gespeichert. Never: Nie +PreviouslyUploadedInfo: Bereits hochgeladene Dateien: +PreviouslyUploadedDeletionInfo: (Nicht ausgewählte Dateien werden gelöscht) MultiFileUploadInfo: (Mehrere Dateien mit Shift oder Strg auswählen) +AddMoreFiles: Weitere Dateien hinzufügen: NrColumn: Nr SelectColumn: Auswahl @@ -496,7 +499,7 @@ MailSubmissionsUnassignedIntro n@Int courseName@Text termDesc@Text sheetName@She MailSubjectSheetSoonInactive csh@CourseShorthand sheetName@SheetName: #{sheetName} in #{csh} kann nur noch kurze Zeit abgegeben werden MailSheetSoonInactiveIntro courseName@Text termDesc@Text sheetName@SheetName: Abgabefirst für #{sheetName} im Kurs #{courseName} (#{termDesc}) endet in Kürze. -MailSubjectSheetInactive csh@CourseShorthand sheetName@SheetName: Abgabfrist für #{sheetName} in #{csh} abgelaufen +MailSubjectSheetInactive csh@CourseShorthand sheetName@SheetName: Abgabezeitraum für #{sheetName} in #{csh} abgelaufen MailSheetInactiveIntro courseName@Text termDesc@Text sheetName@SheetName n@Int num@Int64: Die Abgabefirst für #{sheetName} im Kurs #{courseName} (#{termDesc}) beendet. Es gab #{noneOneMoreDE n "Keine Abgaben" "Nur eine Abgabe von " (display n <> " Abgaben von ")}#{noneOneMoreDE num "" "einem Teilnehmer" (display num <> " Teilnehmern")}. MailSubjectCorrectionsAssigned csh@CourseShorthand sheetName@SheetName: Ihnen wurden Korrekturen zu #{sheetName} in #{csh} zugeteilt @@ -510,6 +513,7 @@ MailLecturerRights n@Int: Als Dozent dürfen Sie Veranstaltungen innerhalb #{plu MailEditNotifications: Benachrichtigungen ein-/ausschalten MailSubjectSupport: Supportanfrage +MailSubjectSupportCustom customSubject@Text: [Support] #{customSubject} SheetGrading: Bewertung SheetGradingPoints maxPoints@Points: #{tshow maxPoints} Punkte @@ -553,7 +557,7 @@ NotificationTriggerSubmissionRatedGraded: Meine Abgabe in einem gewerteten Übun NotificationTriggerSubmissionRated: Meine Abgabe wurde korrigiert NotificationTriggerSheetActive: Ich kann ein neues Übungsblatt herunterladen NotificationTriggerSheetSoonInactive: Ich kann ein Übungsblatt bald nicht mehr abgeben -NotificationTriggerSheetInactive: Abgabefrist eines meiner Übungsblätter ist abgelaufen +NotificationTriggerSheetInactive: Abgabezeitraum eines meiner Übungsblätter ist abgelaufen NotificationTriggerCorrectionsAssigned: Mir wurden Abgaben zur Korrektur zugeteilt NotificationTriggerCorrectionsNotDistributed: Abgaben eines meiner Übungsblätter konnten keinem Korrektur zugeteilt werden NotificationTriggerUserRightsUpdate: Meine Berechtigungen wurden geändert @@ -584,6 +588,7 @@ HelpAnswer: Antworten an HelpUser: Meinen Benutzeraccount HelpAnonymous: Keine Antwort (Anonym) HelpEmail: E-Mail +HelpSubject: Betreff HelpRequest: Supportanfrage / Verbesserungsvorschlag HelpProblemPage: Problematische Seite HelpIntroduction: Wenn Ihnen die Benutzung dieser Webseite Schwierigkeiten bereitet oder Sie einen verbesserbaren Umstand entdecken bitten wir Sie uns das zu melden, auch wenn Sie Ihr Problem bereits selbst lösen konnten. Wir passen die Seite ständig an und versuchen sie auch für zukünftige Benutzer so einsichtig wie möglich zu halten. @@ -739,4 +744,4 @@ AddRecipientCustom: Weitere Empfänger RGCourseParticipants: Kursteilnehmer RGCourseLecturers: Kursverwalter -RGCourseCorrectors: Korrektoren \ No newline at end of file +RGCourseCorrectors: Korrektoren diff --git a/package.yaml b/package.yaml index 339ecff3e..c2a1ebf61 100644 --- a/package.yaml +++ b/package.yaml @@ -218,6 +218,9 @@ executables: dependencies: - uniworx other-modules: [] + when: + - condition: flag(library-only) + buildable: false # Test suite tests: diff --git a/src/Auth/LDAP.hs b/src/Auth/LDAP.hs index 5233faaf3..2131bf527 100644 --- a/src/Auth/LDAP.hs +++ b/src/Auth/LDAP.hs @@ -66,7 +66,7 @@ campusForm :: ( RenderMessage site FormMessage , Button site ButtonSubmit ) => AForm (HandlerT site IO) CampusLogin campusForm = CampusLogin - <$> areq ciField (fslpI MsgCampusIdent "user.name@campus.lmu.de" & setTooltip MsgCampusIdentNote) Nothing + <$> areq ciField (fslpI MsgCampusIdent "user.name@campus.lmu.de" & setTooltip MsgCampusIdentNote & addAttr "autofocus" "") Nothing <*> areq passwordField (fslI MsgCampusPassword) Nothing campusLogin :: forall site. diff --git a/src/Database/Esqueleto/Utils.hs b/src/Database/Esqueleto/Utils.hs index f3aec73aa..6c89e6c96 100644 --- a/src/Database/Esqueleto/Utils.hs +++ b/src/Database/Esqueleto/Utils.hs @@ -5,8 +5,9 @@ module Database.Esqueleto.Utils , isInfixOf, hasInfix , any, all , SqlIn(..) - , mkExactFilter, mkContainsFilter - , anyFilter + , mkExactFilter, mkExactFilterWith + , mkContainsFilter + , anyFilter, allFilter ) where import ClassyPrelude.Yesod hiding (isInfixOf, any, all) @@ -74,13 +75,22 @@ _queryFeaturesDegree = $(sqlIJproj 3 2) -- Given a lens-like function, make filter for exact matches in a collection -- (Generalizing from Set to Foldable ok here, but gives ambigouus types elsewhere) mkExactFilter :: (PersistField a) - => (t -> E.SqlExpr (E.Value a)) -- ^ getter from query to searched element + => (t -> E.SqlExpr (E.Value a)) -- ^ getter from query to searched element -> t -- ^ query row -> Set.Set a -- ^ needle collection -> E.SqlExpr (E.Value Bool) -mkExactFilter lenslike row criterias +mkExactFilter = mkExactFilterWith id + +-- | like @mkExactFiler@ but allows for conversion; convenient in conjunction with @anyFilter@ and @allFilter@ +mkExactFilterWith :: (PersistField b) + => (a -> b) -- ^ type conversion + -> (t -> E.SqlExpr (E.Value b)) -- ^ getter from query to searched element + -> t -- ^ query row + -> Set.Set a -- ^ needle collection + -> E.SqlExpr (E.Value Bool) +mkExactFilterWith cast lenslike row criterias | Set.null criterias = true - | otherwise = lenslike row `E.in_` E.valList (Set.toList criterias) + | otherwise = lenslike row `E.in_` E.valList (cast <$> Set.toList criterias) -- | generic filter creation for dbTable -- Given a lens-like function, make filter searching for needles in String-like elements @@ -94,9 +104,22 @@ mkContainsFilter lenslike row criterias | Set.null criterias = true | otherwise = any (hasInfix $ lenslike row) criterias - -anyFilter :: (Foldable f) => f (t -> Set.Set Text-> E.SqlExpr (E.Value Bool)) - -> t -> Set.Set Text-> E.SqlExpr (E.Value Bool) +-- | Combine several filters, using logical or +anyFilter :: (Foldable f) + => f (t -> Set.Set Text-> E.SqlExpr (E.Value Bool)) + -> t + -> Set.Set Text + -> E.SqlExpr (E.Value Bool) anyFilter fltrs needle criterias = F.foldr aux false fltrs where - aux fltr acc = fltr needle criterias E.||. acc \ No newline at end of file + aux fltr acc = fltr needle criterias E.||. acc + +-- | Combine several filters, using logical and +allFilter :: (Foldable f) + => f (t -> Set.Set Text-> E.SqlExpr (E.Value Bool)) + -> t + -> Set.Set Text + -> E.SqlExpr (E.Value Bool) +allFilter fltrs needle criterias = F.foldr aux true fltrs + where + aux fltr acc = fltr needle criterias E.&&. acc \ No newline at end of file diff --git a/src/Foundation.hs b/src/Foundation.hs index 0d8e5d909..f85e69e54 100644 --- a/src/Foundation.hs +++ b/src/Foundation.hs @@ -187,6 +187,7 @@ mkMessageVariant "UniWorX" "Campus" "messages/campus" "de" mkMessageVariant "UniWorX" "Dummy" "messages/dummy" "de" mkMessageVariant "UniWorX" "PWHash" "messages/pw-hash" "de" mkMessageVariant "UniWorX" "Button" "messages/button" "de" +mkMessageVariant "UniWorX" "Frontend" "messages/frontend" "de" -- This instance is required to use forms. You can modify renderMessage to -- achieve customized and internationalized form validation messages. @@ -1053,6 +1054,11 @@ siteLayout' headingOverride widget = do hasSecondaryPageActions = any (is _PageActionSecondary) $ toListOf (traverse . _1 . _menuItemType) menuTypes hasPrimaryPageActions = any (is _PageActionPrime) $ toListOf (traverse . _1 . _menuItemType) menuTypes + MsgRenderer mr <- getMsgRenderer + let + -- See Utils.Frontend.I18n and files in messages/frontend for message definitions + frontendI18n = toJSON (mr :: FrontendMessage -> Text) + pc <- widgetToPageContent $ do -- 3rd party addScript $ StaticR js_vendor_flatpickr_js @@ -1064,20 +1070,21 @@ siteLayout' headingOverride widget = do -- polyfills addScript $ StaticR js_polyfills_fetchPolyfill_js addScript $ StaticR js_polyfills_urlPolyfill_js + -- JavaScript services + addScript $ StaticR js_services_utilRegistry_js + addScript $ StaticR js_services_httpClient_js + addScript $ StaticR js_services_i18n_js -- JavaScript utils addScript $ StaticR js_utils_alerts_js addScript $ StaticR js_utils_asidenav_js addScript $ StaticR js_utils_asyncForm_js addScript $ StaticR js_utils_asyncTable_js - addScript $ StaticR js_utils_asyncTableFilter_js addScript $ StaticR js_utils_checkAll_js - addScript $ StaticR js_utils_httpClient_js addScript $ StaticR js_utils_form_js addScript $ StaticR js_utils_inputs_js addScript $ StaticR js_utils_modal_js - addScript $ StaticR js_utils_setup_js addScript $ StaticR js_utils_showHide_js - addScript $ StaticR js_utils_tabber_js + -- addScript $ StaticR js_utils_tabber_js addStylesheet $ StaticR css_utils_alerts_scss addStylesheet $ StaticR css_utils_asidenav_scss addStylesheet $ StaticR css_utils_asyncForm_scss @@ -2221,12 +2228,9 @@ instance YesodMail UniWorX where mailT ctx mail = defMailT ctx $ do void setMailObjectId setDateCurrent - replaceMailHeader "Auto-Submitted" $ Just "auto-generated" + replaceMailHeader "Sender" . Just . addressEmail =<< getsYesod (appMailFrom . appSettings) - ret <- mail - - setMailSmtpData - return ret + mail <* setMailSmtpData instance (MonadThrow m, MonadHandler m, HandlerSite m ~ UniWorX) => MonadCrypto m where diff --git a/src/Handler/Admin.hs b/src/Handler/Admin.hs index 4d53f5eed..4e4b07eee 100644 --- a/src/Handler/Admin.hs +++ b/src/Handler/Admin.hs @@ -121,7 +121,7 @@ postAdminTestR = do let emailWidget' = wrapForm emailWidget def { formAction = Just . SomeRoute $ AdminTestR , formEncoding = emailEnctype - , formAttrs = [("data-ajax-submit", "")] + , formAttrs = [("uw-async-form", "")] } diff --git a/src/Handler/Corrections.hs b/src/Handler/Corrections.hs index 9381e0829..42c21d62a 100644 --- a/src/Handler/Corrections.hs +++ b/src/Handler/Corrections.hs @@ -161,6 +161,7 @@ colRating = sortable (Just "rating") (i18nCell MsgRating) $ \DBRow{ dbrOutput=(E mkRoute = do cid <- encrypt subId return $ CSubmissionR tid ssh csh sheetName cid CorrectionR + mTuple mA mB = (,) <$> mA <*> mB -- Hamlet does not support enough haskell-syntax for this in mconcat [ anchorCellM mkRoute $(widgetFile "widgets/rating/rating") , writerCell $ do diff --git a/src/Handler/Course.hs b/src/Handler/Course.hs index 3a2867f62..00b51056f 100644 --- a/src/Handler/Course.hs +++ b/src/Handler/Course.hs @@ -862,15 +862,28 @@ makeCourseUserTable cid colChoices psValidator = do , fltrUserEmail queryUser , fltrUserMatriclenr queryUser , fltrUserNameEmail queryUser - -- , ("course-user-degree", error "TODO") -- TODO - -- , ("field" , FilterColumn $ queryFeaturesField error "TODO") -- TODO - , ("semesternr", FilterColumn $ E.mkExactFilter $ queryFeaturesStudy >>> (E.?. StudyFeaturesSemester)) + , ("field-name" , FilterColumn $ E.mkContainsFilter $ queryFeaturesField >>> (E.?. StudyTermsName)) + , ("field-short" , FilterColumn $ E.mkContainsFilter $ queryFeaturesField >>> (E.?. StudyTermsShorthand)) + , ("field-key" , FilterColumn $ E.mkExactFilter $ queryFeaturesField >>> (E.?. StudyTermsKey)) + , ("field" , FilterColumn $ E.anyFilter + [ E.mkContainsFilter $ queryFeaturesField >>> (E.?. StudyTermsName) + , E.mkContainsFilter $ queryFeaturesField >>> (E.?. StudyTermsShorthand) + , E.mkExactFilterWith readMay $ queryFeaturesField >>> (E.?. StudyTermsKey) + ] ) + , ("degree" , FilterColumn $ E.anyFilter + [ E.mkContainsFilter $ queryFeaturesDegree >>> (E.?. StudyDegreeName) + , E.mkContainsFilter $ queryFeaturesDegree >>> (E.?. StudyDegreeShorthand) + , E.mkExactFilterWith readMay $ queryFeaturesDegree >>> (E.?. StudyDegreeKey) + ] ) + , ("semesternr" , FilterColumn $ E.mkExactFilter $ queryFeaturesStudy >>> (E.?. StudyFeaturesSemester)) -- , ("course-registration", error "TODO") -- TODO -- , ("course-user-note", error "TODO") -- TODO ] dbtFilterUI mPrev = mconcat [ fltrUserNameEmailUI mPrev , fltrUserMatriclenrUI mPrev + , prismAForm (singletonFilter "degree") mPrev $ aopt (searchField False) (fslI MsgStudyFeatureDegree) + , prismAForm (singletonFilter "field") mPrev $ aopt (searchField False) (fslI MsgCourseStudyFeature) ] dbtParams = DBParamsForm { dbParamsFormMethod = POST diff --git a/src/Handler/Help.hs b/src/Handler/Help.hs index 39c1f5381..d29b7f214 100644 --- a/src/Handler/Help.hs +++ b/src/Handler/Help.hs @@ -16,16 +16,18 @@ nullaryPathPiece ''HelpIdentOptions (camelToPathPiece' 1) embedRenderMessage ''UniWorX ''HelpIdentOptions (("Help" <>) . dropPrefix "HI") data HelpForm = HelpForm - { hfReferer:: Maybe (Route UniWorX) - , hfUserId :: Either (Maybe Address) UserId - , hfRequest:: Text + { hfReferer :: Maybe (Route UniWorX) + , hfUserId :: Either (Maybe Address) UserId + , hfSubject :: Maybe Text + , hfRequest :: Text } -helpForm :: Maybe (Route UniWorX) -> Maybe UserId -> AForm _ HelpForm -helpForm mReferer mUid = HelpForm +helpForm :: (forall msg. RenderMessage UniWorX msg => msg -> Text) -> Maybe (Route UniWorX) -> Maybe UserId -> AForm _ HelpForm +helpForm mr mReferer mUid = HelpForm <$> aopt routeField (fslI MsgHelpProblemPage & inputReadonly) (Just <$> mReferer) <*> multiActionA (fslI MsgHelpAnswer) identActions (HIUser <$ mUid) - <*> (unTextarea <$> areq textareaField (fslI MsgHelpRequest) Nothing) + <*> aopt textField (fslpI MsgHelpSubject $ mr MsgHelpSubject) Nothing + <*> (unTextarea <$> areq textareaField (fslpI MsgHelpRequest $ mr MsgHelpRequest) Nothing) where identActions :: Map _ (AForm _ (Either (Maybe Address) UserId)) identActions = Map.fromList $ case mUid of @@ -33,7 +35,7 @@ helpForm mReferer mUid = HelpForm Nothing -> defaultActions defaultActions = - [ (HIEmail, Left . Just <$> (Address <$> aopt textField (fslI MsgName) Nothing <*> apreq emailField (fslI MsgEMail) Nothing)) + [ (HIEmail, Left . Just <$> (Address <$> aopt textField (fslpI MsgName $ mr MsgName) Nothing <*> apreq emailField (fslpI MsgEMail $ mr MsgEMail) Nothing)) , (HIAnonymous, pure $ Left Nothing) ] @@ -43,19 +45,16 @@ postHelpR = do mUid <- maybeAuthId mReferer <- flip formResultMaybe return <=< runInputGetResult $ iopt routeField (toPathPiece GetReferer) isModal <- hasCustomHeader HeaderIsModal + MsgRenderer mr <- getMsgRenderer - ((res,formWidget),formEnctype) <- runFormPost $ renderAForm FormStandard $ helpForm mReferer mUid - let form = wrapForm formWidget def - { formAction = Just $ SomeRoute HelpR - , formEncoding = formEnctype - , formAttrs = [ ("data-ajax-submit", "") | isModal ] - } + ((res,formWidget),formEnctype) <- runFormPost $ renderAForm FormStandard $ helpForm mr mReferer mUid formResultModal res HelpR $ \HelpForm{..} -> do now <- liftIO getCurrentTime hfReferer' <- traverse toTextUrl hfReferer queueJob' JobHelpRequest { jSender = hfUserId + , jHelpSubject = hfSubject , jHelpRequest = hfRequest , jRequestTime = now , jReferer = hfReferer' @@ -64,4 +63,8 @@ postHelpR = do defaultLayout $ do setTitleI MsgHelpTitle - $(widgetFile "help") + wrapForm $(widgetFile "help") def + { formAction = Just $ SomeRoute HelpR + , formEncoding = formEnctype + , formAttrs = [ ("data-ajax-submit", "") | isModal ] + } diff --git a/src/Handler/Home.hs b/src/Handler/Home.hs index dba365b9c..81d9f7066 100644 --- a/src/Handler/Home.hs +++ b/src/Handler/Home.hs @@ -170,4 +170,4 @@ homeUpcomingSheets uid = do , dbtParams = def , dbtIdent = "upcoming-sheets" :: Text } - $(widgetFile "home/upcomingSheets") + $(widgetFile "home/upcomingSheets") \ No newline at end of file diff --git a/src/Handler/Profile.hs b/src/Handler/Profile.hs index 5de418a34..00ac76742 100644 --- a/src/Handler/Profile.hs +++ b/src/Handler/Profile.hs @@ -116,10 +116,11 @@ postProfileR = do siteLayout [whamlet|_{MsgProfileFor} ^{nameWidget userDisplayName userSurname}|] $ do setTitle . toHtml $ "Profil " <> userIdent - wrapForm formWidget def - { formAction = Just $ SomeRoute ProfileR - , formEncoding = formEnctype - } + let settingsForm = wrapForm formWidget def + { formAction = Just $ SomeRoute ProfileR + , formEncoding = formEnctype + } + $(widgetFile "profile") getProfileDataR :: Handler Html diff --git a/src/Handler/Sheet.hs b/src/Handler/Sheet.hs index 7faa02e29..cc5bc7718 100644 --- a/src/Handler/Sheet.hs +++ b/src/Handler/Sheet.hs @@ -199,11 +199,12 @@ getSheetListR tid ssh csh = do let stats = sheetTypeSum sheetType in -- for statistics over all shown rows case mbSub of Nothing -> cellTell mempty $ stats Nothing - (Just (Entity sid Submission{..})) -> + (Just (Entity sid sub@Submission{..})) -> let mkCid = encrypt sid mkRoute = do cid' <- mkCid return $ CSubmissionR tid ssh csh sheetName cid' CorrectionR + mTuple mA mB = (,) <$> mA <*> mB -- Hamlet does not support enough haskell-syntax for this acell = anchorCellM mkRoute $(widgetFile "widgets/rating/rating") in cellTell acell $ stats submissionRatingPoints diff --git a/src/Handler/Utils/Submission.hs b/src/Handler/Utils/Submission.hs index 124da1b83..67c8fab75 100644 --- a/src/Handler/Utils/Submission.hs +++ b/src/Handler/Utils/Submission.hs @@ -462,10 +462,10 @@ sinkSubmission userId mExists isUpdate = do case isUpdate of False -> lift . insert_ $ SubmissionEdit userId now submissionId True -> do - Submission{submissionRatingTime} <- lift $ getJust submissionId - when (isNothing submissionRatingTime) $ tellSt mempty { sinkSubmissionNotifyRating = Any True } - lift $ update submissionId [ SubmissionRatingBy =. Just userId, SubmissionRatingTime =. Just now ] - -- TODO: Should submissionRatingAssigned change here if userId changes? + Submission{submissionRatingTime, submissionRatingBy} <- lift $ getJust submissionId + when (submissionRatingBy == Just userId) $ do + when (isNothing submissionRatingTime) $ tellSt mempty { sinkSubmissionNotifyRating = Any True } + lift $ update submissionId [ SubmissionRatingTime =. Just now ] tellSt $ mempty{ sinkSubmissionTouched = Any True } finalize :: SubmissionSinkState -> YesodJobDB UniWorX () diff --git a/src/Handler/Utils/Table.hs b/src/Handler/Utils/Table.hs index 811da9e2f..2acaf2a6a 100644 --- a/src/Handler/Utils/Table.hs +++ b/src/Handler/Utils/Table.hs @@ -63,6 +63,7 @@ headedRowSelector toExternal fromExternal attrs colonnade tdata = do -> return Nothing view _ name attributes val _ = + -- TODO: move this to a *.hamlet file [whamlet|