diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg index 77edf6cf3..e66535980 100644 --- a/messages/uniworx/de.msg +++ b/messages/uniworx/de.msg @@ -75,15 +75,15 @@ CourseDeregisterUntilTip: Abmeldung darf auch ohne Begrenzung möglich sein Sheet: Blatt SheetList tid@TermId ssh@SchoolId courseShortHand@CourseShorthand: #{display tid}-#{display ssh}-#{courseShortHand} Übersicht Übungsblätter SheetNewHeading tid@TermId ssh@SchoolId courseShortHand@CourseShorthand: #{display tid}-#{display ssh}-#{courseShortHand} Neues Übungsblatt anlegen -SheetNewOk tid@TermId ssh@SchoolId courseShortHand@CourseShorthand sheetName@SheetName: Neues Übungsblatt #{sheetName} wurde im Kurs #{display tid}-#{display ssh}-#{courseShortHand} erfolgreich erstellt. +SheetNewOk tid@TermId ssh@SchoolId courseShortHand@CourseShorthand sheetName@SheetName: #{sheetName} wurde als neues Übungsblatt im Kurs #{display tid}-#{display ssh}-#{courseShortHand} erfolgreich erstellt. SheetTitle tid@TermId ssh@SchoolId courseShortHand@CourseShorthand sheetName@SheetName: #{display tid}-#{display ssh}-#{courseShortHand} #{sheetName} SheetTitleNew tid@TermId ssh@SchoolId courseShortHand@CourseShorthand : #{display tid}-#{display ssh}-#{courseShortHand}: Neues Übungsblatt SheetEditHead tid@TermId ssh@SchoolId courseShortHand@CourseShorthand sheetName@SheetName: #{display tid}-#{display ssh}-#{courseShortHand} #{sheetName} editieren SheetEditOk tid@TermId ssh@SchoolId courseShortHand@CourseShorthand sheetName@SheetName: Übungsblatt #{sheetName} aus Kurs #{display tid}-#{display ssh}-#{courseShortHand} wurde gespeichert. SheetNameDup tid@TermId ssh@SchoolId courseShortHand@CourseShorthand sheetName@SheetName: Es gibt bereits ein Übungsblatt #{sheetName} in diesem Kurs #{display tid}-#{display ssh}-#{courseShortHand}. -SheetDelHead tid@TermId ssh@SchoolId courseShortHand@CourseShorthand sheetName@SheetName: Übungsblatt #{sheetName} wirklich aus Kurs #{display tid}-#{display ssh}-#{courseShortHand} herauslöschen? +SheetDelHead tid@TermId ssh@SchoolId courseShortHand@CourseShorthand sheetName@SheetName: #{sheetName} wirklich aus Kurs #{display tid}-#{display ssh}-#{courseShortHand} herauslöschen? SheetDelText submissionNo@Int: Dies kann nicht mehr rückgängig gemacht werden! Alle Einreichungen gehen ebenfalls verloren! Es gibt #{display submissionNo} Abgaben. -SheetDelOk tid@TermId ssh@SchoolId courseShortHand@CourseShorthand sheetName@SheetName: #{display tid}-#{display ssh}-#{courseShortHand}: Übungsblatt #{sheetName} gelöscht. +SheetDelOk tid@TermId ssh@SchoolId courseShortHand@CourseShorthand sheetName@SheetName: #{display tid}-#{display ssh}-#{courseShortHand}: #{sheetName} gelöscht. SheetExercise: Aufgabenstellung SheetHint: Hinweis @@ -132,7 +132,7 @@ SubmissionGroupName: Gruppenname CorrectionsTitle: Zugewiesene Korrekturen CourseCorrectionsTitle: Korrekturen für diesen Kurs -CorrectorsHead sheetName@SheetName: Korrektoren für Blatt #{sheetName} +CorrectorsHead sheetName@SheetName: Korrektoren für #{sheetName} Unauthorized: Sie haben hierfür keine explizite Berechtigung. UnauthorizedAnd l@Text r@Text: (#{l} UND #{r}) diff --git a/routes b/routes index 9604556ad..014a25e28 100644 --- a/routes +++ b/routes @@ -51,6 +51,7 @@ /school SchoolListR GET /school/#SchoolId SchoolShowR GET + -- For Pattern Synonyms see Foundation /course/ CourseListR GET !free !/course/new CourseNewR GET POST !lecturer @@ -76,6 +77,11 @@ /correctors SCorrR GET POST !/#SheetFileType/*FilePath SFileR GET !timeANDregistered !timeANDmaterials !corrector +-- /user/#CryptoUUIDUser +-- /users +-- /correctors + + /corrections CorrectionsR GET POST !corrector !lecturer /corrections/upload CorrectionsUploadR GET POST !corrector !lecturer diff --git a/src/Handler/Course.hs b/src/Handler/Course.hs index 90d0274ca..c8c016984 100644 --- a/src/Handler/Course.hs +++ b/src/Handler/Course.hs @@ -343,7 +343,7 @@ courseDeleteHandler = undefined courseEditHandler :: Bool -> Maybe (Entity Course) -> Handler Html courseEditHandler isGet course = do - $logDebug "€€€€€€ courseEditHandler started" + -- $logDebug "€€€€€€ courseEditHandler started" aid <- requireAuthId -- TODO: Verify that Editor is owner of the Course to be Edited!!! ((result, formWidget), formEnctype) <- runFormPost . newCourseForm =<< for course courseToForm case result of diff --git a/src/Handler/Profile.hs b/src/Handler/Profile.hs index caade0118..701f3ea4e 100644 --- a/src/Handler/Profile.hs +++ b/src/Handler/Profile.hs @@ -452,7 +452,7 @@ mkCorrectionsTable = sheetCell <$> view _1 <*> view _2 , sortable (Just "cstate") (i18nCell MsgCorState) $ correctorStateCell <$> view (_dbrOutput . _3 . _entityVal) - , sortable (Just "cload") (i18nCell MsgCorProportion) $ + , sortable (toNothing "cload") (i18nCell MsgCorProportion) $ correctorLoadCell <$> view (_dbrOutput . _3 . _entityVal) ] @@ -463,7 +463,6 @@ mkCorrectionsTable = , ( "course", SortColumn $ withType $ \(crse `E.InnerJoin` _ `E.InnerJoin` _ ) -> crse E.^. CourseShorthand) , ( "sheet" , SortColumn $ withType $ \(_ `E.InnerJoin` sheet `E.InnerJoin` _) -> sheet E.^. SheetName ) , ( "cstate", SortColumn $ withType $ \(_ `E.InnerJoin` _ `E.InnerJoin` cs) -> cs E.^. SheetCorrectorState ) - , ( "cload" , SortColumn $ withType $ \(_ `E.InnerJoin` _ `E.InnerJoin` cs) -> cs E.^. SheetCorrectorLoad ) ] dbtFilter = Map.fromList [ ( "term", FilterColumn $ withType $ \(crse `E.InnerJoin` _ `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseTerm ) diff --git a/src/Handler/Utils/DateTime.hs b/src/Handler/Utils/DateTime.hs index 47d28686d..679539202 100644 --- a/src/Handler/Utils/DateTime.hs +++ b/src/Handler/Utils/DateTime.hs @@ -11,6 +11,7 @@ module Handler.Utils.DateTime , formatTime, formatTime', formatTimeW , getTimeLocale, getDateTimeFormat , validDateTimeFormats, dateTimeFormatOptions + , addOneWeek ) where import Import @@ -19,6 +20,7 @@ import Data.Time.Zones hiding (localTimeToUTCFull) import qualified Data.Time.Zones as TZ import Data.Time hiding (formatTime, localTimeToUTC, utcToLocalTime) +import Data.Time.Clock (addUTCTime,nominalDay) import qualified Data.Time.Format as Time import Data.Set (Set) @@ -130,3 +132,10 @@ dateTimeFormatOptions sel = do return $ (dateTime, fmt) optionsPairs <=< mapM toOption . Set.toList $ validDateTimeFormats tl sel + + +addOneWeek :: UTCTime -> UTCTime +addOneWeek = addUTCTime (7 * nominalDay) + +-- addOneTerm? -> Move Handler.Utils.DateTime + diff --git a/src/Model/Migration.hs b/src/Model/Migration.hs index 8d16d1d1e..6e2e2474c 100644 --- a/src/Model/Migration.hs +++ b/src/Model/Migration.hs @@ -23,6 +23,7 @@ import qualified Data.Set as Set import Database.Persist.Sql import Database.Persist.Postgresql +import Text.Read (readMaybe) import Data.CaseInsensitive (CI) -- Database versions must follow https://pvp.haskell.org: @@ -151,6 +152,16 @@ customMigrations = Map.fromListWith (>>) ALTER TABLE "school" ADD PRIMARY KEY (shorthand); |] ) + , ( AppliedMigrationKey [migrationVersion|2.0.0|] [version|3.0.0|] + , whenM (tableExists "sheet_corrector") $ do + correctorLoads <- [sqlQQ| SELECT "id", "load" FROM "sheet_corrector"; |] + forM_ correctorLoads $ \(uid, Single str) -> case readMaybe str of + Just load -> update uid [SheetCorrectorLoad =. load] + _other -> error $ "Could not parse Load: " <> show str + [executeQQ| + ALTER TABLE "sheet_corrector" ALTER COLUMN "load" TYPE json USING "load"::json; + |] + ) ] diff --git a/src/Model/Types.hs b/src/Model/Types.hs index 21f6d4abb..386d828e7 100644 --- a/src/Model/Types.hs +++ b/src/Model/Types.hs @@ -203,7 +203,12 @@ data Load -- = ByTutorial { countsToLoad :: Bool } | ByProportion { load :: Rati , byProportion :: Rational -- ^ workload proportion of all submission not assigned to tutorial leaders } deriving (Show, Read, Eq, Ord) -derivePersistField "Load" + +deriveJSON defaultOptions ''Load +derivePersistFieldJSON ''Load + + + instance Semigroup Load where (Load byTut prop) <> (Load byTut' prop') = Load byTut'' (prop + prop') diff --git a/src/Utils.hs b/src/Utils.hs index 65227a604..692fdbdee 100644 --- a/src/Utils.hs +++ b/src/Utils.hs @@ -104,9 +104,6 @@ tickmarkT = tickmark text2Html :: Text -> Html text2Html = toHtml -- prevents ambiguous types -liftCI :: (Text -> Text) -> (CI Text) -> (CI Text) -liftCI f ci = CI.mk $ f $ CI.original ci - toWgt :: (ToMarkup a, MonadBaseControl IO m, MonadThrow m, MonadIO m) => a -> WidgetT site m () toWgt = toWidget . toHtml @@ -133,6 +130,7 @@ withFragment form html = (flip fmap) form $ \(x, widget) -> (x, toWidget html >> -- Types that can be converted to Text for direct displayed to User! (Show for debugging, Display for Production) +{-# DEPRECATED display "Create RenderMessage Instances instead!" #-} class DisplayAble a where display :: a -> Text -- Default definitions for types belonging to Show (allows empty instance declarations) @@ -185,7 +183,7 @@ textPercent x = lz <> (pack $ show rx) <> "%" lz = if rx < 10.0 then "0" else "" stepTextCounterCI :: CI Text -> CI Text -- find and increment rightmost-number, preserving leading zeroes -stepTextCounterCI = liftCI stepTextCounter +stepTextCounterCI = CI.map stepTextCounter stepTextCounter :: Text -> Text -- find and increment rightmost-number, preserving leading zeroes stepTextCounter text diff --git a/src/Utils/DateTime.hs b/src/Utils/DateTime.hs index ee33ccc72..1b82dbe12 100644 --- a/src/Utils/DateTime.hs +++ b/src/Utils/DateTime.hs @@ -10,7 +10,6 @@ module Utils.DateTime ( timeLocaleMap , TimeLocale(..) , currentYear - , addOneWeek , module Data.Time.Zones , module Data.Time.Zones.TH ) where @@ -19,7 +18,6 @@ import ClassyPrelude.Yesod hiding (lift) import System.Locale.Read import Data.Time (TimeZone(..), TimeLocale(..)) -import Data.Time.Clock (addUTCTime,nominalDay) import Data.Time.Zones (TZ) import Data.Time.Zones.TH (includeSystemTZ) @@ -31,10 +29,6 @@ deriving instance Lift TimeZone deriving instance Lift TimeLocale -addOneWeek :: UTCTime -> UTCTime -addOneWeek = addUTCTime (7 * nominalDay) --better use nominalWeek - - -- $(timeLocaleMap _) :: [Lang] -> TimeLocale timeLocaleMap :: [(Lang, String)] -- ^ Languages and matching locales, first is taken as default -> ExpQ diff --git a/templates/default-layout.hamlet b/templates/default-layout.hamlet index 4d4b024ac..e21813363 100644 --- a/templates/default-layout.hamlet +++ b/templates/default-layout.hamlet @@ -15,8 +15,9 @@

- $maybe back <- lastMaybe parents - #{snd back} + $maybe headline <- contentHeadline ^{headline} $nothing