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

Merge branch 'master' of gitlab.cip.ifi.lmu.de:jost/UniWorX

Browse Source
This commit is contained in:
SJost 2018-09-20 09:42:04 +02:00
commit 7caad588f8
18 changed files with 164 additions and 52 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
ChangeLog.md
View File

@ -9,6 +9,8 @@
Unterstützung von Tabellenzusammenfassungen, z.B. Punktsummen
Intelligente Verteilung von Abgaben auf Korrektoren (z.B. bei Krankheit)
Übungsblätter können Abgabe von Dateien verbieten und angeben ob ZIP-Archive entpackt werden sollen
* Version 06.08.2018

7
db.hs
View File

@ -196,11 +196,11 @@ fillDb = do
void . insert $ DegreeCourse ffp sdMst sdInf
void . insert $ Lecturer jost ffp
void . insert $ Lecturer gkleen ffp
sheetkey <- insert $ Sheet ffp "AdHoc-Gruppen" Nothing NotGraded (Arbitrary 3) Nothing Nothing now now Nothing Nothing
sheetkey <- insert $ Sheet ffp "AdHoc-Gruppen" Nothing NotGraded (Arbitrary 3) Nothing Nothing now now Nothing Nothing (Upload True)
insert_ $ SheetEdit gkleen now sheetkey
sheetkey <- insert $ Sheet ffp "Feste Gruppen" Nothing NotGraded RegisteredGroups Nothing Nothing now now Nothing Nothing
sheetkey <- insert $ Sheet ffp "Feste Gruppen" Nothing NotGraded RegisteredGroups Nothing Nothing now now Nothing Nothing (Upload True)
insert_ $ SheetEdit gkleen now sheetkey
sheetkey <- insert $ Sheet ffp "Keine Gruppen" Nothing NotGraded NoGroups Nothing Nothing now now Nothing Nothing
sheetkey <- insert $ Sheet ffp "Keine Gruppen" Nothing NotGraded NoGroups Nothing Nothing now now Nothing Nothing (Upload True)
insert_ $ SheetEdit gkleen now sheetkey
-- EIP
eip <- insert Course
@ -284,6 +284,7 @@ fillDb = do
, sheetVisibleFrom = Just now
, sheetActiveFrom = now
, sheetActiveTo = (14 * nominalDay) `addUTCTime` now
, sheetUploadMode = Upload True
, sheetHintFrom = Nothing
, sheetSolutionFrom = Nothing
}

9
messages/uniworx/de.msg
View File

@ -85,6 +85,7 @@ SheetDelHead tid@TermId ssh@SchoolId courseShortHand@CourseShorthand sheet
SheetDelText submissionNo@Int: Dies kann nicht mehr rückgängig gemacht werden! Alle Einreichungen gehen ebenfalls verloren! Es gibt #{display submissionNo} Abgaben.
SheetDelOk tid@TermId ssh@SchoolId courseShortHand@CourseShorthand sheetName@SheetName: #{display tid}-#{display ssh}-#{courseShortHand}: #{sheetName} gelöscht.
SheetUploadMode: Abgabe von Dateien
SheetExercise: Aufgabenstellung
SheetHint: Hinweis
SheetHintFrom: Hinweis ab
@ -289,3 +290,11 @@ CorrectorExcused: Entschuldigt
DayIsAHoliday tid@TermId date@Text: #{date} ist ein Feiertag
DayIsOutOfLecture tid@TermId date@Text: #{date} ist außerhalb der Vorlesungszeit des #{display tid}
DayIsOutOfTerm tid@TermId date@Text: #{date} liegt nicht im #{display tid}
UploadModeNone: Kein Upload
UploadModeUnpack: Upload, einzelne Datei
UploadModeNoUnpack: Upload, ZIP-Archive entpacken
SubmissionNoUploadExpected: Es ist keine Abgabe von Dateien vorgesehen.
FieldPrimary: Hauptfach
FieldSecondary: Nebenfach

1
models
View File

@ -108,6 +108,7 @@ Sheet
activeTo UTCTime
hintFrom UTCTime Maybe
solutionFrom UTCTime Maybe
uploadMode UploadMode
CourseSheet course name
SheetEdit
user UserId

