diff --git a/CHANGELOG.md b/CHANGELOG.md index 1c7122941..f99061c58 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,21 @@ All notable changes to this project will be documented in this file. See [standard-version](https://github.com/conventional-changelog/standard-version) for commit guidelines. +## [6.5.0](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/compare/v6.4.0...v6.5.0) (2019-09-05) + + +### Bug Fixes + +* **course-edit:** expand rights of allocation admins ([7f2dd78](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/commit/7f2dd78)) +* **jobs:** implement job priorities ([e29f042](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/commit/e29f042)) + + +### Features + +* **allocation-list:** show numbers of avail. and applied-to courses ([a3f236c](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/commit/a3f236c)) + + + ## [6.4.0](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/compare/v6.3.0...v6.4.0) (2019-09-05) diff --git a/messages/campus/de.msg b/messages/campus/de.msg index 5fdf477b7..9a4b384fc 100644 --- a/messages/campus/de.msg +++ b/messages/campus/de.msg @@ -1,4 +1,4 @@ -CampusIdentNote: Campus-Kennung bitte inkl. Domain-Teil (@campus.lmu.de) angeben. +CampusIdentPlaceholder: Vorname.Nachname@campus.lmu.de CampusIdent: Campus-Kennung CampusPassword: Passwort CampusSubmit: Abschicken diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg index 7228f0612..3ad039d2b 100644 --- a/messages/uniworx/de.msg +++ b/messages/uniworx/de.msg @@ -719,6 +719,8 @@ StudyFeatureAge: Fachsemester StudyFeatureDegree: Abschluss FieldPrimary: Hauptfach FieldSecondary: Nebenfach +ShortFieldPrimary: HF +ShortFieldSecondary: NF NoStudyField: Kein Studienfach StudyFeatureType: StudyFeatureValid: Aktiv @@ -1227,7 +1229,7 @@ TutorialEdited tutn@TutorialName: Tutiorium #{tutn} erfolgreich bearbeitet TutorialEditHeading tutn@TutorialName: #{tutn} bearbeiten -MassInputTip: Es können mehrere Werte angegeben werden. Werte müssen mit + zur Liste hinzugefügt werden und können mit - wieder entfernt werden. Alle Änderungen müssen noch durch Drücken des Forumular-Knopfes bestätigt werden. +MassInputTip: Es können mehrere Werte angegeben werden. Werte müssen mit + zur Liste hinzugefügt werden und können mit - wieder entfernt werden. Alle Änderungen müssen noch durch Drücken des Formular-Knopfes bestätigt werden. HealthReport: Instanz-Zustand InstanceIdentification: Instanz-Identifikation @@ -1523,6 +1525,7 @@ AllocationActive: Aktiv AllocationName: Name AllocationAvailableCourses: Kurse AllocationAppliedCourses: Bewerbungen +AllocationNumCoursesAvailableApplied available@Int applied@Int: Sie haben sich bisher für #{applied}/#{available} #{pluralDE applied "Kurs" "Kursen"} beworben AllocationTitle termText@Text ssh'@SchoolShorthand allocation@AllocationName: #{termText} - #{ssh'}: #{allocation} AllocationShortTitle termText@Text ssh'@SchoolShorthand ash@AllocationShorthand: #{termText} - #{ssh'} - #{ash} AllocationDescription: Beschreibung diff --git a/models/materials b/models/materials index 062ab3232..01076a1cf 100644 --- a/models/materials +++ b/models/materials @@ -1,7 +1,7 @@ Material -- course material for disemination to course participants course CourseId name (CI Text) - type Text Maybe + type (CI Text) Maybe description Html Maybe visibleFrom UTCTime Maybe -- Invisible to enrolled participants before lastEdit UTCTime diff --git a/package-lock.json b/package-lock.json index dd474e46f..82fa1307c 100644 --- a/package-lock.json +++ b/package-lock.json @@ -1,6 +1,6 @@ { "name": "uni2work", - "version": "6.4.0", + "version": "6.5.0", "lockfileVersion": 1, "requires": true, "dependencies": { diff --git a/package.json b/package.json index 998a27ff6..25c9cb292 100644 --- a/package.json +++ b/package.json @@ -1,6 +1,6 @@ { "name": "uni2work", - "version": "6.4.0", + "version": "6.5.0", "description": "", "keywords": [], "author": "", diff --git a/package.yaml b/package.yaml index 61be0c32e..bfd7e66ed 100644 --- a/package.yaml +++ b/package.yaml @@ -1,5 +1,5 @@ name: uniworx -version: 6.4.0 +version: 6.5.0 dependencies: # Due to a bug in GHC 8.0.1, we block its usage diff --git a/src/Auth/Dummy.hs b/src/Auth/Dummy.hs index 9f6ad4964..53a10acde 100644 --- a/src/Auth/Dummy.hs +++ b/src/Auth/Dummy.hs @@ -23,10 +23,10 @@ dummyForm :: ( RenderMessage site FormMessage , SqlBackendCanRead (YesodPersistBackend site) , Button site ButtonSubmit ) => AForm (HandlerT site IO) (CI Text) -dummyForm = areq (selectField userList) (fslI MsgDummyIdent) Nothing +dummyForm = areq (ciField & addDatalist userList) (fslI MsgDummyIdent & noAutocomplete) Nothing where userList = fmap mkOptionList . runDB $ map toOption <$> selectList [] [Asc UserIdent] - toOption (Entity _ User{..}) = Option (CI.original userIdent) userIdent (CI.original userIdent) + toOption (Entity _ User{..}) = Option userDisplayName userIdent (CI.original userIdent) dummyLogin :: ( YesodAuth site , YesodPersist site diff --git a/src/Auth/LDAP.hs b/src/Auth/LDAP.hs index 74c669f3c..320ab6e27 100644 --- a/src/Auth/LDAP.hs +++ b/src/Auth/LDAP.hs @@ -33,7 +33,7 @@ data CampusLogin = CampusLogin , campusPassword :: Text } deriving (Generic, Typeable) -data CampusMessage = MsgCampusIdentNote +data CampusMessage = MsgCampusIdentPlaceholder | MsgCampusIdent | MsgCampusPassword | MsgCampusSubmit @@ -117,10 +117,16 @@ campusUser' conf pool User{userIdent} campusForm :: ( RenderMessage site FormMessage , RenderMessage site CampusMessage , Button site ButtonSubmit - ) => AForm (HandlerT site IO) CampusLogin -campusForm = CampusLogin - <$> areq ciField (fslpI MsgCampusIdent "user.name@campus.lmu.de" & setTooltip MsgCampusIdentNote & addAttr "autofocus" "") Nothing - <*> areq passwordField (fslI MsgCampusPassword) Nothing + ) => WForm (HandlerT site IO) (FormResult CampusLogin) +campusForm = do + MsgRenderer mr <- getMsgRenderer + + ident <- wreq ciField (fslpI MsgCampusIdent (mr MsgCampusIdentPlaceholder) & addAttr "autofocus" "") Nothing + password <- wreq passwordField (fslI MsgCampusPassword) Nothing + + return $ CampusLogin + <$> ident + <*> password apLdap :: Text apLdap = "LDAP" @@ -137,7 +143,7 @@ campusLogin conf@LdapConf{..} pool = AuthPlugin{..} apName = apLdap apDispatch :: Text -> [Text] -> HandlerT Auth (HandlerT site IO) TypedContent apDispatch "POST" [] = do - ((loginRes, _), _) <- lift . runFormPost $ renderAForm FormStandard campusForm + ((loginRes, _), _) <- lift . runFormPost $ renderWForm FormStandard campusForm case loginRes of FormFailure errs -> do forM_ errs $ addMessage Error . toHtml @@ -169,7 +175,7 @@ campusLogin conf@LdapConf{..} pool = AuthPlugin{..} loginErrorMessageI LoginR Msg.AuthError apDispatch _ _ = notFound apLogin toMaster = do - (login, loginEnctype) <- handlerToWidget . generateFormPost $ renderAForm FormStandard campusForm + (login, loginEnctype) <- handlerToWidget . generateFormPost $ renderWForm FormStandard campusForm let loginForm = wrapForm login FormSettings { formMethod = POST , formAction = Just . SomeRoute . toMaster $ PluginR "LDAP" [] diff --git a/src/Foundation.hs b/src/Foundation.hs index eb0991496..60143db44 100644 --- a/src/Foundation.hs +++ b/src/Foundation.hs @@ -350,6 +350,17 @@ instance RenderMessage UniWorX StudyDegreeTerm where where mr :: RenderMessage UniWorX msg => msg -> Text mr = renderMessage foundation ls + +newtype ShortStudyFieldType = ShortStudyFieldType StudyFieldType +embedRenderMessageVariant ''UniWorX ''ShortStudyFieldType ("Short" <>) + +data StudyDegreeTermType = StudyDegreeTermType StudyDegree StudyTerms StudyFieldType + +instance RenderMessage UniWorX StudyDegreeTermType where + renderMessage foundation ls (StudyDegreeTermType deg trm typ) = (mr trm) <> " (" <> (mr $ ShortStudyDegree deg) <> ", " <> (mr $ ShortStudyFieldType typ) <> ")" + where + mr :: RenderMessage UniWorX msg => msg -> Text + mr = renderMessage foundation ls instance RenderMessage UniWorX ExamGrade where renderMessage _ _ = pack . (showFixed False :: Deci -> String) . fromRational . review numberGrade diff --git a/src/Handler/Allocation/Show.hs b/src/Handler/Allocation/Show.hs index bb6410ef0..0029581b7 100644 --- a/src/Handler/Allocation/Show.hs +++ b/src/Handler/Allocation/Show.hs @@ -96,4 +96,6 @@ getAShowR tid ssh ash = do |] let daysToRegistrationStart = assertM (>0) $ (`diffUTCTime` now) <$> allocationRegisterFrom allocationInfoModal = modal [whamlet|_{MsgMenuAllocationInfo}|] $ Left $ SomeRoute InfoAllocationR + numCourses = length courses + numAppliedCourses = lengthOf (folded . _2 . _Just) courses $(widgetFile "allocation/show") diff --git a/src/Handler/Material.hs b/src/Handler/Material.hs index b3a7f8c72..689997aa9 100644 --- a/src/Handler/Material.hs +++ b/src/Handler/Material.hs @@ -8,7 +8,7 @@ import qualified Data.Set as Set -- import Data.Map (Map) import qualified Data.Map as Map import qualified Data.Conduit.List as C --- import qualified Data.CaseInsensitive as CI +import qualified Data.CaseInsensitive as CI -- import qualified Data.Text.Encoding as Text import qualified Database.Esqueleto as E @@ -27,7 +27,7 @@ import System.FilePath (addExtension) data MaterialForm = MaterialForm { mfName :: MaterialName - , mfType :: Maybe Text + , mfType :: Maybe (CI Text) , mfDescription :: Maybe Html , mfVisibleFrom :: Maybe UTCTime , mfFiles :: Maybe (Source Handler (Either FileId File)) @@ -42,16 +42,17 @@ makeMaterialForm cid template = identifyForm FIDmaterial $ \html -> do | Just source <- template >>= mfFiles = runConduit $ source .| C.foldMap setIds | otherwise = return Set.empty - typeOptions :: WidgetT UniWorX IO (Set Text) + typeOptions :: HandlerT UniWorX IO (OptionList (CI Text)) typeOptions = do - let defaults = Set.fromList $ map mr [MsgMaterialTypeSlides,MsgMaterialTypeCode,MsgMaterialTypeExample] - previouslyUsed <- liftHandlerT . runDB $ + let defaults = Set.fromList $ map (CI.mk . mr) [MsgMaterialTypeSlides,MsgMaterialTypeCode,MsgMaterialTypeExample] + previouslyUsed <- runDB $ E.select $ E.from $ \material -> E.distinctOnOrderBy [E.asc $ material E.^. MaterialType] $ do E.where_ $ material E.^. MaterialCourse E.==. E.val cid E.&&. E.not_ (E.isNothing $ material E.^. MaterialType) return $ material E.^. MaterialType - return $ defaults <> Set.fromList (mapMaybe E.unValue previouslyUsed) + return . mkOptionList . map (\t -> Option (CI.original t) t (CI.original t)) . Set.toAscList + $ defaults <> Set.fromList (mapMaybe E.unValue previouslyUsed) now <- liftIO getCurrentTime let ctime = ceilingQuarterHour now @@ -62,7 +63,7 @@ makeMaterialForm cid template = identifyForm FIDmaterial $ \html -> do flip (renderAForm FormStandard) html $ MaterialForm <$> areq ciField (fslI MsgMaterialName) (mfName <$> template) - <*> aopt (textField & addDatalist typeOptions) + <*> aopt (ciField & addDatalist typeOptions) (fslpI MsgMaterialType $ mr MsgMaterialTypePlaceholder) (mfType <$> template) <*> aopt htmlField (fslpI MsgMaterialDescription "Html") @@ -126,7 +127,7 @@ getMaterialListR tid ssh csh = do , dbtColonnade = widgetColonnade $ mconcat [ -- dbRow, sortable (Just "type") (i18nCell MsgMaterialType) - $ foldMap textCell . materialType . row2material + $ foldMap (textCell . CI.original) . materialType . row2material , sortable (Just "name") (i18nCell MsgMaterialName) $ liftA2 anchorCell matLink toWgt . materialName . row2material , sortable (toNothingS "description") mempty diff --git a/src/Handler/School.hs b/src/Handler/School.hs index c743dfae2..19f2646f4 100644 --- a/src/Handler/School.hs +++ b/src/Handler/School.hs @@ -69,10 +69,10 @@ mkSchoolForm :: Maybe SchoolId -> Maybe SchoolForm -> Form SchoolForm mkSchoolForm mSsh template = renderAForm FormStandard $ SchoolForm <$> maybe (\f fs -> areq f fs (sfShorthand <$> template)) (\ssh f fs -> aforced f fs (unSchoolKey ssh)) mSsh ciField (fslI MsgSchoolShort) <*> areq ciField (fslI MsgSchoolName) (sfName <$> template) - <*> (Set.fromList . mapMaybe (fmap CI.mk . assertM' (not . Text.null) . Text.strip) <$> massInputListA (textField & addDatalist ldapOrgs) (const "") (const Nothing) ("ldap-organisations" :: Text) (fslI MsgSchoolLdapOrganisations & setTooltip MsgSchoolLdapOrganisationsTip) False (fmap CI.original . Set.toList . sfOrgUnits <$> template)) + <*> (Set.fromList . mapMaybe (fmap CI.mk . assertM' (not . Text.null) . Text.strip . CI.original) <$> massInputListA (ciField & addDatalist ldapOrgs) (const "") (const Nothing) ("ldap-organisations" :: Text) (fslI MsgSchoolLdapOrganisations & setTooltip MsgSchoolLdapOrganisationsTip) False (Set.toList . sfOrgUnits <$> template)) where - ldapOrgs :: WidgetT UniWorX IO (Set (CI Text)) - ldapOrgs = liftHandlerT . runDB $ + ldapOrgs :: HandlerT UniWorX IO (OptionList (CI Text)) + ldapOrgs = fmap (mkOptionList . map (\t -> Option (CI.original t) t (CI.original t)) . Set.toAscList) . runDB $ setOf (folded . _entityVal . _schoolLdapOrgUnit) <$> selectList [] [] schoolToForm :: SchoolId -> DB (Form SchoolForm) diff --git a/src/Handler/Tutorial.hs b/src/Handler/Tutorial.hs index 0120e766f..35e40a200 100644 --- a/src/Handler/Tutorial.hs +++ b/src/Handler/Tutorial.hs @@ -341,8 +341,8 @@ tutorialForm cid template html = do ) (tfDeregisterUntil <$> template) <*> tutorForm where - tutTypeDatalist :: WidgetT UniWorX IO (Set (CI Text)) - tutTypeDatalist = liftHandlerT . runDB $ + tutTypeDatalist :: HandlerT UniWorX IO (OptionList (CI Text)) + tutTypeDatalist = fmap (mkOptionList . map (\t -> Option (CI.original t) t (CI.original t)) . Set.toAscList) . runDB $ fmap (setOf $ folded . _Value) . E.select . E.from $ \tutorial -> do E.where_ $ tutorial E.^. TutorialCourse E.==. E.val cid return $ tutorial E.^. TutorialType diff --git a/src/Handler/Utils/Form.hs b/src/Handler/Utils/Form.hs index 3e701a619..7dc44c04a 100644 --- a/src/Handler/Utils/Form.hs +++ b/src/Handler/Utils/Form.hs @@ -374,9 +374,17 @@ studyFeaturesFieldFor mRestr isOptional oldFeatures mbuid = selectField $ do E.on $ feature E.^. StudyFeaturesDegree E.==. degree E.^. StudyDegreeId E.where_ $ ((feature E.^. StudyFeaturesId) `E.in_` E.valList oldFeatures) E.||. (isActiveUserStudyFeature feature E.&&. isCorrectType feature) - return (feature E.^. StudyFeaturesId, degree, field) + return (feature, degree, field) MsgRenderer mr <- getMsgRenderer - mkOptionList . nonEmptyOptions (mr MsgNoStudyField) <$> mapM (procOptions mr) rawOptions + let showTypes + | length rawOptions <= 1 + = False + | Just restr <- mRestr + , Set.size restr == 1 + = False + | otherwise + = True + mkOptionList . nonEmptyOptions (mr MsgNoStudyField) <$> mapM (procOptions showTypes mr) rawOptions where isActiveUserStudyFeature feature = case mbuid of Nothing -> E.false @@ -386,11 +394,13 @@ studyFeaturesFieldFor mRestr isOptional oldFeatures mbuid = selectField $ do Nothing -> E.true Just restr -> feature E.^. StudyFeaturesType `E.in_` E.valList (Set.toList restr) - procOptions :: (StudyDegreeTerm -> Text) -> (E.Value StudyFeaturesId, Entity StudyDegree, Entity StudyTerms) -> Handler (Option (Maybe StudyFeaturesId)) - procOptions mr (E.Value sfid, Entity _dgid sdegree, Entity _stid sterm) = do + procOptions :: Bool -> (forall msg. RenderMessage UniWorX msg => msg -> Text) -> (Entity StudyFeatures, Entity StudyDegree, Entity StudyTerms) -> Handler (Option (Maybe StudyFeaturesId)) + procOptions showTypes mr (Entity sfid sfeat, Entity _dgid sdegree, Entity _stid sterm) = do cfid <- encrypt sfid return Option - { optionDisplay = mr $ StudyDegreeTerm sdegree sterm + { optionDisplay = if + | showTypes -> mr $ StudyDegreeTermType sdegree sterm (studyFeaturesType sfeat) + | otherwise -> mr $ StudyDegreeTerm sdegree sterm , optionInternalValue = Just sfid , optionExternalValue = toPathPiece (cfid :: CryptoID UUID StudyFeaturesId) } @@ -641,9 +651,9 @@ examGradingRuleForm prev = multiActionA actions (fslI MsgExamGradingRule) $ clas pseudonymWordField :: Field Handler PseudonymWord -pseudonymWordField = checkMMap doCheck CI.original $ textField & addDatalist (return $ map CI.original pseudonymWordlist) +pseudonymWordField = checkMMap doCheck id $ ciField & addDatalist (return $ mkOptionList [ Option w' w w' | w <- pseudonymWordlist, let w' = CI.original w ]) where - doCheck (CI.mk -> w) + doCheck w | Just w' <- find (== w) pseudonymWordlist = return $ Right w' | otherwise @@ -890,8 +900,11 @@ utcTimeField = checkMMap (return . localTimeToUTC') utcToLocalTime localTimeFiel langField :: Bool -- ^ Only allow values from `appLanguages` -> Field (HandlerT UniWorX IO) Lang -langField False = checkBool (all ((&&) <$> not . null <*> T.all Char.isAlpha) . T.splitOn "-") MsgInvalidLangFormat $ textField & addDatalist (return $ toList appLanguages) -langField True = selectField . optionsPairs . map (MsgLanguage &&& id) $ toList appLanguages +langField False = checkBool langCheck MsgInvalidLangFormat $ textField & addDatalist appLanguagesOpts + where langCheck (T.splitOn "-" -> lParts) + = all ((&&) <$> not . null <*> T.all Char.isAlpha) lParts + && not (null lParts) +langField True = selectField appLanguagesOpts jsonField :: ( ToJSON a, FromJSON a , MonadHandler m diff --git a/src/Utils/Form.hs b/src/Utils/Form.hs index 092deaa1e..52e1900f7 100644 --- a/src/Utils/Form.hs +++ b/src/Utils/Form.hs @@ -153,22 +153,36 @@ setNameClass fs gName gClass = fs { fsName = Just gName setTooltip :: RenderMessage site msg => msg -> FieldSettings site -> FieldSettings site setTooltip msg fs = fs { fsTooltip = Just $ SomeMessage msg } -addDatalist :: (PathPiece (Element vals), MonoFoldable vals, Monad m) => WidgetT (HandlerSite m) IO vals -> Field m a -> Field m a -addDatalist mValues field = field +addDatalist :: MonadHandler m => HandlerT (HandlerSite m) IO (OptionList a) -> Field m a -> Field m a +addDatalist mkOptions field = field { fieldView = \fId fName fAttrs fRes fReq -> do listId <- newIdent - values <- map toPathPiece . otoList <$> mValues + fieldView field fId fName (("list", listId) : fAttrs) fRes fReq + + options <- liftHandlerT $ olOptions <$> mkOptions [whamlet| $newline never - $forall value <- values -