chore(terms): fix add term help message and allow alternative TermId Format

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

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)<four digit year>
+TermPlaceholder: YYYY-MM-DD (First day of courses)
 TermStartDay: Starting day
 TermStartDayTooltip: Usually 1st of April or 1st of October
 TermEndDay: Last day

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 
+termToText2 :: TermIdentifier -> Text 
-termToText' TermIdentifier{..} = Text.pack $ show weeknr ++ wd ++ show year
+termToText2 TermIdentifier{..} = Text.pack $ show weeknr ++ wd ++ show year
   where 
     wd = take 3 $ show $ dayOfWeek getTermDay
     (year,weeknr,_wd_) = toWeekDate getTermDay
 
-{- TODO
+termFromText2 :: Text -> Either Text TermIdentifier
-termFromText' :: Text -> Either Text TermIdentifier
+termFromText2 t = mapLeft (const errm) parseTerm
-termFromText' t = error "not implemented"
   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)

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