From c5848b24e850eb0bfc13db3ff68fd05df522b057 Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Fri, 21 Feb 2020 17:34:49 +0100 Subject: [PATCH] feat: pandoc-markdown based htmlField BREAKING CHANGE: markdown based HTML input --- frontend/src/app.sass | 6 ++ messages/uniworx/de-de-formal.msg | 2 - messages/uniworx/en-eu.msg | 2 - package.yaml | 1 + src/Foundation.hs | 3 - src/Foundation/I18n.hs | 7 +- src/Handler/Course/Edit.hs | 8 +- src/Handler/Course/News/Form.hs | 6 +- src/Handler/Course/User.hs | 10 +- src/Handler/Exam/Form.hs | 2 +- src/Handler/Material.hs | 2 +- src/Handler/Sheet.hs | 4 +- src/Handler/SystemMessage.hs | 16 +-- src/Handler/Utils/Communication.hs | 4 +- src/Handler/Utils/Form.hs | 10 +- src/Handler/Utils/I18n.hs | 6 +- src/Handler/Utils/Pandoc.hs | 74 ++++++++++++++ src/Import/NoModel.hs | 1 + src/Utils/Form.hs | 10 -- stack.yaml | 15 +++ stack.yaml.lock | 98 +++++++++++++++++++ .../markdown-explanation/de-de-formal.hamlet | 3 + .../i18n/markdown-explanation/en-eu.hamlet | 3 + templates/widgets/html-field.hamlet | 9 ++ 24 files changed, 249 insertions(+), 53 deletions(-) create mode 100644 src/Handler/Utils/Pandoc.hs create mode 100644 templates/i18n/markdown-explanation/de-de-formal.hamlet create mode 100644 templates/i18n/markdown-explanation/en-eu.hamlet create mode 100644 templates/widgets/html-field.hamlet diff --git a/frontend/src/app.sass b/frontend/src/app.sass index b819e5d4a..6b65ab057 100644 --- a/frontend/src/app.sass +++ b/frontend/src/app.sass @@ -854,6 +854,12 @@ th, td dd + dt, .dd + dt, dd + .dt, .dd + .dt margin-top: 17px +.explanation + font-style: italic + font-size: 0.9rem + font-weight: 600 + color: var(--color-fontsec) + // SORTABLE TABLE-HEADERS .table__th.sortable position: relative diff --git a/messages/uniworx/de-de-formal.msg b/messages/uniworx/de-de-formal.msg index de61d9ffd..d8ef3d1de 100644 --- a/messages/uniworx/de-de-formal.msg +++ b/messages/uniworx/de-de-formal.msg @@ -138,7 +138,6 @@ CourseMembersCountLimited n@Int max@Int: #{n}/#{max} CourseMembersCountOf n@Int mbNum@IntMaybe: #{n} Kursanmeldungen #{maybeToMessage " von " mbNum " möglichen"} CourseName: Name CourseDescription: Beschreibung -CourseDescriptionTip: Beliebiges Html-Markup ist gestattet CourseHomepageExternal: Externe Homepage CourseShorthand: Kürzel CourseShorthandUnique: Muss nur innerhalb Institut und Semester eindeutig sein. Wird verbatim in die Url der Kursseite übernommen. @@ -1340,7 +1339,6 @@ NavigationFavourites: Favoriten CommSubject: Betreff CommBody: Nachricht -CommBodyTip: Das Eingabefeld akzeptiert derzeit ausschließlich Html. U.A. Zeilumbrüche werden dementsprechend ignoriert und müssen manuell mit
eingefügt werden. CommRecipients: Empfänger CommRecipientsTip: Sie selbst erhalten immer eine Kopie der Nachricht CommRecipientsList: Die an Sie selbst verschickte Kopie der Nachricht wird, zu Archivierungszwecken, eine vollständige Liste aller Empfänger enthalten. Die Empfängerliste wird im CSV-Format an die E-Mail angehängt. Andere Empfänger erhalten die Liste nicht. Bitte entfernen Sie dementsprechend den Anhang bevor Sie die E-Mail weiterleiten oder anderweitig mit Dritten teilen. diff --git a/messages/uniworx/en-eu.msg b/messages/uniworx/en-eu.msg index 19a403532..224cb684a 100644 --- a/messages/uniworx/en-eu.msg +++ b/messages/uniworx/en-eu.msg @@ -138,7 +138,6 @@ CourseMembersCountLimited n max: #{n}/#{max} CourseMembersCountOf n mbNum: #{n} #{maybeToMessage "of " mbNum " "}participants CourseName: Title CourseDescription: Description -CourseDescriptionTip: You may use arbitrary Html-Markup CourseHomepageExternal: External homepage CourseShorthand: Shorthand CourseShorthandUnique: Needs to be unique within school and semester. Will be used verbatim within the url of the course page. @@ -1339,7 +1338,6 @@ NavigationFavourites: Favourites CommSubject: Subject CommBody: Message -CommBodyTip: This input field currently accepts only Html. Line breaks are thus ignored and must be designated manually by inserting
in the appropriate places. CommRecipients: Recipients CommRecipientsTip: You always receive a copy of the message CommRecipientsList: For archival purposes the copy of the message sent to you will contain a complete list of all recipients. The list of recipients will be attached to the email in CSV-format. Other recipients do not receive the list. Thus, please remove the attachment before you forward the email or otherwise share it with third parties. diff --git a/package.yaml b/package.yaml index a81ac2588..32a5bd8df 100644 --- a/package.yaml +++ b/package.yaml @@ -139,6 +139,7 @@ dependencies: - wai-middleware-prometheus - extended-reals - rfc5051 + - pandoc other-extensions: - GeneralizedNewtypeDeriving diff --git a/src/Foundation.hs b/src/Foundation.hs index b76e29fc1..d79b5a45e 100644 --- a/src/Foundation.hs +++ b/src/Foundation.hs @@ -221,9 +221,6 @@ getTimeLocale' = $(timeLocaleMap [("de-de", "de_DE.utf8"), ("en-GB", "en_GB.utf8 appTZ :: TZ appTZ = $(includeSystemTZ "Europe/Berlin") -appLanguages :: NonEmpty Lang -appLanguages = "de-de-formal" :| ["en-eu"] - appLanguagesOpts :: ( MonadHandler m , HandlerSite m ~ UniWorX ) => m (OptionList Lang) diff --git a/src/Foundation/I18n.hs b/src/Foundation/I18n.hs index df110ddbb..aa7933300 100644 --- a/src/Foundation/I18n.hs +++ b/src/Foundation/I18n.hs @@ -1,7 +1,8 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Foundation.I18n - ( UniWorXMessage(..) + ( appLanguages + , UniWorXMessage(..) , ShortTermIdentifier(..) , MsgLanguage(..) , ShortSex(..) @@ -36,6 +37,10 @@ import Text.Shakespeare.Text (st) import GHC.Exts (IsList(..)) +appLanguages :: NonEmpty Lang +appLanguages = "de-de-formal" :| ["en-eu"] + + pluralDE :: (Eq a, Num a) => a -- ^ Count -> Text -- ^ Singular diff --git a/src/Handler/Course/Edit.hs b/src/Handler/Course/Edit.hs index 2b1b2fa7e..9c4805798 100644 --- a/src/Handler/Course/Edit.hs +++ b/src/Handler/Course/Edit.hs @@ -27,8 +27,6 @@ import Jobs.Queue import Handler.Course.LecturerInvite -import Text.Blaze.Html.Renderer.Text (renderHtml) - import qualified Data.Conduit.List as C @@ -273,15 +271,15 @@ makeCourseForm miButtonAction template = identifyForm FIDcourse . validateFormDB <*> areq (schoolFieldFor userSchools) (fslI MsgCourseSchool) (cfSchool <$> template) <* bool (pure ()) (aformMessage multipleTermsMsg) (length userTerms > 1) <*> areq termsField (fslI MsgCourseSemester) (cfTerm <$> template) - <*> aopt htmlField (fslpI MsgCourseDescription (mr MsgCourseDescriptionPlaceholder) - & setTooltip MsgCourseDescriptionTip) (cfDesc <$> template) + <*> aopt htmlField (fslpI MsgCourseDescription (mr MsgCourseDescriptionPlaceholder)) + (cfDesc <$> template) <*> aopt (urlField & cfStrip) (fslpI MsgCourseHomepageExternal (mr MsgCourseHomepageExternalPlaceholder)) (cfLink <$> template) <*> apopt checkBoxField (fslI MsgMaterialFree) (cfMatFree <$> template) <* aformSection MsgCourseFormSectionRegistration <*> allocationForm <*> apopt checkBoxField (fslI MsgCourseApplicationRequired & setTooltip MsgCourseApplicationRequiredTip) (cfAppRequired <$> template) - <*> (assertM (not . null . renderHtml) <$> aopt htmlField (fslI MsgCourseApplicationInstructions & setTooltip MsgCourseApplicationInstructionsTip) (cfAppInstructions <$> template)) + <*> aopt htmlField (fslI MsgCourseApplicationInstructions & setTooltip MsgCourseApplicationInstructionsTip) (cfAppInstructions <$> template) <*> aopt (multiFileField' . fromMaybe (return ()) $ cfAppInstructionFiles =<< template) (fslI MsgCourseApplicationTemplate & setTooltip MsgCourseApplicationTemplateTip) (cfAppInstructionFiles <$> template) <*> apopt checkBoxField (fslI MsgCourseApplicationsText & setTooltip MsgCourseApplicationsTextTip) (cfAppText <$> template) <*> uploadModeForm (cfAppFiles <$> template) diff --git a/src/Handler/Course/News/Form.hs b/src/Handler/Course/News/Form.hs index eb4edaf0a..992b1099c 100644 --- a/src/Handler/Course/News/Form.hs +++ b/src/Handler/Course/News/Form.hs @@ -7,8 +7,6 @@ module Handler.Course.News.Form import Import import Handler.Utils -import Text.Blaze.Renderer.Text (renderMarkup) - import qualified Data.Conduit.List as C import qualified Data.Set as Set @@ -41,11 +39,11 @@ courseNewsForm template = identifyForm FIDCourseNews . renderWForm FormStandard (fslI MsgCourseNewsTitle) (cnfTitle <$> template) cnfSummary' <- wopt - (htmlField & guardField (not . null . renderMarkup)) + htmlField (fslI MsgCourseNewsSummary & setTooltip MsgCourseNewsSummaryTip) (cnfSummary <$> template) cnfContent' <- wreq - (htmlField & guardField (not . null . renderMarkup)) + htmlField (fslI MsgCourseNewsContent) (cnfContent <$> template) cnfParticipantsOnly' <- wpopt checkBoxField (fslI MsgCourseNewsParticipantsOnly) (cnfParticipantsOnly <$> template) diff --git a/src/Handler/Course/User.hs b/src/Handler/Course/User.hs index 9a35b8e62..9b9806169 100644 --- a/src/Handler/Course/User.hs +++ b/src/Handler/Course/User.hs @@ -61,13 +61,15 @@ postCUserR tid ssh csh uCId = do return (studyfeat, studydegree, studyterms) return (cid, user, registration, thisUniqueNote, noteText, noteEdits, studies) let editByWgt = [whamlet| - $forall (etime,_eemail,ename,_esurname) <- noteEdits -
- _{MsgLastEdit} ^{editedByW SelFormatDateTime etime ename} + $newline never +