feat: pandoc-markdown based htmlField

BREAKING CHANGE: markdown based HTML input

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

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 <br> 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.

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 <br> 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.

package.yaml

@@ -139,6 +139,7 @@ dependencies:
   - wai-middleware-prometheus
   - extended-reals
   - rfc5051
+  - pandoc
 
 other-extensions:
   - GeneralizedNewtypeDeriving

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)

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

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)
+      <*> aopt htmlField (fslpI MsgCourseDescription (mr MsgCourseDescriptionPlaceholder))
-                         & setTooltip MsgCourseDescriptionTip)          (cfDesc       <$> template)
+                                                                        (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)

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)

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
+          $newline never
-            <br>
+          <ul .list--iconless>
-            _{MsgLastEdit} ^{editedByW SelFormatDateTime etime ename}
+            $forall (etime,_eemail,ename,_esurname) <- noteEdits
+              <li>
+                _{MsgLastEdit} ^{editedByW SelFormatDateTime etime ename}
         |] -- _{MsgLastEdit} ^{formatTimeW SelFormatDateTime etime} ^{nameWidget ename esurname}
 
   ((noteRes, noteView), noteEnctype) <- runFormPost . identifyForm FIDcUserNote . renderAForm FormStandard $
-      aopt (annotateField editByWgt htmlField') (fslpI MsgCourseUserNote "HTML" & setTooltip MsgCourseUserNoteTooltip) (Just noteText)
+      aopt (annotateField editByWgt htmlField) (fslpI MsgCourseUserNote "HTML" & setTooltip MsgCourseUserNoteTooltip) (Just noteText)
   let noteFrag :: Text
       noteFrag = "notes"
       noteWidget = wrapForm noteView FormSettings

src/Handler/Exam/Form.hs

@@ -79,7 +79,7 @@ examForm template html = do
 
   flip (renderAForm FormStandard) html $ ExamForm
     <$> areq ciField (fslpI MsgExamName (mr MsgExamName) & setTooltip MsgExamNameTip) (efName <$> template)
-    <*> (assertM (not . null . renderHtml) <$> aopt htmlField (fslpI MsgExamDescription "Html") (efDescription <$> template))
+    <*> aopt htmlField (fslI MsgExamDescription) (efDescription <$> template)
     <*> apopt (selectField optionsFinite) (fslI MsgExamGradingMode & setTooltip MsgExamGradingModeTip) (efGradingMode <$> template <|> Just ExamGradingMixed)
     <*  aformSection MsgExamFormTimes
     <*> aopt utcTimeField (fslpI MsgExamStart (mr MsgDate) & setTooltip MsgExamTimeTip) (efStart <$> template)

src/Handler/Material.hs

@@ -64,7 +64,7 @@ makeMaterialForm cid template = identifyForm FIDmaterial $ \html -> do
       <*> aopt (textField & cfStrip & guardField (not . null) & cfCI & addDatalist typeOptions)
                               (fslpI MsgMaterialType $ mr MsgMaterialTypePlaceholder)
                                                              (mfType        <$> template)
-      <*> aopt htmlField      (fslpI MsgMaterialDescription "Html")
+      <*> aopt htmlField      (fslI MsgMaterialDescription)
                                                              (mfDescription <$> template)
       <*> aopt utcTimeField   (fslI MsgMaterialVisibleFrom & setTooltip visibleToolTip)
                                                             ((mfVisibleFrom <$> template) <|> pure (Just ctime))

src/Handler/Sheet.hs

@@ -113,7 +113,7 @@ makeSheetForm msId template = identifyForm FIDsheet $ \html -> do
     ctime <- ceilingQuarterHour <$> liftIO getCurrentTime
     (result, widget) <- flip (renderAForm FormStandard) html $ SheetForm
       <$> areq (textField & cfStrip & cfCI) (fslI MsgSheetName)         (sfName        <$> template)
-      <*> aopt htmlField      (fslpI MsgSheetDescription "Html") (sfDescription <$> template)
+      <*> aopt htmlField      (fslI MsgSheetDescription) (sfDescription <$> template)
       <* aformSection MsgSheetFormFiles
       <*> aopt (multiFileField $ oldFileIds SheetExercise) (fslI MsgSheetExercise) (sfSheetF <$> template)
       <*> aopt (multiFileField $ oldFileIds SheetHint)     (fslI MsgSheetHint)      (sfHintF <$> template)
@@ -139,7 +139,7 @@ makeSheetForm msId template = identifyForm FIDsheet $ \html -> do
       <*> sheetGroupAFormReq  (fslI MsgSheetGroup)        (sfGrouping    <$> template)
       <*> submissionModeForm ((sfSubmissionMode <$> template) <|> pure (SubmissionMode False . Just $ UploadAny True defaultExtensionRestriction))
       <*> apopt checkBoxField (fslI MsgAutoAssignCorrs) (sfAutoDistribute <$> template)
-      <*> aopt htmlField    (fslpI MsgSheetMarking "Html") (sfMarkingText <$> template)
+      <*> aopt htmlField    (fslI MsgSheetMarking) (sfMarkingText <$> template)
       <*> correctorForm (fromMaybe mempty $ sfCorrectors <$> template)
     return $ case result of
       FormSuccess sheetResult

src/Handler/SystemMessage.hs

@@ -33,8 +33,8 @@ postMessageR cID = do
           <*> areq checkBoxField (fslI MsgSystemMessageAuthenticatedOnly) (Just systemMessageAuthenticatedOnly)
           <*> areq (selectField optionsFinite) (fslI MsgSystemMessageSeverity) (Just systemMessageSeverity)
           <*> areq (langField False) (fslpI MsgSystemMessageLanguage (mr MsgRFC1766)) (Just systemMessageDefaultLanguage)
-          <*> areq htmlField' (fslpI MsgSystemMessageContent "Html") (Just systemMessageContent)
+          <*> areq htmlField (fslI MsgSystemMessageContent) (Just systemMessageContent)
-          <*> aopt htmlField' (fslpI MsgSystemMessageSummary "Html") (Just systemMessageSummary)
+          <*> aopt htmlField (fslI MsgSystemMessageSummary) (Just systemMessageSummary)
 
       ts <- runDB $ selectList [ SystemMessageTranslationMessage ==. smId ] [Asc SystemMessageTranslationLanguage]
       let ts' = Map.fromList $ (systemMessageTranslationLanguage . entityVal &&& id) <$> ts
@@ -47,8 +47,8 @@ postMessageR cID = do
               ( SystemMessageTranslation
                   <$> pure systemMessageTranslationMessage
                   <*> areq (langField False) (fslpI MsgSystemMessageLanguage (mr MsgRFC1766)) (Just systemMessageTranslationLanguage)
-                  <*> areq htmlField' (fslpI MsgSystemMessageContent "Html") (Just systemMessageTranslationContent)
+                  <*> areq htmlField (fslI MsgSystemMessageContent) (Just systemMessageTranslationContent)
-                  <*> aopt htmlField' (fslpI MsgSystemMessageSummary "Html") (Just systemMessageTranslationSummary)
+                  <*> aopt htmlField (fslI MsgSystemMessageSummary) (Just systemMessageTranslationSummary)
               )
           <*> combinedButtonFieldF ""
 
@@ -58,8 +58,8 @@ postMessageR cID = do
         $ SystemMessageTranslation
           <$> pure smId
           <*> areq (langField False) (fslpI MsgSystemMessageLanguage (mr MsgRFC1766)) Nothing
-          <*> areq htmlField' (fslpI MsgSystemMessageContent "Html") Nothing
+          <*> areq htmlField (fslI MsgSystemMessageContent) Nothing
-          <*> aopt htmlField' (fslpI MsgSystemMessageSummary "Html") Nothing
+          <*> aopt htmlField (fslI MsgSystemMessageSummary) Nothing
 
       formResult modifyRes $ modifySystemMessage smId
 
@@ -260,8 +260,8 @@ postMessageListR = do
     <*> areq checkBoxField (fslI MsgSystemMessageAuthenticatedOnly) Nothing
     <*> areq (selectField optionsFinite) (fslI MsgSystemMessageSeverity) Nothing
     <*> areq (langField False) (fslpI MsgSystemMessageLanguage (mr MsgRFC1766)) (Just $ NonEmpty.head appLanguages)
-    <*> areq htmlField' (fslpI MsgSystemMessageContent "Html") Nothing
+    <*> areq htmlField (fslI MsgSystemMessageContent) Nothing
-    <*> aopt htmlField' (fslpI MsgSystemMessageSummary "Html") Nothing
+    <*> aopt htmlField (fslI MsgSystemMessageSummary) Nothing
 
   case addRes of
     FormMissing -> return ()

src/Handler/Utils/Communication.hs

@@ -170,8 +170,8 @@ commR CommunicationRoute{..} =  do
   ((commRes,commWdgt),commEncoding) <- runFormPost . identifyForm FIDCommunication . renderAForm FormStandard $ Communication
     <$> recipientAForm
     <*  aformMessage recipientsListMsg
-    <*> aopt textField (fslI  MsgCommSubject)     Nothing
+    <*> aopt textField (fslI MsgCommSubject) Nothing
-    <*> areq htmlField (fslpI MsgCommBody "Html" & setTooltip MsgCommBodyTip) Nothing
+    <*> areq htmlField (fslI MsgCommBody) Nothing
   formResult commRes $ \comm -> do
     runDBJobs . runConduit $ transPipe (mapReaderT lift) (crJobs comm) .| sinkDBJobs
     addMessageI Success . MsgCommSuccess . Set.size $ cRecipients comm

src/Handler/Utils/Form.hs

@@ -1,6 +1,7 @@
 module Handler.Utils.Form
   ( module Handler.Utils.Form
   , module Handler.Utils.Form.MassInput
+  , module Handler.Utils.Pandoc
   , module Utils.Form
   , MonadWriter(..)
   ) where
@@ -9,6 +10,8 @@ import Utils.Form
 
 import Handler.Utils.Form.Types
 
+import Handler.Utils.Pandoc
+
 import Handler.Utils.DateTime
 
 import Import
@@ -327,6 +330,7 @@ annotateField :: ToWidget (HandlerSite m) wgt => wgt -> Field m a -> Field m a
 annotateField ann field@Field{fieldView=fvf} =
   let fvf' idt nmt atts ei bl =
         [whamlet|
+          $newline never
           ^{fvf idt nmt atts ei bl}
           ^{ann}
         |]
@@ -339,12 +343,6 @@ routeField :: ( Monad m
               ) => Field m (Route UniWorX)
 routeField = checkMMap (return . maybe (Left MsgInvalidRoute) Right . fromPathPiece) toPathPiece textField
 
--- | Variant that simply removes leading and trailing white space
-htmlField' :: Field Handler Html
-htmlField' = htmlField
-  { fieldParse = \vs fis -> fieldParse htmlField (map Text.strip vs) fis
-  }
-
 natFieldI :: (Monad m, Integral i, RenderMessage (HandlerSite m) msg, RenderMessage (HandlerSite m) FormMessage) => msg -> Field m i
 natFieldI msg = convertField fromInteger toInteger $ checkBool (>= 0) msg $ intMinField 0
 

src/Handler/Utils/I18n.hs

@@ -3,7 +3,9 @@ module Handler.Utils.I18n
   , i18nWidgetFilesAvailable, i18nWidgetFilesAvailable', i18nWidgetFiles
   ) where
 
