fraport/fradrive-old
Archived
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

feat(forms): show studyFeaturesField in studyFeaturesFieldFor

Browse Source 
Fixes #451
This commit is contained in:
Gregor Kleen 2019-09-05 19:14:10 +02:00
parent 5826f79e75
commit b7496f9940
3 changed files with 28 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
messages/uniworx/de.msg
View File

@ -719,6 +719,8 @@ StudyFeatureAge: Fachsemester
StudyFeatureDegree: Abschluss StudyFeatureDegree: Abschluss
FieldPrimary: Hauptfach FieldPrimary: Hauptfach
FieldSecondary: Nebenfach FieldSecondary: Nebenfach
ShortFieldPrimary: HF
ShortFieldSecondary: NF
NoStudyField: Kein Studienfach NoStudyField: Kein Studienfach
StudyFeatureType: StudyFeatureType:
StudyFeatureValid: Aktiv StudyFeatureValid: Aktiv

11
src/Foundation.hs
View File

@ -351,6 +351,17 @@ instance RenderMessage UniWorX StudyDegreeTerm where
mr :: RenderMessage UniWorX msg => msg -> Text mr :: RenderMessage UniWorX msg => msg -> Text
mr = renderMessage foundation ls mr = renderMessage foundation ls
newtype ShortStudyFieldType = ShortStudyFieldType StudyFieldType
embedRenderMessageVariant ''UniWorX ''ShortStudyFieldType ("Short" <>)
data StudyDegreeTermType = StudyDegreeTermType StudyDegree StudyTerms StudyFieldType
instance RenderMessage UniWorX StudyDegreeTermType where
renderMessage foundation ls (StudyDegreeTermType deg trm typ) = (mr trm) <> " (" <> (mr $ ShortStudyDegree deg) <> ", " <> (mr $ ShortStudyFieldType typ) <> ")"
where
mr :: RenderMessage UniWorX msg => msg -> Text
mr = renderMessage foundation ls
instance RenderMessage UniWorX ExamGrade where instance RenderMessage UniWorX ExamGrade where
renderMessage _ _ = pack . (showFixed False :: Deci -> String) . fromRational . review numberGrade renderMessage _ _ = pack . (showFixed False :: Deci -> String) . fromRational . review numberGrade

20
src/Handler/Utils/Form.hs
View File

@ -374,9 +374,17 @@ studyFeaturesFieldFor mRestr isOptional oldFeatures mbuid = selectField $ do
E.on $ feature E.^. StudyFeaturesDegree E.==. degree E.^. StudyDegreeId E.on $ feature E.^. StudyFeaturesDegree E.==. degree E.^. StudyDegreeId
E.where_ $ ((feature E.^. StudyFeaturesId) `E.in_` E.valList oldFeatures) E.where_ $ ((feature E.^. StudyFeaturesId) `E.in_` E.valList oldFeatures)
E.||. (isActiveUserStudyFeature feature E.&&. isCorrectType feature) E.||. (isActiveUserStudyFeature feature E.&&. isCorrectType feature)
return (feature E.^. StudyFeaturesId, degree, field) return (feature, degree, field)
MsgRenderer mr <- getMsgRenderer MsgRenderer mr <- getMsgRenderer
mkOptionList . nonEmptyOptions (mr MsgNoStudyField) <$> mapM (procOptions mr) rawOptions let showTypes
| length rawOptions <= 1
= False
| Just restr <- mRestr
, Set.size restr == 1
= False
| otherwise
= True
mkOptionList . nonEmptyOptions (mr MsgNoStudyField) <$> mapM (procOptions showTypes mr) rawOptions
where where
isActiveUserStudyFeature feature = case mbuid of isActiveUserStudyFeature feature = case mbuid of
Nothing -> E.false Nothing -> E.false
@ -386,11 +394,13 @@ studyFeaturesFieldFor mRestr isOptional oldFeatures mbuid = selectField $ do
Nothing -> E.true Nothing -> E.true
Just restr -> feature E.^. StudyFeaturesType `E.in_` E.valList (Set.toList restr) Just restr -> feature E.^. StudyFeaturesType `E.in_` E.valList (Set.toList restr)
procOptions :: (StudyDegreeTerm -> Text) -> (E.Value StudyFeaturesId, Entity StudyDegree, Entity StudyTerms) -> Handler (Option (Maybe StudyFeaturesId)) procOptions :: Bool -> (forall msg. RenderMessage UniWorX msg => msg -> Text) -> (Entity StudyFeatures, Entity StudyDegree, Entity StudyTerms) -> Handler (Option (Maybe StudyFeaturesId))
procOptions mr (E.Value sfid, Entity _dgid sdegree, Entity _stid sterm) = do procOptions showTypes mr (Entity sfid sfeat, Entity _dgid sdegree, Entity _stid sterm) = do
cfid <- encrypt sfid cfid <- encrypt sfid
return Option return Option
{ optionDisplay = mr $ StudyDegreeTerm sdegree sterm { optionDisplay = if
| showTypes -> mr $ StudyDegreeTermType sdegree sterm (studyFeaturesType sfeat)
| otherwise -> mr $ StudyDegreeTerm sdegree sterm
, optionInternalValue = Just sfid , optionInternalValue = Just sfid
, optionExternalValue = toPathPiece (cfid :: CryptoID UUID StudyFeaturesId) , optionExternalValue = toPathPiece (cfid :: CryptoID UUID StudyFeaturesId)
} }