diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg index 0d7a1a441..27cfe8586 100644 --- a/messages/uniworx/de.msg +++ b/messages/uniworx/de.msg @@ -227,6 +227,8 @@ CourseAllocationCapacityMayNotBeChanged: Kapazität eines Kurses, der an einer Z CourseLecturerRightsIdentical: Alle Sorten von Kursverwalter haben identische Rechte. +School: Institut + NoSuchTerm tid@TermId: Semester #{tid} gibt es nicht. NoSuchSchool ssh@SchoolId: Institut #{ssh} gibt es nicht. NoSuchCourseShorthand csh@CourseShorthand: Kein Kurs mit Kürzel #{csh} bekannt. @@ -963,10 +965,12 @@ MenuHelp: Hilfe MenuProfile: Anpassen MenuLogin: Login MenuLogout: Logout +MenuAllocationList: Zentralanmeldungen MenuCourseList: Kurse MenuCourseMembers: Kursteilnehmer MenuCourseAddMembers: Kursteilnehmer hinzufügen MenuCourseCommunication: Kursmitteilung +MenuCourseApplications: Bewerbungen MenuTermShow: Semester MenuSubmissionDelete: Abgabe löschen MenuUsers: Benutzer @@ -1469,6 +1473,7 @@ MailSchoolLecturerInviteHeading school@SchoolName: Einladung zum Dozent für „ SchoolLecturerInviteExplanation: Sie wurden eingeladen, Dozent für ein Institut zu sein. Sie können, nachdem Sie die Einladung annehmen, eigenständig neue Kurse anlegen. SchoolLecturerInvitationAccepted school@SchoolName: Einladung zum Dozent für „#{school}“ angenommen +AllocationName: Name AllocationTitle termText@Text ssh'@SchoolShorthand allocation@AllocationName: #{termText} - #{ssh'}: #{allocation} AllocationShortTitle termText@Text ssh'@SchoolShorthand ash@AllocationShorthand: #{termText} - #{ssh'} - #{ash} AllocationDescription: Beschreibung @@ -1513,4 +1518,14 @@ ApplicationRatingCommentInvisibleTip: Dient zunächst nur als Notiz für Kursver AllocationSchoolShort: Institut Allocation: Zentralanmeldung -AllocationRegisterTo: Anmeldungen bis \ No newline at end of file +AllocationRegisterTo: Anmeldungen bis + +AllocationListTitle: Zentralanmeldungen + +CourseApplicationsListTitle: Bewerbungen +CourseApplicationId: Bewerbungsnummer +CourseApplicationRatingPoints: Bewertung +CourseApplicationVeto: Veto + +UserDisplayName: Voller Name +UserMatriculation: Matrikelnummer \ No newline at end of file diff --git a/models/users b/models/users index 33a92adf1..21143848c 100644 --- a/models/users +++ b/models/users @@ -12,10 +12,10 @@ User json -- Each Uni2work user has a corresponding row in this table; create authentication AuthenticationMode -- 'AuthLDAP' or ('AuthPWHash'+password-hash) lastAuthentication UTCTime Maybe -- last login date tokensIssuedAfter UTCTime Maybe -- do not accept bearer tokens issued before this time (accept all tokens if null) - matrikelnummer Text Maybe -- optional immatriculation-string; usually a number, but not always (e.g. lecturers, pupils, guests,...) + matrikelnummer UserMatriculation Maybe -- optional immatriculation-string; usually a number, but not always (e.g. lecturers, pupils, guests,...) email (CI Text) -- Case-insensitive eMail address - displayName Text -- we only show LDAP-DisplayName, and highlight LDAP-Surname within (appended if not contained) - surname Text -- Display user names always through 'nameWidget displayName surname' + displayName UserDisplayName -- we only show LDAP-DisplayName, and highlight LDAP-Surname within (appended if not contained) + surname UserSurname -- Display user names always through 'nameWidget displayName surname' firstName Text -- For export in tables, pre-split firstName from displayName title Text Maybe -- For upcoming name customisation maxFavourites Int default=12 -- max number of rows with this userId in table "CourseFavourite"; for convenience links; user-defined diff --git a/routes b/routes index e1b8714b3..88099df1a 100644 --- a/routes +++ b/routes @@ -81,6 +81,7 @@ /school SchoolListR GET !development /school/#SchoolId SchoolShowR GET !development +/allocation/ AllocationListR GET !free /allocation/#TermId/#SchoolId/#AllocationShorthand AllocationR: / AShowR GET !free /register ARegisterR POST !time diff --git a/src/Application.hs b/src/Application.hs index 597a316fd..fe1bc98ff 100644 --- a/src/Application.hs +++ b/src/Application.hs @@ -64,10 +64,6 @@ import qualified Yesod.Core.Types as Yesod (Logger(..)) import qualified Data.HashMap.Strict as HashMap -import Utils.Lens - -import Data.Proxy - import qualified Data.Aeson as Aeson import System.Exit diff --git a/src/Auth/LDAP.hs b/src/Auth/LDAP.hs index 26026dfee..406a3a2d4 100644 --- a/src/Auth/LDAP.hs +++ b/src/Auth/LDAP.hs @@ -10,7 +10,6 @@ module Auth.LDAP ) where import Import.NoFoundation hiding (userEmail, userDisplayName) -import Control.Lens import Network.Connection import Data.CaseInsensitive (CI) diff --git a/src/Colonnade/Instances.hs b/src/Colonnade/Instances.hs new file mode 100644 index 000000000..d47902515 --- /dev/null +++ b/src/Colonnade/Instances.hs @@ -0,0 +1,19 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} + +module Colonnade.Instances + ( + ) where + +import ClassyPrelude + +import Control.Lens.Indexed (FunctorWithIndex(imap)) + +import Colonnade.Encode (Colonnade(..), OneColonnade(..)) + +instance Functor h => FunctorWithIndex (Maybe a) (Colonnade h a) where + imap f (Colonnade ones) = Colonnade $ dimapColonnade' <$> ones + where + dimapColonnade' OneColonnade{..} = OneColonnade + { oneColonnadeEncode = \x -> f (Just x) $ oneColonnadeEncode x + , oneColonnadeHead = f Nothing <$> oneColonnadeHead + } diff --git a/src/Database/Esqueleto/Utils.hs b/src/Database/Esqueleto/Utils.hs index 201091a2d..beaddbc0d 100644 --- a/src/Database/Esqueleto/Utils.hs +++ b/src/Database/Esqueleto/Utils.hs @@ -18,6 +18,7 @@ module Database.Esqueleto.Utils , SqlHashable , sha256 , maybe + , SqlProject(..) ) where @@ -232,3 +233,16 @@ maybe onNothing onJust val = E.case_ (onJust $ E.veryUnsafeCoerceSqlExprValue val) ] (E.else_ onNothing) + + +class (PersistEntity entity, PersistField value) => SqlProject entity value entity' value' | entity value entity' -> value', entity value value' -> entity' where + sqlProject :: E.SqlExpr entity' -> EntityField entity value -> E.SqlExpr (E.Value value') + unSqlProject :: forall p1 p2. p1 entity -> p2 entity' -> value -> value' + +instance (PersistEntity val, PersistField typ) => SqlProject val typ (E.Entity val) typ where + sqlProject = (E.^.) + unSqlProject _ _ = id + +instance (PersistEntity val, PersistField typ) => SqlProject val typ (Maybe (E.Entity val)) (Maybe typ) where + sqlProject = (E.?.) + unSqlProject _ _ = Just diff --git a/src/Foundation.hs b/src/Foundation.hs index c6e9be2f2..5ed273b2f 100644 --- a/src/Foundation.hs +++ b/src/Foundation.hs @@ -65,7 +65,6 @@ import Control.Monad.Memo.Class (MonadMemo(..), for4) import qualified Control.Monad.Catch as C import Handler.Utils.StudyFeatures -import Utils.Lens import Utils.Form import Utils.Sheet import Utils.SystemMessage @@ -1047,6 +1046,7 @@ tagAccessPredicate AuthAllocationRegistered = APDB $ \mAuthId route _ -> case ro r -> $unsupportedAuthPredicate AuthAllocationRegistered r tagAccessPredicate AuthParticipant = APDB $ \_ route _ -> case route of CourseR tid ssh csh (CUserR cID) -> exceptT return return $ do + cTime <- liftIO getCurrentTime let authorizedIfExists f = do [E.Value ok] <- lift . E.select . return . E.exists $ E.from f whenExceptT ok Authorized @@ -1107,12 +1107,16 @@ tagAccessPredicate AuthParticipant = APDB $ \_ route _ -> case route of E.&&. course E.^. CourseSchool E.==. E.val ssh E.&&. course E.^. CourseShorthand E.==. E.val csh -- participant is applicant for this course - $cachedHereBinary (participant, tid, ssh, csh) . authorizedIfExists $ \(course `E.InnerJoin` courseApplication) -> do + $cachedHereBinary (participant, tid, ssh, csh) . authorizedIfExists $ \((course `E.InnerJoin` courseApplication) `E.LeftOuterJoin` allocation) -> do + E.on $ allocation E.?. AllocationId E.==. courseApplication E.^. CourseApplicationAllocation E.on $ course E.^. CourseId E.==. courseApplication E.^. CourseApplicationCourse E.where_ $ courseApplication E.^. CourseApplicationUser E.==. E.val participant E.&&. course E.^. CourseTerm E.==. E.val tid E.&&. course E.^. CourseSchool E.==. E.val ssh E.&&. course E.^. CourseShorthand E.==. E.val csh + E.where_ $ E.maybe E.true (E.maybe E.false $ \f -> f E.<=. E.val cTime) (allocation E.?. AllocationStaffAllocationFrom) + E.&&. E.maybe E.true (E.maybe E.true $ \t -> t E.>=. E.val cTime) (allocation E.?. AllocationStaffAllocationTo) + unauthorizedI MsgUnauthorizedParticipant r -> $unsupportedAuthPredicate AuthParticipant r tagAccessPredicate AuthCapacity = APDB $ \_ route _ -> case route of @@ -1748,10 +1752,11 @@ instance YesodBreadcrumbs UniWorX where breadcrumb (TermSchoolCourseListR tid ssh) = return (original $ unSchoolKey ssh, Just $ TermCourseListR tid) + breadcrumb AllocationListR = return ("Zentralanmeldungen", Just HomeR) breadcrumb (AllocationR tid ssh ash AShowR) = do mr <- getMessageRender Entity _ Allocation{allocationName} <- runDB . getBy404 $ TermSchoolAllocationShort tid ssh ash - return ([st|#{allocationName} (#{mr (ShortTermIdentifier (unTermKey tid))}, #{original (unSchoolKey ssh)})|], Just $ HomeR) + return ([st|#{allocationName} (#{mr (ShortTermIdentifier (unTermKey tid))}, #{original (unSchoolKey ssh)})|], Just $ AllocationListR) breadcrumb (AllocationR tid ssh ash (AApplicationR _)) = return ("Bewerbung", Just $ AllocationR tid ssh ash AShowR) breadcrumb CourseListR = return ("Kurse" , Nothing) @@ -1776,6 +1781,8 @@ instance YesodBreadcrumbs UniWorX where breadcrumb (CourseR tid ssh csh CExamListR) = return ("Prüfungen", Just $ CourseR tid ssh csh CShowR) breadcrumb (CourseR tid ssh csh CExamNewR) = return ("Anlegen", Just $ CourseR tid ssh csh CExamListR) + breadcrumb (CourseR tid ssh csh CApplicationsR) = return ("Bewerbungen", Just $ CourseR tid ssh csh CShowR) + breadcrumb (CExamR tid ssh csh examn EShowR) = return (original examn, Just $ CourseR tid ssh csh CExamListR) breadcrumb (CExamR tid ssh csh examn EEditR) = return ("Bearbeiten", Just $ CExamR tid ssh csh examn EShowR) breadcrumb (CExamR tid ssh csh examn EUsersR) = return ("Teilnehmer", Just $ CExamR tid ssh csh examn EShowR) @@ -1970,35 +1977,11 @@ pageActions (HomeR) = , menuItemModal = False , menuItemAccessCallback' = return True } - , MenuItem - { menuItemType = PageActionPrime - , menuItemLabel = MsgAdminHeading - , menuItemIcon = Just "screwdriver" - , menuItemRoute = SomeRoute AdminR - , menuItemModal = False - , menuItemAccessCallback' = return True - } - , MenuItem - { menuItemType = PageActionPrime - , menuItemLabel = MsgAdminFeaturesHeading - , menuItemIcon = Nothing - , menuItemRoute = SomeRoute AdminFeaturesR - , menuItemModal = False - , menuItemAccessCallback' = return True - } , MenuItem { menuItemType = PageActionPrime - , menuItemLabel = MsgMenuMessageList + , menuItemLabel = MsgMenuAllocationList , menuItemIcon = Nothing - , menuItemRoute = SomeRoute MessageListR - , menuItemModal = False - , menuItemAccessCallback' = return True - } - , MenuItem - { menuItemType = PageActionPrime - , menuItemLabel = MsgMenuAdminErrMsg - , menuItemIcon = Nothing - , menuItemRoute = SomeRoute AdminErrMsgR + , menuItemRoute = SomeRoute AllocationListR , menuItemModal = False , menuItemAccessCallback' = return True } @@ -2022,20 +2005,12 @@ pageActions (AdminR) = } , MenuItem { menuItemType = PageActionPrime - , menuItemLabel = MsgErrMsgHeading + , menuItemLabel = MsgMenuAdminErrMsg , menuItemIcon = Nothing , menuItemRoute = SomeRoute AdminErrMsgR , menuItemModal = False , menuItemAccessCallback' = return True } - , MenuItem - { menuItemType = PageActionPrime - , menuItemLabel = MsgMenuUsers - , menuItemIcon = Nothing - , menuItemRoute = SomeRoute UsersR - , menuItemModal = False - , menuItemAccessCallback' = return True - } , MenuItem { menuItemType = PageActionSecondary , menuItemLabel = MsgMenuAdminTest @@ -2201,6 +2176,14 @@ pageActions (CourseListR) = , menuItemModal = False , menuItemAccessCallback' = return True } + , MenuItem + { menuItemType = PageActionPrime + , menuItemLabel = MsgMenuAllocationList + , menuItemIcon = Nothing + , menuItemRoute = SomeRoute AllocationListR + , menuItemModal = False + , menuItemAccessCallback' = return True + } ] pageActions (CourseNewR) = [ MenuItem @@ -2279,6 +2262,28 @@ pageActions (CourseR tid ssh csh CShowR) = anyM examNames $ examAccess . E.unValue in runDB $ lecturerAccess `or2M` existsVisible } + , MenuItem + { menuItemType = PageActionSecondary + , menuItemLabel = MsgMenuCourseApplications + , menuItemIcon = Nothing + , menuItemRoute = SomeRoute $ CourseR tid ssh csh CApplicationsR + , menuItemModal = False + , menuItemAccessCallback' = + let courseWhere course = course <$ do + E.where_ $ course E.^. CourseTerm E.==. E.val tid + E.&&. course E.^. CourseSchool E.==. E.val ssh + E.&&. course E.^. CourseShorthand E.==. E.val csh + existsApplications = E.selectExists . E.from $ \(course `E.InnerJoin` courseApplication) -> do + E.on $ course E.^. CourseId E.==. courseApplication E.^. CourseApplicationCourse + void $ courseWhere course + courseApplications = fmap (any E.unValue) . E.select . E.from $ \course -> do + void $ courseWhere course + return $ course E.^. CourseApplicationsRequired + courseAllocation = E.selectExists . E.from $ \(course `E.InnerJoin` allocationCourse) -> do + E.on $ course E.^. CourseId E.==. allocationCourse E.^. AllocationCourseCourse + void $ courseWhere course + in runDB $ courseAllocation `or2M` courseApplications `or2M` existsApplications + } , MenuItem { menuItemType = PageActionSecondary , menuItemLabel = MsgMenuCourseMembers diff --git a/src/Handler/Admin.hs b/src/Handler/Admin.hs index ded5ebec7..db6096bec 100644 --- a/src/Handler/Admin.hs +++ b/src/Handler/Admin.hs @@ -8,8 +8,6 @@ import Data.Aeson.Encode.Pretty (encodePrettyToTextBuilder) import Control.Monad.Trans.Except import Control.Monad.Trans.Writer (mapWriterT) -import Utils.Lens - -- import Data.Time import Data.Char (isDigit) import qualified Data.Text as Text diff --git a/src/Handler/Allocation.hs b/src/Handler/Allocation.hs index 231b33b46..3cb35e7cc 100644 --- a/src/Handler/Allocation.hs +++ b/src/Handler/Allocation.hs @@ -6,3 +6,4 @@ import Handler.Allocation.Info as Handler.Allocation import Handler.Allocation.Show as Handler.Allocation import Handler.Allocation.Application as Handler.Allocation import Handler.Allocation.Register as Handler.Allocation +import Handler.Allocation.List as Handler.Allocation diff --git a/src/Handler/Allocation/Application.hs b/src/Handler/Allocation/Application.hs index cae507c55..2cf732df8 100644 --- a/src/Handler/Allocation/Application.hs +++ b/src/Handler/Allocation/Application.hs @@ -12,8 +12,6 @@ module Handler.Allocation.Application import Import hiding (hash) import Handler.Utils -import Utils.Lens - import qualified Data.Text as Text import qualified Data.Set as Set diff --git a/src/Handler/Allocation/List.hs b/src/Handler/Allocation/List.hs new file mode 100644 index 000000000..d87161bd7 --- /dev/null +++ b/src/Handler/Allocation/List.hs @@ -0,0 +1,86 @@ +module Handler.Allocation.List + ( getAllocationListR + ) where + +import Import + +import qualified Database.Esqueleto as E +import Handler.Utils.Table.Columns +import Handler.Utils.Table.Pagination + + +type AllocationTableExpr = E.SqlExpr (Entity Allocation) +type AllocationTableData = DBRow (Entity Allocation) + +allocationListIdent :: Text +allocationListIdent = "allocations" + +queryAllocation :: Getter AllocationTableExpr (E.SqlExpr (Entity Allocation)) +queryAllocation = id + +resultAllocation :: Lens' AllocationTableData (Entity Allocation) +resultAllocation = _dbrOutput + +allocationTermLink :: TermId -> SomeRoute UniWorX +allocationTermLink tid = SomeRoute (AllocationListR, [(dbFilterKey allocationListIdent "term", toPathPiece tid)]) + +allocationSchoolLink :: SchoolId -> SomeRoute UniWorX +allocationSchoolLink ssh = SomeRoute (AllocationListR, [(dbFilterKey allocationListIdent "school", toPathPiece ssh)]) + +allocationLink :: Allocation -> SomeRoute UniWorX +allocationLink Allocation{..} = SomeRoute $ AllocationR allocationTerm allocationSchool allocationShorthand AShowR + +getAllocationListR :: Handler Html +getAllocationListR = do + let + dbtSQLQuery :: AllocationTableExpr -> E.SqlQuery _ + dbtSQLQuery = return + + dbtProj :: DBRow _ -> MaybeT (YesodDB UniWorX) AllocationTableData + dbtProj = return + + dbtRowKey = view $ queryAllocation . to (E.^. AllocationId) + + dbtColonnade :: Colonnade Sortable _ _ + dbtColonnade = mconcat + [ anchorColonnade (views (resultAllocation . _entityVal . _allocationTerm) allocationTermLink) $ colTermShort (resultAllocation . _entityVal . _allocationTerm) + , anchorColonnade (views (resultAllocation . _entityVal . _allocationSchool) allocationSchoolLink) $ colSchoolShort (resultAllocation . _entityVal . _allocationSchool) + , anchorColonnade (views (resultAllocation . _entityVal) allocationLink) $ colAllocationName (resultAllocation . _entityVal . _allocationName) + ] + + dbtSorting = mconcat + [ sortTerm $ queryAllocation . to (E.^. AllocationTerm) + , sortSchool $ queryAllocation . to (E.^. AllocationSchool) + , sortAllocationName $ queryAllocation . to (E.^. AllocationName) + ] + + dbtFilter = mconcat + [ fltrTerm $ queryAllocation . to (E.^. AllocationTerm) + , fltrSchool $ queryAllocation . to (E.^. AllocationSchool) + , fltrAllocation queryAllocation + ] + dbtFilterUI = mconcat + [ fltrTermUI + , fltrSchoolUI + , fltrAllocationUI + ] + + dbtStyle = def + { dbsFilterLayout = defaultDBSFilterLayout + } + dbtParams = def + + dbtCsvEncode = noCsvEncode + dbtCsvDecode = Nothing + + dbtIdent = allocationListIdent + + psValidator :: PSValidator _ _ + psValidator = def + & defaultSorting [SortAscBy "term", SortAscBy "school", SortAscBy "allocation"] + + table <- runDB $ dbTableWidget' psValidator DBTable{..} + + siteLayoutMsg MsgAllocationListTitle $ do + setTitleI MsgAllocationListTitle + table diff --git a/src/Handler/Allocation/Register.hs b/src/Handler/Allocation/Register.hs index 9c2256695..eb5e55255 100644 --- a/src/Handler/Allocation/Register.hs +++ b/src/Handler/Allocation/Register.hs @@ -8,8 +8,6 @@ module Handler.Allocation.Register import Import -import Utils.Lens - import Handler.Utils.Form {-# ANN module ("HLint: ignore Use newtype instead of data"::String) #-} diff --git a/src/Handler/Allocation/Show.hs b/src/Handler/Allocation/Show.hs index 6cfe5e19a..0cc4d455b 100644 --- a/src/Handler/Allocation/Show.hs +++ b/src/Handler/Allocation/Show.hs @@ -4,8 +4,7 @@ module Handler.Allocation.Show import Import import Handler.Utils -import Utils.Lens - + import Handler.Allocation.Register import Handler.Allocation.Application diff --git a/src/Handler/Corrections.hs b/src/Handler/Corrections.hs index 3e0a5a825..b366885d3 100644 --- a/src/Handler/Corrections.hs +++ b/src/Handler/Corrections.hs @@ -12,8 +12,6 @@ import Handler.Utils.SheetType import Handler.Utils.Delete -- import Handler.Utils.Zip -import Utils.Lens - import Data.List as List (nub, foldl, foldr) import Data.Set (Set) import qualified Data.Set as Set diff --git a/src/Handler/Course/Application.hs b/src/Handler/Course/Application.hs index 7bdbb62ba..998ff9670 100644 --- a/src/Handler/Course/Application.hs +++ b/src/Handler/Course/Application.hs @@ -6,8 +6,10 @@ module Handler.Course.Application import Import import Handler.Utils +import Handler.Utils.Table.Columns import qualified Database.Esqueleto as E +import Database.Esqueleto.Utils.TH import System.FilePath (addExtension) @@ -37,6 +39,192 @@ getCAFilesR tid ssh csh cID = do serveSomeFiles archiveName $ fsSource .| C.map entityVal + +type CourseApplicationsTableExpr = ( E.SqlExpr (Entity CourseApplication) + `E.InnerJoin` E.SqlExpr (Entity User) + ) + `E.LeftOuterJoin` E.SqlExpr (Maybe (Entity Allocation)) + `E.LeftOuterJoin` ( E.SqlExpr (Maybe (Entity StudyFeatures)) + `E.InnerJoin` E.SqlExpr (Maybe (Entity StudyTerms)) + `E.InnerJoin` E.SqlExpr (Maybe (Entity StudyDegree)) + ) +type CourseApplicationsTableData = DBRow ( Entity CourseApplication + , Entity User + , E.Value Bool -- hasFiles + , Maybe (Entity Allocation) + , Maybe (Entity StudyFeatures) + , Maybe (Entity StudyTerms) + , Maybe (Entity StudyDegree) + ) + +courseApplicationsIdent :: Text +courseApplicationsIdent = "applications" + +queryCourseApplication :: Getter CourseApplicationsTableExpr (E.SqlExpr (Entity CourseApplication)) +queryCourseApplication = to $ $(sqlIJproj 2 1) . $(sqlLOJproj 3 1) + +queryUser :: Getter CourseApplicationsTableExpr (E.SqlExpr (Entity User)) +queryUser = to $ $(sqlIJproj 2 2) . $(sqlLOJproj 3 1) + +queryHasFiles :: Getter CourseApplicationsTableExpr (E.SqlExpr (E.Value Bool)) +queryHasFiles = to $ hasFiles . $(sqlIJproj 2 1) . $(sqlLOJproj 3 1) + where + hasFiles appl = E.exists . E.from $ \courseApplicationFile -> + E.where_ $ courseApplicationFile E.^. CourseApplicationFileApplication E.==. appl E.^. CourseApplicationId + +queryAllocation :: Getter CourseApplicationsTableExpr (E.SqlExpr (Maybe (Entity Allocation))) +queryAllocation = to $(sqlLOJproj 3 2) + +queryStudyFeatures :: Getter CourseApplicationsTableExpr (E.SqlExpr (Maybe (Entity StudyFeatures))) +queryStudyFeatures = to $ $(sqlIJproj 3 1) . $(sqlLOJproj 3 3) + +queryStudyTerms :: Getter CourseApplicationsTableExpr (E.SqlExpr (Maybe (Entity StudyTerms))) +queryStudyTerms = to $ $(sqlIJproj 3 2) . $(sqlLOJproj 3 3) + +queryStudyDegree :: Getter CourseApplicationsTableExpr (E.SqlExpr (Maybe (Entity StudyDegree))) +queryStudyDegree = to $ $(sqlIJproj 3 3) . $(sqlLOJproj 3 3) + +resultCourseApplication :: Lens' CourseApplicationsTableData (Entity CourseApplication) +resultCourseApplication = _dbrOutput . _1 + +resultUser :: Lens' CourseApplicationsTableData (Entity User) +resultUser = _dbrOutput . _2 + +resultHasFiles :: Lens' CourseApplicationsTableData Bool +resultHasFiles = _dbrOutput . _3 . _Value + +resultAllocation :: Traversal' CourseApplicationsTableData (Entity Allocation) +resultAllocation = _dbrOutput . _4 . _Just + +resultStudyFeatures :: Traversal' CourseApplicationsTableData (Entity StudyFeatures) +resultStudyFeatures = _dbrOutput . _5 . _Just + +resultStudyTerms :: Traversal' CourseApplicationsTableData (Entity StudyTerms) +resultStudyTerms = _dbrOutput . _6 . _Just + +resultStudyDegree :: Traversal' CourseApplicationsTableData (Entity StudyDegree) +resultStudyDegree = _dbrOutput . _7 . _Just + getCApplicationsR, postCApplicationsR :: TermId -> SchoolId -> CourseShorthand -> Handler Html getCApplicationsR = postCApplicationsR -postCApplicationsR = fail "not implemented" -- dbtable of _all_ course applications +postCApplicationsR tid ssh csh = do + table <- runDB $ do + cid <- getKeyBy404 $ TermSchoolCourseShort tid ssh csh + + let + allocationLink :: Allocation -> SomeRoute UniWorX + allocationLink Allocation{..} = SomeRoute $ AllocationR allocationTerm allocationSchool allocationShorthand AShowR + + participantLink :: MonadCrypto m => UserId -> m (SomeRoute UniWorX) + participantLink uid = do + cID <- encrypt uid + return . SomeRoute . CourseR tid ssh csh $ CUserR cID + + dbtSQLQuery :: CourseApplicationsTableExpr -> E.SqlQuery _ + dbtSQLQuery = runReaderT $ do + courseApplication <- view queryCourseApplication + hasFiles <- view queryHasFiles + user <- view queryUser + allocation <- view queryAllocation + studyFeatures <- view queryStudyFeatures + studyTerms <- view queryStudyTerms + studyDegree <- view queryStudyDegree + + lift $ do + E.on $ studyDegree E.?. StudyDegreeId E.==. studyFeatures E.?. StudyFeaturesDegree + E.on $ studyTerms E.?. StudyTermsId E.==. studyFeatures E.?. StudyFeaturesField + E.on $ studyFeatures E.?. StudyFeaturesId E.==. courseApplication E.^. CourseApplicationField + E.on $ courseApplication E.^. CourseApplicationAllocation E.==. allocation E.?. AllocationId + E.on $ user E.^. UserId E.==. courseApplication E.^. CourseApplicationUser + E.where_ $ courseApplication E.^. CourseApplicationCourse E.==. E.val cid + + return (courseApplication, user, hasFiles, allocation, studyFeatures, studyTerms, studyDegree) + + dbtProj :: DBRow _ -> MaybeT (YesodDB UniWorX) CourseApplicationsTableData + dbtProj = runReaderT $ do + appId <- view $ resultCourseApplication . _entityKey + cID <- encrypt appId + + guardM . hasReadAccessTo $ CApplicationR tid ssh csh cID CAFilesR -- TODO: replace with CAShowR + + view id + + dbtRowKey = view $ queryCourseApplication . to (E.^. CourseApplicationId) + + dbtColonnade :: Colonnade Sortable _ _ + dbtColonnade = mconcat + [ emptyOpticColonnade (resultAllocation . _entityVal) $ \l -> anchorColonnade (views l allocationLink) $ colAllocationShorthand (l . _allocationShorthand) + , colApplicationId (resultCourseApplication . _entityKey) + , anchorColonnadeM (views (resultUser . _entityKey) participantLink) $ colUserDisplayName (resultUser . _entityVal . $(multifocusL 2) _userDisplayName _userSurname) + , colUserMatriculation (resultUser . _entityVal . _userMatrikelnummer) + , emptyOpticColonnade (resultStudyTerms . _entityVal) colStudyTerms + , emptyOpticColonnade (resultStudyDegree . _entityVal) colStudyDegree + , emptyOpticColonnade (resultStudyFeatures . _entityVal . _studyFeaturesSemester) colStudyFeaturesSemester + , colApplicationText (resultCourseApplication . _entityVal . _courseApplicationText) + , lmap ((tid, ssh, csh), ) $ colApplicationFiles ($(multifocusL 5) (_1 . _1) (_1 . _2) (_1 . _3) (_2 . resultCourseApplication . _entityKey) (_2 . resultHasFiles)) + , colApplicationVeto (resultCourseApplication . _entityVal . _courseApplicationRatingVeto) + , colApplicationRatingPoints (resultCourseApplication . _entityVal . _courseApplicationRatingPoints) + , colApplicationRatingComment (resultCourseApplication . _entityVal . _courseApplicationRatingComment) + ] + + dbtSorting = mconcat + [ sortAllocationShorthand $ queryAllocation . to (E.?. AllocationShorthand) + , sortUserName' $ $(multifocusG 2) (queryUser . to (E.^. UserDisplayName)) (queryUser . to (E.^. UserSurname)) + , sortUserMatriculation $ queryUser . to (E.^. UserMatrikelnummer) + , sortStudyTerms queryStudyTerms + , sortStudyDegree queryStudyDegree + , sortStudyFeaturesSemester $ queryStudyFeatures . to (E.?. StudyFeaturesSemester) + , sortApplicationText $ queryCourseApplication . to (E.^. CourseApplicationText) + , sortApplicationFiles queryHasFiles + , sortApplicationVeto $ queryCourseApplication . to (E.^. CourseApplicationRatingVeto) + , sortApplicationRatingPoints $ queryCourseApplication . to (E.^. CourseApplicationRatingPoints) + , sortApplicationRatingComment $ queryCourseApplication . to (E.^. CourseApplicationRatingComment) + ] + + dbtFilter = mconcat + [ fltrAllocation queryAllocation + , fltrUserName' $ queryUser . to (E.^. UserDisplayName) + , fltrUserMatriculation $ queryUser . to (E.^. UserMatrikelnummer) + , fltrStudyTerms queryStudyTerms + , fltrStudyDegree queryStudyDegree + , fltrStudyFeaturesSemester $ queryStudyFeatures . to (E.?. StudyFeaturesSemester) + , fltrApplicationText $ queryCourseApplication . to (E.^. CourseApplicationText) + , fltrApplicationFiles queryHasFiles + , fltrApplicationVeto $ queryCourseApplication . to (E.^. CourseApplicationRatingVeto) + , fltrApplicationRatingPoints $ queryCourseApplication . to (E.^. CourseApplicationRatingPoints) + , fltrApplicationRatingComment $ queryCourseApplication . to (E.^. CourseApplicationRatingComment) + ] + dbtFilterUI = mconcat + [ fltrAllocationUI + , fltrUserNameUI' + , fltrUserMatriculationUI + , fltrStudyTermsUI + , fltrStudyDegreeUI + , fltrStudyFeaturesSemesterUI + , fltrApplicationTextUI + , fltrApplicationFilesUI + , fltrApplicationVetoUI + , fltrApplicationRatingPointsUI + , fltrApplicationRatingCommentUI + ] + + dbtStyle = def + { dbsFilterLayout = defaultDBSFilterLayout + } + dbtParams = def + + dbtCsvEncode = noCsvEncode + dbtCsvDecode = Nothing + + dbtIdent = courseApplicationsIdent + + psValidator :: PSValidator _ _ + psValidator = def + + dbTableWidget' psValidator DBTable{..} + + let title = prependCourseTitle tid ssh csh MsgCourseApplicationsListTitle + + siteLayoutMsg title $ do + setTitleI title + table diff --git a/src/Handler/Course/Edit.hs b/src/Handler/Course/Edit.hs index cdedd90bb..ce9d0e422 100644 --- a/src/Handler/Course/Edit.hs +++ b/src/Handler/Course/Edit.hs @@ -5,7 +5,6 @@ module Handler.Course.Edit import Import -import Utils.Lens import Utils.Form import Handler.Utils import Handler.Utils.Invitations diff --git a/src/Handler/Course/LecturerInvite.hs b/src/Handler/Course/LecturerInvite.hs index 25086ff1b..7bc870396 100644 --- a/src/Handler/Course/LecturerInvite.hs +++ b/src/Handler/Course/LecturerInvite.hs @@ -8,7 +8,6 @@ module Handler.Course.LecturerInvite import Import -import Utils.Lens import Utils.Form import Handler.Utils.Invitations diff --git a/src/Handler/Course/List.hs b/src/Handler/Course/List.hs index 00395a855..3aeaa7f46 100644 --- a/src/Handler/Course/List.hs +++ b/src/Handler/Course/List.hs @@ -10,7 +10,6 @@ import Import import Data.Maybe (fromJust) -import Utils.Lens import Utils.Form -- import Utils.DB import Handler.Utils diff --git a/src/Handler/Course/ParticipantInvite.hs b/src/Handler/Course/ParticipantInvite.hs index 292d0bf26..97b79e54c 100644 --- a/src/Handler/Course/ParticipantInvite.hs +++ b/src/Handler/Course/ParticipantInvite.hs @@ -8,7 +8,6 @@ module Handler.Course.ParticipantInvite import Import -import Utils.Lens import Utils.Form import Handler.Utils import Handler.Utils.Invitations diff --git a/src/Handler/Course/Register.hs b/src/Handler/Course/Register.hs index 7729d82f8..d134e31d1 100644 --- a/src/Handler/Course/Register.hs +++ b/src/Handler/Course/Register.hs @@ -7,7 +7,6 @@ module Handler.Course.Register import Import -import Utils.Lens import Handler.Utils import Data.Function ((&)) diff --git a/src/Handler/Course/Show.hs b/src/Handler/Course/Show.hs index 9bc1b8f53..17125062d 100644 --- a/src/Handler/Course/Show.hs +++ b/src/Handler/Course/Show.hs @@ -12,7 +12,6 @@ import qualified Database.Esqueleto.Utils as E import Database.Esqueleto.Utils.TH import qualified Data.CaseInsensitive as CI -import Utils.Lens import qualified Data.Map as Map diff --git a/src/Handler/Course/User.hs b/src/Handler/Course/User.hs index 798e23244..81ac54d5b 100644 --- a/src/Handler/Course/User.hs +++ b/src/Handler/Course/User.hs @@ -4,7 +4,6 @@ module Handler.Course.User import Import -import Utils.Lens import Utils.Form import Handler.Utils import Database.Esqueleto.Utils.TH diff --git a/src/Handler/Course/Users.hs b/src/Handler/Course/Users.hs index f0c0da708..0549a0745 100644 --- a/src/Handler/Course/Users.hs +++ b/src/Handler/Course/Users.hs @@ -9,7 +9,6 @@ module Handler.Course.Users import Import -import Utils.Lens import Utils.Form import Handler.Utils import Handler.Utils.Database diff --git a/src/Handler/CryptoIDDispatch.hs b/src/Handler/CryptoIDDispatch.hs index 54c2ec760..8a34cde8d 100644 --- a/src/Handler/CryptoIDDispatch.hs +++ b/src/Handler/CryptoIDDispatch.hs @@ -5,8 +5,6 @@ module Handler.CryptoIDDispatch import Import -import Data.Proxy - import qualified Data.Text as Text import Yesod.Core.Types (HandlerContents(..), ErrorResponse(..)) diff --git a/src/Handler/Exam/AddUser.hs b/src/Handler/Exam/AddUser.hs index f8e250831..7aafb58e2 100644 --- a/src/Handler/Exam/AddUser.hs +++ b/src/Handler/Exam/AddUser.hs @@ -8,8 +8,6 @@ import Handler.Exam.RegistrationInvite import Handler.Utils import Handler.Utils.Exam import Handler.Utils.Invitations - -import Utils.Lens import qualified Data.Set as Set diff --git a/src/Handler/Exam/CorrectorInvite.hs b/src/Handler/Exam/CorrectorInvite.hs index cc2882679..f8398487a 100644 --- a/src/Handler/Exam/CorrectorInvite.hs +++ b/src/Handler/Exam/CorrectorInvite.hs @@ -12,8 +12,6 @@ import Import import Handler.Utils.Invitations import Handler.Utils.Exam -import Utils.Lens - import Text.Hamlet (ihamlet) import Data.Aeson hiding (Result(..)) diff --git a/src/Handler/Exam/Edit.hs b/src/Handler/Exam/Edit.hs index 06abd7834..99bd12772 100644 --- a/src/Handler/Exam/Edit.hs +++ b/src/Handler/Exam/Edit.hs @@ -6,8 +6,6 @@ import Import import Handler.Exam.Form import Handler.Exam.CorrectorInvite -import Utils.Lens - import qualified Data.Set as Set import Handler.Utils diff --git a/src/Handler/Exam/Form.hs b/src/Handler/Exam/Form.hs index 1020c6f28..b2c51c946 100644 --- a/src/Handler/Exam/Form.hs +++ b/src/Handler/Exam/Form.hs @@ -8,8 +8,6 @@ module Handler.Exam.Form ) where import Import -import Utils.Lens hiding (parts) - import Handler.Exam.CorrectorInvite import Handler.Utils @@ -230,12 +228,12 @@ examPartsForm prev = wFormToAForm $ do examFormTemplate :: Entity Exam -> DB ExamForm examFormTemplate (Entity eId Exam{..}) = do - parts <- selectList [ ExamPartExam ==. eId ] [] + examParts <- selectList [ ExamPartExam ==. eId ] [] occurrences <- selectList [ ExamOccurrenceExam ==. eId ] [] correctors <- selectList [ ExamCorrectorExam ==. eId ] [] invitations <- map (\(email, InvDBDataExamCorrector) -> email) <$> sourceInvitationsList eId - parts' <- forM parts $ \(Entity pid part) -> (,) <$> encrypt pid <*> pure part + examParts' <- forM examParts $ \(Entity pid part) -> (,) <$> encrypt pid <*> pure part occurrences' <- forM occurrences $ \(Entity oid occ) -> (,) <$> encrypt oid <*> pure occ return ExamForm @@ -267,7 +265,7 @@ examFormTemplate (Entity eId Exam{..}) = do , eofDescription = examOccurrenceDescription } , efExamParts = Set.fromList $ do - (Just -> epfId, ExamPart{..}) <- parts' + (Just -> epfId, ExamPart{..}) <- examParts' return ExamPartForm { epfId , epfName = examPartName diff --git a/src/Handler/Exam/RegistrationInvite.hs b/src/Handler/Exam/RegistrationInvite.hs index 6ebcae157..2b41622b9 100644 --- a/src/Handler/Exam/RegistrationInvite.hs +++ b/src/Handler/Exam/RegistrationInvite.hs @@ -16,8 +16,6 @@ import Handler.Utils.Invitations import qualified Data.Set as Set import Text.Hamlet (ihamlet) - -import Utils.Lens import Data.Aeson hiding (Result(..)) diff --git a/src/Handler/Exam/Show.hs b/src/Handler/Exam/Show.hs index ad371d147..72c6058b4 100644 --- a/src/Handler/Exam/Show.hs +++ b/src/Handler/Exam/Show.hs @@ -5,8 +5,6 @@ module Handler.Exam.Show import Import import Handler.Exam.Register -import Utils.Lens hiding (parts) - import Data.Map ((!?)) import qualified Data.Map as Map @@ -24,7 +22,7 @@ getEShowR tid ssh csh examn = do cTime <- liftIO getCurrentTime mUid <- maybeAuthId - (Entity _ Exam{..}, parts, examVisible, (gradingVisible, gradingShown), (occurrenceAssignmentsVisible, occurrenceAssignmentsShown), results, result, occurrences, (registered, mayRegister), occurrenceNamesShown) <- runDB $ do + (Entity _ Exam{..}, examParts, examVisible, (gradingVisible, gradingShown), (occurrenceAssignmentsVisible, occurrenceAssignmentsShown), results, result, occurrences, (registered, mayRegister), occurrenceNamesShown) <- runDB $ do exam@(Entity eId Exam{..}) <- fetchExam tid ssh csh examn let examVisible = NTop (Just cTime) >= NTop examVisibleFrom @@ -35,12 +33,12 @@ getEShowR tid ssh csh examn = do let occurrenceAssignmentsVisible = NTop (Just cTime) >= NTop examPublishOccurrenceAssignments occurrenceAssignmentsShown <- or2M (return occurrenceAssignmentsVisible) . hasReadAccessTo $ CExamR tid ssh csh examn EEditR - parts <- selectList [ ExamPartExam ==. eId ] [ Asc ExamPartName ] + examParts <- selectList [ ExamPartExam ==. eId ] [ Asc ExamPartName ] resultsRaw <- for mUid $ \uid -> E.select . E.from $ \examPartResult -> do E.where_ $ examPartResult E.^. ExamPartResultUser E.==. E.val uid - E.&&. examPartResult E.^. ExamPartResultExamPart `E.in_` E.valList (map entityKey parts) + E.&&. examPartResult E.^. ExamPartResultExamPart `E.in_` E.valList (map entityKey examParts) return examPartResult let results = maybe Map.empty (\rs -> Map.fromList [ (examPartResultExamPart, res) | res@(Entity _ ExamPartResult{..}) <- rs ]) resultsRaw @@ -66,7 +64,7 @@ getEShowR tid ssh csh examn = do occurrenceNamesShown <- hasReadAccessTo $ CExamR tid ssh csh examn EEditR - return (exam, parts, examVisible, (gradingVisible, gradingShown), (occurrenceAssignmentsVisible, occurrenceAssignmentsShown), results, result, occurrences, (registered, mayRegister), occurrenceNamesShown) + return (exam, examParts, examVisible, (gradingVisible, gradingShown), (occurrenceAssignmentsVisible, occurrenceAssignmentsShown), results, result, occurrences, (registered, mayRegister), occurrenceNamesShown) let examTimes = all (\(Entity _ ExamOccurrence{..}, _) -> Just examOccurrenceStart == examStart && examOccurrenceEnd == examEnd) occurrences registerWidget diff --git a/src/Handler/Exam/Users.hs b/src/Handler/Exam/Users.hs index 2a5f9fbe9..6bd06b1b5 100644 --- a/src/Handler/Exam/Users.hs +++ b/src/Handler/Exam/Users.hs @@ -6,7 +6,6 @@ module Handler.Exam.Users import Import -import Utils.Lens import Handler.Utils import Handler.Utils.Exam import Handler.Utils.Table.Columns diff --git a/src/Handler/Health.hs b/src/Handler/Health.hs index 36649a436..dad7ef747 100644 --- a/src/Handler/Health.hs +++ b/src/Handler/Health.hs @@ -5,8 +5,6 @@ import Import import qualified Data.Aeson.Encode.Pretty as Aeson import qualified Data.Text.Lazy.Builder as Builder -import Utils.Lens - import qualified Data.UUID as UUID import Data.Semigroup (Min(..), Max(..)) diff --git a/src/Handler/Home.hs b/src/Handler/Home.hs index 51e9975a5..c3ebe55dd 100644 --- a/src/Handler/Home.hs +++ b/src/Handler/Home.hs @@ -2,7 +2,6 @@ module Handler.Home where import Import -import Utils.Lens import Handler.Utils import Handler.Utils.Table.Cells diff --git a/src/Handler/Material.hs b/src/Handler/Material.hs index d0abf6824..025b0c9bc 100644 --- a/src/Handler/Material.hs +++ b/src/Handler/Material.hs @@ -14,7 +14,6 @@ import qualified Data.Conduit.List as C import qualified Database.Esqueleto as E import Database.Esqueleto.Utils.TH -import Utils.Lens import Utils.Form import Handler.Utils import Handler.Utils.Delete diff --git a/src/Handler/Profile.hs b/src/Handler/Profile.hs index e871575dc..f5f897135 100644 --- a/src/Handler/Profile.hs +++ b/src/Handler/Profile.hs @@ -5,7 +5,6 @@ import Import import Handler.Utils import Handler.Utils.Table.Cells -import Utils.Lens -- import Colonnade hiding (fromMaybe, singleton) -- import Yesod.Colonnade import Data.Monoid (Any(..)) diff --git a/src/Handler/Sheet.hs b/src/Handler/Sheet.hs index cecc6a3db..5ee6ba68f 100644 --- a/src/Handler/Sheet.hs +++ b/src/Handler/Sheet.hs @@ -49,11 +49,6 @@ import Data.Map (Map, (!)) import Data.Monoid (Any(..)) --- import Control.Lens -import Utils.Lens - ---import qualified Data.Aeson as Aeson - import Control.Monad.Random.Class (MonadRandom(..)) import Utils.Sql diff --git a/src/Handler/Submission.hs b/src/Handler/Submission.hs index 0d2268d24..1d14a8d9f 100644 --- a/src/Handler/Submission.hs +++ b/src/Handler/Submission.hs @@ -6,8 +6,6 @@ import Import import Jobs -import Utils.Lens - -- import Yesod.Form.Bootstrap3 import Handler.Utils diff --git a/src/Handler/SystemMessage.hs b/src/Handler/SystemMessage.hs index ae1c7f757..b2c7ef90f 100644 --- a/src/Handler/SystemMessage.hs +++ b/src/Handler/SystemMessage.hs @@ -11,8 +11,6 @@ import qualified Data.List.NonEmpty as NonEmpty import Handler.Utils import Handler.Utils.Table.Cells -import Utils.Lens - import qualified Database.Esqueleto as E -- htmlField' moved to Handler.Utils.Form/Fields diff --git a/src/Handler/Term.hs b/src/Handler/Term.hs index 8d67d8e5c..26cba329a 100644 --- a/src/Handler/Term.hs +++ b/src/Handler/Term.hs @@ -5,8 +5,6 @@ import Handler.Utils import Handler.Utils.Table.Cells import qualified Data.Map as Map -import Utils.Lens - import qualified Database.Esqueleto as E import qualified Data.Set as Set diff --git a/src/Handler/Tutorial.hs b/src/Handler/Tutorial.hs index 5232dad17..ae2c26ea0 100644 --- a/src/Handler/Tutorial.hs +++ b/src/Handler/Tutorial.hs @@ -25,8 +25,6 @@ import qualified Data.CaseInsensitive as CI import qualified Data.Text as Text -import Utils.Lens - import Data.Aeson hiding (Result(..)) import Text.Hamlet (ihamlet) diff --git a/src/Handler/Tutorial/Users.hs b/src/Handler/Tutorial/Users.hs index 3650755d5..34046f452 100644 --- a/src/Handler/Tutorial/Users.hs +++ b/src/Handler/Tutorial/Users.hs @@ -4,7 +4,6 @@ module Handler.Tutorial.Users import Import -import Utils.Lens import Utils.Form -- import Utils.DB import Handler.Utils diff --git a/src/Handler/Users.hs b/src/Handler/Users.hs index 59f5837c9..a8df63296 100644 --- a/src/Handler/Users.hs +++ b/src/Handler/Users.hs @@ -13,8 +13,6 @@ import Handler.Utils.Invitations import qualified Auth.LDAP as Auth -import Utils.Lens - import qualified Data.CaseInsensitive as CI import qualified Data.Set as Set diff --git a/src/Handler/Utils.hs b/src/Handler/Utils.hs index c0d067554..21f140921 100644 --- a/src/Handler/Utils.hs +++ b/src/Handler/Utils.hs @@ -4,8 +4,6 @@ module Handler.Utils import Import -import Utils.Lens - import qualified Data.Text as T import qualified Data.Text.Encoding as T import Data.Map ((!)) diff --git a/src/Handler/Utils/Communication.hs b/src/Handler/Utils/Communication.hs index 7ee1f815a..2e2ef88c8 100644 --- a/src/Handler/Utils/Communication.hs +++ b/src/Handler/Utils/Communication.hs @@ -9,7 +9,6 @@ module Handler.Utils.Communication import Import import Handler.Utils -import Utils.Lens import Jobs.Queue import Control.Monad.Trans.Reader (mapReaderT) diff --git a/src/Handler/Utils/ContentDisposition.hs b/src/Handler/Utils/ContentDisposition.hs index 7be2bd81b..b353d1bb3 100644 --- a/src/Handler/Utils/ContentDisposition.hs +++ b/src/Handler/Utils/ContentDisposition.hs @@ -5,8 +5,6 @@ module Handler.Utils.ContentDisposition import Import -import Utils.Lens - -- | Check whether the user's preference for files is inline-viewing or downloading downloadFiles :: (MonadHandler m, HandlerSite m ~ UniWorX) => m Bool downloadFiles = do diff --git a/src/Handler/Utils/DateTime.hs b/src/Handler/Utils/DateTime.hs index 8bb33a222..56553ce38 100644 --- a/src/Handler/Utils/DateTime.hs +++ b/src/Handler/Utils/DateTime.hs @@ -16,8 +16,6 @@ module Handler.Utils.DateTime import Import -import Utils.Lens - import Data.Time.Zones import qualified Data.Time.Zones as TZ diff --git a/src/Handler/Utils/Delete.hs b/src/Handler/Utils/Delete.hs index 149ab8285..8a268ac2c 100644 --- a/src/Handler/Utils/Delete.hs +++ b/src/Handler/Utils/Delete.hs @@ -17,8 +17,6 @@ module Handler.Utils.Delete import Import import Handler.Utils.Form -import Utils.Lens - import qualified Data.Text as Text import qualified Data.Set as Set diff --git a/src/Handler/Utils/Exam.hs b/src/Handler/Utils/Exam.hs index 3f53325a8..5cdd6fd29 100644 --- a/src/Handler/Utils/Exam.hs +++ b/src/Handler/Utils/Exam.hs @@ -12,8 +12,6 @@ import qualified Database.Esqueleto.Utils as E import qualified Database.Esqueleto.Internal.Sql as E import Database.Esqueleto.Utils.TH -import Utils.Lens - import qualified Data.Conduit.List as C import qualified Data.Map as Map diff --git a/src/Handler/Utils/Form.hs b/src/Handler/Utils/Form.hs index 4db9808a8..b040cf31e 100644 --- a/src/Handler/Utils/Form.hs +++ b/src/Handler/Utils/Form.hs @@ -40,13 +40,9 @@ import Control.Monad.Error.Class (MonadError(..)) import Data.Either (partitionEithers) -import Utils.Lens - import Data.Aeson (eitherDecodeStrict') import Data.Aeson.Text (encodeToLazyText) -import Data.Proxy - import qualified Text.Email.Validate as Email import Yesod.Core.Types (FileInfo(..)) diff --git a/src/Handler/Utils/Form/MassInput.hs b/src/Handler/Utils/Form/MassInput.hs index c8a869514..7e2131ae3 100644 --- a/src/Handler/Utils/Form/MassInput.hs +++ b/src/Handler/Utils/Form/MassInput.hs @@ -17,7 +17,6 @@ module Handler.Utils.Form.MassInput import Import import Utils.Form -import Utils.Lens import Handler.Utils.Form.MassInput.Liveliness import Handler.Utils.Form.MassInput.TH diff --git a/src/Handler/Utils/Form/Occurrences.hs b/src/Handler/Utils/Form/Occurrences.hs index 753868a9e..ced9c3c0b 100644 --- a/src/Handler/Utils/Form/Occurrences.hs +++ b/src/Handler/Utils/Form/Occurrences.hs @@ -10,8 +10,6 @@ import qualified Data.Set as Set import Data.Map ((!)) import qualified Data.Map as Map -import Utils.Lens - data OccurrenceScheduleKind = ScheduleKindWeekly deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic, Typeable) diff --git a/src/Handler/Utils/Invitations.hs b/src/Handler/Utils/Invitations.hs index a4ab660d2..94740d96c 100644 --- a/src/Handler/Utils/Invitations.hs +++ b/src/Handler/Utils/Invitations.hs @@ -16,7 +16,6 @@ module Handler.Utils.Invitations ) where import Import -import Utils.Lens import Utils.Form import Jobs.Queue diff --git a/src/Handler/Utils/Mail.hs b/src/Handler/Utils/Mail.hs index 0548d341c..e370676d5 100644 --- a/src/Handler/Utils/Mail.hs +++ b/src/Handler/Utils/Mail.hs @@ -7,8 +7,6 @@ module Handler.Utils.Mail import Import -import Utils.Lens - import qualified Data.CaseInsensitive as CI import qualified Data.ByteString.Lazy as LBS diff --git a/src/Handler/Utils/Rating.hs b/src/Handler/Utils/Rating.hs index 472e49950..5549766dc 100644 --- a/src/Handler/Utils/Rating.hs +++ b/src/Handler/Utils/Rating.hs @@ -39,8 +39,6 @@ import qualified Database.Esqueleto as E import qualified Data.Conduit.List as Conduit -import Utils.Lens - instance HasResolution prec => Pretty (Fixed prec) where pretty = pretty . show diff --git a/src/Handler/Utils/SheetType.hs b/src/Handler/Utils/SheetType.hs index a4cd057b3..494729793 100644 --- a/src/Handler/Utils/SheetType.hs +++ b/src/Handler/Utils/SheetType.hs @@ -5,7 +5,6 @@ module Handler.Utils.SheetType import Import import Data.Monoid (Sum(..)) -import Utils.Lens addBonusToPoints :: SheetTypeSummary -> SheetTypeSummary addBonusToPoints sts = diff --git a/src/Handler/Utils/Submission.hs b/src/Handler/Utils/Submission.hs index bcda2d83c..b048177d3 100644 --- a/src/Handler/Utils/Submission.hs +++ b/src/Handler/Utils/Submission.hs @@ -15,8 +15,6 @@ import Import hiding (joinPath) import Jobs.Queue import Yesod.Core.Types (HandlerContents(..), ErrorResponse(..)) -import Utils.Lens - import Control.Monad.State as State (StateT) import Control.Monad.State.Class as State import Control.Monad.Writer (MonadWriter(..), execWriterT, execWriter) diff --git a/src/Handler/Utils/Table.hs b/src/Handler/Utils/Table.hs index 2acaf2a6a..626fa7e11 100644 --- a/src/Handler/Utils/Table.hs +++ b/src/Handler/Utils/Table.hs @@ -2,7 +2,6 @@ module Handler.Utils.Table where -- General Utilities for Tables import Import -import Data.Profunctor import Control.Monad.Except @@ -51,10 +50,12 @@ headedRowSelector toExternal fromExternal attrs colonnade tdata = do externalIds <- mapM (lift . toExternal) tdata let - checkbox extId = Field parse view UrlEncoded + checkbox extId = Field{..} where - parse [] _ = return $ Right Nothing - parse optlist _ = runExceptT $ do + fieldEnctype = UrlEncoded + + fieldParse [] _ = return $ Right Nothing + fieldParse optlist _ = runExceptT $ do extIds <- maybe (throwError "Error parsing values") return $ mapM fromPathPiece optlist case () of _ | extId `elem` extIds @@ -62,11 +63,11 @@ headedRowSelector toExternal fromExternal attrs colonnade tdata = do | otherwise -> return Nothing - view _ name attributes val _ = + fieldView theId name attributes val _ = -- TODO: move this to a *.hamlet file [whamlet|