chore(form): create calendarDiffDaysField
This commit is contained in:
parent
e5cf120af2
commit
b26dd285df
@ -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.
|
||||
|
||||
@ -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.
|
||||
|
||||
52
src/Handler/Qualification/Edit.hs
Normal file
52
src/Handler/Qualification/Edit.hs
Normal file
@ -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"
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user