fraport/fradrive
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Merge branch 'master' into 302-transaction-log

Browse Source
This commit is contained in:
Gregor Kleen 2019-09-06 09:38:16 +02:00
commit 1d8630663a
18 changed files with 134 additions and 53 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
CHANGELOG.md
View File

@ -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)

2
messages/campus/de.msg
View File

@ -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

5
messages/uniworx/de.msg
View File

@ -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

2
models/materials
View File

@ -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

2
package-lock.json generated
View File

@ -1,6 +1,6 @@
{
"name": "uni2work",
"version": "6.4.0",
"version": "6.5.0",
"lockfileVersion": 1,
"requires": true,
"dependencies": {

2
package.json
View File

@ -1,6 +1,6 @@
{
"name": "uni2work",
"version": "6.4.0",
"version": "6.5.0",
"description": "",
"keywords": [],
"author": "",

2
package.yaml
View File

@ -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

4
src/Auth/Dummy.hs
View File

@ -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

20
src/Auth/LDAP.hs
View File

@ -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" []

11
src/Foundation.hs
View File

@ -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

2
src/Handler/Allocation/Show.hs
View File

@ -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")

17
src/Handler/Material.hs
View File

@ -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

6
src/Handler/School.hs
View File

@ -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)

4
src/Handler/Tutorial.hs
View File

@ -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

31
src/Handler/Utils/Form.hs
View File

@ -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

24
src/Utils/Form.hs
View File

@ -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
<datalist ##{listId}>
$forall value <- values
<option value=#{value}>
$forall Option{optionDisplay, optionExternalValue} <- options
<option value=#{optionExternalValue}>
#{optionDisplay}
|]
, fieldParse = fieldParse'
}
where
fieldParse' [t] [] = do
readExt <- liftHandlerT $ olReadExternal <$> mkOptions
case readExt t of
Just v -> return . Right $ Just v
Nothing -> fieldParse field [t] []
fieldParse' ts fs = fieldParse field ts fs
noValidate :: FieldSettings site -> FieldSettings site
noValidate = addAttr "formnovalidate" ""
noAutocomplete :: FieldSettings site -> FieldSettings site
noAutocomplete = addAttr "autocomplete" "off"
inputDisabled :: FieldSettings site -> FieldSettings site
inputDisabled = addAttr "disabled" ""

3
templates/allocation/show.hamlet
View File

@ -78,6 +78,9 @@ $if not (null courseWidgets)
<p>_{MsgAllocationPriorityTip}
<p>_{MsgAllocationPriorityRelative}
<p>_{MsgApplicationEditTip}
$if is _Just muid
<p .allocation__state>
_{MsgAllocationNumCoursesAvailableApplied numCourses numAppliedCourses}
<div .allocation__courses>
$forall courseWgt <- courseWidgets
^{courseWgt}

35
templates/allocation/show.lucius
View File

@ -3,31 +3,44 @@
font-style: italic;
}
.allocation__state {
color: var(--color-font);
font-weight: 600;
font-style: normal;
}
.allocation__courses {
margin-top: 20px;
margin: 20px 0 0 40px;
}
.allocation-course {
display: grid;
grid-template-columns: 140px 1fr;
grid-template-columns: minmax(105px, 1fr) 9fr;
grid-template-areas:
'. name '
'name name '
'prio-label prio '
'instr-label instr '
'form-label form ';
grid-gap: 5px 7px;
padding: 12px 10px;
margin: 12px 0;
padding: 0 10px 12px 7px;
&:last-child {
padding: 12px 10px 0 10px;
border-left: 1px solid var(--color-grey);
/* &:last-child {
* padding: 12px 10px 0 10px;
* }
*
* & + .allocation-course {
* border-top: 1px solid var(--color-grey);
* }
*/
&:nth-child(2n) {
background-color: rgba(0, 0, 0, 0.015);
}
& + .allocation-course {
border-top: 1px solid var(--color-grey);
}
.allocation-course__priority {
grid-area: prio;
}