feat(allocations): show table of all allocations

Cleanup imports & pageactions

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
+AllocationRegisterTo: Anmeldungen bis
+
+AllocationListTitle: Zentralanmeldungen

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

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

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)

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
+       }

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

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

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

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
 

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

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) #-}

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
 

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

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

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
 

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

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

src/Handler/Course/Register.hs

@@ -7,7 +7,6 @@ module Handler.Course.Register
 
 import Import
 
-import Utils.Lens
 import Handler.Utils
 
 import Data.Function ((&))

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
 

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

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

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
 

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(..))

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

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

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(..))
   

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

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

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(..))

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
 

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

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(..))

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
 

src/Handler/Submission.hs

@@ -6,8 +6,6 @@ import Import
 
 import Jobs
 
-import Utils.Lens
-
 -- import Yesod.Form.Bootstrap3
 
 import Handler.Utils

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

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

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)
 

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

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

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 ((!))

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)

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

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
 

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
 

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

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)
 

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
 

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)

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
 

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

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

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 =

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)

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|
             <label style="display: block">
-              <input type=checkbox name=#{name} value=#{toPathPiece extId} *{attributes} :isRight val:checked>
+              <input ##{theId} type=checkbox name=#{name} value=#{toPathPiece extId} *{attributes} :isRight val:checked>
           |]
 
   selectionIdent <- newFormIdent

src/Handler/Utils/Table/Cells.hs

@@ -13,7 +13,6 @@ import Control.Monad.Trans.Writer (WriterT)
 
 import Text.Blaze (ToMarkup(..))
 
-import Utils.Lens
 import Handler.Utils
 
 import Utils.Occurrences

src/Handler/Utils/Table/Columns.hs

@@ -14,12 +14,14 @@ import Import
 import qualified Database.Esqueleto as E
 import Database.Esqueleto.Utils (mkExactFilter, mkExactFilterWith, mkContainsFilter, mkContainsFilterWith, anyFilter)
 
-import Utils.Lens
 import Handler.Utils
 import Handler.Utils.Table.Cells
 
 import qualified Data.CaseInsensitive as CI
 
+import qualified Colonnade
+import Colonnade.Encode (Colonnade(..), OneColonnade(..))
+
 
 --------------------------------
 -- Generic Columns
@@ -35,6 +37,31 @@ import qualified Data.CaseInsensitive as CI
 --  * fltrXYZ  : filter  definitions for these columns
 --  * additional helper, such as default sorting
 
+type OpticColonnade focus
+  = forall m x r' h.
+       ( IsDBTable m x
+       , FromSortable h
+       )
+    => Getting focus r' focus
+    -> Colonnade h r' (DBCell m x)
+
+type OpticSortColumn focus
+  = forall t sortingMap.
+       ( IsMap sortingMap
+       , ContainerKey sortingMap ~ SortingKey
+       , MapValue sortingMap ~ SortColumn t
+       )
+    => Getting (E.SqlExpr focus) t (E.SqlExpr focus)
+    -> sortingMap
+
+type OpticFilterColumn t focus
+  = forall filterMap.
+       ( IsMap filterMap
+       , ContainerKey filterMap ~ FilterKey
+       , MapValue filterMap ~ FilterColumn t
+       )
+    => Getting (E.SqlExpr focus) t (E.SqlExpr focus)
+    -> filterMap
 
 -----------------------
 -- Numbers and Indices
@@ -44,6 +71,65 @@ import qualified Data.CaseInsensitive as CI
 dbRowIndicator :: IsDBTable m Any => Colonnade Sortable (DBRow r) (DBCell m Any)
 dbRowIndicator = sortable Nothing (i18nCell MsgNrColumn) $ \DBRow{ dbrIndex } ->  tellCell (Any True) $ textCell $ tshow dbrIndex
 
