From 9540f5ce0ffda023ba146da543e731be9a593a02 Mon Sep 17 00:00:00 2001 From: Steffen Jost Date: Wed, 22 Sep 2021 09:57:35 +0200 Subject: [PATCH] chore(term): terms changed to quarters; does not compile yet. tests and fill are todos --- .../uniworx/categories/I18n/de-de-formal.msg | 12 ++-- messages/uniworx/categories/I18n/en-eu.msg | 12 ++-- src/Application.hs | 2 +- src/Foundation/I18n.hs | 12 ++-- src/Handler/Course/Edit.hs | 2 +- src/Handler/Term.hs | 33 ++++------- src/Model/Types/DateTime.hs | 56 ++++++++++++------- 7 files changed, 75 insertions(+), 54 deletions(-) diff --git a/messages/uniworx/categories/I18n/de-de-formal.msg b/messages/uniworx/categories/I18n/de-de-formal.msg index 280fbf7a0..e3300f6aa 100644 --- a/messages/uniworx/categories/I18n/de-de-formal.msg +++ b/messages/uniworx/categories/I18n/de-de-formal.msg @@ -1,7 +1,11 @@ -SummerTerm year@Integer: Sommersemester #{year} -WinterTerm year@Integer: Wintersemester #{year}/#{succ year} -SummerTermShort year@Integer: SoSe #{year} -WinterTermShort year@Integer: WiSe #{year}/#{mod (succ year) 100} +Quarter1st year@Integer: Erstes Quartal #{year} +Quarter2nd year@Integer: Zweites Quartal #{year} +Quarter3rd year@Integer: Drittes Quartal #{year} +Quarter4th year@Integer: Viertes Quartal #{year} +Quarter1stShort year@Integer: #{year}/Q1 +Quarter2ndShort year@Integer: #{year}/Q2 +Quarter3rdShort year@Integer: #{year}/Q3 +Quarter4thShort year@Integer: #{year}/Q4 CorByProportionOnly proportion@Rational: #{rationalToFixed3 proportion} Anteile CorByProportionIncludingTutorial proportion@Rational: #{rationalToFixed3 proportion} Anteile - Tutorium CorByProportionExcludingTutorial proportion@Rational: #{rationalToFixed3 proportion} Anteile + Tutorium diff --git a/messages/uniworx/categories/I18n/en-eu.msg b/messages/uniworx/categories/I18n/en-eu.msg index 800426582..f18480470 100644 --- a/messages/uniworx/categories/I18n/en-eu.msg +++ b/messages/uniworx/categories/I18n/en-eu.msg @@ -1,7 +1,11 @@ -SummerTerm year: Summer semester #{year} -WinterTerm year: Winter semester #{year}/#{succ year} -SummerTermShort year: Summer #{year} -WinterTermShort year: Winter #{year}/#{mod (succ year) 100} +Quarter1st year@Integer: First Quarter of #{year} +Quarter2nd year@Integer: Second Quarter of #{year} +Quarter3rd year@Integer: Third Quarter of #{year} +Quarter4th year@Integer: Last Quarter of #{year} +Quarter1stShort year@Integer: #{year}/Q1st +Quarter2ndShort year@Integer: #{year}/Q2nd +Quarter3rdShort year@Integer: #{year}/Q3rd +Quarter4thShort year@Integer: #{year}/Q4th CorByProportionOnly proportion: #{rationalToFixed3 proportion} parts CorByProportionIncludingTutorial proportion: #{rationalToFixed3 proportion} parts - tutorials CorByProportionExcludingTutorial proportion: #{rationalToFixed3 proportion} parts + tutorials diff --git a/src/Application.hs b/src/Application.hs index cfa04f60a..c0f54303f 100644 --- a/src/Application.hs +++ b/src/Application.hs @@ -1,5 +1,5 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} - + module Application ( getAppSettings, getAppDevSettings , appMain diff --git a/src/Foundation/I18n.hs b/src/Foundation/I18n.hs index 2d3a82ed2..6f111b616 100644 --- a/src/Foundation/I18n.hs +++ b/src/Foundation/I18n.hs @@ -196,14 +196,18 @@ mkMessageVariant ''UniWorX ''FrontendMessage "messages/frontend" "de-de-formal" instance RenderMessage UniWorX TermIdentifier where renderMessage foundation ls TermIdentifier{..} = case season of - Summer -> renderMessage' $ MsgSummerTerm year - Winter -> renderMessage' $ MsgWinterTerm year + Q1 -> renderMessage' $ MsgQuarter1st year + Q2 -> renderMessage' $ MsgQuarter2nd year + Q3 -> renderMessage' $ MsgQuarter3rd year + Q4 -> renderMessage' $ MsgQuarter4th year where renderMessage' = renderMessage foundation ls instance RenderMessage UniWorX ShortTermIdentifier where renderMessage foundation ls (ShortTermIdentifier TermIdentifier{..}) = case season of - Summer -> renderMessage' $ MsgSummerTermShort year - Winter -> renderMessage' $ MsgWinterTermShort year + Q1 -> renderMessage' $ MsgQuarter1stShort year + Q2 -> renderMessage' $ MsgQuarter2ndShort year + Q3 -> renderMessage' $ MsgQuarter3rdShort year + Q4 -> renderMessage' $ MsgQuarter4thShort year where renderMessage' = renderMessage foundation ls instance RenderMessage UniWorX String where diff --git a/src/Handler/Course/Edit.hs b/src/Handler/Course/Edit.hs index fb426ca94..c9a5e572d 100644 --- a/src/Handler/Course/Edit.hs +++ b/src/Handler/Course/Edit.hs @@ -435,7 +435,7 @@ getCourseNewR = do let newTemplate = courseToForm oldTemplate mempty mempty Nothing in return $ Just $ newTemplate { cfCourseId = Nothing - , cfTerm = TermKey $ TermIdentifier 0 Winter -- invalid, will be ignored; undefined won't work due to strictness + , cfTerm = TermKey $ TermIdentifier 0 Q1 -- invalid, will be ignored; undefined won't work due to strictness , cfRegFrom = Nothing , cfRegTo = Nothing , cfDeRegUntil = Nothing diff --git a/src/Handler/Term.hs b/src/Handler/Term.hs index 015f14bdc..ec0f615ad 100644 --- a/src/Handler/Term.hs +++ b/src/Handler/Term.hs @@ -31,27 +31,18 @@ data TermDay guessDay :: TermIdentifier -> TermDay -> Day -guessDay TermIdentifier{ year, season = Winter } TermDayStart - = fromGregorian year 10 1 -guessDay TermIdentifier{ year, season = Winter } TermDayEnd - = fromGregorian (succ year) 3 31 -guessDay TermIdentifier{ year, season = Summer } TermDayStart - = fromGregorian year 4 1 -guessDay TermIdentifier{ year, season = Summer } TermDayEnd - = fromGregorian year 9 30 -guessDay tid@TermIdentifier{ year, season = Winter } TermDayLectureStart - = fromWeekDate year (wWeekStart + 2) 1 - where (_, wWeekStart, _) = toWeekDate $ guessDay tid TermDayStart -guessDay tid@TermIdentifier{ year, season = Winter } TermDayLectureEnd - = fromWeekDate (succ year) ((wWeekStart + 21) `div` bool 53 54 longYear) 5 - where longYear = is _Just $ fromWeekDateValid year 53 1 - (_, wWeekStart, _) = toWeekDate $ guessDay tid TermDayStart -guessDay tid@TermIdentifier{ year, season = Summer } TermDayLectureStart - = fromWeekDate year (wWeekStart + 2) 1 - where (_, wWeekStart, _) = toWeekDate $ guessDay tid TermDayStart -guessDay tid@TermIdentifier{ year, season = Summer } TermDayLectureEnd - = fromWeekDate year (wWeekStart + 17) 5 - where (_, wWeekStart, _) = toWeekDate $ guessDay tid TermDayStart +guessDay TermIdentifier{ year, season = Q1 } TermDayStart = fromGregorian year 1 1 +guessDay TermIdentifier{ year, season = Q1 } TermDayEnd = fromGregorian year 3 31 +guessDay TermIdentifier{ year, season = Q2 } TermDayStart = fromGregorian year 4 1 +guessDay TermIdentifier{ year, season = Q2 } TermDayEnd = fromGregorian year 6 30 +guessDay TermIdentifier{ year, season = Q3 } TermDayStart = fromGregorian year 7 1 +guessDay TermIdentifier{ year, season = Q3 } TermDayEnd = fromGregorian year 9 30 +guessDay TermIdentifier{ year, season = Q4 } TermDayStart = fromGregorian year 10 1 +guessDay TermIdentifier{ year, season = Q4 } TermDayEnd = fromGregorian year 12 31 +guessDay tid@TermIdentifier{ year } TermDayLectureStart = fromWeekDate year weekStart 1 -- first Monday within Quarter + where (_, weekStart, _) = toWeekDate $ guessDay tid TermDayStart +guessDay tid@TermIdentifier{ year } TermDayLectureEnd = fromWeekDate year weekStart 5 -- Friday of last week within Quarter + where (_, weekStart, _) = toWeekDate $ guessDay tid TermDayEnd validateTerm :: (MonadHandler m, HandlerSite m ~ UniWorX) diff --git a/src/Model/Types/DateTime.hs b/src/Model/Types/DateTime.hs index 8f9a3bd28..cfb6f0ed1 100644 --- a/src/Model/Types/DateTime.hs +++ b/src/Model/Types/DateTime.hs @@ -13,6 +13,7 @@ import Import.NoModel import qualified Data.Text as Text import qualified Data.CaseInsensitive as CI +import Data.Either.Combinators (maybeToRight) import Text.Read (readMaybe) import Database.Persist.Sql @@ -25,19 +26,29 @@ import Data.Aeson.Types as Aeson ---- -- Terms, Seaons, anything loosely related to time -data Season = Summer | Winter +data Season = Q1 | Q2 | Q3 | Q4 deriving (Show, Read, Eq, Ord, Enum, Bounded, Generic, Typeable) deriving anyclass (Binary, Universe, Finite, NFData) -seasonToChar :: Season -> Char -seasonToChar Summer = 'S' -seasonToChar Winter = 'W' +numSeasons :: Int -- to be flexible +numSeasons = fromEnum(maxBound::Season) -seasonFromChar :: Char -> Either Text Season -seasonFromChar c - | c ~= 'S' = Right Summer - | c ~= 'W' = Right Winter - | otherwise = Left $ "Invalid season character: ‘" <> tshow c <> "’" +seasonFromText' :: Text -> Either Text Season +seasonFromText' t = maybeToRight errmsg (readMaybe $ Text.unpack $ Text.toUpper t) + where + errmsg = "Invalid season: ‘" <> tshow t <> "’" + +seasonFromText :: Text -> Either Text Season +seasonFromText t + | Just (q, ne) <- Text.uncons t + , q ~= 'Q' + , Just (n, e) <- Text.uncons ne + , Text.null e = case n of '1' -> Right Q1 + '2' -> Right Q2 + '3' -> Right Q3 + '4' -> Right Q4 + _ -> Left $ "Invalid quarter number: ‘" <> tshow t <> "’" + | otherwise = Left $ "Invalid season: ‘" <> tshow t <> "’" where (~=) :: Char -> Char -> Bool (~=) = (==) `on` CI.mk @@ -50,8 +61,8 @@ data TermIdentifier = TermIdentifier instance Enum TermIdentifier where -- ^ Do not use for conversion – Enumeration only - toEnum int = let (toInteger -> year, toEnum -> season) = int `divMod` 2 in TermIdentifier{..} - fromEnum TermIdentifier{..} = fromInteger year * 2 + fromEnum season + toEnum int = let (toInteger -> year, toEnum -> season) = int `divMod` numSeasons in TermIdentifier{..} + fromEnum TermIdentifier{..} = fromInteger year * numSeasons + fromEnum season -- Conversion TermId <-> TermIdentifier:: -- from_TermId_to_TermIdentifier = unTermKey @@ -82,23 +93,28 @@ shortened = iso shorten expand | otherwise = year termToText :: TermIdentifier -> Text -termToText TermIdentifier{..} = Text.pack $ seasonToChar season : show (year ^. shortened) +termToText TermIdentifier{..} = Text.pack $ show (year ^. shortened) ++ show season -- also see Hander.Utils.tidFromText termFromText :: Text -> Either Text TermIdentifier termFromText t - | (s:ys) <- Text.unpack t - , Just (review shortened -> year) <- readMaybe ys - , Right season <- seasonFromChar s + | (ys,s) <- Text.break (~= 'Q') t + , Right season <- seasonFromText s + , Just (review shortened -> year) <- readMaybe $ Text.unpack ys = Right TermIdentifier{..} | otherwise = Left $ "Invalid TermIdentifier: “" <> t <> "”" -- TODO: Could be improved, I.e. say "W"/"S" from Number + where + (~=) :: Char -> Char -> Bool + (~=) = (==) `on` CI.mk termToRational :: TermIdentifier -> Rational termToRational TermIdentifier{..} = fromInteger year + seasonOffset where seasonOffset - | Summer <- season = 0 - | Winter <- season = 0.5 + | Q1 <- season = 0 + | Q2 <- season = 0.25 + | Q3 <- season = 0.5 + | Q4 <- season = 0.75 termFromRational :: Rational -> TermIdentifier termFromRational n = TermIdentifier{..} @@ -106,8 +122,10 @@ termFromRational n = TermIdentifier{..} year = floor n remainder = n - fromInteger (floor n) season - | remainder == 0 = Summer - | otherwise = Winter + | remainder == 0 = Q1 + | remainder == 0.25 = Q2 + | remainder == 0.5 = Q3 + | otherwise = Q4 instance PersistField TermIdentifier where toPersistValue = PersistRational . termToRational