diff --git a/src/Foundation.hs b/src/Foundation.hs index fe478f1ca..06e945166 100644 --- a/src/Foundation.hs +++ b/src/Foundation.hs @@ -882,7 +882,7 @@ defaultLinks = -- Define the menu items of the header. , menuItemAccessCallback' = return True } , NavbarRight $ MenuItem - { menuItemLabel = "Einstellungen" + { menuItemLabel = "Anpassen" , menuItemIcon = Just "cogs" , menuItemRoute = ProfileR , menuItemModal = False @@ -917,7 +917,7 @@ defaultLinks = -- Define the menu items of the header. , menuItemAccessCallback' = return True } , NavbarAside $ MenuItem - { menuItemLabel = "Korrekturen" + { menuItemLabel = "Korrektur" , menuItemIcon = Just "check" , menuItemRoute = CorrectionsR , menuItemModal = False diff --git a/src/Handler/Sheet.hs b/src/Handler/Sheet.hs index e001b3a84..3eeba1975 100644 --- a/src/Handler/Sheet.hs +++ b/src/Handler/Sheet.hs @@ -65,7 +65,7 @@ import Control.Lens -- import Utils.Lens import qualified Data.Text as Text -import qualified Data.Aeson as Aeson +--import qualified Data.Aeson as Aeson import Control.Monad.Random.Class (MonadRandom(..)) import Utils.Sql diff --git a/src/Model/Migration.hs b/src/Model/Migration.hs index bd6be6098..03911070f 100644 --- a/src/Model/Migration.hs +++ b/src/Model/Migration.hs @@ -16,6 +16,7 @@ import Utils (lastMaybe) import Model import Model.Migration.Version +import qualified Model.Migration.Types as Legacy import Data.Map (Map) import qualified Data.Map as Map @@ -196,6 +197,11 @@ customMigrations = Map.fromListWith (>>) UPDATE "user" SET "notification_settings" = (#{def :: NotificationSettings} :: json) WHERE "notification_settings" is null; |] ) + , ( AppliedMigrationKey [migrationVersion|5.0.0|] [version|6.0.0|] + , whenM (tableExists "sheet") $ do + sheets <- [sqlQQ| SELECT "id", "type" FROM "sheet"; |] + forM_ sheets $ \(sid, Single lsty) -> update sid [SheetType =. Legacy.sheetType lsty] + ) ] diff --git a/src/Model/Migration/Types.hs b/src/Model/Migration/Types.hs new file mode 100644 index 000000000..44c94b23d --- /dev/null +++ b/src/Model/Migration/Types.hs @@ -0,0 +1,17 @@ +module Model.Migration.Types where + +import qualified Model as Current + +data SheetType + = Bonus { maxPoints :: Current.Points } -- Erhöht nicht das Maximum, wird gutgeschrieben + | Normal { maxPoints :: Current.Points } -- Erhöht das Maximum, wird gutgeschrieben + | Pass { maxPoints, passingPoints :: Current.Points } + | NotGraded + deriving (Show, Read, Eq) + +sheetType :: SheetType -> Current.SheetType +sheetType = undefined + + +deriveJSON defaultOptions ''SheetType +derivePersistFieldJSON ''SheetType \ No newline at end of file diff --git a/src/Model/Types.hs b/src/Model/Types.hs index b4d3a41c5..f57db4598 100644 --- a/src/Model/Types.hs +++ b/src/Model/Types.hs @@ -123,24 +123,34 @@ fromPoints = round instance DisplayAble Points -data SheetType - = Bonus { maxPoints :: Points } -- Erhöht nicht das Maximum, wird gutgeschrieben - | Normal { maxPoints :: Points } -- Erhöht das Maximum, wird gutgeschrieben --- | Informational { maxPoints :: Points } -- Erhöht nicht das Maximum Keine Gutschrift - | Pass { maxPoints, passingPoints :: Points } + +data SheetGrading + = Points { maxPoints :: Points } + | PassPoints { maxPoints, passingPoints :: Points } + | PassBinary + deriving (Eq, Read, Show) + +deriveJSON defaultOptions + { constructorTagModifier = intercalate "-" . map toLower . splitCamel + , fieldLabelModifier = intercalate "-" . map toLower . drop 1 . splitCamel + , sumEncoding = TaggedObject "type" "data" + } ''SheetGrading +derivePersistFieldJSON ''SheetGrading + +data SheetType + = Bonus { grading :: SheetGrading } + | Normal { grading :: SheetGrading } + | Informational { grading :: SheetGrading } | NotGraded - deriving (Show, Read, Eq) + deriving (Eq, Read, Show) -instance DisplayAble SheetType where - display (Bonus {..}) = tshow maxPoints <> " Bonuspunkte" - display (Normal{..}) = tshow maxPoints <> " Punkte" - display (Pass {..}) = "Bestanden ab " <> tshow (pToI passingPoints) <> " von " <> tshow maxPoints - display (NotGraded) = "Unbewertet" - -deriveJSON defaultOptions ''SheetType +deriveJSON defaultOptions + { constructorTagModifier = intercalate "-" . map toLower . splitCamel + , fieldLabelModifier = intercalate "-" . map toLower . drop 1 . splitCamel + , sumEncoding = TaggedObject "type" "data" + } ''SheetType derivePersistFieldJSON ''SheetType -makeLenses_ ''SheetType data SheetTypeSummary = SheetTypeSummary { sumBonusPoints :: Sum Points diff --git a/src/Utils/Lens.hs b/src/Utils/Lens.hs index 55f8d406c..cf6507fc3 100644 --- a/src/Utils/Lens.hs +++ b/src/Utils/Lens.hs @@ -29,6 +29,10 @@ makeLenses_ ''SheetCorrector makeLenses_ ''SubmissionGroup +makeLenses_ ''SheetGrading + +makeLenses_ ''SheetType + -- makeClassy_ ''Load