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

messages/uniworx/de.msg

@@ -235,7 +235,9 @@ MaterialEditHeading materialName@MaterialName: Material "#{materialName}" editie
 MaterialEditTitle materialName@MaterialName: Material "#{materialName}" editieren
 MaterialSaveOk  tid@TermId ssh@SchoolId csh@CourseShorthand materialName@MaterialName: Material "#{materialName}" erfolgreich gespeichert in Kurs #{display tid}-#{display ssh}-#{csh}
 MaterialNameDup tid@TermId ssh@SchoolId csh@CourseShorthand materialName@MaterialName: Es gibt bereits Material mit Namen "#{materialName}" in diesem Kurs #{display tid}-#{display ssh}-#{csh}
-MaterialDeleteQuestion: Wollen Sie das unten aufgeführte Material wirklich löschen?
+MaterialDeleteCaption: Wollen Sie das unten aufgeführte Material wirklich löschen?
+MaterialDelHasFiles count@Int64: inklusive #{tshow count} #{pluralDE count "Datei" "Dateien"}
+MaterialIsVisible: Achtung, dieses Material wurde bereits veröffentlicht.
 MaterialDeleted materialName@MaterialName: Material "#{materialName}" gelöscht
 
 

src/Handler/Material.hs

@@ -16,7 +16,7 @@ import Database.Esqueleto.Utils.TH
 import Utils.Lens
 import Utils.Form
 import Handler.Utils
--- import Handler.Utils.Delete
+import Handler.Utils.Delete
 import Handler.Utils.Table.Cells
 import Handler.Utils.Table.Columns
 
@@ -309,18 +309,31 @@ handleMaterialEdit tid ssh csh cid template dbMaterial = do
 getMDelR, postMDelR :: TermId -> SchoolId -> CourseShorthand ->  MaterialName -> Handler Html
 getMDelR = postMDelR
 postMDelR tid ssh csh mnm = do
