diff --git a/messages/uniworx/categories/term/de-de-formal.msg b/messages/uniworx/categories/term/de-de-formal.msg index bb892f022..d88a9600f 100644 --- a/messages/uniworx/categories/term/de-de-formal.msg +++ b/messages/uniworx/categories/term/de-de-formal.msg @@ -12,7 +12,7 @@ TermEdited tid@TermId: Semester #{tid} erfolgreich editiert. TermNewTitle: Semester editieren/anlegen. InvalidInput: Eingaben bitte korrigieren. Term !ident-ok: Semester -TermPlaceholder: W/S + vierstellige Jahreszahl +TermPlaceholder: JJJJ-MM-TT (Erster Tag einer Schulung) TermStartDay: Erster Tag TermStartDayTooltip: Üblicherweise immer 1. April oder 1. Oktober TermEndDay: Letzter Tag diff --git a/messages/uniworx/categories/term/en-eu.msg b/messages/uniworx/categories/term/en-eu.msg index 30b2f9122..8f2218f58 100644 --- a/messages/uniworx/categories/term/en-eu.msg +++ b/messages/uniworx/categories/term/en-eu.msg @@ -12,7 +12,7 @@ TermEdited tid: Successfully edited semester #{tid} TermNewTitle: Edit/create semester InvalidInput: Invalid input Term: Semester -TermPlaceholder: (W|S) +TermPlaceholder: YYYY-MM-DD (First day of courses) TermStartDay: Starting day TermStartDayTooltip: Usually 1st of April or 1st of October TermEndDay: Last day diff --git a/src/Model/Types/DateTime.hs b/src/Model/Types/DateTime.hs index a03928b78..faf8ec4ca 100644 --- a/src/Model/Types/DateTime.hs +++ b/src/Model/Types/DateTime.hs @@ -12,11 +12,14 @@ module Model.Types.DateTime import Import.NoModel import qualified Data.Text as Text -import Data.Either.Combinators (maybeToRight) +import Data.Either.Combinators (maybeToRight, mapLeft) import Data.Time.Calendar.WeekDate import Data.Time.Format.ISO8601 +import qualified Text.Parsec as Parse (choice, parse, string, try) +import qualified Text.ParserCombinators.Parsec.Number as ParseNum (nat) + import Database.Persist.Sql import Web.HttpApiData @@ -61,29 +64,51 @@ shortened = iso shorten expand , year < $currentYear + 50 = year `mod` 100 | otherwise = year --- Option 1: date in iso8601 +-- Also see +-- Handler.Utils.Widget.tidFromText +-- MsgTermPlaceHolder termToText :: TermIdentifier -> Text -termToText = Text.pack . iso8601Show +termToText = termToText1 --- also see Hander.Utils.tidFromText termFromText :: Text -> Either Text TermIdentifier -termFromText t = maybeToRight errm $ iso8601ParseM $ Text.unpack t +termFromText t = termFromText1 t <> termFromText2 t + +-- Option 1: date in iso8601, i.e. YYYY-MM-DD +termToText1 :: TermIdentifier -> Text +termToText1 = Text.pack . iso8601Show + +termFromText1 :: Text -> Either Text TermIdentifier +termFromText1 t = maybeToRight errm $ iso8601ParseM $ Text.unpack t where errm = "Invalid TermIdentifier: “" <> t <> "”" -- Option 2: show as WeekNr-DayOfWeek-Year, e.g. 22Mon2021? -termToText' :: TermIdentifier -> Text -termToText' TermIdentifier{..} = Text.pack $ show weeknr ++ wd ++ show year +termToText2 :: TermIdentifier -> Text +termToText2 TermIdentifier{..} = Text.pack $ show weeknr ++ wd ++ show year where wd = take 3 $ show $ dayOfWeek getTermDay (year,weeknr,_wd_) = toWeekDate getTermDay -{- TODO -termFromText' :: Text -> Either Text TermIdentifier -termFromText' t = error "not implemented" +termFromText2 :: Text -> Either Text TermIdentifier +termFromText2 t = mapLeft (const errm) parseTerm where - errm = "Invalid TermIdentifier: “" <> t <> "”" --} + parseTerm = Parse.parse pWeekDate "termFromText2" $ Text.unpack t + + -- pWeekDate :: Parse.Parsec String () TermIdentifier + pWeekDate = do + wknr <- ParseNum.nat + dowk <- Parse.choice $ pDayOfWeek <$> (universe :: [DayOfWeek]) + year <- ParseNum.nat + case fromWeekDateValid year wknr (fromEnum dowk) of + (Just d) -> return $ TermIdentifier d + Nothing -> fail "invalid weekdate" + + -- pDayOfWeek :: DayOfWeek -> Parse.Parsec String () DayOfWeek + pDayOfWeek wd = do + void $ Parse.try $ Parse.string $ take 3 $ show wd + return wd + + errm = "Invalid TermIdentifier: “" <> t <> "”" daysPerYear :: Rational daysPerYear = 365 + (97 % 400) diff --git a/test/Database/Fill.hs b/test/Database/Fill.hs index 386294b18..b2a839e1c 100644 --- a/test/Database/Fill.hs +++ b/test/Database/Fill.hs @@ -601,7 +601,7 @@ fillDb = do secondDay = utctDay $ termTime tid TermDayLectureStart 1 Nothing toMidnight -- thirdDay = utctDay $ termTime tid TermDayLectureStart 2 Nothing toMidnight capacity = Just 8 - mkName = CI.mk . (<> termToText' tid) . (<> "_") + mkName = CI.mk . (<> termToText2 tid) . (<> "_") if weekDay `elem` [Friday, Saturday, Sunday] then return () else do