chore(term): terms changed to quarters; does not compile yet. tests and fill are todos

messages/uniworx/categories/I18n/de-de-formal.msg

@@ -1,7 +1,11 @@
-SummerTerm year@Integer: Sommersemester #{year}
+Quarter1st year@Integer: Erstes Quartal #{year}
-WinterTerm year@Integer: Wintersemester #{year}/#{succ year}
+Quarter2nd year@Integer: Zweites Quartal #{year}
-SummerTermShort year@Integer: SoSe #{year}
+Quarter3rd year@Integer: Drittes Quartal #{year}
-WinterTermShort year@Integer: WiSe #{year}/#{mod (succ year) 100}
+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

messages/uniworx/categories/I18n/en-eu.msg

@@ -1,7 +1,11 @@
-SummerTerm year: Summer semester #{year}
+Quarter1st year@Integer: First Quarter of #{year}
-WinterTerm year: Winter semester #{year}/#{succ year}
+Quarter2nd year@Integer: Second Quarter of #{year}
-SummerTermShort year: Summer #{year}
+Quarter3rd year@Integer: Third Quarter of #{year}
-WinterTermShort year: Winter #{year}/#{mod (succ year) 100}
+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

src/Application.hs

@@ -1,5 +1,5 @@
 {-# OPTIONS_GHC -fno-warn-orphans #-}
-
+ 
 module Application
     ( getAppSettings, getAppDevSettings
     , appMain

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
+    Q1 -> renderMessage' $ MsgQuarter1st year
-    Winter -> renderMessage' $ MsgWinterTerm 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
+    Q1 -> renderMessage' $ MsgQuarter1stShort year
-    Winter -> renderMessage' $ MsgWinterTermShort year
+    Q2 -> renderMessage' $ MsgQuarter2ndShort year
+    Q3 -> renderMessage' $ MsgQuarter3rdShort year
+    Q4 -> renderMessage' $ MsgQuarter4thShort year
     where renderMessage' = renderMessage foundation ls
 
 instance RenderMessage UniWorX String where

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

src/Handler/Term.hs

@@ -31,27 +31,18 @@ data TermDay
 guessDay :: TermIdentifier
          -> TermDay
          -> Day
-guessDay TermIdentifier{ year, season = Winter } TermDayStart
+guessDay TermIdentifier{ year, season = Q1 } TermDayStart  = fromGregorian year  1  1
-  = fromGregorian year 10 1
+guessDay TermIdentifier{ year, season = Q1 } TermDayEnd    = fromGregorian year  3 31
-guessDay TermIdentifier{ year, season = Winter } TermDayEnd
+guessDay TermIdentifier{ year, season = Q2 } TermDayStart  = fromGregorian year  4  1
-  = fromGregorian (succ year) 3 31
+guessDay TermIdentifier{ year, season = Q2 } TermDayEnd    = fromGregorian year  6 30
-guessDay TermIdentifier{ year, season = Summer } TermDayStart
+guessDay TermIdentifier{ year, season = Q3 } TermDayStart  = fromGregorian year  7  1
-  = fromGregorian year 4 1
+guessDay TermIdentifier{ year, season = Q3 } TermDayEnd    = fromGregorian year  9 30
-guessDay TermIdentifier{ year, season = Summer } TermDayEnd
+guessDay TermIdentifier{ year, season = Q4 } TermDayStart  = fromGregorian year 10  1
-  = fromGregorian year 9 30
+guessDay TermIdentifier{ year, season = Q4 } TermDayEnd    = fromGregorian year 12 31
-guessDay tid@TermIdentifier{ year, season = Winter } TermDayLectureStart
+guessDay tid@TermIdentifier{ year } TermDayLectureStart = fromWeekDate year weekStart 1 -- first Monday within Quarter
-  = fromWeekDate year (wWeekStart + 2) 1
+  where (_, weekStart, _) = toWeekDate $ guessDay tid TermDayStart
-  where (_, wWeekStart, _) = toWeekDate $ guessDay tid TermDayStart
+guessDay tid@TermIdentifier{ year } TermDayLectureEnd   = fromWeekDate year weekStart 5 -- Friday of last week within Quarter
-guessDay tid@TermIdentifier{ year, season = Winter } TermDayLectureEnd
+  where (_, weekStart, _) = toWeekDate $ guessDay tid TermDayEnd
-  = 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
 
 
 validateTerm :: (MonadHandler m, HandlerSite m ~ UniWorX)

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
+numSeasons :: Int -- to be flexible
-seasonToChar Summer = 'S'
+numSeasons = fromEnum(maxBound::Season)
-seasonToChar Winter = 'W'
 
-seasonFromChar :: Char -> Either Text Season
+seasonFromText' :: Text -> Either Text Season
-seasonFromChar c
+seasonFromText' t = maybeToRight errmsg (readMaybe $ Text.unpack $ Text.toUpper t)
-  | c ~= 'S'  = Right Summer
+  where 
-  | c ~= 'W'  = Right Winter
+    errmsg = "Invalid season: ‘" <> tshow t <> "’"
-  | otherwise = Left $ "Invalid season character: ‘" <> tshow c <> "’"
+
+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{..}
+  toEnum int = let (toInteger -> year, toEnum -> season) = int `divMod` numSeasons in TermIdentifier{..}
-  fromEnum TermIdentifier{..} = fromInteger year * 2 + fromEnum season
+  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
+  | (ys,s) <- Text.break (~= 'Q') t
-  , Just (review shortened -> year) <- readMaybe ys
+  , Right season <- seasonFromText s
-  , Right season <- seasonFromChar 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
+      | Q1 <- season = 0
-      | Winter <- season = 0.5
+      | 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
+      | remainder == 0    = Q1
-      | otherwise      = Winter
+      | remainder == 0.25 = Q2
+      | remainder == 0.5  = Q3
+      | otherwise         = Q4
 
 instance PersistField TermIdentifier where
   toPersistValue = PersistRational . termToRational