Forms for terms added, but buggy
This commit is contained in:
Steffen Jost
parent
b2bb30a429
commit
6cce5c05cc
2
db.sh
2
db.sh
@ -1,4 +1,4 @@
|
||||
#!/usr/bin/env -S bash -xe
|
||||
|
||||
# Options: see /test/Database.hs (Main)
|
||||
stack build --fast --flag uniworx:library-only --flag uniworx:dev
|
||||
stack exec uniworxdb -- $@
|
||||
|
||||
@ -419,8 +419,8 @@ DegreeShort: Abschlusskürzel
|
||||
StudyTermsKey: Schlüssel Studiengang
|
||||
StudyTermsName: Studiengang
|
||||
StudyTermsShort: Studiengangkürzel
|
||||
StudyDegreeChangeSuccess: Abschlusszuordnungen wurden aktualisiert
|
||||
|
||||
StudyTermsChangeSuccess: Zuordnung Abschlüsse aktualisiert
|
||||
StudyDegreeChangeSuccess: Zuordnung Studiengänge aktualisiert
|
||||
|
||||
MailTestFormEmail: Email-Addresse
|
||||
MailTestFormLanguages: Spracheinstellungen
|
||||
|
||||
@ -166,7 +166,9 @@ postAdminErrMsgR = do
|
||||
getAdminFeaturesR, postAdminFeaturesR :: Handler Html
|
||||
getAdminFeaturesR = postAdminFeaturesR
|
||||
postAdminFeaturesR = do
|
||||
((degreeResult,degreeTable),studytermsTable,candidateTable) <- runDB $ (,,)
|
||||
( (degreeResult,degreeTable)
|
||||
, (studyTermsResult,studytermsTable)
|
||||
, ((),candidateTable)) <- runDB $ (,,)
|
||||
<$> mkDegreeTable
|
||||
<*> mkStudytermsTable
|
||||
<*> mkCandidateTable
|
||||
@ -181,6 +183,16 @@ postAdminFeaturesR = do
|
||||
void . runDB $ Map.traverseWithKey updateDegree res
|
||||
addMessageI Success MsgStudyDegreeChangeSuccess
|
||||
|
||||
let studyTermsResult' :: FormResult (Map (Key StudyTerms) (Maybe Text, Maybe Text))
|
||||
studyTermsResult' = studyTermsResult <&> getDBFormResult
|
||||
(\row -> ( row ^. _dbrOutput . _entityVal . _studyTermsName
|
||||
, row ^. _dbrOutput . _entityVal . _studyTermsShorthand
|
||||
))
|
||||
updateStudyTerms studyTermsKey (name,short) = update studyTermsKey [StudyTermsName =. name, StudyTermsShorthand =. short]
|
||||
formResult studyTermsResult' $ \res -> do
|
||||
void . runDB $ Map.traverseWithKey updateStudyTerms res
|
||||
addMessageI Success MsgStudyTermsChangeSuccess
|
||||
|
||||
siteLayoutMsg MsgAdminFeaturesHeading $ do
|
||||
setTitleI MsgAdminFeaturesHeading
|
||||
[whamlet|
|
||||
@ -195,6 +207,12 @@ postAdminFeaturesR = do
|
||||
^{candidateTable}
|
||||
|]
|
||||
where
|
||||
textInputCell lensRes lensDefault = formCell id (return . view (_dbrOutput . _entityKey))
|
||||
(\row _mkUnique -> (\(res,fieldView) -> (set lensRes <$> res, fvInput fieldView))
|
||||
<$> mopt textField "" (Just $ row ^. lensDefault)
|
||||
)
|
||||
|
||||
|
||||
mkDegreeTable :: DB (FormResult (DBFormResult (Key StudyDegree) (Maybe Text, Maybe Text) (DBRow (Entity StudyDegree))), Widget)
|
||||
mkDegreeTable =
|
||||
let dbtIdent = "admin-studydegrees" :: Text
|
||||
@ -203,20 +221,10 @@ postAdminFeaturesR = do
|
||||
dbtSQLQuery = return
|
||||
dbtRowKey = (E.^. StudyDegreeKey)
|
||||
dbtProj = return
|
||||
dbtColonnade = mconcat
|
||||
dbtColonnade = formColonnade $ mconcat
|
||||
[ sortable (Just "degree-key") (i18nCell MsgDegreeKey) (numCell . view (_dbrOutput . _entityVal . _studyDegreeKey))
|
||||
, sortable (Just "degree-name") (i18nCell MsgDegreeName)
|
||||
(formCell id (return . view (_dbrOutput . _entityKey))
|
||||
(\row _mkUnique ->
|
||||
(\(res,nameview) -> (set _1 <$> res, fvInput nameview)) <$>
|
||||
mopt textField "" (Just $ row ^. _dbrOutput . _entityVal . _studyDegreeName)
|
||||
))
|
||||
, sortable (Just "degree-short") (i18nCell MsgDegreeShort)
|
||||
(formCell id (return . view (_dbrOutput . _entityKey))
|
||||
(\row _mkUnique ->
|
||||
(\(res,shortview) -> (set _2 <$> res, fvInput shortview)) <$>
|
||||
mopt textField "" (Just $ row ^. _dbrOutput . _entityVal . _studyDegreeShorthand)
|
||||
))
|
||||
, sortable (Just "degree-name") (i18nCell MsgDegreeName) (textInputCell _1 (_dbrOutput . _entityVal . _studyDegreeName))
|
||||
, sortable (Just "degree-short") (i18nCell MsgDegreeShort) (textInputCell _2 (_dbrOutput . _entityVal . _studyDegreeShorthand))
|
||||
]
|
||||
dbtSorting = Map.fromList
|
||||
[ ("degree-key" , SortColumn (E.^. StudyDegreeKey))
|
||||
@ -225,10 +233,11 @@ postAdminFeaturesR = do
|
||||
]
|
||||
dbtFilter = mempty
|
||||
dbtFilterUI = mempty
|
||||
dbtParams = def { dbParamsFormAddSubmit = True }
|
||||
dbtParams = def { dbParamsFormAddSubmit = True } -- dbParamsFormEvaluate = liftHandlerT . (runFormPost . identifyForm "degree-table" - (identForm FIDdegree))}
|
||||
psValidator = def & defaultSorting [SortAscBy "degree-name", SortAscBy "degree-short", SortAscBy "degree-key"]
|
||||
in dbTable psValidator DBTable{..}
|
||||
|
||||
mkStudytermsTable :: DB (FormResult (DBFormResult (Key StudyTerms) (Maybe Text, Maybe Text) (DBRow (Entity StudyTerms))), Widget)
|
||||
mkStudytermsTable =
|
||||
let dbtIdent = "admin-studyterms" :: Text
|
||||
dbtStyle = def
|
||||
@ -236,10 +245,10 @@ postAdminFeaturesR = do
|
||||
dbtSQLQuery = return
|
||||
dbtRowKey = (E.^. StudyTermsKey)
|
||||
dbtProj = return
|
||||
dbtColonnade = mconcat
|
||||
dbtColonnade = formColonnade $ mconcat
|
||||
[ sortable (Just "studyterms-key") (i18nCell MsgStudyTermsKey) (numCell . view (_dbrOutput . _entityVal . _studyTermsKey))
|
||||
, sortable (Just "studyterms-name") (i18nCell MsgStudyTermsName) (foldMap textCell . view (_dbrOutput . _entityVal . _studyTermsName))
|
||||
, sortable (Just "studyterms-short") (i18nCell MsgStudyTermsShort) (foldMap textCell . view (_dbrOutput . _entityVal . _studyTermsShorthand))
|
||||
, sortable (Just "studyterms-name") (i18nCell MsgStudyTermsName) (textInputCell _1 (_dbrOutput . _entityVal . _studyTermsName))
|
||||
, sortable (Just "studyterms-short") (i18nCell MsgStudyTermsShort) (textInputCell _2 (_dbrOutput . _entityVal . _studyTermsShorthand))
|
||||
]
|
||||
dbtSorting = Map.fromList
|
||||
[ ("studyterms-key" , SortColumn (E.^. StudyTermsKey))
|
||||
@ -248,9 +257,9 @@ postAdminFeaturesR = do
|
||||
]
|
||||
dbtFilter = mempty
|
||||
dbtFilterUI = mempty
|
||||
dbtParams = def
|
||||
dbtParams = def { dbParamsFormAddSubmit = True } -- , dbParamsFormEvaluate = liftHandlerT . runFormPost }
|
||||
psValidator = def & defaultSorting [SortAscBy "studyterms-name", SortAscBy "studyterms-short", SortAscBy "studyterms-key"]
|
||||
in dbTableWidget' psValidator DBTable{..}
|
||||
in dbTable psValidator DBTable{..}
|
||||
|
||||
mkCandidateTable =
|
||||
let dbtIdent = "admin-termcandidate" :: Text
|
||||
@ -259,7 +268,7 @@ postAdminFeaturesR = do
|
||||
dbtSQLQuery = return
|
||||
dbtRowKey = (E.^. StudyTermCandidateId)
|
||||
dbtProj = return
|
||||
dbtColonnade = mconcat
|
||||
dbtColonnade = dbColonnade $ mconcat
|
||||
[ sortable (Just "termcandidate-key") (i18nCell MsgStudyTermsKey) (numCell . view (_dbrOutput . _entityVal . _studyTermCandidateKey))
|
||||
, sortable (Just "termcandidate-name") (i18nCell MsgStudyTermsName) (textCell . view (_dbrOutput . _entityVal . _studyTermCandidateName))
|
||||
, sortable (Just "termcandidate-incidence") (i18nCell MsgStudyTermsShort) (pathPieceCell . view (_dbrOutput . _entityVal . _studyTermCandidateIncidence))
|
||||
@ -273,4 +282,4 @@ postAdminFeaturesR = do
|
||||
dbtFilterUI = mempty
|
||||
dbtParams = def
|
||||
psValidator = def & defaultSorting [SortAscBy "termcandidate-name", SortAscBy "termcandidate-key"]
|
||||
in dbTableWidget' psValidator DBTable{..}
|
||||
in dbTable psValidator DBTable{..}
|
||||
@ -45,6 +45,11 @@ htmlCell = cell . toWidget . toMarkup
|
||||
pathPieceCell :: (IsDBTable m a, PathPiece p) => p -> DBCell m a
|
||||
pathPieceCell = cell . toWidget . toPathPiece
|
||||
|
||||
-- | execute a DB action that return a widget for the cell contents
|
||||
sqlCell :: (IsDBTable (YesodDB UniWorX) a) => YesodDB UniWorX Widget -> DBCell (YesodDB UniWorX) a
|
||||
sqlCell act = mempty & cellContents .~ lift act
|
||||
|
||||
|
||||
---------------------
|
||||
-- Icon cells
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user