-  _matEnt <- runDB $ fetchMaterial tid ssh csh mnm
-  error "todo" -- CONTINUE HERE
-  {-
+  matEnt <- runDB $ fetchMaterial tid ssh csh mnm
   deleteR DeleteRoute
     { drRecords = Set.singleton $ entityKey matEnt
-    , drGetInfo = error "todo"
-    , drUnjoin  = error "todo"
-    , drRenderRecord = error "todo"
-    , drRecordConfirmString = error "todo"
-    , drCaption        = SomeMessage   MsgMaterialDeleteQuestion
+    , drGetInfo = \(material `E.InnerJoin` course) -> do
+        E.on $ material E.^. MaterialCourse E.==. course E.^. CourseId
+        let filecount = E.sub_select . E.from $ \matfile -> do
+                E.where_ $ matfile E.^. MaterialFileMaterial E.==. material E.^. MaterialId
+                return (E.countRows :: E.SqlExpr (E.Value Int64))
+        return (material,course,filecount)
+    , drUnjoin  = \(material `E.InnerJoin` _course) -> material
+    , drRenderRecord  = \(Entity _ Material{..}, Entity _ Course{..}, E.Value fileCount) -> do
+        now <- liftIO getCurrentTime
+        let isPublished = NTop (Just now)  >=  NTop materialVisibleFrom
+            pCT = prependCourseTitle courseTerm courseSchool courseShorthand
+        return [whamlet|
+          _{SomeMessage $ pCT $ MsgMaterialHeading materialName}
+          $if fileCount /= 0
+            &nbsp;<i>_{SomeMessage $ MsgMaterialDelHasFiles fileCount}
+          $if isPublished
+            &nbsp;_{SomeMessage $ MsgMaterialIsVisible}
+        |]
+    , drRecordConfirmString = \(Entity _ Material{..}, Entity _ Course{..}, E.Value fileCount) ->
+        return $ [st|#{termToText (unTermKey courseTerm)}/#{unSchoolKey courseSchool}/#{courseShorthand}/#{materialName}|] <> bool mempty [st| + #{tshow fileCount} Files|] (fileCount /= 0)
+    , drCaption        = SomeMessage   MsgMaterialDeleteCaption
     , drSuccessMessage = SomeMessage $ MsgMaterialDeleted mnm
     , drSuccess = SomeRoute $ CourseR tid ssh csh   MaterialListR
     , drAbort   = SomeRoute $ CourseR tid ssh csh $ MaterialR mnm MShowR
     }
-  -}

src/Handler/Utils/Form/MassInput.hs

@@ -269,6 +269,8 @@ type MassInputLayout liveliness cellData cellResult
     -> Map (Natural, BoxCoord liveliness) Widget -- Addition forms
     -> Widget
 
+-- | Multiple multi-layerd input fields
+--   May short-circuit a handler if the frontend only asks for the content, i.e. handler actions after calls to massInput may not happen at all.
 massInput :: forall handler cellData cellResult liveliness.
            ( MonadHandler handler, HandlerSite handler ~ UniWorX
            , ToJSON cellData, FromJSON cellData
@@ -443,7 +445,7 @@ defaultMiLayout liveliness _ cellResults delResults addResults = miWidget' boxOr
           cells
             | [] <- remDims = do
                 coord <- coords
-                Just cellWdgt <- return $ Map.lookup coord cellResults 
+                Just cellWdgt <- return $ Map.lookup coord cellResults
                 let deleteButton = Map.lookup coord delResults
                 return (coord, $(widgetFile "widgets/massinput/cell"))
             | otherwise =

src/Handler/Utils/Table/Cells.hs

@@ -53,10 +53,11 @@ pathPieceCell = cell . toWidget . toPathPiece
 sqlCell :: (IsDBTable (YesodDB UniWorX) a) => YesodDB UniWorX Widget -> DBCell (YesodDB UniWorX) a
 sqlCell act = mempty & cellContents .~ lift act
 
+-- | Highlight table cells with warning: Is not yet implemented in frontend.
 markCell :: (IsDBTable m a) => (t -> Bool) -> (t -> DBCell m a) -> (t -> DBCell m a)
 markCell condition normal x
-  | condition x = normal x <> cell (isVisibleWidget False)
-  | otherwise   = normal x
+   | condition x = normal x & cellAttrs <>~ [("class","urgency__warning")] ---TODO: handle existing classe akin to Form.addAttr/addClass
+   | otherwise   = normal x
 
 ifCell :: (IsDBTable m a) => (t -> Bool) -> (t -> DBCell m a) -> (t -> DBCell m a) -> (t -> DBCell m a)
 ifCell decision cTrue cFalse x
@@ -103,9 +104,10 @@ dateTimeCell t = cell $ formatTime SelFormatDateTime t >>= toWidget
 
 dateTimeCellVisible :: IsDBTable m a => UTCTime -> UTCTime -> DBCell m a
 dateTimeCellVisible watershed t = cell $ do
-    tfw <- formatTime SelFormatDateTime t >>= toWidget
-    icn <- bool mempty (toWidget $ isVisible False) $ watershed < t
-    return $ tfw <> icn
+    let tfw = formatTimeW SelFormatDateTime t
+        icn :: Widget
+        icn = bool mempty (toWidget $ isVisible False) $ watershed < t
+    [whamlet|^{tfw}&nbsp;^{icn}|]
 
 userCell :: IsDBTable m a => Text -> Text -> DBCell m a
 userCell displayName surname = cell $ nameWidget displayName surname

src/Handler/Utils/Table/Pagination.hs

@@ -613,7 +613,7 @@ instance Monoid' x => Monoid (DBCell (RWST (Maybe (Env, FileEnv), UniWorX, [Lang
 instance IsDBTable m a => IsString (DBCell m a) where
   fromString = cell . fromString
 
--- | DB-backed tables with pagination, may short-circuit a handler
+-- | DB-backed tables with pagination, may short-circuit a handler if the frontend only asks for the table content, i.e. handler actions after calls to dbTable may not happen at all.
 dbTable :: forall m x. IsDBTable m x => PSValidator m x -> DBTable m x -> DB (DBResult m x)
 dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> dbtIdent), dbtStyle = DBStyle{..}, .. } = do
   let