6
src/Foundation.hs
View File

@ -178,6 +178,12 @@ instance RenderMessage UniWorX TermIdentifier where
Winter -> renderMessage' $ MsgWinterTerm year
where renderMessage' = renderMessage foundation ls
instance RenderMessage UniWorX StudyFieldType where
renderMessage foundation ls = \case
FieldPrimary -> renderMessage' MsgFieldPrimary
FieldSecondary -> renderMessage' MsgFieldSecondary
where renderMessage' = renderMessage foundation ls
newtype ShortTermIdentifier = ShortTermIdentifier TermIdentifier
deriving (Eq, Ord, Read, Show)

12
src/Handler/Profile.hs
View File

@ -130,10 +130,14 @@ getProfileR = do
E.where_ $ studyfeat E.^. StudyFeaturesUser E.==. E.val uid
E.on $ studyfeat E.^. StudyFeaturesField E.==. studyterms E.^. StudyTermsId
E.on $ studyfeat E.^. StudyFeaturesDegree E.==. studydegree E.^. StudyDegreeId
return (studydegree E.^. StudyDegreeName
,studyterms E.^. StudyTermsName
,studyfeat E.^. StudyFeaturesType
,studyfeat E.^. StudyFeaturesSemester)
return ( ( studydegree E.^. StudyDegreeName
, studydegree E.^. StudyDegreeKey
)
, ( studyterms E.^. StudyTermsName
, studyterms E.^. StudyTermsKey
)
, studyfeat E.^. StudyFeaturesType
, studyfeat E.^. StudyFeaturesSemester)
)
let formText = Just MsgSettings
actionUrl = ProfileR

7
src/Handler/Sheet.hs
View File