+-----------
+-- Terms --
+-----------
+
+colTermShort :: OpticColonnade TermId
+colTermShort resultTid = Colonnade.singleton (fromSortable header) body
+  where
+    header = Sortable (Just "term") (i18nCell MsgTerm)
+    body = i18nCell . ShortTermIdentifier . unTermKey . view resultTid
+
+sortTerm :: OpticSortColumn (E.Value TermId)
+sortTerm queryTid = singletonMap "term" . SortColumn $ view queryTid
+
+fltrTerm :: IsFilterColumn t (t -> Set TermId -> E.SqlExpr (E.Value Bool))
+         => OpticFilterColumn t (E.Value TermId)
+fltrTerm queryTid = singletonMap "term" . FilterColumn $ mkExactFilter (view queryTid)
+
+fltrTermUI :: DBFilterUI
+fltrTermUI mPrev = prismAForm (singletonFilter "term" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift termField) (fslI MsgTerm)
+
+-------------
+-- Schools --
+-------------
+
+colSchoolShort :: OpticColonnade SchoolId
+colSchoolShort resultSsh = Colonnade.singleton (fromSortable header) body
+  where
+    header = Sortable (Just "school") (i18nCell MsgSchool)
+    body = i18nCell . unSchoolKey . view resultSsh
+
+sortSchool :: OpticSortColumn (E.Value SchoolId)
+sortSchool querySsh = singletonMap "school" . SortColumn $ view querySsh
+
+fltrSchool :: IsFilterColumn t (t -> Set SchoolId -> E.SqlExpr (E.Value Bool))
+           => OpticFilterColumn t (E.Value SchoolId)
+fltrSchool querySsh = singletonMap "school" . FilterColumn $ mkExactFilter (view querySsh)
+
+fltrSchoolUI :: DBFilterUI
+fltrSchoolUI mPrev = prismAForm (singletonFilter "school" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift schoolField) (fslI MsgSchool)
+
+-----------------
+-- Allocations --
+-----------------
+
+colAllocationName :: OpticColonnade AllocationName
+colAllocationName resultName = Colonnade.singleton (fromSortable header) body
+  where
+    header = Sortable (Just "allocation") (i18nCell MsgAllocationName)
+    body = i18nCell . view resultName
+
+sortAllocationName :: OpticSortColumn (E.Value AllocationName)
+sortAllocationName queryName = singletonMap "allocation" . SortColumn $ view queryName
+
+fltrAllocationName :: IsFilterColumn t (t -> Set AllocationName -> E.SqlExpr (E.Value Bool))
+                   => OpticFilterColumn t (E.Value AllocationName)
+fltrAllocationName queryName = singletonMap "allocation" . FilterColumn $ mkContainsFilter (view queryName)
+
+fltrAllocationNameUI :: DBFilterUI
+fltrAllocationNameUI mPrev = prismAForm (singletonFilter "allocation" . maybePrism _PathPiece) mPrev $ aopt (ciField :: Field _ AllocationName) (fslI MsgAllocation)
 
 ---------------
 -- Files
