diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg index 75e54f8d6..2198f54b8 100644 --- a/messages/uniworx/de.msg +++ b/messages/uniworx/de.msg @@ -269,7 +269,7 @@ CorByProportionIncludingTutorial proportion@Rational: #{display proportion} Ante CorByProportionExcludingTutorial proportion@Rational: #{display proportion} Anteile + Tutorium RowCount count@Int64: #{display count} #{pluralDE count "Eintrag" "Einträge"} nach Filter -DeleteRow: Zeile entfernen +DeleteRow: Entfernen ProportionNegative: Anteile dürfen nicht negativ sein CorrectorUpdated: Korrektor erfolgreich aktualisiert CorrectorsUpdated: Korrektoren erfolgreich aktualisiert @@ -775,6 +775,7 @@ CommSuccess n@Int: Nachricht wurde an #{tshow n} Empfänger versandt CommCourseHeading: Kursmitteilung RecipientCustom: Weitere Empfänger +RecipientToggleAll: Alle/Keine RGCourseParticipants: Kursteilnehmer RGCourseLecturers: Kursverwalter diff --git a/package.yaml b/package.yaml index 47917503c..217f65626 100644 --- a/package.yaml +++ b/package.yaml @@ -121,6 +121,7 @@ dependencies: - jose-jwt - mono-traversable - lens-aeson + - systemd other-extensions: - GeneralizedNewtypeDeriving diff --git a/src/Application.hs b/src/Application.hs index 5b130dd50..ae1ca9dbd 100644 --- a/src/Application.hs +++ b/src/Application.hs @@ -24,7 +24,8 @@ import Language.Haskell.TH.Syntax (qLocation) import Network.Wai (Middleware) import Network.Wai.Handler.Warp (Settings, defaultSettings, defaultShouldDisplayException, - runSettings, setHost, + runSettings, runSettingsSocket, setHost, + setBeforeMainLoop, setOnException, setPort, getPort) import Network.Wai.Middleware.RequestLogger (Destination (Logger), IPAddrSource (..), @@ -71,6 +72,8 @@ import qualified Data.Aeson as Aeson import System.Exit (exitFailure) import qualified Database.Memcached.Binary.IO as Memcached + +import qualified System.Systemd.Daemon as Systemd -- Import all relevant handler modules here. -- (HPack takes care to add new modules to our cabal file nowadays.) @@ -291,6 +294,7 @@ warpSettings :: UniWorX -> Settings warpSettings foundation = defaultSettings & setPort (foundation ^. _appPort) & setHost (foundation ^. _appHost) + & setBeforeMainLoop (void Systemd.notifyReady) & setOnException (\_req e -> when (defaultShouldDisplayException e) $ do logger <- readTVarIO . snd $ appLogger foundation @@ -338,7 +342,12 @@ appMain = runResourceT $ do app <- makeApplication foundation -- Run the application with Warp - liftIO $ runSettings (warpSettings foundation) app + activatedSockets <- liftIO Systemd.getActivatedSockets + liftIO $ case activatedSockets of + Just [sock] + -> runSettingsSocket (warpSettings foundation) sock app + _other + -> runSettings (warpSettings foundation) app -------------------------------------------------------------- diff --git a/src/Handler/Corrections.hs b/src/Handler/Corrections.hs index dba8b49fc..7de5e6b0d 100644 --- a/src/Handler/Corrections.hs +++ b/src/Handler/Corrections.hs @@ -721,7 +721,9 @@ postCorrectionsUploadR = do , formEncoding = uploadEncoding } - defaultLayout + + defaultLayout $ do + let uploadInstruction = $(i18nWidgetFile "corrections-upload-instructions") $(widgetFile "corrections-upload") getCorrectionsCreateR, postCorrectionsCreateR :: Handler Html diff --git a/src/Handler/Course.hs b/src/Handler/Course.hs index 5697b7bd4..4c1d7a153 100644 --- a/src/Handler/Course.hs +++ b/src/Handler/Course.hs @@ -553,7 +553,7 @@ courseEditHandler miButtonAction mbCourseForm = do case insertRes of Just _ -> queueDBJob . JobLecturerInvitation aid $ LecturerInvitation lEmail cid mLTy - Nothing -> + Nothing -> updateBy (UniqueLecturerInvitation lEmail cid) [ LecturerInvitationType =. mLTy ] insert_ $ CourseEdit aid now cid addMessageI Success $ MsgCourseEditOk tid ssh csh @@ -803,8 +803,9 @@ userTableQuery :: CourseId -> UserTableExpr -> E.SqlQuery ( E.SqlExpr (Entity Us userTableQuery cid ((user `E.InnerJoin` participant) `E.LeftOuterJoin` note `E.LeftOuterJoin` studyFeatures) = do -- Note that order of E.on for nested joins is seemingly right-to-left, ignoring nesting paranthesis features <- studyFeaturesQuery' (participant E.^. CourseParticipantField) studyFeatures - E.on $ E.just (participant E.^. CourseParticipantUser) E.==. note E.?. CourseUserNoteUser - E.on $ participant E.^. CourseParticipantUser E.==. user E.^. UserId + E.on $ (note E.?. CourseUserNoteUser E.==. E.just (participant E.^. CourseParticipantUser)) + E.&&. (note E.?. CourseUserNoteCourse E.==. E.just (E.val cid)) + E.on $ participant E.^. CourseParticipantUser E.==. user E.^. UserId E.where_ $ participant E.^. CourseParticipantCourse E.==. E.val cid return (user, participant E.^. CourseParticipantRegistration, note E.?. CourseUserNoteId, features) @@ -1130,7 +1131,7 @@ postCCommR tid ssh csh = do evalAccessDB (CourseR tid ssh csh $ CUserR cID) False } - + data ButtonLecInvite = BtnLecInvAccept | BtnLecInvDecline deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable) instance Universe ButtonLecInvite diff --git a/src/Handler/Profile.hs b/src/Handler/Profile.hs index 38f47c3e1..403e133c7 100644 --- a/src/Handler/Profile.hs +++ b/src/Handler/Profile.hs @@ -27,7 +27,7 @@ data SettingsForm = SettingsForm } makeSettingForm :: Maybe SettingsForm -> Form SettingsForm -makeSettingForm template = identifyForm FIDsettings $ \html -> do +makeSettingForm template html = do (result, widget) <- flip (renderAForm FormStandard) html $ SettingsForm <$ aformSection MsgFormCosmetics <*> areq (natFieldI $ MsgNatField "Favoriten") -- TODO: natFieldI not working here diff --git a/src/Handler/Sheet.hs b/src/Handler/Sheet.hs index 297708e5f..5016f8662 100644 --- a/src/Handler/Sheet.hs +++ b/src/Handler/Sheet.hs @@ -3,7 +3,7 @@ module Handler.Sheet where import Import import Jobs.Queue - + import System.FilePath (takeFileName) import Utils.Sheet @@ -642,7 +642,7 @@ correctorForm shid = wFormToAForm $ do Just currentRoute <- liftHandlerT getCurrentRoute userId <- liftHandlerT requireAuthId MsgRenderer mr <- getMsgRenderer - + let currentLoads :: DB Loads currentLoads = Map.union @@ -661,7 +661,7 @@ correctorForm shid = wFormToAForm $ do when (not (Map.null loads) && applyDefaultLoads) $ addMessageI Warning MsgCorrectorsDefaulted - + countTutRes <- wreq checkBoxField (fsm MsgCountTutProp) . Just . any (\(_, Load{..}) -> fromMaybe False byTutorial) $ Map.elems loads let @@ -673,7 +673,7 @@ correctorForm shid = wFormToAForm $ do E.on $ sheetCorrector E.^. SheetCorrectorUser E.==. user E.^. UserId E.where_ $ lecturer E.^. LecturerUser E.==. E.val userId return user - + miAdd :: ListPosition -> Natural -> (Text -> Text) @@ -710,7 +710,7 @@ correctorForm shid = wFormToAForm $ do User{userEmail, userDisplayName, userSurname} <- liftHandlerT . runDB $ getJust uid return $ nameEmailWidget userEmail userDisplayName userSurname return (res, $(widgetFile "sheetCorrectors/cell")) - + miDelete :: ListLength -> ListPosition @@ -748,7 +748,7 @@ correctorForm shid = wFormToAForm $ do where sheetCorrectorSheet = shid sheetCorrectorInvitationSheet = shid - + postProcess' :: (Either UserEmail UserId, (CorrectorState, Load)) -> Either SheetCorrectorInvitation SheetCorrector postProcess' (Right sheetCorrectorUser, (sheetCorrectorState, sheetCorrectorLoad)) = Right SheetCorrector{..} postProcess' (Left sheetCorrectorInvitationEmail, (sheetCorrectorInvitationState, sheetCorrectorInvitationLoad)) = Left SheetCorrectorInvitation{..} diff --git a/src/Handler/Utils/Table/Pagination.hs b/src/Handler/Utils/Table/Pagination.hs index 81ca65bd4..ce39f6300 100644 --- a/src/Handler/Utils/Table/Pagination.hs +++ b/src/Handler/Utils/Table/Pagination.hs @@ -727,6 +727,7 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db isSortable = isJust sortableKey isSorted = (`elem` directions) attrs = sortableContent ^. cellAttrs + piSorting' = [ sSet | sSet <- fromMaybe [] piSorting, Just (sortKey sSet) /= sortableKey ] return $(widgetFile "table/cell/header") columnCount :: Int64 diff --git a/src/Model/Types.hs b/src/Model/Types.hs index 527c748f1..ab73b6ba7 100644 --- a/src/Model/Types.hs +++ b/src/Model/Types.hs @@ -16,7 +16,6 @@ import Utils import Control.Lens hiding (universe) import Utils.Lens.TH -import Data.Map ((!)) import Data.Set (Set) import qualified Data.Set as Set import qualified Data.Map as Map @@ -320,19 +319,16 @@ deriveJSON defaultOptions } ''SubmissionMode derivePersistFieldJSON ''SubmissionMode -instance PathPiece SubmissionMode where - toPathPiece = (Map.fromList (zip universeF verbs) !) - where - verbs = [ "no-submissions" - , "no-upload" - , "no-unpack" - , "unpack" - , "correctors" - , "correctors+no-upload" - , "correctors+no-unpack" - , "correctors+unpack" - ] - fromPathPiece = finiteFromPathPiece +finitePathPiece ''SubmissionMode + [ "no-submissions" + , "no-upload" + , "no-unpack" + , "unpack" + , "correctors" + , "correctors+no-upload" + , "correctors+no-unpack" + , "correctors+unpack" + ] data SubmissionModeDescr = SubmissionModeNone | SubmissionModeCorrector @@ -342,7 +338,12 @@ data SubmissionModeDescr = SubmissionModeNone instance Universe SubmissionModeDescr instance Finite SubmissionModeDescr -nullaryPathPiece ''SubmissionModeDescr $ camelToPathPiece' 2 +finitePathPiece ''SubmissionModeDescr + [ "no-submissions" + , "correctors" + , "users" + , "correctors+users" + ] classifySubmissionMode :: SubmissionMode -> SubmissionModeDescr classifySubmissionMode (SubmissionMode False Nothing ) = SubmissionModeNone diff --git a/src/Utils/PathPiece.hs b/src/Utils/PathPiece.hs index 7a391bc01..c7434b54f 100644 --- a/src/Utils/PathPiece.hs +++ b/src/Utils/PathPiece.hs @@ -1,7 +1,7 @@ module Utils.PathPiece ( finiteFromPathPiece , nullaryToPathPiece - , nullaryPathPiece + , nullaryPathPiece, finitePathPiece , splitCamel , camelToPathPiece, camelToPathPiece' , tuplePathPiece @@ -16,6 +16,9 @@ import Data.Universe import qualified Data.Text as Text import qualified Data.Char as Char +import Data.Map ((!), (!?)) +import qualified Data.Map as Map + import Numeric.Natural import Data.List (foldl) @@ -44,6 +47,16 @@ nullaryPathPiece nullaryType mangle = , funD 'fromPathPiece [ clause [] (normalB [e|finiteFromPathPiece|]) [] ] ] + +finitePathPiece :: Name -> [Text] -> DecsQ +finitePathPiece finiteType verbs = + pure <$> instanceD (cxt []) [t|PathPiece $(conT finiteType)|] + [ funD 'toPathPiece + [ clause [] (normalB [|(Map.fromList (zip universeF verbs) !)|]) [] ] + , funD 'fromPathPiece + [ clause [] (normalB [e|(Map.fromList (zip verbs universeF) !?)|]) [] ] + ] + splitCamel :: Textual t => t -> [t] splitCamel = map fromList . reverse . helper (error "hasChange undefined at start of string") [] "" . otoList diff --git a/stack.yaml b/stack.yaml index 94be126d8..df8eb7fb3 100644 --- a/stack.yaml +++ b/stack.yaml @@ -49,4 +49,6 @@ extra-deps: - quickcheck-classes-0.4.14 - semirings-0.2.1.1 + - systemd-1.1.2 + resolver: lts-10.5 diff --git a/static/css/utils/checkbox.scss b/static/css/utils/checkbox.scss index 9a73b01e7..6db7f97e3 100644 --- a/static/css/utils/checkbox.scss +++ b/static/css/utils/checkbox.scss @@ -74,3 +74,9 @@ filter: grayscale(1); } } + +/* special treatment for checkboxes in table headers */ +th .checkbox { + margin-right: 7px; + vertical-align: bottom; +} diff --git a/static/js/utils/checkAll.js b/static/js/utils/checkAll.js index 86749f2a9..5a15e0ac7 100644 --- a/static/js/utils/checkAll.js +++ b/static/js/utils/checkAll.js @@ -96,9 +96,9 @@ checkAllCheckbox.setAttribute('id', getCheckboxId()); th.insertBefore(checkAllCheckbox, th.firstChild); - // manually set up newly created checkbox + // manually set up new checkbox if (UtilRegistry) { - UtilRegistry.setup(UtilRegistry.find('checkbox')); + UtilRegistry.setup(UtilRegistry.find('checkbox'), th); } checkAllCheckbox.addEventListener('input', onCheckAllCheckboxInput); diff --git a/templates/corrections-upload-instructions/de.hamlet b/templates/corrections-upload-instructions/de.hamlet new file mode 100644 index 000000000..0a04c6c4f --- /dev/null +++ b/templates/corrections-upload-instructions/de.hamlet @@ -0,0 +1,22 @@ +
+