src/Import/NoFoundation.hs

@@ -18,6 +18,7 @@ import Yesod.Default.Config2  as Import
 import Utils                  as Import
 import Utils.Frontend.Modal   as Import
 import Utils.Frontend.I18n    as Import
+import Utils.DB               as Import
 import Yesod.Core.Json        as Import (provideJson)
 import Yesod.Core.Types.Instances as Import (CachedMemoT(..))
 

src/Utils.hs

@@ -19,7 +19,7 @@ import qualified Data.ByteString.Lazy as LBS
 import qualified Data.Text as Text
 import qualified Data.Text.Encoding as Text
 
-import Utils.DB as Utils
+-- import Utils.DB as Utils
 import Utils.TH as Utils
 import Utils.DateTime as Utils
 import Utils.PathPiece as Utils
@@ -420,11 +420,13 @@ toNothing = const Nothing
 toNothingS :: String -> Maybe b
 toNothingS = const Nothing
 
--- MOVED TO UTILS.DB due to cyclic dependency
---  Swap 'Nothing' for 'Just' and vice versa
--- flipMaybe :: b -> Maybe b -> Maybe b
--- flipMaybe x Nothing  = Just x
--- flipMaybe _ (Just _) = Nothing
+-- | Swap 'Nothing' for 'Just' and vice versa
+-- This belongs into Module 'Utils' but we have a weird cyclic
+-- dependency
+flipMaybe :: b -> Maybe a -> Maybe b
+flipMaybe x Nothing  = Just x
+flipMaybe _ (Just _) = Nothing
+
 
 maybeAdd :: Num a => Maybe a -> Maybe a -> Maybe a -- treats Nothing as neutral/zero, unlike fmap/ap
 maybeAdd (Just x) (Just y) = Just (x + y)

src/Utils/DB.hs

@@ -10,13 +10,8 @@ import qualified Data.Set as Set
 import qualified Database.Esqueleto as E
 -- import Database.Persist -- currently not needed here
 
+import Utils
 
--- | Swap 'Nothing' for 'Just' and vice versa
--- This belongs into Module 'Utils' but we have a weird cyclic
--- dependency
-flipMaybe :: b -> Maybe a -> Maybe b
-flipMaybe x Nothing  = Just x
-flipMaybe _ (Just _) = Nothing
 
 
 

templates/info-lecturer/de.hamlet

@@ -175,12 +175,22 @@ $newline text
             Studierenden ein neues Pseudonym
             erstellen, damit eine anonyme Korrektur
             gewährleistet werden kann.
+            Dadurch wird aber noch keine Abgabe im System angelegt,
+            da ich nicht alle Teilnehmer, welche ein Pseudonym anfordern,
+            auch tatsächlich abgeben.
         <li>
-          Korrektoren bekommen die externen Abgaben
-          ausgehändigt.
-          Anhand der Pseudonyme werden
-          in Uni2work Abgaben angelegt,
-          welche wie üblich korrigiert werden können.
+          <p>
+            Korrektoren bekommen die externen Abgaben
+            ausgehändigt.
+            Anhand der Pseudonyme
+            muss der Korrektor dann in Uni2work
+            <a href="@{CorrectionsCreateR}">
+              Abgaben anlegen
+            , welche danach wie üblich korrigiert werden können.
+          <p>
+            Solche angelgten Abgaben werden bei der nächsten
+            Verteilung von Übungsblättern
+            dem jeweiligen Korrektor zum Arbeitspensum angerechnet.
 
 <section>
   <h2>Tutorien

templates/versionHistory.hamlet

@@ -7,10 +7,8 @@
     <h2>
       Bekannte Bugs
     <h3>
-      Stand: März 2019
+      Stand: Mai 2019
     <ul>
-      <li>
-        Login ist u.U. anders als im alten System, z.B. momentan geht nur <span style="font-family:monospace">@campus.lmu.de</span> aber nicht die Abkürzung <span style="font-family:monospace">@lmu.de</span>
       <li>
         Format von Bewertungsdateien ist noch provisorisch