From d621e61b11b1ddb85ba3c2611a24b0c28fe841c2 Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Tue, 20 Aug 2019 13:55:01 +0200 Subject: [PATCH 01/37] feat(allocations): show table of all allocations Cleanup imports & pageactions --- messages/uniworx/de.msg | 8 +- routes | 1 + src/Application.hs | 2 - src/Auth/LDAP.hs | 1 - src/Colonnade/Instances.hs | 19 +++ src/Foundation.hs | 50 ++----- src/Handler/Admin.hs | 2 - src/Handler/Allocation.hs | 1 + src/Handler/Allocation/Application.hs | 2 - src/Handler/Allocation/List.hs | 85 ++++++++++++ src/Handler/Allocation/Register.hs | 2 - src/Handler/Allocation/Show.hs | 3 +- src/Handler/Corrections.hs | 2 - src/Handler/Course/Edit.hs | 1 - src/Handler/Course/LecturerInvite.hs | 1 - src/Handler/Course/List.hs | 1 - src/Handler/Course/ParticipantInvite.hs | 1 - src/Handler/Course/Register.hs | 1 - src/Handler/Course/Show.hs | 1 - src/Handler/Course/User.hs | 1 - src/Handler/Course/Users.hs | 1 - src/Handler/Exam/AddUser.hs | 2 - src/Handler/Exam/CorrectorInvite.hs | 2 - src/Handler/Exam/Edit.hs | 2 - src/Handler/Exam/Form.hs | 8 +- src/Handler/Exam/RegistrationInvite.hs | 2 - src/Handler/Exam/Show.hs | 10 +- src/Handler/Exam/Users.hs | 1 - src/Handler/Health.hs | 2 - src/Handler/Home.hs | 1 - src/Handler/Material.hs | 1 - src/Handler/Profile.hs | 1 - src/Handler/Sheet.hs | 5 - src/Handler/Submission.hs | 2 - src/Handler/SystemMessage.hs | 2 - src/Handler/Term.hs | 2 - src/Handler/Tutorial.hs | 2 - src/Handler/Tutorial/Users.hs | 1 - src/Handler/Users.hs | 2 - src/Handler/Utils.hs | 2 - src/Handler/Utils/Communication.hs | 1 - src/Handler/Utils/ContentDisposition.hs | 2 - src/Handler/Utils/DateTime.hs | 2 - src/Handler/Utils/Delete.hs | 2 - src/Handler/Utils/Exam.hs | 2 - src/Handler/Utils/Form.hs | 2 - src/Handler/Utils/Form/MassInput.hs | 1 - src/Handler/Utils/Form/Occurrences.hs | 2 - src/Handler/Utils/Invitations.hs | 1 - src/Handler/Utils/Mail.hs | 2 - src/Handler/Utils/Rating.hs | 2 - src/Handler/Utils/SheetType.hs | 1 - src/Handler/Utils/Submission.hs | 2 - src/Handler/Utils/Table.hs | 13 +- src/Handler/Utils/Table/Cells.hs | 1 - src/Handler/Utils/Table/Columns.hs | 128 +++++++++++++++++- src/Handler/Utils/Table/Pagination.hs | 40 +++--- src/Handler/Utils/Table/Pagination/Types.hs | 15 +- src/Handler/Utils/Tokens.hs | 2 - src/Handler/Utils/Tutorial.hs | 2 - src/Import/NoFoundation.hs | 1 + src/Import/NoModel.hs | 23 +++- src/Jobs.hs | 2 - src/Jobs/Crontab.hs | 2 - src/Jobs/Handler/HelpRequest.hs | 2 - src/Jobs/Handler/Invitation.hs | 1 - src/Jobs/Handler/SendCourseCommunication.hs | 1 - .../SendNotification/SubmissionRated.hs | 1 - .../SendNotification/UserAuthModeUpdate.hs | 1 - src/Jobs/Handler/SendPasswordReset.hs | 1 - src/Jobs/Handler/SendTestEmail.hs | 2 - src/Jobs/Handler/TransactionLog.hs | 1 - src/Jobs/HealthReport.hs | 2 - src/Jobs/Queue.hs | 1 - src/Model/Types/DateTime.hs | 1 - src/Model/Types/Exam.hs | 1 - src/Model/Types/Misc.hs | 1 - src/Model/Types/Sheet.hs | 2 - src/Model/Types/Submission.hs | 2 - src/Settings.hs | 2 - src/Utils/Lens.hs | 13 +- templates/exam-show.hamlet | 4 +- templates/table/layout.hamlet | 10 +- 83 files changed, 346 insertions(+), 190 deletions(-) create mode 100644 src/Colonnade/Instances.hs create mode 100644 src/Handler/Allocation/List.hs diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg index c4862d134..1dd86e0ac 100644 --- a/messages/uniworx/de.msg +++ b/messages/uniworx/de.msg @@ -226,6 +226,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. @@ -962,6 +964,7 @@ MenuHelp: Hilfe MenuProfile: Anpassen MenuLogin: Login MenuLogout: Logout +MenuAllocationList: Zentralanmeldungen MenuCourseList: Kurse MenuCourseMembers: Kursteilnehmer MenuCourseAddMembers: Kursteilnehmer hinzufügen @@ -1466,6 +1469,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 @@ -1507,4 +1511,6 @@ 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 \ No newline at end of file diff --git a/routes b/routes index cec9b58f7..670718f01 100644 --- a/routes +++ b/routes @@ -80,6 +80,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..fc6d0fc8f 100644 --- a/src/Application.hs +++ b/src/Application.hs @@ -64,8 +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 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/Foundation.hs b/src/Foundation.hs index a80f277d6..c4c722ff2 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 @@ -1742,10 +1741,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) @@ -1964,35 +1964,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 } @@ -2016,20 +1992,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 @@ -2185,6 +2153,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 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 286a87aa1..991ef61bb 100644 --- a/src/Handler/Allocation.hs +++ b/src/Handler/Allocation.hs @@ -5,3 +5,4 @@ module 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..372625b7e --- /dev/null +++ b/src/Handler/Allocation/List.hs @@ -0,0 +1,85 @@ +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 :: Getter 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) + , fltrAllocationName $ queryAllocation . to (E.^. AllocationName) + ] + dbtFilterUI = mconcat + [ fltrTermUI + , fltrSchoolUI + , fltrAllocationNameUI + ] + + dbtStyle = def + { dbsFilterLayout = defaultDBSFilterLayout + } + dbtParams = def + + dbtCsvEncode = noCsvEncode + dbtCsvDecode = Nothing + + dbtIdent = allocationListIdent + + psValidator :: PSValidator _ _ + psValidator = def + + 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 53149712a..57264cf1c 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/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 4a29f3851..57ab63b48 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/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 35a8842a4..7f90ea2a5 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 f1bf685b8..e4d03153e 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 65e701eed..fa230101e 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..540b05040 100644 --- a/src/Handler/Utils/Form.hs +++ b/src/Handler/Utils/Form.hs @@ -40,8 +40,6 @@ import Control.Monad.Error.Class (MonadError(..)) import Data.Either (partitionEithers) -import Utils.Lens - import Data.Aeson (eitherDecodeStrict') import Data.Aeson.Text (encodeToLazyText) 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|