+ Das Hochladen einer Korrekturen markiert die entsprechende + Abgabe automatisch als "korrigiert", falls Ihnen die Abgabe zugeteilt gewesen war. +

+ Lädt jedoch ein Assistent Korrekturen hoch, welche anderen Korrektoren + oder noch nicht zugeteilt wurden, so werden diese Abgaben noch nicht als "korrigiert" markiert. +

+ Es ist geplant, dass die Bewertungsdatei in Zukunft ein eigenes Feld enthält, + in dem Korrektoren angeben können, ob die Korrektur abgeschlossen ist oder nicht. +

+ Im Gegensatz zu UniWorX enthalten die heruntergeladenen Abgaben immer den + aktuellen Stand der Bewertung. Dies betrifft ggf. auch geänderte Dateien! + +

+

+ Bei der Korrektur können Dateien verändert, hinzugefügt und gelöscht werden. + Die Abgebenden werden entsprechend informiert, sobald die Abgabe als "korrigiert" markiert wurde. +

+ Temporäre Dateien einer eventuellen Vorkorrektur müssen also durch das Hochladen der + Korrekturen des letzten Korrektors gelöscht werden, falls diese den Abgabenden + nicht zur Verfügung gestellt werden sollen. diff --git a/templates/corrections-upload.hamlet b/templates/corrections-upload.hamlet index 5a7ac5710..a479c6257 100644 --- a/templates/corrections-upload.hamlet +++ b/templates/corrections-upload.hamlet @@ -1 +1,4 @@ -^{uploadForm} +

+ ^{uploadInstruction} +
+ ^{uploadForm} diff --git a/templates/table/cell/header.hamlet b/templates/table/cell/header.hamlet index 5322aef4d..408dc4561 100644 --- a/templates/table/cell/header.hamlet +++ b/templates/table/cell/header.hamlet @@ -2,10 +2,10 @@ $maybe flag <- sortableKey $case directions $of [SortAsc] - + ^{widget} $of _ - + ^{widget} $nothing ^{widget} diff --git a/templates/widgets/communication/recipientLayout.hamlet b/templates/widgets/communication/recipientLayout.hamlet index f3f759de1..5f47cb7b7 100644 --- a/templates/widgets/communication/recipientLayout.hamlet +++ b/templates/widgets/communication/recipientLayout.hamlet @@ -3,14 +3,20 @@ $if not (null activeCategories)
$forall category <- activeCategories
- +