@ -82,6 +82,7 @@ data SheetForm = SheetForm
, sfVisibleFrom :: Maybe UTCTime
, sfActiveFrom :: UTCTime
, sfActiveTo :: UTCTime
, sfUploadMode :: UploadMode
, sfSheetF :: Maybe (Source Handler (Either FileId File))
, sfHintFrom :: Maybe UTCTime
, sfHintF :: Maybe (Source Handler (Either FileId File))
@ -119,6 +120,7 @@ makeSheetForm msId template = identForm FIDsheet $ \html -> do
& setTooltip MsgSheetActiveFromTip)
(sfActiveFrom <$> template)
<*> areq utcTimeField (fslI MsgSheetActiveTo) (sfActiveTo <$> template)
<*> areq uploadModeField (fslI MsgSheetUploadMode) ((sfUploadMode <$> template) <|> pure (Upload True))
<*> aopt (multiFileField $ oldFileIds SheetExercise) (fslI MsgSheetExercise) (sfSheetF <$> template)
<*> aopt utcTimeField (fslpI MsgSheetHintFrom "Datum, sonst nur für Korrektoren"
& setTooltip MsgSheetHintFromTip) (sfHintFrom <$> template)
@ -364,6 +366,7 @@ getSheetNewR tid ssh csh = do
, sfVisibleFrom = addOneWeek <$> sheetVisibleFrom
, sfActiveFrom = addOneWeek sheetActiveFrom
, sfActiveTo = addOneWeek sheetActiveTo
, sfUploadMode = sheetUploadMode
, sfSheetF = Nothing
, sfHintFrom = addOneWeek <$> sheetHintFrom
, sfHintF = Nothing
@ -397,6 +400,7 @@ getSEditR tid ssh csh shn = do
, sfVisibleFrom = sheetVisibleFrom
, sfActiveFrom = sheetActiveFrom
, sfActiveTo = sheetActiveTo
, sfUploadMode = sheetUploadMode
, sfSheetF = Just . yieldMany . map Left . Set.elems $ sheetFileIds SheetExercise
, sfHintFrom = sheetHintFrom
, sfHintF = Just . yieldMany . map Left . Set.elems $ sheetFileIds SheetHint
@ -425,7 +429,7 @@ handleSheetEdit tid ssh csh msId template dbAction = do
actTime <- liftIO getCurrentTime
cid <- getKeyBy404 $ TermSchoolCourseShort tid ssh csh
let newSheet = Sheet
{ sheetCourse = cid
{ sheetCourse = cid
, sheetName = sfName
, sheetDescription = sfDescription
, sheetType = sfType
@ -436,6 +440,7 @@ handleSheetEdit tid ssh csh msId template dbAction = do
, sheetActiveTo = sfActiveTo
, sheetHintFrom = sfHintFrom
, sheetSolutionFrom = sfSolutionFrom
, sheetUploadMode = sfUploadMode
}
mbsid <- dbAction newSheet
case mbsid of

22
src/Handler/Submission.hs
View File

@ -63,10 +63,14 @@ import System.FilePath
-- numberOfSubmissionEditDates = 3 -- for debugging only, should be 1 in production.
makeSubmissionForm :: Maybe SubmissionId -> Bool -> SheetGroup -> [UserEmail] -> Form (Maybe (Source Handler File), [UserEmail])
makeSubmissionForm msmid unpackZips grouping buddies = identForm FIDsubmission $ \html -> do
makeSubmissionForm :: Maybe SubmissionId -> UploadMode -> SheetGroup -> [UserEmail] -> Form (Maybe (Source Handler File), [UserEmail])
makeSubmissionForm msmid uploadMode grouping buddies = identForm FIDsubmission $ \html -> do
let
fileUpload = case uploadMode of
NoUpload -> pure Nothing
(Upload unpackZips) -> (bool (\f fs _ -> Just <$> areq f fs Nothing) aopt $ isJust msmid) (zipFileField unpackZips) (fsm $ bool MsgSubmissionFile MsgSubmissionArchive unpackZips) Nothing
flip (renderAForm FormStandard) html $ (,)
<$> (bool (\f fs _ -> Just <$> areq f fs Nothing) aopt $ isJust msmid) (zipFileField unpackZips) (fsm $ bool MsgSubmissionFile MsgSubmissionArchive unpackZips) Nothing
<$> fileUpload
<*> (catMaybes <$> sequenceA [bool aforced' aopt editableBuddies (ciField textField) (fslpI (MsgSubmissionMember g) "user@campus.lmu.de" ) buddy
| g <- [1..(max groupNr $ length buddies)] -- groupNr might have decreased meanwhile
| buddy <- map (Just . Just) buddies ++ repeat Nothing -- show current buddies
@ -173,8 +177,7 @@ submissionHelper tid ssh csh shn (SubmissionMode mcid) = do
return $ (userName, submissionEdit E.^. SubmissionEditTime)
forM raw $ \(E.Value name, E.Value time) -> (name, ) <$> formatTime SelFormatDateTime time
return (csheet,buddies,lastEdits)
let unpackZips = True -- undefined -- TODO
((res,formWidget), formEnctype) <- runFormPost $ makeSubmissionForm msmid unpackZips sheetGrouping buddies
((res,formWidget), formEnctype) <- runFormPost $ makeSubmissionForm msmid sheetUploadMode sheetGrouping buddies
mCID <- runDB $ do
res' <- case res of
(FormMissing ) -> return $ FormMissing
@ -231,7 +234,14 @@ submissionHelper tid ssh csh shn (SubmissionMode mcid) = do
-> return smid
(Just files, _) -- new files
-> runConduit $ transPipe lift files .| extractRatingsMsg .| sinkSubmission uid (maybe (Left shid) Right msmid) False
_ -> error "Impossible, because of definition of `makeSubmissionForm`"
(Nothing, Nothing) -- new submission, no file upload requested
-> insert Submission
{ submissionSheet = shid
, submissionRatingPoints = Nothing
, submissionRatingComment = Nothing
, submissionRatingBy = Nothing
, submissionRatingTime = Nothing
}
-- Determine members of pre-registered group
groupUids <- fmap (setFromList . map E.unValue) . E.select . E.from $ \(submissionGroupUser `E.InnerJoin` submissionGroup `E.InnerJoin` submissionGroupUser') -> do
E.on $ submissionGroup E.^. SubmissionGroupId E.==. submissionGroupUser' E.^. SubmissionGroupUserSubmissionGroup

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

@ -249,6 +249,13 @@ schoolFieldEnt = selectField $ optionsPersist [] [Asc SchoolName] schoolName
schoolFieldFor :: [SchoolId] -> Field Handler SchoolId
schoolFieldFor userSchools = selectField $ optionsPersistKey [SchoolShorthand <-. map unSchoolKey userSchools] [Asc SchoolName] schoolName
uploadModeField :: Field Handler UploadMode
uploadModeField = selectFieldList
[ (MsgUploadModeNone , NoUpload )
, (MsgUploadModeNoUnpack, Upload False)
, (MsgUploadModeUnpack , Upload True )
]
zipFileField :: Bool -- ^ Unpack zips?
-> Field Handler (Source Handler File)
zipFileField doUnpack = Field{..}

8
src/Model/Migration.hs
View File

@ -168,12 +168,18 @@ customMigrations = Map.fromListWith (>>)
, whenM (tableExists "user") $ do
userDisplayNames <- [sqlQQ| SELECT "id", "display_name" FROM "user"; |]
[executeQQ|
ALTER TABLE "user" ADD COLUMN "surname" text DEFAULT ' ';
ALTER TABLE "user" ADD COLUMN "surname" text DEFAULT '';
|]
forM_ userDisplayNames $ \(uid, Single str) -> case lastMaybe $ words str of
Just name -> update uid [UserSurname =. name]
_other -> error $ "Empty userDisplayName found"
)
, ( AppliedMigrationKey [migrationVersion|3.1.0|] [version|3.2.0|]
, whenM (tableExists "sheet") $ do
[executeQQ|
ALTER TABLE "sheet" ADD COLUMN "upload_mode" json DEFAULT '{ "tag": "Upload", "unpackZips": true }';
|]
)
]

6
src/Model/Types.hs
View File

@ -193,6 +193,12 @@ instance DisplayAble DA where
-}
data UploadMode = NoUpload | Upload { unpackZips :: Bool }
deriving (Show, Read, Eq, Ord)
deriveJSON defaultOptions ''UploadMode
derivePersistFieldJSON ''UploadMode
data ExamStatus = Attended | NoShow | Voided
deriving (Show, Read, Eq, Ord, Enum, Bounded)
derivePersistField "ExamStatus"

2
templates/default-layout.lucius
View File

@ -156,6 +156,7 @@ h4 {
position: relative;
min-height: calc(100vh - var(--header-height));
padding: 20px;
overflow: hidden;
}
@media (max-width: 768px) {
@ -169,7 +170,6 @@ h4 {
.main__content {
position: relative;
background-color: white;
overflow: hidden;
transition: padding-left .2s ease-out;
max-width: 1200px;
margin: 0 auto;

18
templates/profile.hamlet
View File

@ -49,12 +49,20 @@
<th .table__th> Studienart
<th .table__th> Semester
$forall (degree,field,fieldtype,semester) <- studies
$forall ((degree, degreeKey),(field, fieldKey),fieldtype,semester) <- studies
<tr.table__row>
<td .table__td> #{display degree}
<td .table__td> #{display field}
<td .table__td> #{display fieldtype}
<td .table__td> #{display semester}
<td .table__td>
$maybe name <- E.unValue degree
#{display name}
$nothing
#{display degreeKey}
<td .table__td>
$maybe name <- E.unValue field
#{display name}
$nothing
#{display fieldKey}
<td .table__td>_{E.unValue fieldtype}
<td .table__td>#{display semester}
$if not $ null participant
<dt .deflist__dt> Teilnehmer

17
templates/submission.hamlet
View File

@ -1,12 +1,17 @@
$maybe cID <- mcid
<section>
<h2>
<a href=@{urlArchive cID}>Archiv
(<a href=@{urlOriginal cID}>Original</a>)
$case sheetUploadMode
$of Upload _
<h2>
<a href=@{urlArchive cID}>Archiv
(<a href=@{urlOriginal cID}>Original</a>)
$maybe fileTable <- mFileTable
<h3>_{MsgSubmissionFiles}
^{fileTable}
$maybe fileTable <- mFileTable
<h3>_{MsgSubmissionFiles}
^{fileTable}
$of _
<p>
_{MsgSubmissionNoUploadExpected}
$if not (null lastEdits)
<h3>_{MsgLastEdits}

2
templates/widgets/breadcrumbs.hamlet
View File

@ -4,4 +4,4 @@ $newline never
$forall bc <- parents
<li .breadcrumbs__item>
<a .breadcrumbs__link href="@{fst bc}">#{snd bc}
<li .breadcrumbs__item>#{title}
<li .breadcrumbs__last-item>#{title}

48
templates/widgets/breadcrumbs.lucius
View File

@ -1,13 +1,28 @@
.breadcrumbs__container {
position: relative;
color: var(--color-font);
margin-bottom: 10px;
color: var(--color-lightwhite);
margin-top: -11px;
margin-right: -20px;
margin-bottom: 20px;
margin-left: -42px;
padding: 4px 13px;
padding-left: 42px;
background-color: var(--color-dark);
line-height: 30px;
}
@media (min-width: 768px) {
.breadcrumbs__container {
margin-top: -22px;
}
}
.breadcrumbs__link {
color: var(--color-lightwhite);
&:hover {
color: var(--color-fontsec);
color: var(--color-white);
}
}
@ -19,24 +34,10 @@
z-index: 1;
margin-right: 10px;
&:last-child {
margin-right: 0;
font-weight: 800;
color: var(--color-dark);
top: 1px;
&::after {
content: none;
}
}
--color-separator: var(--color-primary);
&:hover {
opacity: 1;
}
&::after {
content: '';
position: absolute;
@ -44,9 +45,18 @@
right: 0;
width: 7px;
height: 7px;
border-bottom: 1px solid var(--color-separator);
border-right: 1px solid var(--color-separator);
border-style: solid;
border-width: 0;
border-bottom-width: 1px;
border-right-width: 1px;
border-color: var(--color-white);
transform: rotate(-45deg);
z-index: 10;
}
}
.breadcrumbs__last-item {
line-height: 28px;
vertical-align: bottom;
font-weight: 600;
}

1
templates/widgets/navbar.hamlet
View File

@ -1,5 +1,6 @@
$newline never
<div .navbar-container>
<div .navbar-shadow>
<nav .navbar.js-sticky-navbar>
<a href="/" .navbar__logo>

41
templates/widgets/navbar.lucius
View File

@ -1,3 +1,30 @@
.navbar-container {
position: relative;
}
.navbar-shadow {
position: absolute;
right: 0;
height: var(--header-height-collapsed);
width: 20px;
z-index: 50;
background-image: linear-gradient(to left, rgba(0, 0, 0, 0.4), transparent);
}
@media (min-width: 768px) {
.navbar-shadow {
height: var(--header-height);
}
}
@media (min-width: 1024px) {
.navbar-shadow {
display: none;
}
}
.navbar {
position: fixed;
display: flex;
@ -5,26 +32,26 @@
align-items: center;
justify-content: flex-start;
width: 100%;
top: 0;
left: 0;
height: var(--header-height);
background: var(--color-darker); /* Old browsers */
background: -moz-linear-gradient(bottom, var(--color-dark) 0%, var(--color-darker) 100%); /* FF3.6-15 */
background: -webkit-linear-gradient(bottom, var(--color-dark) 0%,var(--color-darker) 100%); /* Chrome10-25,Safari5.1-6 */
background: linear-gradient(to top, var(--color-dark) 0%,var(--color-darker) 100%); /* W3C, IE10+, FF16+, Chrome26+, Opera12+, Safari7+ */
color: white;
margin-right: 40px;
z-index: 10;
top: 0;
left: 0;
overflow: hidden;
box-shadow: 0 0 4px rgba(0, 0, 0, 0.2);
transition: all .2s cubic-bezier(0.03, 0.43, 0.58, 1);
width: 100%;
overflow: auto;
transition: all .2s cubic-bezier(0.03, 0.43, 0.58, 1);
}
@media (max-width: 768px) {
.navbar {
padding: 0px;
margin-right: 0;
}
}
@ -167,6 +194,10 @@
+ .navbar__list {
margin-left: 12px;
}
&:last-of-type {
padding-right: 40px;
}
}
@media (min-width: 768px) {