fix(number-input-fields): number inputs made HTML5 compatible
number inputs of rational fields allow rational inputs and optionally provide min-max attributes for HTML5 Closes #412
This commit is contained in:
Steffen Jost
parent
8ec00220da
commit
609821595b
@ -449,6 +449,7 @@ RatingPercent: Erreicht
|
||||
RatingFiles: Korrigierte Dateien
|
||||
PointsNotPositive: Punktzahl darf nicht negativ sein
|
||||
PointsTooHigh maxPoints@Points: Punktzahl darf nicht höher als #{maxPoints} sein
|
||||
PointsTooLow minPoints@Points: Punktzahl darf nicht kleiner als #{minPoints} sein
|
||||
RatingPointsDone: Abgabe zählt als korrigiert, gdw. Punktezahl gesetzt ist
|
||||
ColumnRatingPoints: Punktzahl
|
||||
Pseudonyms: Pseudonyme
|
||||
|
||||
@ -215,7 +215,7 @@ colPointsField = sortable (Just "rating") (i18nCell MsgColumnRatingPoints) $ for
|
||||
(\DBRow{ dbrOutput=(Entity subId _, _, _, _, _, _) } -> return subId)
|
||||
(\DBRow{ dbrOutput=(Entity _ Submission{..}, Entity _ Sheet{..}, _, _, _, _) } mkUnique -> case sheetType of
|
||||
NotGraded -> over (_1.mapped) (_2 .~) <$> pure (FormSuccess Nothing, mempty)
|
||||
_other -> over (_1.mapped) (_2 .~) . over _2 fvInput <$> mopt pointsField (fsUniq mkUnique "points") (Just submissionRatingPoints)
|
||||
_other -> over (_1.mapped) (_2 .~) . over _2 fvInput <$> mopt (pointsFieldMax $ preview (_grading . _maxPoints) sheetType) (fsUniq mkUnique "points") (Just submissionRatingPoints)
|
||||
)
|
||||
|
||||
colCommentField :: Colonnade Sortable CorrectionTableData (DBCell _ (FormResult (DBFormResult SubmissionId (a, b, Maybe Text) CorrectionTableData)))
|
||||
|
||||
@ -241,30 +241,38 @@ htmlField' = htmlField
|
||||
}
|
||||
|
||||
natFieldI :: (Monad m, Integral i, RenderMessage (HandlerSite m) msg, RenderMessage (HandlerSite m) FormMessage) => msg -> Field m i
|
||||
natFieldI msg = convertField fromInteger toInteger $ checkBool (>= 0) msg intField
|
||||
natFieldI msg = convertField fromInteger toInteger $ checkBool (>= 0) msg $ intMinField 0
|
||||
|
||||
natField :: (Monad m, Integral i, RenderMessage (HandlerSite m) FormMessage) => Text -> Field m i
|
||||
natField d = convertField fromInteger toInteger $ checkBool (>= 0) (T.append d " muss eine natürliche Zahl sein.") intField
|
||||
natField d = convertField fromInteger toInteger $ checkBool (>= 0) (T.append d " muss eine natürliche Zahl sein.") $ intMinField 0
|
||||
|
||||
natIntField ::(Monad m, RenderMessage (HandlerSite m) FormMessage) => Text -> Field m Integer
|
||||
natIntField = natField
|
||||
|
||||
posIntField :: (Monad m, Integral i, RenderMessage (HandlerSite m) FormMessage) => Text -> Field m i
|
||||
posIntField d = convertField fromInteger toInteger $ checkBool (> 0) (T.append d " muss eine positive Zahl sein.") intField
|
||||
posIntField d = convertField fromInteger toInteger $ checkBool (> 0) (T.append d " muss eine positive Zahl sein.") $ intMinField 1
|
||||
|
||||
posIntFieldI :: (Monad m, Integral i, RenderMessage (HandlerSite m) msg, RenderMessage (HandlerSite m) FormMessage) => msg -> Field m i
|
||||
posIntFieldI msg = convertField fromInteger toInteger $ checkBool (> 0) msg intField
|
||||
posIntFieldI msg = convertField fromInteger toInteger $ checkBool (> 0) msg $ intMinField 0
|
||||
|
||||
-- | Field to request integral number > 'm'
|
||||
minIntField :: (Monad m, Integral i, Show i, RenderMessage (HandlerSite m) FormMessage) => i -> Text -> Field m i
|
||||
minIntField m d = checkBool (> m) (T.concat [d," muss größer als ", T.pack $ show m, " sein."]) intField
|
||||
minIntField m d = checkBool (> m) (T.concat [d," muss größer als ", T.pack $ show m, " sein."]) $ intMinField m
|
||||
|
||||
pointsField :: (Monad m, HandlerSite m ~ UniWorX) => Field m Points
|
||||
pointsField = checkBool (>= 0) MsgPointsNotPositive fixedPrecField
|
||||
pointsField = pointsFieldMinMax (Just 0) Nothing
|
||||
|
||||
pointsFieldMax :: (Monad m, HandlerSite m ~ UniWorX) => Maybe Points -> Field m Points
|
||||
pointsFieldMax Nothing = pointsField
|
||||
pointsFieldMax (Just maxp) = checkBool (<= maxp) (MsgPointsTooHigh maxp) pointsField
|
||||
pointsFieldMax limit = pointsFieldMinMax (Just 0) limit
|
||||
|
||||
pointsFieldMinMax :: (Monad m, HandlerSite m ~ UniWorX) => Maybe Points -> Maybe Points -> Field m Points
|
||||
pointsFieldMinMax lower upper = checklower $ checkupper $ fixedPrecMinMaxField lower upper -- NOTE: fixedPrecMinMaxField uses HTML5 input attributes min & max for better browser supprt, but may not be supported by all browsers yet
|
||||
where
|
||||
checklower | Just 0 <- lower = checkBool (>= 0) MsgPointsNotPositive
|
||||
| Just minp <- lower = checkBool (>= minp) $ MsgPointsTooLow minp
|
||||
| otherwise = id
|
||||
checkupper | Just maxp <- upper = checkBool (<= maxp) $ MsgPointsTooHigh maxp
|
||||
| otherwise = id
|
||||
|
||||
matriculationField :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field m Text
|
||||
matriculationField = textField -- no restrictions, since not everyone has a matriculation and pupils need special tags here
|
||||
@ -358,7 +366,7 @@ uploadModeForm prev = multiActionA actions (fslI MsgSheetUploadMode) (classifyUp
|
||||
, UploadSpecific <$> specificFileForm
|
||||
)
|
||||
]
|
||||
|
||||
|
||||
extensionRestrictionField :: Field Handler (NonNull (Set Extension))
|
||||
extensionRestrictionField = checkMMap (return . maybe (Left MsgUploadModeExtensionRestrictionEmpty) Right . fromNullable . toSet) (intercalate ", " . Set.toList . toNullable) textField
|
||||
where
|
||||
@ -366,7 +374,7 @@ uploadModeForm prev = multiActionA actions (fslI MsgSheetUploadMode) (classifyUp
|
||||
stripDot ext
|
||||
| Just nExt <- Text.stripPrefix "." ext = nExt
|
||||
| otherwise = ext
|
||||
|
||||
|
||||
specificFileForm :: AForm Handler (NonNull (Set UploadSpecificFile))
|
||||
specificFileForm = wFormToAForm $ do
|
||||
Just currentRoute <- getCurrentRoute
|
||||
@ -377,7 +385,7 @@ uploadModeForm prev = multiActionA actions (fslI MsgSheetUploadMode) (classifyUp
|
||||
where
|
||||
preProcess :: NonNull (Set UploadSpecificFile) -> Map ListPosition (UploadSpecificFile, UploadSpecificFile)
|
||||
preProcess = Map.fromList . zip [0..] . map (\x -> (x, x)) . Set.toList . toNullable
|
||||
|
||||
|
||||
postProcess :: FormResult (Map ListPosition (UploadSpecificFile, UploadSpecificFile)) -> WForm Handler (FormResult (NonNull (Set UploadSpecificFile)))
|
||||
postProcess mapResult = do
|
||||
MsgRenderer mr <- getMsgRenderer
|
||||
@ -420,7 +428,7 @@ uploadModeForm prev = multiActionA actions (fslI MsgSheetUploadMode) (classifyUp
|
||||
miAddEmpty _ _ _ = Set.empty
|
||||
miLayout :: MassInputLayout ListLength UploadSpecificFile UploadSpecificFile
|
||||
miLayout lLength _ cellWdgts delButtons addWdgts = $(widgetFile "widgets/massinput/uploadSpecificFiles/layout")
|
||||
|
||||
|
||||
|
||||
submissionModeForm :: Maybe SubmissionMode -> AForm Handler SubmissionMode
|
||||
submissionModeForm prev = multiActionA actions (fslI MsgSheetSubmissionMode) $ classifySubmissionMode <$> prev
|
||||
@ -524,7 +532,7 @@ examGradingRuleForm prev = multiActionA actions (fslI MsgExamGradingRule) $ clas
|
||||
)
|
||||
]
|
||||
|
||||
|
||||
|
||||
gradingKeyForm :: FieldSettings UniWorX -> Maybe [Points] -> AForm Handler [Points]
|
||||
gradingKeyForm FieldSettings{..} template = formToAForm . over (mapped . _2) pure $ do
|
||||
MsgRenderer mr <- getMsgRenderer
|
||||
|
||||
@ -67,6 +67,13 @@ validateRating ratingSheetType Rating'{ratingPoints=Just rp, ..}
|
||||
| (Just PassBinary) <- ratingSheetType ^? _grading
|
||||
, not (rp == 0 || rp == 1)
|
||||
= [RatingBinaryExpected]
|
||||
-- QUICKFIX: Vorkorrektur füllt keine Punkte ein und sollte trotzdem akzeptiert werden!
|
||||
-- Alternative: Fehler fangen und ignorieren, falls der Benutzer Dozent/Assistent/Admin ist
|
||||
-- validateRating ratingSheetType Rating'{ .. }
|
||||
-- | has _grading ratingSheetType
|
||||
-- , is _Nothing ratingPoints
|
||||
-- , isn't _Nothing ratingTime
|
||||
-- = [RatingPointsRequired]
|
||||
validateRating _ _ = []
|
||||
|
||||
getRating :: SubmissionId -> YesodDB UniWorX (Maybe Rating)
|
||||
|
||||
@ -503,41 +503,64 @@ fractionalField = Field{..}
|
||||
where
|
||||
scientific' :: Iso' a Scientific
|
||||
scientific' = iso (fromRational . toRational) (fromRational . toRational)
|
||||
|
||||
|
||||
fieldEnctype = UrlEncoded
|
||||
fieldView theId name attrs (fmap $ view scientific' -> val) isReq
|
||||
= [whamlet|
|
||||
$newline never
|
||||
<input id=#{theId} name=#{name} *{attrs} type=number :isReq:required value=#{either id (pack . formatScientific Fixed Nothing) val}>
|
||||
<input id=#{theId} name=#{name} *{attrs} type=number step=any :isReq:required value=#{either id (pack . formatScientific Fixed Nothing) val}>
|
||||
|]
|
||||
fieldParse = parseHelper $ \t ->
|
||||
maybe (Left $ MsgInvalidNumber t) (Right . review scientific') (readMay t :: Maybe Scientific)
|
||||
maybe (Left $ MsgInvalidNumber (t<>"HERE")) (Right . review scientific') (readMay t :: Maybe Scientific)
|
||||
|
||||
fixedPrecField :: forall m p.
|
||||
( Monad m
|
||||
, RenderMessage (HandlerSite m) FormMessage
|
||||
, HasResolution p
|
||||
) => Field m (Fixed p)
|
||||
fixedPrecField = Field{..}
|
||||
fixedPrecField = fixedPrecMinMaxField Nothing Nothing
|
||||
|
||||
fixedPrecMinMaxField :: forall m p.
|
||||
( Monad m
|
||||
, RenderMessage (HandlerSite m) FormMessage
|
||||
, HasResolution p
|
||||
) => Maybe (Fixed p) -> Maybe (Fixed p) -> Field m (Fixed p)
|
||||
fixedPrecMinMaxField lower upper = Field{..}
|
||||
where
|
||||
resolution' :: Integer
|
||||
resolution' = resolution $ Proxy @p
|
||||
|
||||
step = showFixed True (fromRational $ 1 % resolution' :: Fixed p)
|
||||
|
||||
showF = showFixed True
|
||||
step = showFixed True (fromRational $ 1 % resolution' :: Fixed p)
|
||||
|
||||
fieldEnctype = UrlEncoded
|
||||
fieldView theId name attrs val isReq
|
||||
= [whamlet|
|
||||
$newline never
|
||||
<input id=#{theId} name=#{name} *{attrs} type=number step=#{step} :isReq:required value=#{either id (pack . showFixed True) val}>
|
||||
<input id=#{theId} name=#{name} *{attrs} type=number step=#{step} :hasMin:min="#{showF vMin}" :hasMax:max="#{showF vMax}" :isReq:required value=#{either id (pack . showFixed True) val}>
|
||||
|]
|
||||
fieldParse = parseHelper $ \t -> do
|
||||
sci <- maybe (Left $ MsgInvalidNumber t) Right (readMay t :: Maybe Scientific)
|
||||
return . fromRational $ round (sci * fromIntegral resolution') % resolution'
|
||||
(hasMin, vMin) = maybe (False, 0) (True,) lower
|
||||
(hasMax, vMax) = maybe (False, 0) (True,) upper
|
||||
|
||||
|
||||
rationalField :: (MonadHandler m, RenderMessage (HandlerSite m) FormMessage) => Field m Rational
|
||||
rationalField = fractionalField
|
||||
|
||||
-- | Sepcify lower bound via HTML5 min attribute, may not work in older browser, so better use `Handler.Utils.Form.minIntField` (which in turn calls this function)
|
||||
intMinField :: (Monad m, Integral i, Show i, RenderMessage (HandlerSite m) FormMessage) => i -> Field m i
|
||||
intMinField lower = intMinMaxField (Just lower) Nothing
|
||||
|
||||
-- | Sepcify lower/upper bounds via HTML5 min attribute, may not work in older browser, so better use `Handler.Utils.Form.minIntField` (which in turn calls this function)
|
||||
intMinMaxField :: (Monad m, Integral i, Show i, RenderMessage (HandlerSite m) FormMessage) => Maybe i -> Maybe i -> Field m i
|
||||
intMinMaxField lower upper = intF{ fieldView=newView }
|
||||
where
|
||||
intF@Field{ fieldView=oldView } = intField
|
||||
newView theId name attrs val isReq = oldView theId name (newAttrs <> attrs) val isReq
|
||||
newAttrs = [ (a,tshow v) | (a,Just v) <- [("min", lower),("max", upper)] ]
|
||||
|
||||
data SecretJSONFieldException = SecretJSONFieldDecryptFailure
|
||||
deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable)
|
||||
instance Exception SecretJSONFieldException
|
||||
|
||||
Loading…
Reference in New Issue
Block a user