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

src/Handler/Material.hs

@@ -267,6 +267,7 @@ postMaterialNewR tid ssh csh = do
   siteLayoutMsg headingLong $ do
     setTitleI headingShort
     editWidget
+    $(i18nWidgetFile "html-input")
 
 handleMaterialEdit :: TermId -> SchoolId -> CourseShorthand -> CourseId -> Maybe MaterialForm -> (Material -> DB (Maybe MaterialId)) -> Handler Widget
 handleMaterialEdit tid ssh csh cid template dbMaterial = do

src/Handler/Sheet.hs

@@ -127,7 +127,7 @@ makeSheetForm msId template = identifyForm FIDsheet $ \html -> do
       <*> aopt (multiFileField $ oldFileIds SheetSolution) (fslI MsgSheetSolution) (sfSolutionF <$> template)
       <*> aopt (multiFileField $ oldFileIds SheetMarking)  (fslI MsgSheetMarking
             & setTooltip MsgSheetMarkingTip)   (sfMarkingF <$> template)
-      <*> aopt htmlField      (fslI MsgSheetMarking)      (sfMarkingText <$> template)
+      <*> aopt htmlField    (fslpI MsgSheetMarking "Html") (sfMarkingText <$> template)
     return $ case result of
       FormSuccess sheetResult
         | errorMsgs <- validateSheet mr sheetResult

src/Handler/Utils.hs

@@ -202,7 +202,7 @@ warnTermDays tid times = do
 i18nWidgetFile :: FilePath -> Q Exp
 i18nWidgetFile basename = do
   -- Construct list of available translations (@de@, @en@, ...) at compile time
-  let i18nDirectory = "templates" </> basename
+  let i18nDirectory = "templates" </> "i18n" </> basename
   availableFiles <- qRunIO $ listDirectory i18nDirectory
   let availableTranslations = sortWith (NTop . flip List.elemIndex (NonEmpty.toList appLanguages)) . List.nub $ pack . takeBaseName <$> availableFiles
   availableTranslations' <- maybe (fail $ "‘" <> i18nDirectory <> "’ is empty") return $ NonEmpty.nonEmpty availableTranslations
@@ -210,7 +210,7 @@ i18nWidgetFile 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 l] (normalB . widgetFile $ basename </> l) []
+    [ funD ws $ [ clause [litP $ stringL l] (normalB . widgetFile $ "i18n" </> basename </> l) []
                 | l <- unpack <$> NonEmpty.toList availableTranslations' -- One function definition for every available language
                 ] ++ [ clause [wildP] (normalB [e| error "selectLanguage returned an invalid translation" |]) [] ] -- Fallback mostly there so compiler does not complain about non-exhaustive pattern match
     ] [e|selectLanguage availableTranslations' >>= $(varE ws)|]

src/Handler/Utils/Communication.hs

@@ -172,8 +172,8 @@ commR CommunicationRoute{..} =  do
 
   ((commRes,commWdgt),commEncoding) <- runFormPost . identifyForm FIDCommunication . renderAForm FormStandard $ Communication
     <$> recipientAForm
-    <*> aopt textField (fslI MsgCommSubject) Nothing
+    <*> aopt textField (fslI  MsgCommSubject)     Nothing
-    <*> areq htmlField (fslI MsgCommBody)    Nothing
+    <*> areq htmlField (fslpI MsgCommBody "Html") Nothing
   formResult commRes $ \comm -> do
     runDBJobs . runConduit $ hoist (mapReaderT lift) (crJobs comm) .| sinkDBJobs
     addMessageI Success . MsgCommSuccess . Set.size $ cRecipients comm
@@ -188,3 +188,4 @@ commR CommunicationRoute{..} =  do
   siteLayoutMsg crHeading $ do
     setTitleI crHeading
     formWdgt
+    $(i18nWidgetFile "html-input")

templates/i18n/html-input/de.hamlet

@@ -0,0 +1,8 @@
+<h3>Hinweis: Leerzeilen werden entfernt!
+<p>
+  Das Eingabefeld für Mitteilungstext/Beschreibung akzeptiert derzeit nur Html.
+  Zeilumbrüche spielen dementsprechend keine Rolle, können aber mit
+  <code>&lt;br&gt;
+  eingefügt werden.
+<p>
+  Für die Zukunft ist Markdown Unterstützung inklusive Editor geplant.