chore(form): create calendarDiffDaysField

messages/uniworx/misc/de-de-formal.msg

@@ -5,6 +5,7 @@
 #messages or constructors that are used all over the code
 
 Logo !ident-ok: FRADrive
+LdapIdentificationOrEmail: Fraport AG-Kennung / E-Mail-Adresse
 EmailInvitationWarning: Diese Adresse konnte keinem FRADrive-Benutzer/-Benutzerin zugeordnet werden. Es wird eine Einladung per E-Mail versandt.
 BoolIrrelevant !ident-ok: —
 FieldPrimary: Hauptfach
@@ -13,7 +14,8 @@ MultiEmailFieldTip: Es sind mehrere, Komma-separierte, E-Mail-Adressen möglich
 MultiSelectTip: Mehrfachauswahl und Abwählen mit Strg-Klick
 WeekDay: Wochentag
 Hours: Stunden
-LdapIdentificationOrEmail: Fraport AG-Kennung / E-Mail-Adresse
+SomeMonths: Monate
+SomeDays: Tage
 Months num@Int64: #{num} #{pluralDE num "Monat" "Monate"}
 Days num@Int64: #{num} #{pluralDE num "Tag" "Tage"}
 NoAutomaticUpdateTip: Dieser Wert wurde manuell editiert und wird daher nicht mehr automatisch durch as AVS aktualisiert.

messages/uniworx/misc/en-eu.msg

@@ -5,6 +5,7 @@
 #messages or constructors that are used all over the Code
 
 Logo: FRADrive
+LdapIdentificationOrEmail: Fraport AG-Kennung / email address
 EmailInvitationWarning: This address could not be matched to any FRADrive user. An invitation will be sent via email.
 BoolIrrelevant: —
 FieldPrimary: Major
@@ -13,7 +14,8 @@ MultiEmailFieldTip: Multiple emails addresses may be specified (comma-separated)
 MultiSelectTip: Multiple selection and desection via Ctrl-Click
 WeekDay: Day of the week
 Hours: Hours
-LdapIdentificationOrEmail: Fraport AG-Kennung / email address
+SomeMonths: Months
+SomeDays: Days
 Months num: #{num} #{pluralEN num "Month" "Months"}
 Days num: #{num} #{pluralEN num "Day" "Days"}
 NoAutomaticUpdateTip: This particular value receives no automatic AVS updates, since it has been edited manually.

src/Handler/Qualification/Edit.hs

