chore(term): terms changed to quarters; does not compile yet. tests and fill are todos
This commit is contained in:
Steffen Jost
parent
318bb74160
commit
9540f5ce0f
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -1,5 +1,5 @@
|
||||
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
||||
|
||||
|
||||
module Application
|
||||
( getAppSettings, getAppDevSettings
|
||||
, appMain
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user