feat(course): allow csv-export of all features-of-study
This commit is contained in:
Gregor Kleen
parent
6926e2ecd7
commit
e60f1b2bfc
@ -1553,6 +1553,7 @@ CsvColumnExamUserCourseNote: Notizen zum Teilnehmer
|
||||
CsvColumnUserName: Voller Name des Teilnehmers
|
||||
CsvColumnUserMatriculation: Matrikelnummer des Teilnehmers
|
||||
CsvColumnUserEmail: E-Mail Addresse des Teilnehmers
|
||||
CsvColumnUserStudyFeatures: Alle aktiven Studiendaten des Teilnehmers als Semikolon (;) separierte Liste
|
||||
CsvColumnUserField: Studienfach, mit dem der Teilnehmer seine Kursanmeldung assoziiert hat
|
||||
CsvColumnUserDegree: Abschluss, den der Teilnehmer im assoziierten Studienfach anstrebt
|
||||
CsvColumnUserSemester: Fachsemester des Teilnehmers im assoziierten Studienfach
|
||||
@ -1934,3 +1935,6 @@ CourseEventCreated: Kurstermin erfolgreich angelegt
|
||||
CourseEventEdited: Kurstermin erfolgreich editiert
|
||||
CourseEventDeleteQuestion: Wollen Sie den unten aufgeführten Termin wirklich löschen?
|
||||
CourseEventDeleted: Kurstermin erfolgreich gelöscht
|
||||
|
||||
UserSimplifiedFeaturesOfStudyCsv: Vereinfachte Studiengangsdaten
|
||||
UserSimplifiedFeaturesOfStudyCsvTip: Sollen Abschluss, Studiengang und Semester zur einfacheren Verarbeitung als separate Spalten exportiert werden? Es wird dann nur jeweils das Fach exportiert, dass der Student bei der Anmeldung ausgewählt hat.
|
||||
@ -18,11 +18,14 @@ import Data.Function ((&))
|
||||
|
||||
import qualified Data.Set as Set
|
||||
import qualified Data.Map as Map
|
||||
import qualified Data.Text as Text
|
||||
|
||||
import qualified Database.Esqueleto as E
|
||||
|
||||
import qualified Data.Csv as Csv
|
||||
|
||||
import qualified Data.Conduit.List as C
|
||||
|
||||
|
||||
type UserTableExpr = (E.SqlExpr (Entity User) `E.InnerJoin` E.SqlExpr (Entity CourseParticipant))
|
||||
`E.LeftOuterJoin` E.SqlExpr (Maybe (Entity CourseUserNote))
|
||||
@ -119,36 +122,73 @@ colUserDegreeShort = sortable (Just "degree-short") (i18nCell MsgStudyFeatureDeg
|
||||
foldMap (i18nCell . ShortStudyDegree) . preview (_userTableFeatures . _2 . _Just)
|
||||
|
||||
|
||||
data UserTableCsvStudyFeature = UserTableCsvStudyFeature
|
||||
{ csvUserField :: Text
|
||||
, csvUserDegree :: Text
|
||||
, csvUserSemester :: Int
|
||||
, csvUserType :: StudyFieldType
|
||||
} deriving (Eq, Ord, Read, Show, Generic, Typeable)
|
||||
makeLenses_ ''UserTableCsvStudyFeature
|
||||
|
||||
data UserTableCsv = UserTableCsv
|
||||
{ csvUserName :: Text
|
||||
, csvUserMatriculation :: Maybe Text
|
||||
, csvUserEmail :: CI Email
|
||||
, csvUserField :: Maybe Text
|
||||
, csvUserDegree :: Maybe Text
|
||||
, csvUserSemester :: Maybe Int
|
||||
, csvUserStudyFeatures :: Either (Maybe UserTableCsvStudyFeature) (Set UserTableCsvStudyFeature)
|
||||
, csvUserRegistration :: UTCTime
|
||||
, csvUserNote :: Maybe Html
|
||||
}
|
||||
deriving (Generic)
|
||||
} deriving (Eq, Ord, Read, Show, Generic, Typeable)
|
||||
makeLenses_ ''UserTableCsv
|
||||
|
||||
userTableCsvOptions :: Csv.Options
|
||||
userTableCsvOptions = Csv.defaultOptions { Csv.fieldLabelModifier = camelToPathPiece' 2 }
|
||||
instance Csv.ToNamedRecord UserTableCsv where
|
||||
toNamedRecord = Csv.genericToNamedRecord userTableCsvOptions
|
||||
instance Csv.DefaultOrdered UserTableCsv where
|
||||
headerOrder = Csv.genericHeaderOrder userTableCsvOptions
|
||||
instance CsvColumnsExplained UserTableCsv where
|
||||
csvColumnsExplanations = genericCsvColumnsExplanations userTableCsvOptions $ mconcat
|
||||
[ singletonMap 'csvUserName MsgCsvColumnUserName
|
||||
, singletonMap 'csvUserMatriculation MsgCsvColumnUserMatriculation
|
||||
, singletonMap 'csvUserEmail MsgCsvColumnUserEmail
|
||||
, singletonMap 'csvUserField MsgCsvColumnUserField
|
||||
, singletonMap 'csvUserDegree MsgCsvColumnUserDegree
|
||||
, singletonMap 'csvUserSemester MsgCsvColumnUserSemester
|
||||
, singletonMap 'csvUserRegistration MsgCsvColumnUserRegistration
|
||||
, singletonMap 'csvUserNote MsgCsvColumnUserNote
|
||||
toNamedRecord UserTableCsv{..} = Csv.namedRecord $
|
||||
[ "name" Csv..= csvUserName
|
||||
, "matriculation" Csv..= csvUserMatriculation
|
||||
, "email" Csv..= csvUserEmail
|
||||
] ++ case csvUserStudyFeatures of
|
||||
Left feats
|
||||
-> [ "field" Csv..= (csvUserField <$> feats)
|
||||
, "degree" Csv..= (csvUserDegree <$> feats)
|
||||
, "semester" Csv..= (csvUserSemester <$> feats)
|
||||
]
|
||||
Right feats
|
||||
-> let featsStr = Text.intercalate "; " . flip map (Set.toList feats) $ \UserTableCsvStudyFeature{..}
|
||||
-> let csvUserType' = renderMessage (error "no foundation needed" :: UniWorX) [] $ ShortStudyFieldType csvUserType
|
||||
in [st|#{csvUserField} #{csvUserDegree} (#{csvUserType'} #{tshow csvUserSemester})|]
|
||||
in [ "study-features" Csv..= featsStr
|
||||
]
|
||||
++
|
||||
[ "registration" Csv..= csvUserRegistration
|
||||
, "note" Csv..= csvUserNote
|
||||
]
|
||||
instance CsvColumnsExplained UserTableCsv where
|
||||
csvColumnsExplanations _ = mconcat
|
||||
[ single "name" MsgCsvColumnUserName
|
||||
, single "matriculation" MsgCsvColumnUserMatriculation
|
||||
, single "email" MsgCsvColumnUserEmail
|
||||
, single "study-features" MsgCsvColumnUserStudyFeatures
|
||||
, single "field" MsgCsvColumnUserField
|
||||
, single "degree" MsgCsvColumnUserDegree
|
||||
, single "semester" MsgCsvColumnUserSemester
|
||||
, single "registration" MsgCsvColumnUserRegistration
|
||||
, single "note" MsgCsvColumnUserNote
|
||||
]
|
||||
where
|
||||
single :: RenderMessage UniWorX msg => Csv.Name -> msg -> Map Csv.Name Widget
|
||||
single k v = singletonMap k [whamlet|_{v}|]
|
||||
|
||||
newtype UserCsvExportData = UserCsvExportData
|
||||
{ csvUserSimplifiedFeaturesOfStudy :: Bool
|
||||
} deriving (Eq, Ord, Read, Show, Generic, Typeable)
|
||||
instance Default UserCsvExportData where
|
||||
def = UserCsvExportData True
|
||||
|
||||
userTableCsvHeader :: UserCsvExportData -> Csv.Header
|
||||
userTableCsvHeader UserCsvExportData{..} = Csv.header $
|
||||
[ "name", "matriculation", "email"
|
||||
] ++ bool (pure "study-features") ["field", "degree", "semester"] csvUserSimplifiedFeaturesOfStudy ++
|
||||
[ "registration", "note"
|
||||
]
|
||||
|
||||
|
||||
data CourseUserAction = CourseUserSendMail | CourseUserDeregister
|
||||
@ -254,19 +294,50 @@ makeCourseUserTable cid acts restrict colChoices psValidator = do
|
||||
, dbParamsFormResult = id
|
||||
, dbParamsFormIdent = def
|
||||
}
|
||||
dbtCsvEncode = simpleCsvEncodeM csvName $ UserTableCsv
|
||||
<$> view (hasUser . _userDisplayName)
|
||||
<*> view (hasUser . _userMatrikelnummer)
|
||||
<*> view (hasUser . _userEmail)
|
||||
<*> preview ( _userTableFeatures . _3 . _Just . _studyTermsName . _Just
|
||||
<> _userTableFeatures . _3 . _Just . _studyTermsKey . to tshow
|
||||
)
|
||||
<*> preview ( _userTableFeatures . _2 . _Just . _studyDegreeName . _Just
|
||||
<> _userTableFeatures . _2 . _Just . _studyDegreeKey . to tshow
|
||||
)
|
||||
<*> preview (_userTableFeatures . _1 . _Just . _studyFeaturesSemester)
|
||||
<*> view _userTableRegistration
|
||||
<*> userNote
|
||||
dbtCsvEncode = Just DBTCsvEncode
|
||||
{ dbtCsvExportForm = UserCsvExportData
|
||||
<$> apopt checkBoxField (fslI MsgUserSimplifiedFeaturesOfStudyCsv & setTooltip MsgUserSimplifiedFeaturesOfStudyCsvTip) (Just $ csvUserSimplifiedFeaturesOfStudy def)
|
||||
, dbtCsvDoEncode = \UserCsvExportData{..} -> C.mapM $ \(E.Value uid, row) -> flip runReaderT row $
|
||||
UserTableCsv
|
||||
<$> view (hasUser . _userDisplayName)
|
||||
<*> view (hasUser . _userMatrikelnummer)
|
||||
<*> view (hasUser . _userEmail)
|
||||
<*> if
|
||||
| csvUserSimplifiedFeaturesOfStudy -> fmap Left . runMaybeT $
|
||||
UserTableCsvStudyFeature
|
||||
<$> MaybeT (preview $ _userTableFeatures . _3 . _Just . _studyTermsName . _Just
|
||||
<> _userTableFeatures . _3 . _Just . _studyTermsKey . to tshow
|
||||
)
|
||||
<*> MaybeT (preview $ _userTableFeatures . _2 . _Just . _studyDegreeName . _Just
|
||||
<> _userTableFeatures . _2 . _Just . _studyDegreeKey . to tshow
|
||||
)
|
||||
<*> MaybeT (preview $ _userTableFeatures . _1 . _Just . _studyFeaturesSemester)
|
||||
<*> MaybeT (preview $ _userTableFeatures . _1 . _Just . _studyFeaturesType)
|
||||
| otherwise -> Right <$> do
|
||||
feats <- lift . E.select . E.from $ \(feat `E.InnerJoin` terms `E.InnerJoin` degree) -> do
|
||||
E.on $ degree E.^. StudyDegreeId E.==. feat E.^. StudyFeaturesDegree
|
||||
E.on $ terms E.^. StudyTermsId E.==. feat E.^. StudyFeaturesField
|
||||
let registered = E.exists . E.from $ \participant ->
|
||||
E.where_ $ participant E.^. CourseParticipantCourse E.==. E.val cid
|
||||
E.&&. participant E.^. CourseParticipantUser E.==. E.val uid
|
||||
E.&&. participant E.^. CourseParticipantField E.==. E.just (feat E.^. StudyFeaturesId)
|
||||
E.where_ $ registered
|
||||
E.||. feat E.^. StudyFeaturesValid
|
||||
E.where_ $ feat E.^. StudyFeaturesUser E.==. E.val uid
|
||||
return (terms, degree, feat)
|
||||
return . Set.fromList . flip map feats $ \(Entity _ StudyTerms{..}, Entity _ StudyDegree{..}, Entity _ StudyFeatures{..}) ->
|
||||
UserTableCsvStudyFeature
|
||||
{ csvUserField = fromMaybe (tshow studyTermsKey) studyTermsName
|
||||
, csvUserDegree = fromMaybe (tshow studyDegreeKey) studyDegreeName
|
||||
, csvUserSemester = studyFeaturesSemester
|
||||
, csvUserType = studyFeaturesType
|
||||
}
|
||||
<*> view _userTableRegistration
|
||||
<*> userNote
|
||||
, dbtCsvName = unpack csvName
|
||||
, dbtCsvNoExportData = Nothing
|
||||
, dbtCsvHeader = return . userTableCsvHeader . fromMaybe def
|
||||
}
|
||||
where
|
||||
userNote = runMaybeT $ do
|
||||
noteId <- MaybeT . preview $ _userTableNote . _Just
|
||||
|
||||
Loading…
Reference in New Issue
Block a user