@@ -0,0 +1,52 @@
+-- SPDX-FileCopyrightText: 2025 Steffen Jost <S.Jost@fraport.de>
+--
+-- SPDX-License-Identifier: AGPL-3.0-or-later
+
+{-# OPTIONS_GHC -fno-warn-orphans #-}      -- needed for HasEntity instances
+{-# LANGUAGE TypeApplications #-}
+
+module Handler.Qualification.Edit
+  ( getQualificationNewR,  postQualificationNewR
+  , getQualificationEditR, postQualificationEditR
+  )
+  where
+
+import Import
+
+import Handler.Utils
+-- import           Database.Esqueleto.Experimental ((:&)(..))
+-- import qualified Database.Esqueleto.Experimental as E -- needs TypeApplications Lang-Pragma
+
+
+getQualificationNewR,  postQualificationNewR :: SchoolId -> Handler Html
+getQualificationNewR = postQualificationNewR
+postQualificationNewR ssh = handleQualificationEdit ssh Nothing
+
+getQualificationEditR,  postQualificationEditR :: SchoolId -> QualificationShorthand -> Handler Html
+getQualificationEditR = postQualificationEditR
+postQualificationEditR ssh qsh = do
+  qent <- runDBRead $ getBy404 $ SchoolQualificationShort ssh qsh
+  handleQualificationEdit ssh $ Just qent
+
+
+mkQualificationForm :: Maybe Qualification -> SchoolId -> Qualification
+mkQualificationForm templ ssh = renderAForm FormStandard $ Qualification -- to reorder form fiels, use permuteFun on Qualification
+  <$> areq hiddenField "" (Just ssh)
+  <*> areq ciField                                      (fslI MsgQualificationShort)                (qualificationShorthand           <$> templ)
+  <*> areq ciField                                      (fslI MsgQualificationName)                 (qualificationName                <$> templ)
+  <*> aopt htmlField                                    (fslI MsgQualificationDescription)          (qualificationDescription         <$> templ)
+  <*> aopt (posIntFieldI MsgQualificationValidDuration) (fslI MsgQualificationValidDuration)        (qualificationValidDuration       <$> templ)
+  <*> aopt (posIntFieldI MsgQualificationAuditDuration) (fslI MsgQualificationAuditDuration)        (qualificationAuditDuration       <$> templ)
+  <*> aopt calendarDiffDaysField                        (fslI MsgQualificationRefreshWithin)        (qualificationRefreshWithin       <$> templ)
+  <*> aopt calendarDiffDaysField                        (fslI MsgQualificationRefreshReminder)      (qualificationRefreshReminder     <$> templ)
+  <*> areq checkBoxField                                (fslI MsgQualificationElearningStart)       (qualificationElearningStart      <$> templ)
+  <*> areq checkBoxField                                (fslI MsgTableQualificationElearningRenews) (qualificationElearningRenews     <$> templ)
+  <*> aopt (posIntFieldI MsgQualificationElearningLimit)(fslI MsgQualificationElearningLimit)       (qualificationElearningLimit      <$> templ)
+  <*> aopt (error "TODO")                               (fslI MsgTableQualificationLmsReuses)       (qualificationLmsReuses           <$> templ)
+  <*> areq checkBoxField                                (fslI MsgQualificationExpiryNotification)   (qualificationExpiryNotification  <$> templ)
+  <*> aopt (error "TODO")                               (fslI MsgQualificationAvsLicence)           (qualificationAvsLicence          <$> templ)
+  <*> aopt textField                                    (fslI MsgQualficiationSapId)                (qualificationSapId               <$> templ)
+  -- TODO: add tooltips
+
+handleQualificationEdit :: SchoolId -> Maybe (Entity Qualification) -> Handler Html
+handleQualificationEdit _ _ = error "todo"

src/Handler/Tutorial/Users.hs

@@ -98,6 +98,7 @@ mkGenTutForm fltr html = do
   let res :: FormResult GenTutAction -> FormResult ExamId -> FormResult GenTutActionData
       res (FormSuccess GenTutActOccCopy) (FormSuccess eid) = FormSuccess $ GenTutActOccCopyData eid
       res (FormSuccess GenTutActOccEdit) (FormSuccess eid) = FormSuccess $ GenTutActOccEditData eid
+      res (FormFailure e1) (FormFailure e2) = FormFailure $ e1 <> e2
       res (FormFailure e) _ = FormFailure e
       res _ (FormFailure e) = FormFailure e
       res _ _ = FormMissing

src/Handler/Utils/Form.hs

@@ -1425,6 +1425,35 @@ utcTimeField = checkMMap (return . localTimeToUTC') utcToLocalTime localTimeFiel
       LTUNone{}             -> Left MsgIllDefinedUTCTime
       LTUAmbiguous{}        -> Left MsgAmbiguousUTCTime
 
+calendarDiffDaysField :: (MonadHandler m, HandlerSite m ~ UniWorX) => Field m CalendarDiffDays
+calendarDiffDaysField = Field
+    { fieldParse = parseDD
+    , fieldEnctype = UrlEncoded
+    , fieldView = \theId name attrs val isReq -> do
+        let (vmon, vday) = showDD val
+        [whamlet|
+          $newline never
+          <input id="#{theId}-months" name="#{name}" *{attrs} type="number" step=1 :isReq:required value="#{vmon}">
+          _{MsgSomeMonths}
+          <input id="#{theId}-days"   name="#{name}" *{attrs} type="number" step=1 :isReq:required value="#{vday}">
+          _{MsgSomeDays}
+        |]
+    }
+  where
+    showDD :: Either Text CalendarDiffDays -> (Text,Text)
+    showDD (Left t) = (mempty, t) -- show error message only once, on day field
+    showDD (Right CalendarDiffDays{..}) = (tshow cdMonths, tshow cdDays)
+
+    parseDD [tmon, tday] _
+      | Just nmon <- readMay tmon
+      , Just nday <- readMay tday
+      -- , 0 =< nmon + nday
+        = return $ Right $ if 0 == nmon + nday -- TODO: this should not be distinguished here
+            then Nothing
+            else Just $ CalendarDiffDays { cdMonths=nmon, cdDays=nday}
+    parseDD [] _ = return $ Right Nothing
+    parseDD _  _ = return $ Left "Parsing calendarDiffDaysField failed" -- TODO: better error messages
+
 
 langField :: Bool -- ^ Only allow values from `appLanguages`
           -> Field Handler Lang

src/Utils/Form.hs

@@ -821,6 +821,7 @@ daysField = convertField fromDays toDays fractionalField
       fromDays = (* nominalDay)
 
 
+
 data SecretJSONFieldException = SecretJSONFieldDecryptFailure
   deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic)
 instance Exception SecretJSONFieldException