diff --git a/CHANGELOG.md b/CHANGELOG.md index c98e50ecd..1fa57179b 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,51 @@ 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. +### [7.19.1](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/compare/v7.19.0...v7.19.1) (2019-10-25) + + +### Bug Fixes + +* **datepicker:** workaround for new Date(..) inconsistency ([d24ebf8](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/commit/d24ebf8)) + + + +## [7.19.0](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/compare/v7.18.3...v7.19.0) (2019-10-24) + + +### Bug Fixes + +* **datepicker:** handle output format when reformatting ([09622bd](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/commit/09622bd)) + + +### Features + +* **csv:** encoding ([81415e1](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/commit/81415e1)) + + + +### [7.18.3](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/compare/v7.18.2...v7.18.3) (2019-10-23) + + +### Bug Fixes + +* **submission-form:** fix display of all courseParticipants ([b67819d](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/commit/b67819d)) + + + +### [7.18.2](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/compare/v7.18.1...v7.18.2) (2019-10-20) + + + +### [7.18.1](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/compare/v7.18.0...v7.18.1) (2019-10-20) + + +### Bug Fixes + +* **assign-submissions:** avoid division by zero ([640326c](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/commit/640326c)) + + + ## [7.18.0](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/compare/v7.17.14...v7.18.0) (2019-10-17) diff --git a/frontend/src/utils/form/datepicker.js b/frontend/src/utils/form/datepicker.js index ec6540cc8..2cc4972c8 100644 --- a/frontend/src/utils/form/datepicker.js +++ b/frontend/src/utils/form/datepicker.js @@ -33,7 +33,7 @@ const FORM_DATE_FORMAT_MOMENT = { * @param {*} formatOut format string of the desired output date string */ function reformatDateString(dateStr, formatIn, formatOut) { - const parsedMomentDate = moment(dateStr, formatIn); + const parsedMomentDate = moment(dateStr, [formatIn, formatOut]); return parsedMomentDate.isValid() ? parsedMomentDate.format(formatOut) : dateStr; } @@ -123,12 +123,23 @@ export class Datepicker { throw new Error('Datepicker utility called on unsupported element!'); } - // format any existing dates to fancy display format on pageload - this.formatElementValue(true); + // FIXME dirty hack below; fix tail.datetime instead - // initialize tail.datetime (datepicker) instance + // get date object from internal format before datetime does nasty things with it + var parsedMomentDate = moment(this._element.value, [ FORM_DATE_FORMAT[this.elementType], FORM_DATE_FORMAT_MOMENT[this.elementType] ], true); + if (parsedMomentDate && parsedMomentDate.isValid()) { + parsedMomentDate = parsedMomentDate.toDate(); + } else { + parsedMomentDate = undefined; + } + + // initialize tail.datetime (datepicker) instance and let it do weird stuff with the element value this.datepickerInstance = datetime(this._element, { ...datepickerGlobalConfig, ...datepickerConfig }); + // reset date to something sane + if (parsedMomentDate) + this.datepickerInstance.selectDate(parsedMomentDate); + // insert the datepicker element (dt) after the form this._element.form.parentNode.insertBefore(this.datepickerInstance.dt, this._element.form.nextSibling); diff --git a/messages/uniworx/de-de-formal.msg b/messages/uniworx/de-de-formal.msg index 0ce2fca11..0a00e838e 100644 --- a/messages/uniworx/de-de-formal.msg +++ b/messages/uniworx/de-de-formal.msg @@ -1945,7 +1945,10 @@ AcceptApplicationsSecondaryRandom: Zufällig AcceptApplicationsSecondaryTime: Nach Zeitpunkt der Bewerbung CsvOptions: CSV-Optionen -CsvOptionsTip: Diese Einstellungen betreffen nur den CSV-Export; beim Import werden die verwendeten Einstellungen automatisch ermittelt. +CsvOptionsTip: Diese Einstellungen betreffen nur den CSV-Export; beim Import werden die verwendeten Einstellungen automatisch ermittelt. Als Zeichenkodierung wird beim Import stets Unicode erwartet. +CsvFormatOptions: Dateiformat +CsvTimestamp: Zeitstempel +CsvTimestampTip: Soll an den Namen jeder exportierten CSV-Datei ein Zeitstempel vorne angehängt werden? CsvPresetRFC: Standard-Konform (RFC 4180) CsvPresetExcel: Excel-Kompatibel CsvCustom: Benutzerdefiniert @@ -1953,6 +1956,10 @@ CsvDelimiter: Trennzeichen CsvUseCrLf: Zeilenumbrüche CsvQuoting: Quoting CsvQuotingTip: Wann sollen Anführungszeichen (") um Felder platziert werden, um Interpretation von im Feld enthaltenen Zeichen als Trennzeichen zu verhindern? +CsvEncoding: Encoding +CsvEncodingTip: CSV-Dateien können in einer anderen Zeichenkodierung als dem vom System standardmäßig verwendeten UTF-8 exportiert werden. Beachten Sie dass es bei nicht-UTF-8 Zeichenkodierungen wmgl. zu Darstellungsproblemen mit Sonderzeichen kommt. +CsvUTF8: UTF-8 (Unicode) +CsvCP1252: Windows CP-1252 ("ANSI") CsvDelimiterNull: Null-Byte CsvDelimiterTab: Tabulator CsvDelimiterComma: Komma diff --git a/package-lock.json b/package-lock.json index 5afa89724..fd2a7eb32 100644 --- a/package-lock.json +++ b/package-lock.json @@ -1,6 +1,6 @@ { "name": "uni2work", - "version": "7.18.0", + "version": "7.19.1", "lockfileVersion": 1, "requires": true, "dependencies": { diff --git a/package.json b/package.json index c52d819fc..b6b5193fa 100644 --- a/package.json +++ b/package.json @@ -1,6 +1,6 @@ { "name": "uni2work", - "version": "7.18.0", + "version": "7.19.1", "description": "", "keywords": [], "author": "", diff --git a/package.yaml b/package.yaml index e002f165f..9bb03756c 100644 --- a/package.yaml +++ b/package.yaml @@ -1,5 +1,5 @@ name: uniworx -version: 7.18.0 +version: 7.19.1 dependencies: - base >=4.9.1.0 && <5 diff --git a/src/Data/Encoding/Instances.hs b/src/Data/Encoding/Instances.hs new file mode 100644 index 000000000..ee73551fb --- /dev/null +++ b/src/Data/Encoding/Instances.hs @@ -0,0 +1,33 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} + +module Data.Encoding.Instances + ( + ) where + +import ClassyPrelude +import Utils.PathPiece +import Data.String (IsString(..)) +import Text.Read + +import Web.PathPieces + +import Data.Encoding + + +instance PathPiece DynEncoding where + toPathPiece = showToPathPiece + fromPathPiece = encodingFromStringExplicit . unpack + +pathPieceJSON ''DynEncoding + + +instance IsString DynEncoding where + fromString = encodingFromString +instance Read DynEncoding where + readPrec = parens $ lexP >>= \case + Ident str -> maybe (fail "Could not parse encoding") return $ encodingFromStringExplicit str + _ -> fail "Ident lexeme expected" + + +instance Ord DynEncoding where + compare = comparing show diff --git a/src/Handler/Profile.hs b/src/Handler/Profile.hs index b68c93006..19c59a07c 100644 --- a/src/Handler/Profile.hs +++ b/src/Handler/Profile.hs @@ -827,7 +827,7 @@ postCsvOptionsR = do Entity uid User{userCsvOptions} <- requireAuth ((optionsRes, optionsWgt'), optionsEnctype) <- runFormPost . renderAForm FormStandard $ - csvOptionsForm (fslI MsgCsvOptions & setTooltip MsgCsvOptionsTip) (Just userCsvOptions) + csvOptionsForm (Just userCsvOptions) formResultModal optionsRes CsvOptionsR $ \opts -> do lift . runDB $ update uid [ UserCsvOptions =. opts ] diff --git a/src/Handler/Submission.hs b/src/Handler/Submission.hs index a925753dd..8e5ca85c1 100644 --- a/src/Handler/Submission.hs +++ b/src/Handler/Submission.hs @@ -155,9 +155,24 @@ makeSubmissionForm cid msmid uploadMode grouping isLecturer prefillUsers = ident E.where_ $ participant E.^. CourseParticipantCourse E.==. E.val cid E.orderBy [E.asc $ user E.^. UserEmail] return user + previousCoSubmittors :: UserId -> E.SqlQuery (E.SqlExpr (Entity User)) + previousCoSubmittors uid = E.from $ \(user `E.InnerJoin` submissionUser `E.InnerJoin` submission `E.InnerJoin` sheet) -> do + E.on $ sheet E.^. SheetId E.==. submission E.^. SubmissionSheet + E.&&. sheet E.^. SheetCourse E.==. E.val cid + E.on $ submission E.^. SubmissionId E.==. submissionUser E.^. SubmissionUserSubmission + E.on $ user E.^. UserId E.==. submissionUser E.^. SubmissionUserUser + E.where_ . E.exists . E.from $ \submissionUser' -> + E.where_ $ submissionUser' E.^. SubmissionUserUser E.==. E.val uid + E.&&. submissionUser' E.^. SubmissionUserSubmission E.==. submission E.^. SubmissionId + E.orderBy [E.asc $ user E.^. UserEmail] + return user - addField :: (MonadHandler m, HandlerSite m ~ UniWorX) => Bool -> Field m (Set (Either UserEmail UserId)) - addField isAdmin = multiUserField True $ courseUsers <$ guard isAdmin + addField, addFieldLecturer :: (MonadHandler m, HandlerSite m ~ UniWorX) => UserId -> Field m (Set (Either UserEmail UserId)) + addField = addField' False + addFieldLecturer = addField' True + addField' isAdmin uid = multiUserField True . Just $ if + | isAdmin -> courseUsers + | otherwise -> previousCoSubmittors uid addFieldSettings, submittorSettings, singleSubSettings :: FieldSettings UniWorX addFieldSettings = fslI MsgSubmissionMembers @@ -176,12 +191,13 @@ makeSubmissionForm cid msmid uploadMode grouping isLecturer prefillUsers = ident miButtonAction' mCurrent frag = mCurrent <&> \current -> SomeRoute (current :#: frag) submittorsForm - | isLecturer = do-- Form is being used by lecturer; allow Everything™ + | isLecturer = do -- Form is being used by lecturer; allow Everything™ + uid <- liftHandler requireAuthId let miAdd :: (Text -> Text) -> FieldView UniWorX -> Form ([Either UserEmail UserId] -> FormResult [Either UserEmail UserId]) miAdd nudge btn csrf = do MsgRenderer mr <- getMsgRenderer - (addRes, addView) <- mpreq (addField True) (addFieldSettings & addName (nudge "emails")) Nothing + (addRes, addView) <- mpreq (addFieldLecturer uid) (addFieldSettings & addName (nudge "emails")) Nothing let addRes' = addRes <&> \newData oldData -> if | existing <- newData `Set.intersection` Set.fromList oldData , not $ Set.null existing @@ -208,7 +224,7 @@ makeSubmissionForm cid msmid uploadMode grouping isLecturer prefillUsers = ident -> Maybe (Form (Map ListPosition (Either UserEmail UserId) -> FormResult (Map ListPosition (Either UserEmail UserId)))) miAdd _ _ nudge btn = Just $ \csrf -> do MsgRenderer mr <- getMsgRenderer - (addRes, addView) <- mpreq (addField True) (addFieldSettings & addName (nudge "emails")) Nothing + (addRes, addView) <- mpreq (addField uid) (addFieldSettings & addName (nudge "emails")) Nothing let addRes' = addRes <&> \newData oldData -> if | existing <- newData `Set.intersection` setOf folded oldData , not $ Set.null existing diff --git a/src/Handler/Utils/Csv.hs b/src/Handler/Utils/Csv.hs index b13e2c0e3..13ea6546c 100644 --- a/src/Handler/Utils/Csv.hs +++ b/src/Handler/Utils/Csv.hs @@ -2,11 +2,13 @@ module Handler.Utils.Csv ( decodeCsv, decodeCsvPositional + , timestampCsv , encodeCsv , encodeDefaultOrderedCsv , respondCsv, respondCsvDB , respondDefaultOrderedCsv, respondDefaultOrderedCsvDB , fileSourceCsv + , partIsAttachmentCsv , CsvParseError(..) , ToNamedRecord(..), FromNamedRecord(..) , DefaultOrdered(..) @@ -37,24 +39,42 @@ import qualified Data.Attoparsec.ByteString.Lazy as A import Control.Monad.Except (ExceptT) +import Handler.Utils.DateTime +import Data.Time.Format (iso8601DateFormat) -decodeCsv :: (MonadThrow m, FromNamedRecord csv, MonadLogger m) => ConduitT ByteString csv m () + +decodeCsv :: (MonadHandler m, HandlerSite m ~ UniWorX, MonadThrow m, FromNamedRecord csv) => ConduitT ByteString csv m () decodeCsv = decodeCsv' fromNamedCsv -decodeCsvPositional :: (MonadThrow m, FromRecord csv, MonadLogger m) => HasHeader -> ConduitT ByteString csv m () +decodeCsvPositional :: (MonadHandler m, HandlerSite m ~ UniWorX, MonadThrow m, FromRecord csv) => HasHeader -> ConduitT ByteString csv m () decodeCsvPositional hdr = decodeCsv' (`fromCsv` hdr) -decodeCsv' :: (MonadThrow m, MonadLogger m) => (forall m'. Monad m' => DecodeOptions -> ConduitT ByteString csv (ExceptT CsvParseError m') ()) -> ConduitT ByteString csv m () -decodeCsv' fromCsv' = transPipe throwExceptT $ do - testBuffer <- accumTestBuffer LBS.empty - mapM_ leftover $ LBS.toChunks testBuffer +decodeCsv' :: (MonadHandler m, HandlerSite m ~ UniWorX, MonadThrow m) => (forall m'. Monad m' => DecodeOptions -> ConduitT ByteString csv (ExceptT CsvParseError m') ()) -> ConduitT ByteString csv m () +decodeCsv' fromCsv' = do + encOpts <- maybe def (userCsvOptions . entityVal) <$> lift maybeAuth - let decodeOptions = defaultDecodeOptions - & guessDelimiter testBuffer - $logInfoS "decodeCsv" [st|Guessed Csv.DecodeOptions from buffer of size #{tshow (LBS.length testBuffer)}/#{tshow testBufferSize}: #{tshow decodeOptions}|] - - fromCsv' decodeOptions + let + recode' + | enc == "UTF8" + = id + | otherwise + = \act -> do + inp <- sinkLazy + let inp' = encodeLazyByteString UTF8 $ decodeLazyByteString enc inp + sourceLazy inp' .| act + where enc = encOpts ^. _csvFormat . _csvEncoding + + recode' decodeCsv'' where + decodeCsv'' = transPipe throwExceptT $ do + testBuffer <- accumTestBuffer LBS.empty + mapM_ leftover $ LBS.toChunks testBuffer + + let decodeOptions = defaultDecodeOptions + & guessDelimiter testBuffer + $logInfoS "decodeCsv" [st|Guessed Csv.DecodeOptions from buffer of size #{tshow (LBS.length testBuffer)}/#{tshow testBufferSize}: #{tshow decodeOptions}|] + + fromCsv' decodeOptions testBufferSize = 4096 accumTestBuffer acc | LBS.length acc >= testBufferSize = return acc @@ -115,8 +135,33 @@ encodeCsv :: ( ToNamedRecord csv -- -- Currently not streaming encodeCsv hdr = do - csvOpts <- fmap (maybe def (userCsvOptions . entityVal)) . lift $ liftHandler maybeAuth - fmap (encodeByNameWith (csvOpts ^. _CsvEncodeOptions) hdr) (C.foldMap pure) >>= C.sourceLazy + csvOpts <- maybe def (userCsvOptions . entityVal) <$> lift maybeAuth + let recode' + | enc == "UTF8" + = id + | otherwise + = encodeLazyByteString enc . decodeLazyByteString UTF8 + where enc = csvOpts ^. _csvFormat . _csvEncoding + fmap (encodeByNameWith (csvOpts ^. _csvFormat . _CsvEncodeOptions) hdr) (C.foldMap pure) >>= C.sourceLazy . recode' + +timestampCsv :: ( MonadHandler m + , HandlerSite m ~ UniWorX + ) + => m (FilePath -> FilePath) +timestampCsv = do + csvOpts <- maybe def (userCsvOptions . entityVal) <$> maybeAuth + if + | csvOpts ^. _csvTimestamp -> do + ts <- formatTime' (iso8601DateFormat $ Just "%H%M") =<< liftIO getCurrentTime + return $ (<>) (unpack ts <> "-") + | otherwise -> return id + +partIsAttachmentCsv :: (Textual t, MonadMail m, HandlerSite m ~ UniWorX) + => t + -> StateT Part m () +partIsAttachmentCsv (repack -> fName) = do + ts <- timestampCsv + partIsAttachment . ts $ fName `addExtension` unpack extensionCsv encodeDefaultOrderedCsv :: forall csv m. ( ToNamedRecord csv @@ -157,9 +202,9 @@ respondDefaultOrderedCsvDB :: forall csv. respondDefaultOrderedCsvDB = respondCsvDB $ headerOrder (error "headerOrder" :: csv) fileSourceCsv :: ( FromNamedRecord csv - , MonadResource m - , MonadLogger m , MonadThrow m + , MonadHandler m + , HandlerSite m ~ UniWorX ) => FileInfo -> ConduitT () csv m () diff --git a/src/Handler/Utils/Form.hs b/src/Handler/Utils/Form.hs index c94045265..73c8e076e 100644 --- a/src/Handler/Utils/Form.hs +++ b/src/Handler/Utils/Form.hs @@ -1117,14 +1117,15 @@ multiUserField onlySuggested suggestions = Field{..} |] whenIsJust suggestions $ \suggestions' -> do - suggestedEmails <- fmap (Set.fromList . map E.unValue) . liftHandler . runDB . E.select $ do + suggestedEmails <- fmap (Set.fromList . map (over _2 E.unValue . over _1 E.unValue)) . liftHandler . runDB . E.select $ do user <- suggestions' - return $ user E.^. UserEmail + return $ (user E.^. UserEmail, user E.^. UserDisplayName) [whamlet| $newline never - $forall email <- suggestedEmails + $forall (email, dName) <- suggestedEmails