-import Import
+import Import.NoFoundation
+import Foundation.Type
+import Foundation.I18n
 
 import Language.Haskell.TH
 import Language.Haskell.TH.Syntax (qRunIO)
@@ -71,7 +73,7 @@ i18nWidgetFiles basename = do
   -- Dispatch to correct language (depending on user settings via `selectLanguage`) at run time
   ws <- newName "ws" -- Name for dispatch function
   letE
-    [ funD ws $ [ clause [litP $ stringL kind, litP $ stringL l] (normalB [e|$(widgetFile $ "i18n" </> basename </> kind <.> l) :: Widget|]) []
+    [ funD ws $ [ clause [litP $ stringL kind, litP $ stringL l] (normalB [e|$(widgetFile $ "i18n" </> basename </> kind <.> l) :: WidgetFor UniWorX ()|]) []
                 | (unpack -> kind, ls) <- Map.toList availableTranslations'
                 , l <- unpack <$> NonEmpty.toList ls
                 ] ++ [ clause [wildP, wildP] (normalB [e| error "selectLanguage returned an invalid translation" |]) [] ] -- Fallback mostly there so compiler does not complain about non-exhaustive pattern match

src/Handler/Utils/Pandoc.hs

@@ -0,0 +1,74 @@
+module Handler.Utils.Pandoc
+  ( htmlField, htmlFieldSmall
+  , htmlReaderOptions, markdownReaderOptions
+  , markdownWriterOptions, htmlWriterOptions
+  ) where
+
+import Import.NoFoundation
+import Handler.Utils.I18n
+
+import qualified Data.Text as Text
+
+import qualified Text.Pandoc as P
+
+import Text.Blaze (preEscapedText)
+import Text.Blaze.Html.Renderer.Text (renderHtml)
+import Text.HTML.SanitizeXSS (sanitizeBalance)
+
+
+data HtmlFieldKind
+  = HtmlFieldNormal
+  | HtmlFieldSmall
+  deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic, Typeable)
+instance Universe HtmlFieldKind
+instance Finite HtmlFieldKind
+
+htmlField, htmlFieldSmall :: MonadLogger m => Field m Html
+htmlField = htmlField' HtmlFieldNormal
+htmlFieldSmall = htmlField' HtmlFieldSmall
+
+
+htmlField' :: MonadLogger m => HtmlFieldKind -> Field m Html
+htmlField' fieldKind = Field{..}
+  where
+    fieldEnctype = UrlEncoded
+    
+    fieldParse (t : _) _
+      = return . fmap (assertM' $ not . null . renderHtml) . parseMarkdown $ Text.strip t
+    fieldParse []     _ = return $ Right Nothing
+
+    fieldView theId name attrs val isReq = do
+      val' <- either return (maybeT (return mempty) . renderMarkdown) val
+      let markdownExplanation = $(i18nWidgetFile "markdown-explanation")
+      $(widgetFile "widgets/html-field")
+
+parseMarkdown :: Text -> Either (SomeMessage site) Html
+parseMarkdown text =
+  bimap pandocError (preEscapedText . sanitizeBalance) . P.runPure $
+    P.writeHtml5String htmlWriterOptions =<< P.readMarkdown markdownReaderOptions text
+  where
+    pandocError = SomeMessage . tshow
+
+renderMarkdown :: (MonadLogger m, MonadPlus m) => Html -> m Text
+renderMarkdown html =
+  either (\e -> logPandocError e >> mzero) return . P.runPure $
+    P.writeMarkdown markdownWriterOptions =<< P.readHtml htmlReaderOptions (toStrict $ renderHtml html)
+  where
+    logPandocError = $logErrorS "renderMarkdown" . tshow
+
+
+htmlReaderOptions, markdownReaderOptions :: P.ReaderOptions
+htmlReaderOptions = markdownReaderOptions
+markdownReaderOptions = def
+  { P.readerExtensions = P.pandocExtensions
+      & P.enableExtension P.Ext_hard_line_breaks
+      & P.enableExtension P.Ext_autolink_bare_uris
+  , P.readerTabStop = 2
+  }
+
+markdownWriterOptions, htmlWriterOptions :: P.WriterOptions
+markdownWriterOptions = def
+  { P.writerExtensions = P.readerExtensions markdownReaderOptions
+  , P.writerTabStop = P.readerTabStop markdownReaderOptions
+  }
+htmlWriterOptions = markdownWriterOptions

src/Import/NoModel.hs

@@ -17,6 +17,7 @@ import ClassyPrelude.Yesod    as Import
          , embed
          , try, embed, catches, handle, catch, bracket, bracketOnError, bracket_, catchJust, finally, handleJust, mask, mask_, onException, tryJust, uninterruptibleMask, uninterruptibleMask_
          , fail
+         , htmlField
          )
 
 import UnliftIO.Async.Utils as Import

src/Utils/Form.hs

@@ -53,10 +53,6 @@ import Utils.Frontend.Notification
 
 import Data.Proxy
 
-import Text.HTML.SanitizeXSS (sanitizeBalance)
-import Text.Blaze (preEscapedText)
-import Text.Blaze.Html.Renderer.Pretty (renderHtml)
-
 import Data.Monoid (Endo(..))
 
 
@@ -643,12 +639,6 @@ secretJsonField :: forall m a.
                 => Field m a
 secretJsonField = secretJsonField' $ fieldView (hiddenField :: Field m Text)
 
-htmlFieldSmall :: forall m. (Monad m, RenderMessage (HandlerSite m) FormMessage) => Field m Html
-htmlFieldSmall = checkMMap sanitize (pack . renderHtml) textField
-  where
-    sanitize :: Text -> m (Either FormMessage Html)
-    sanitize = return . Right . preEscapedText . sanitizeBalance
-
 fileFieldMultiple :: Monad m => Field m [FileInfo]
 fileFieldMultiple = Field
   { fieldParse = \_ files -> return $ case files of

stack.yaml

@@ -69,5 +69,20 @@ extra-deps:
 
   - extended-reals-0.2.3.0
 
+  - pandoc-2.9.2
+  - doclayout-0.3
+  - emojis-0.1
+  - hslua-module-system-0.2.1
+  - ipynb-0.1
+  - jira-wiki-markup-1.0.0
+  - HsYAML-0.2.1.0
+  - cmark-gfm-0.2.1
+  - doctemplates-0.8.1
+  - haddock-library-1.8.0
+  - pandoc-types-1.20
+  - skylighting-0.8.3.2
+  - skylighting-core-0.8.3.2
+  - texmath-0.12.0.1
+
 resolver: lts-13.21
 allow-newer: true

stack.yaml.lock

@@ -284,6 +284,104 @@ packages:
       sha256: 29629bb0ac41c49671b7f792e540165ee091eb24ffd0eaff229a2f40cc03f3af
   original:
     hackage: extended-reals-0.2.3.0
+- completed:
+    hackage: pandoc-2.9.2@sha256:fa04b214c79328a4519093a5e82fe961a21179539165b98773a6f8bfb66bc662,36181
+    pantry-tree:
+      size: 88080
+      sha256: 95eeae57b3d00eb7fa1accacab31e032f4d535c8c2cb992891a20d694eb00339
+  original:
+    hackage: pandoc-2.9.2
+- completed:
+    hackage: doclayout-0.3@sha256:06c03875b1645e6ab835c40f9b73fd959b6c4232c01d06f07debedfae46723f2,2059
+    pantry-tree:
+      size: 425
+      sha256: ed2fc2dd826fbba67cb8018979be437b215735fab90dcc49ad30b296f7005eed
+  original:
+    hackage: doclayout-0.3
+- completed:
+    hackage: emojis-0.1@sha256:3cd86b552ad71c118a7822128c97054b6cf22bc4ff5b8f7e3eb0b356202aeecd,1907
+    pantry-tree:
+      size: 426
+      sha256: 0af0e5f0ba2af10a2eda8b96b41ff77d2229d90682c1220723a13b9582c4a41b
+  original:
+    hackage: emojis-0.1
+- completed:
+    hackage: hslua-module-system-0.2.1@sha256:7c498e51df885be5fd9abe9b762372ff4f125002824d8e11a7d5832154a7a1c3,2216
+    pantry-tree:
+      size: 508
+      sha256: 19a1e580174d2e02da4942887b2330804e8ceeed1ff4fd178a1bec4663e474ea
+  original:
+    hackage: hslua-module-system-0.2.1
+- completed:
+    hackage: ipynb-0.1@sha256:5b5240a9793781da557f82891d49cea63d71c8c5d3500fa3eac9fd702046b520,1926
+    pantry-tree:
+      size: 812
+      sha256: df171745ba4d6625eb71167a37237776cd10929994b05578b040592e2d5d5579
+  original:
+    hackage: ipynb-0.1
+- completed:
+    hackage: jira-wiki-markup-1.0.0@sha256:24484791e650c80c452348e2523decc9a410aa965f79c0734c1e257f93b25cd1,3576
+    pantry-tree:
+      size: 1178
+      sha256: 60c39181a59a497be6c754e1cbf03461d9c4950bd4c523ca1efe1bd11e6f6b4f
+  original:
+    hackage: jira-wiki-markup-1.0.0
+- completed:
+    hackage: HsYAML-0.2.1.0@sha256:e4677daeba57f7a1e9a709a1f3022fe937336c91513e893166bd1f023f530d68,5311
+    pantry-tree:
+      size: 1340
+      sha256: 21f61bf9cad31674126b106071dd9b852e408796aeffc90eec1792f784107eff
+  original:
+    hackage: HsYAML-0.2.1.0
+- completed:
+    hackage: cmark-gfm-0.2.1@sha256:f49c10f6f1f8f41cb5d47e69ad6593dc45d2b28a083bbe22926d9f5bebf479b5,5191
+    pantry-tree:
+      size: 4555
+      sha256: 309d25e57e2c6d43834accc1f3a0f79150b9646f412957488d100e9cf7c37100
+  original:
+    hackage: cmark-gfm-0.2.1
+- completed:
+    hackage: doctemplates-0.8.1@sha256:be34c3210d9ebbba1c10100e30d8c3ba3b6c34653ec2ed15f09e5d05055aa37d,3111
+    pantry-tree:
+      size: 2303
+      sha256: 9d4d8e7a85166ffd951b02f87be540607b55084c04730932346072329adf4913
+  original:
+    hackage: doctemplates-0.8.1
+- completed:
+    hackage: haddock-library-1.8.0@sha256:293544a80c3d817a021fec69c430e808914a9d86db0c6bd6e96a386607a66627,3850
+    pantry-tree:
+      size: 3397
+      sha256: 2fb23fd09565829807a0368011cd57ea13e9a79fa4c65a47810aaf9a528427c2
+  original:
+    hackage: haddock-library-1.8.0
+- completed:
+    hackage: pandoc-types-1.20@sha256:8393b1a73b8a6a1f3feaeb3a6592c176461082c3e4d897f1b316b1a58dd84c39,3999
+    pantry-tree:
+      size: 855
+      sha256: cdaa66d381a21406434e7a733c9b9291a3bc44b623e7a9f97ef335283770f3fa
+  original:
+    hackage: pandoc-types-1.20
+- completed:
+    hackage: skylighting-0.8.3.2@sha256:8b8573cd8820129a4c00675f52606f0f4c04c65d2e631e9e0e3d793cefdb534c,9730
+    pantry-tree:
+      size: 10380
+      sha256: cfe063d17444f6e12a8884cab7b2ec76afba9925be04155af605931793eac1f3
+  original:
+    hackage: skylighting-0.8.3.2
+- completed:
+    hackage: skylighting-core-0.8.3.2@sha256:1f7cb6c8bb9299a83c50ae1f4b00d3808e27e4401807c530c8c3df956ad26d23,8058
+    pantry-tree:
+      size: 13279
+      sha256: 1cc0d70bd3f066bf8382206721a1e3854b78fbd067ece3d76ddbfc1c4e73fd2b
+  original:
+    hackage: skylighting-core-0.8.3.2
+- completed:
+    hackage: texmath-0.12.0.1@sha256:f68e0d01b34f53552deb506ba0b53b5cbba1bc5d87cc0d3de1bb5662d00ca5db,6569
+    pantry-tree:
+      size: 274222
+      sha256: 7bcd4a5c93f645b84fc93285e4868d7a418c66408f115710a73ad5370df9edc2
+  original:
+    hackage: texmath-0.12.0.1
 snapshots:
 - completed:
     size: 498180

templates/i18n/markdown-explanation/de-de-formal.hamlet

@@ -0,0 +1,3 @@
+$newline never
+Dieses Eingabefeld akzeptiert #{iconLink}<a href="https://pandoc.org/MANUAL.html#pandocs-markdown" target=_blank>Pandoc-Markdown</a> (Englisch).<br />
+Nach dem Abschicken wird das eingegebene Markdown umgewandelt und als HTML weiterverarbeitet bzw. gespeichert.

templates/i18n/markdown-explanation/en-eu.hamlet

@@ -0,0 +1,3 @@
+$newline never
+This field accepts #{iconLink}<a href="https://pandoc.org/MANUAL.html#pandocs-markdown" target=_blank>Pandoc-Markdown</a>.<br />
+After sending, the content of will be converted into HTML before being processed further or saved.

templates/widgets/html-field.hamlet

@@ -0,0 +1,9 @@
+$newline never
+$case fieldKind
+  $of HtmlFieldNormal
+    <textarea id=#{theId} name=#{name} :isReq:required *{attrs}>
+      #{val'}
+    <p .explanation>
+      ^{markdownExplanation}
+  $of HtmlFieldSmall
+    <input id=#{theId} name=#{name} *{attrs} type="text" :isReq:required value=#{val'}>