@@ -282,3 +368,43 @@ fltrDegree queryFeatures = ( "degree"
 fltrDegreeUI :: Maybe (Map FilterKey [Text]) -> AForm (YesodDB UniWorX) (Map FilterKey [Text])
 fltrDegreeUI mPrev =
   prismAForm (singletonFilter "degree") mPrev $ aopt textField (fslI MsgDegreeName)
+
+----------------------------
+-- Colonnade manipulation --
+----------------------------
+
+imapColonnade :: (a -> c -> c)
+              -> Colonnade h a c
+              -> Colonnade h a c
+-- ^ Not quite `imap`
+imapColonnade f (Colonnade ones) = Colonnade $ dimapColonnade' <$> ones
+   where
+     dimapColonnade' OneColonnade{..} = OneColonnade
+       { oneColonnadeEncode = \x -> f x $ oneColonnadeEncode x
+       , oneColonnadeHead
+       }
+
+anchorColonnade :: forall h r' m a url.
+                   ( HasRoute UniWorX url
+                   , IsDBTable m a
+                   , HandlerSite m ~ UniWorX
+                   )
+                => (r' -> url)
+                -> Colonnade h r' (DBCell m a)
+                -> Colonnade h r' (DBCell m a)
+anchorColonnade = anchorColonnadeM . (return .)
+
+  
+anchorColonnadeM :: forall h r' m a url.
+                    ( HasRoute UniWorX url
+                    , IsDBTable m a
+                    , HandlerSite m ~ UniWorX
+                    )
+                 => (r' -> WidgetT UniWorX IO url)
+                 -> Colonnade h r' (DBCell m a)
+                 -> Colonnade h r' (DBCell m a)
+anchorColonnadeM mkUrl = imapColonnade anchorColonnade'
+  where
+    anchorColonnade' :: r' -> DBCell m a -> DBCell m a
+    anchorColonnade' inp (view dbCell -> (attrs, act)) = review dbCell . (attrs,) $
+      view (dbCell . _2) . anchorCellM (mkUrl inp) =<< act

src/Handler/Utils/Table/Pagination.hs

@@ -1,5 +1,6 @@
 module Handler.Utils.Table.Pagination
   ( module Handler.Utils.Table.Pagination.Types
+  , dbFilterKey
   , SortColumn(..), SortDirection(..)
   , SortingSetting(..)
   , pattern SortAscBy, pattern SortDescBy
@@ -10,7 +11,7 @@ module Handler.Utils.Table.Pagination
   , DBCsvActionMode(..)
   , DBCsvDiff(..), _DBCsvDiffNew, _DBCsvDiffExisting, _DBCsvDiffMissing, _dbCsvOldKey, _dbCsvOld, _dbCsvNewKey, _dbCsvNew
   , DBTCsvEncode, DBTCsvDecode(..)
-  , DBTable(..), noCsvEncode, IsDBTable(..), DBCell(..)
+  , DBTable(..), DBFilterUI, noCsvEncode, IsDBTable(..), DBCell(..)
   , singletonFilter
   , DBParams(..)
   , cellAttrs, cellContents
@@ -80,8 +81,6 @@ import Text.Hamlet (hamletFile)
 
 import Data.Ratio ((%))
 
-import Control.Lens.Extras (is)
-
 import Data.List (elemIndex)
 
 import Data.Aeson (Options(..), SumEncoding(..), defaultOptions)
@@ -115,6 +114,22 @@ type Monoid' x = (Sem.Semigroup x, Monoid x)
 #endif
 
 
+data WithIdent x = forall ident. PathPiece ident => WithIdent { _ident :: ident, _withoutIdent :: x }
+
+instance PathPiece x => PathPiece (WithIdent x) where
+  toPathPiece (WithIdent ident x)
+    | not . null $ toPathPiece ident = toPathPiece ident <> "-" <> toPathPiece x
+    | otherwise = toPathPiece x
+  fromPathPiece txt = do
+    let sep = "-"
+    (ident, (Text.stripSuffix sep -> Just rest)) <- return $ Text.breakOn sep txt
+    WithIdent <$> pure ident <*> fromPathPiece rest
+
+
+dbFilterKey :: PathPiece dbtIdent => dbtIdent -> FilterKey -> Text
+dbFilterKey ident = toPathPiece . WithIdent ident
+
+
 data SortColumn t = forall a. PersistField a => SortColumn { getSortColumn :: t -> E.SqlExpr (E.Value a) }
 
 data SortDirection = SortAsc | SortDesc
@@ -485,17 +500,6 @@ singletonFilter key = prism' fromInner (fmap Just . fromOuter)
       fromOuter = Map.lookup key >=> listToMaybe
 
 
-data WithIdent x = forall ident. PathPiece ident => WithIdent { _ident :: ident, _withoutIdent :: x }
-
-instance PathPiece x => PathPiece (WithIdent x) where
-  toPathPiece (WithIdent ident x)
-    | not . null $ toPathPiece ident = toPathPiece ident <> "-" <> toPathPiece x
-    | otherwise = toPathPiece x
-  fromPathPiece txt = do
-    let sep = "-"
-    (ident, (Text.stripSuffix sep -> Just rest)) <- return $ Text.breakOn sep txt
-    WithIdent <$> pure ident <*> fromPathPiece rest
-
 type DBTCsvEncode r' csv = DictMaybe (ToNamedRecord csv, DefaultOrdered csv, CsvColumnsExplained csv) (Conduit r' (YesodDB UniWorX) csv)
 data DBTCsvDecode r' k' csv = forall route csvAction csvActionClass csvException.
   ( FromNamedRecord csv, ToNamedRecord csv, DefaultOrdered csv
@@ -528,7 +532,7 @@ data DBTable m x = forall a r r' h i t k k' csv.
   , dbtColonnade :: Colonnade h r' (DBCell m x)
   , dbtSorting :: Map SortingKey (SortColumn t)
   , dbtFilter :: Map FilterKey (FilterColumn t)
-  , dbtFilterUI :: Maybe (Map FilterKey [Text]) -> AForm (YesodDB UniWorX) (Map FilterKey [Text])
+  , dbtFilterUI :: DBFilterUI
   , dbtStyle :: DBStyle r'
   , dbtParams :: DBParams m x
   , dbtCsvEncode :: DBTCsvEncode r' csv
@@ -536,6 +540,8 @@ data DBTable m x = forall a r r' h i t k k' csv.
   , dbtIdent :: i
   }
 
+type DBFilterUI = Maybe (Map FilterKey [Text]) -> AForm (YesodDB UniWorX) (Map FilterKey [Text])
+
 noCsvEncode :: DictMaybe (ToNamedRecord Void, DefaultOrdered Void, CsvColumnsExplained Void) (Conduit r' (YesodDB UniWorX) Void)
 noCsvEncode = Nothing
 
@@ -770,7 +776,7 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db
 
   piInput <- lift . runInputGetResult $ PaginationInput
     <$> iopt (multiSelectField $ return sortingOptions) (wIdent "sorting")
-    <*> (assertM' (not . Map.null) . Map.mapMaybe (assertM $ not . null) <$> Map.traverseWithKey (\k _ -> iopt multiTextField . wIdent $ toPathPiece k) dbtFilter)
+    <*> (assertM' (not . Map.null) . Map.mapMaybe (assertM $ not . null) <$> Map.traverseWithKey (\k _ -> iopt multiTextField $ dbFilterKey dbtIdent' k) dbtFilter)
     <*> iopt pathPieceField (wIdent "pagesize")
     <*> iopt intField (wIdent "page")
 
@@ -817,7 +823,7 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db
     tblLink f = SomeRoute . (currentRoute, ) . over (mapped . _2) (fromMaybe Text.empty) $ (f . substPi . setParam "_hasdata" Nothing) getParams
     substPi = foldr (.) id
       [ setParams (wIdent "sorting") . map toPathPiece $ fromMaybe [] piSorting
-      , foldr (.) id . map (\k -> setParams (wIdent $ toPathPiece k) . fromMaybe [] . join $ traverse (Map.lookup k) piFilter) $ Map.keys dbtFilter
+      , foldr (.) id . map (\k -> setParams (dbFilterKey dbtIdent' k) . fromMaybe [] . join $ traverse (Map.lookup k) piFilter) $ Map.keys dbtFilter
       , setParam (wIdent "pagesize") $ fmap toPathPiece piLimit
       , setParam (wIdent "page") $ fmap toPathPiece piPage
       , setParam (wIdent "pagination") Nothing

src/Handler/Utils/Table/Pagination/Types.hs

@@ -4,7 +4,7 @@ module Handler.Utils.Table.Pagination.Types
   ( FilterKey, SortingKey
   , Sortable(..)
   , sortable
-  , ToSortable(..)
+  , ToSortable(..), FromSortable(..)
   , SortableP(..)
   , DBTableInvalid(..)
   ) where
@@ -58,6 +58,19 @@ instance ToSortable Headless where
   pSortable = Nothing
 
 
+class FromSortable s where
+  fromSortable :: forall a. Sortable a -> s a
+
+instance FromSortable Sortable where
+  fromSortable = id
+
+instance FromSortable Headed where
+  fromSortable Sortable{..} = Headed sortableContent
+
+instance FromSortable Headless where
+  fromSortable _ = Headless
+
+
 data DBTableInvalid = DBTIRowsMissing Int
   deriving (Eq, Ord, Read, Show, Generic, Typeable)
 

src/Handler/Utils/Tokens.hs

@@ -5,8 +5,6 @@ module Handler.Utils.Tokens
 
 import Import
 
-import Utils.Lens
-
 import Control.Monad.Trans.Maybe (runMaybeT)
 
 

src/Handler/Utils/Tutorial.hs

@@ -10,8 +10,6 @@ import qualified Database.Esqueleto as E
 import qualified Database.Esqueleto.Internal.Sql as E
 import Database.Esqueleto.Utils.TH
 
-import Utils.Lens
-
 
 fetchTutorialAux :: ( SqlBackendCanRead backend
                     , E.SqlSelect b a

src/Import/NoFoundation.hs

@@ -10,6 +10,7 @@ import Model.Submission       as Import
 import Model.Tokens           as Import
 import Utils.Tokens           as Import
 import Utils.Frontend.Modal   as Import
+import Utils.Lens             as Import
 
 import Settings               as Import
 import Settings.StaticFiles   as Import

src/Import/NoModel.hs

@@ -3,7 +3,18 @@ module Import.NoModel
   , MForm
   ) where
 
-import ClassyPrelude.Yesod    as Import hiding (formatTime, derivePersistFieldJSON, getMessages, addMessage, addMessageI, (.=), MForm, Proxy, foldlM, static, boolField, identifyForm, cons, HasHttpManager(..))
+import ClassyPrelude.Yesod    as Import
+  hiding ( formatTime
+         , derivePersistFieldJSON
+         , getMessages, addMessage, addMessageI
+         , (.=)
+         , MForm
+         , Proxy
+         , foldlM
+         , static
+         , boolField, identifyForm
+         , HasHttpManager(..)
+         )
 
 import Model.Types.TH.JSON as Import
 import Model.Types.TH.Wordlist as Import
@@ -114,6 +125,16 @@ import System.FilePath.Instances as Import ()
 import Net.IP.Instances as Import ()
 import Data.Void.Instances as Import ()
 import Crypto.Hash.Instances as Import ()
+import Colonnade.Instances as Import ()
+
+import Control.Lens as Import
+  hiding ( (<.>)
+         , universe
+         , cons, uncons, snoc, unsnoc, (<|)
+         , Index, index, (<.)
+         )
+import Control.Lens.Extras as Import (is)
+import Data.Set.Lens as Import
 
 
 import Control.Monad.Trans.RWS (RWST)

src/Jobs.hs

@@ -6,8 +6,6 @@ module Jobs
   ) where
 
 import Import
-import Utils.Lens
-
 import Jobs.Types as Types hiding (JobCtl(JobCtlQueue))
 import Jobs.Types (JobCtl(JobCtlQueue))
 import Jobs.Queue

src/Jobs/Crontab.hs

@@ -4,8 +4,6 @@ module Jobs.Crontab
 
 import Import 
 
-import Utils.Lens
-
 import qualified Data.HashMap.Strict as HashMap
 import Jobs.Types
 

src/Jobs/Handler/HelpRequest.hs

@@ -9,8 +9,6 @@ import qualified Data.CaseInsensitive as CI
 
 import Handler.Utils
 
-import Utils.Lens
-
 import Data.Bitraversable
   
 

src/Jobs/Handler/Invitation.hs

@@ -3,7 +3,6 @@ module Jobs.Handler.Invitation
   ) where
 
 import Import
-import Utils.Lens
 import Handler.Utils.Mail
 
 import qualified Data.CaseInsensitive as CI

src/Jobs/Handler/SendCourseCommunication.hs

@@ -4,7 +4,6 @@ module Jobs.Handler.SendCourseCommunication
 
 import Import
 
-import Utils.Lens
 import Handler.Utils
 
 import qualified Data.Set as Set

src/Jobs/Handler/SendNotification/SubmissionRated.hs

@@ -6,7 +6,6 @@ module Jobs.Handler.SendNotification.SubmissionRated
 
 import Import
 
-import Utils.Lens
 import Handler.Utils
 import Jobs.Handler.SendNotification.Utils
 

src/Jobs/Handler/SendNotification/UserAuthModeUpdate.hs

@@ -5,7 +5,6 @@ module Jobs.Handler.SendNotification.UserAuthModeUpdate
   ) where
 
 import Import
-import Utils.Lens
 
 import Handler.Utils.Mail
 import Jobs.Handler.SendNotification.Utils

src/Jobs/Handler/SendPasswordReset.hs

@@ -4,7 +4,6 @@ module Jobs.Handler.SendPasswordReset
 
 import Import
 
-import Utils.Lens
 import Handler.Utils
 import Handler.Utils.Users
 

src/Jobs/Handler/SendTestEmail.hs

@@ -8,8 +8,6 @@ import Handler.Utils.DateTime
 
 import Text.Shakespeare.Text
 
-import Utils.Lens
-
 dispatchJobSendTestEmail :: Email -> MailContext -> Handler ()
 dispatchJobSendTestEmail jEmail jMailContext = mailT jMailContext $ do
   _mailTo .= [Address Nothing jEmail]

src/Jobs/Handler/TransactionLog.hs

@@ -4,7 +4,6 @@ module Jobs.Handler.TransactionLog
   ) where
 
 import Import hiding (currentYear)
-import Utils.Lens hiding ((<.))
 import Handler.Utils.DateTime
 
 import Database.Persist.Sql (updateWhereCount, deleteWhereCount)

src/Jobs/HealthReport.hs

@@ -14,8 +14,6 @@ import Data.Proxy (Proxy(..))
 
 import qualified Data.ByteArray as ByteArray
 
-import Utils.Lens
-
 import Network.HTTP.Simple (httpJSON, httpLBS)
 import qualified Network.HTTP.Simple as HTTP
 

src/Jobs/Queue.hs

@@ -11,7 +11,6 @@ module Jobs.Queue
 import Import hiding ((<>))
 
 import Utils.Sql
-import Utils.Lens
 import Jobs.Types
 
 import Control.Monad.Trans.Writer (WriterT, runWriterT)

src/Model/Types/DateTime.hs

@@ -9,7 +9,6 @@ module Model.Types.DateTime
   ) where
 
 import Import.NoModel
-import Control.Lens
 
 import qualified Data.Text as Text
 import qualified Data.CaseInsensitive as CI

src/Model/Types/Exam.hs

@@ -14,7 +14,6 @@ import Model.Types.Common
 
 import qualified Data.Text as Text
 
-import Control.Lens hiding (universe)
 import Utils.Lens.TH
 
 import qualified Data.Csv as Csv

src/Model/Types/Misc.hs

@@ -8,7 +8,6 @@ module Model.Types.Misc
   ) where
 
 import Import.NoModel
-import Control.Lens
 
 import Data.Maybe (fromJust)
 

src/Model/Types/Sheet.hs

@@ -11,8 +11,6 @@ import Import.NoModel
 import Model.Types.Common
 import Utils.Lens.TH
 
-import Control.Lens
-import Control.Lens.Extras (is)
 import Generics.Deriving.Monoid (memptydefault, mappenddefault)
 
 import Data.Set (Set)

src/Model/Types/Submission.hs

@@ -20,8 +20,6 @@ import Data.Word.Word24
 
 import qualified Data.CaseInsensitive as CI
 
-import Control.Lens
-
 import qualified Data.Text as Text
 import qualified Data.Set as Set
 

src/Settings.hs

@@ -44,8 +44,6 @@ import qualified Data.Text.Encoding as Text
 
 import qualified Ldap.Client as Ldap
 
-import Control.Lens
-
 import qualified Network.HaskellNet.Auth as HaskellNet (UserName, Password, AuthType(..))
 import qualified Network.Socket as HaskellNet (PortNumber(..), HostName)
 import qualified Network

src/Utils/Lens.hs

@@ -3,11 +3,16 @@
 
 module Utils.Lens ( module Utils.Lens ) where
 
-import ClassyPrelude.Yesod hiding (HasHttpManager(..))
-import qualified ClassyPrelude.Yesod as Yesod (HasHttpManager(..))
+import Import.NoModel
 import Model
+import qualified ClassyPrelude.Yesod as Yesod (HasHttpManager(..))
   
-import Control.Lens as Utils.Lens hiding ((<.>), universe, snoc)
+import Control.Lens as Utils.Lens
+  hiding ( (<.>)
+         , universe
+         , cons, uncons, snoc, unsnoc, (<|)
+         , Index, index, (<.)
+         )
 import Control.Lens.Extras as Utils.Lens (is)
 import Utils.Lens.TH as Utils.Lens (makeLenses_, makeClassyFor_)
 import Data.Set.Lens as Utils.Lens
@@ -42,6 +47,8 @@ _SchoolId = iso unSchoolKey SchoolKey
 -----------------------------------
 -- Lens Definitions for our Types
 
+makeClassyFor_ ''Term
+
 
 -- makeLenses_ ''Course
 makeClassyFor_ ''Course

templates/exam-show.hamlet

@@ -126,7 +126,7 @@ $if not (null occurrences)
               $maybe desc <- examOccurrenceDescription
                 #{desc}
 
-$if gradingShown && not (null parts)
+$if gradingShown && not (null examParts)
   <section>
     <h2>
       _{MsgExamParts}
@@ -139,7 +139,7 @@ $if gradingShown && not (null parts)
           <th .table__th>_{MsgExamPartMaxPoints}
           <th .table__th>_{MsgExamPartResultPoints}
       <tbody>
-        $forall Entity partId ExamPart{examPartName, examPartWeight, examPartMaxPoints} <- parts
+        $forall Entity partId ExamPart{examPartName, examPartWeight, examPartMaxPoints} <- examParts
           <tr .table__row>
             <td .table__td>#{examPartName}
             <td .table__td>

templates/table/layout.hamlet

@@ -3,14 +3,16 @@ $if null rows && (dbsEmptyStyle == DBESNoHeading)
   _{dbsEmptyMessage}
 $else
   <div .table-header>
-    <div .table__row-count>
-      _{MsgRowCount rowCount}
+    $if rowCount > 5
+      <div .table__row-count>
+        _{MsgRowCount rowCount}
 
   ^{table}
 
   <div .table-footer>
-    <div .table__row-count>
-      _{MsgRowCount rowCount}
+    $if rowCount > 5
+      <div .table__row-count>
+        _{MsgRowCount rowCount}
     $# Since the current pagesize is always a member of pagesizeOptions we don't need to check `pageCount > 1`
     $if toEnum (fromIntegral rowCount) > minimum (pagesizeOptions referencePagesize)
       ^{pagesizeWdgt'}