diff --git a/src/Handler/Corrections.hs b/src/Handler/Corrections.hs index b77167ca8..de08b182d 100644 --- a/src/Handler/Corrections.hs +++ b/src/Handler/Corrections.hs @@ -127,8 +127,8 @@ colSubmissionLink = sortable Nothing (i18nCell MsgSubmission) return $ CSubmissionR tid ssh csh shn cid SubShowR in anchorCellM mkRoute (mkCid >>= \cid -> [whamlet|#{display cid}|]) -colSelect :: Colonnade _ CorrectionTableData (DBCell _ (FormResult (DBFormResult CorrectionTableData CryptoFileNameSubmission Bool))) -colSelect = dbSelect id $ \DBRow{ dbrOutput=(Entity subId _, _, _, _, _) } -> encrypt subId +colSelect :: forall act h. (Monoid act, Headedness h) => Colonnade h CorrectionTableData (DBCell _ (FormResult (act, DBFormResult CorrectionTableData CryptoFileNameSubmission Bool))) +colSelect = dbSelect _2 id $ \DBRow{ dbrOutput=(Entity subId _, _, _, _, _) } -> encrypt subId colSubmittors :: IsDBTable m a => Colonnade _ CorrectionTableData (DBCell m a) colSubmittors = sortable (Just "submittors") (i18nCell MsgSubmissionUsers) $ \DBRow{ dbrOutput=(_, _, course, _, users) } -> let @@ -174,12 +174,12 @@ colPseudonyms = sortable Nothing (i18nCell MsgPseudonyms) $ \DBRow{ dbrOutput=(_ in lCell & cellAttrs <>~ [("class", "list--inline list--comma-separated")] colRatedField :: Colonnade _ CorrectionTableData (DBCell _ (FormResult (DBFormResult CorrectionTableData SubmissionId (Bool, a, b)))) -colRatedField = sortable Nothing (i18nCell MsgRatingDone) $ formCell +colRatedField = sortable Nothing (i18nCell MsgRatingDone) $ formCell id (\DBRow{ dbrOutput=(Entity subId _, _, _, _, _) } -> return subId) (\DBRow{ dbrOutput=(Entity _ (submissionRatingDone -> done), _, _, _, _) } _ -> over (_1.mapped) (_1 .~) . over _2 fvInput <$> mreq checkBoxField "" (Just done)) colPointsField :: Colonnade _ CorrectionTableData (DBCell _ (FormResult (DBFormResult CorrectionTableData SubmissionId (a, Maybe Points, b)))) -colPointsField = sortable (Just "rating") (i18nCell MsgColumnRatingPoints) $ formCell +colPointsField = sortable (Just "rating") (i18nCell MsgColumnRatingPoints) $ formCell id (\DBRow{ dbrOutput=(Entity subId _, _, _, _, _) } -> return subId) (\DBRow{ dbrOutput=(Entity _ Submission{..}, Entity _ Sheet{..}, _, _, _) } _ -> case sheetType of NotGraded -> over (_1.mapped) (_2 .~) <$> pure (FormSuccess Nothing, mempty) @@ -187,14 +187,14 @@ colPointsField = sortable (Just "rating") (i18nCell MsgColumnRatingPoints) $ for ) colCommentField :: Colonnade _ CorrectionTableData (DBCell _ (FormResult (DBFormResult CorrectionTableData SubmissionId (a, b, Maybe Text)))) -colCommentField = sortable Nothing (i18nCell MsgRatingComment) $ formCell +colCommentField = sortable Nothing (i18nCell MsgRatingComment) $ formCell id (\DBRow{ dbrOutput=(Entity subId _, _, _, _, _) } -> return subId) (\DBRow{ dbrOutput=(Entity _ Submission{..}, _, _, _, _) } _ -> over (_1.mapped) ((_3 .~) . assertM (not . null) . fmap (Text.strip . unTextarea)) . over _2 fvInput <$> mopt textareaField "" (Just $ Textarea <$> submissionRatingComment)) makeCorrectionsTable :: ( IsDBTable m x, ToSortable h, Functor h ) - => CorrectionTableWhere -> Colonnade h CorrectionTableData (DBCell m x) -> PSValidator m x -> _ -> DB (DBResult m x) -makeCorrectionsTable whereClause dbtColonnade psValidator dbtProj' = do + => CorrectionTableWhere -> Colonnade h CorrectionTableData (DBCell m x) -> PSValidator m x -> _ -> DBParams m x -> DB (DBResult m x) +makeCorrectionsTable whereClause dbtColonnade psValidator dbtProj' dbtParams = do let dbtSQLQuery :: CorrectionTableExpr -> E.SqlQuery _ dbtSQLQuery = correctionsTableQuery whereClause (\((course `E.InnerJoin` sheet `E.InnerJoin` submission) `E.LeftOuterJoin` corrector) -> @@ -279,6 +279,7 @@ makeCorrectionsTable whereClause dbtColonnade psValidator dbtProj' = do ] , dbtFilterUI = mempty , dbtStyle = def + , dbtParams , dbtIdent = "corrections" :: Text } @@ -301,13 +302,19 @@ data ActionCorrectionsData = CorrDownloadData correctionsR :: _ -> _ -> _ -> Map ActionCorrections (AForm (HandlerT UniWorX IO) ActionCorrectionsData) -> Handler TypedContent correctionsR whereClause (formColonnade -> displayColumns) psValidator actions = do - tableForm <- runDB $ makeCorrectionsTable whereClause displayColumns psValidator return - ((actionRes, table), tableEncoding) <- runFormPost $ \csrf -> do - (fmap $ Map.keysSet . Map.filter id . getDBFormResult (const False) -> selectionRes, table) <- tableForm csrf - (actionRes, action) <- multiAction actions Nothing - return ((,) <$> actionRes <*> selectionRes, table <> action) - Just currentRoute <- getCurrentRoute -- This should never be called from a 404 handler + + (actionRes', table) <- runDB $ makeCorrectionsTable whereClause displayColumns psValidator return def + { dbParamsFormAction = Just $ SomeRoute currentRoute + , dbParamsFormAddSubmit = True + , dbParamsFormAdditional = \frag -> do + (actionRes, action) <- multiAction actions Nothing + return ((, mempty) . Last . Just <$> actionRes, toWidget frag <> action) + } + + let actionRes = actionRes' & mapped._2 %~ Map.keysSet . Map.filter id . getDBFormResult (const False) + & mapped._1 %~ fromMaybe (error "By consctruction the form should always return an action") . getLast + case actionRes of FormFailure errs -> mapM_ (addMessage Warning . toHtml) errs FormMissing -> return () @@ -795,14 +802,17 @@ postCorrectionsGradeR = do , colCommentField ] -- Continue here psValidator = def - & defaultSorting [("ratingtime", SortDesc)] :: PSValidator (RWST (Maybe (Env, FileEnv), UniWorX, [Lang]) Enctype Ints (HandlerT UniWorX IO)) (FormResult (DBFormResult CorrectionTableData SubmissionId (Bool, Maybe Points, Maybe Text))) + & defaultSorting [SortDescBy "ratingtime"] :: PSValidator (RWST (Maybe (Env, FileEnv), UniWorX, [Lang]) Enctype Ints (HandlerT UniWorX IO)) (FormResult (DBFormResult CorrectionTableData SubmissionId (Bool, Maybe Points, Maybe Text))) unFormResult = getDBFormResult $ \DBRow{ dbrOutput = (Entity _ sub@Submission{..}, _, _, _, _) } -> (submissionRatingDone sub, submissionRatingPoints, submissionRatingComment) + dbtProj' i@(Entity subId _, Entity _ Sheet{ sheetName = shn }, (_, csh, tid, ssh), _, _) = do + cID <- encrypt subId + void . assertM (== Authorized) . lift $ evalAccessDB (CSubmissionR tid ssh csh shn cID CorrectionR) True + return i - tableForm <- runDB $ makeCorrectionsTable whereClause displayColumns psValidator $ \i@(Entity subId _, Entity _ Sheet{ sheetName = shn }, (_, csh, tid, ssh), _, _) -> do - cID <- encrypt subId - void . assertM (== Authorized) . lift $ evalAccessDB (CSubmissionR tid ssh csh shn cID CorrectionR) True - return i - ((fmap unFormResult -> tableRes, table), tableEncoding) <- runFormPost tableForm + (fmap unFormResult -> tableRes, table) <- runDB $ makeCorrectionsTable whereClause displayColumns psValidator dbtProj' $ def + { dbParamsFormAction = Just $ SomeRoute CorrectionsGradeR + , dbParamsFormAddSubmit = True + } case tableRes of FormMissing -> return () diff --git a/src/Handler/Course.hs b/src/Handler/Course.hs index d34542f87..cd62c1333 100644 --- a/src/Handler/Course.hs +++ b/src/Handler/Course.hs @@ -179,6 +179,7 @@ makeCourseTable whereClause colChoices psValidator = do , Map.singleton "registered" . fmap toPathPiece . maybeToList <$> aopt boolField (fslI MsgCourseFilterRegistered) Nothing ] , dbtStyle = def + , dbtParams = def , dbtIdent = "courses" :: Text } @@ -194,7 +195,7 @@ getCourseListR = do ] whereClause = const $ E.val True validator = def - & defaultSorting [("course", SortAsc), ("term", SortDesc)] + & defaultSorting [SortAscBy "course", SortDescBy "term"] coursesTable <- runDB $ makeCourseTable whereClause colonnade validator defaultLayout $ do setTitleI MsgCourseListTitle @@ -225,7 +226,7 @@ getTermSchoolCourseListR tid ssh = do course E.^. CourseTerm E.==. E.val tid E.&&. course E.^. CourseSchool E.==. E.val ssh validator = def - & defaultSorting [("cshort", SortAsc)] + & defaultSorting [SortAscBy "cshort"] coursesTable <- runDB $ makeCourseTable whereClause colonnade validator defaultLayout $ do setTitleI $ MsgTermSchoolCourseListTitle tid school @@ -247,7 +248,7 @@ getTermCourseListR tid = do ] whereClause (course, _, _) = course E.^. CourseTerm E.==. E.val tid validator = def - & defaultSorting [("cshort", SortAsc)] + & defaultSorting [SortAscBy "cshort"] coursesTable <- runDB $ makeCourseTable whereClause colonnade validator defaultLayout $ do setTitleI . MsgTermCourseListTitle $ tid diff --git a/src/Handler/Home.hs b/src/Handler/Home.hs index f5bd47c51..abde50485 100644 --- a/src/Handler/Home.hs +++ b/src/Handler/Home.hs @@ -99,6 +99,7 @@ homeAnonymous = do ] -} , dbtFilterUI = mempty , dbtStyle = def + , dbtParams = def , dbtIdent = "upcomingdeadlines" :: Text } -- let features = $(widgetFile "featureList") @@ -167,7 +168,7 @@ homeUser uid = do (Just sid) -> anchorCellM (CSubmissionR tid ssh csh shn <$> encrypt sid <*> pure SubShowR) tickmark ] - let validator = def & defaultSorting [("done",SortDesc), ("deadline",SortDesc)] + let validator = def & defaultSorting [SortDescBy "done", SortDescBy "deadline"] sheetTable <- runDB $ dbTableWidget' validator DBTable { dbtSQLQuery = tableData , dbtColonnade = colonnade @@ -201,6 +202,7 @@ homeUser uid = do ] -} , dbtFilterUI = mempty , dbtStyle = def { dbsEmptyStyle = DBESNoHeading, dbsEmptyMessage = MsgNoUpcomingSheetDeadlines } + , dbtParams = def , dbtIdent = "upcomingdeadlines" :: Text } -- addMessage Warning "Vorabversion! Die Implementierung von Uni2work ist noch nicht abgeschlossen." diff --git a/src/Handler/Profile.hs b/src/Handler/Profile.hs index 410f6862a..cb487fcc8 100644 --- a/src/Handler/Profile.hs +++ b/src/Handler/Profile.hs @@ -262,7 +262,7 @@ mkOwnedCoursesTable = courseCellCL <$> view _dbrOutput ] - validator = def & defaultSorting [ ("term", SortDesc), ("school", SortAsc), ("course", SortAsc) ] + validator = def & defaultSorting [ SortDescBy "term", SortAscBy "school", SortAscBy "course" ] dbtSorting = Map.fromList [ ( "course", SortColumn $ withType $ \(crse `E.InnerJoin` _) -> crse E.^. CourseShorthand) , ( "term" , SortColumn $ withType $ \(crse `E.InnerJoin` _) -> crse E.^. CourseTerm ) @@ -274,6 +274,7 @@ mkOwnedCoursesTable = , ( "school", FilterColumn $ withType $ \(crse `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseSchool ) ] dbtFilterUI = mempty + dbtParams = def in \uid -> let dbtSQLQuery = dbtSQLQuery' uid in (_1 %~ getAny) <$> dbTableWidget validator DBTable{..} @@ -285,7 +286,7 @@ mkEnrolledCoursesTable = -> ((E.SqlExpr (Entity Course) `E.InnerJoin` E.SqlExpr (Entity CourseParticipant)) -> a) withType = id - validator = def & defaultSorting [("time",SortDesc)] + validator = def & defaultSorting [SortDescBy "time"] in \uid -> dbTableWidget' validator DBTable @@ -322,6 +323,7 @@ mkEnrolledCoursesTable = ] , dbtFilterUI = mempty , dbtStyle = def + , dbtParams = def } @@ -385,7 +387,7 @@ mkSubmissionTable = validator = def -- DUPLICATED CODE: Handler.Corrections & restrictFilter (\name _ -> name /= "corrector") -- We need to be careful to restrict allowed sorting/filter to not expose sensitive information & restrictSorting (\name _ -> name /= "corrector") - & defaultSorting [("edit",SortDesc)] + & defaultSorting [SortDescBy "edit"] dbtSorting' uid = Map.fromList [ ( "course", SortColumn $ withType $ \(crse `E.InnerJoin` _ `E.InnerJoin` _ `E.InnerJoin` _) -> crse E.^. CourseShorthand) , ( "term" , SortColumn $ withType $ \(crse `E.InnerJoin` _ `E.InnerJoin` _ `E.InnerJoin` _) -> crse E.^. CourseTerm ) @@ -399,6 +401,7 @@ mkSubmissionTable = , ( "school", FilterColumn $ withType $ \(crse `E.InnerJoin` _ `E.InnerJoin` _ `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseSchool ) ] dbtFilterUI = mempty + dbtParams = def in \uid -> let dbtSQLQuery = dbtSQLQuery' uid dbtSorting = dbtSorting' uid in dbTableWidget' validator DBTable{..} @@ -455,7 +458,7 @@ mkSubmissionGroupTable = validator = def -- DUPLICATED CODE: Handler.Corrections & restrictFilter (\name _ -> name /= "corrector") -- We need to be careful to restrict allowed sorting/filter to not expose sensitive information & restrictSorting (\name _ -> name /= "corrector") - & defaultSorting [("edit",SortDesc)] + & defaultSorting [SortDescBy "edit"] dbtSorting = Map.fromList [ ( "course", SortColumn $ withType $ \(crse `E.InnerJoin` _ `E.InnerJoin` _ ) -> crse E.^. CourseShorthand) , ( "term" , SortColumn $ withType $ \(crse `E.InnerJoin` _ `E.InnerJoin` _ ) -> crse E.^. CourseTerm ) @@ -469,6 +472,7 @@ mkSubmissionGroupTable = , ( "school", FilterColumn $ withType $ \(crse `E.InnerJoin` _ `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseSchool ) ] dbtFilterUI = mempty + dbtParams = def in \uid -> let dbtSQLQuery = dbtSQLQuery' uid in dbTableWidget' validator DBTable{..} @@ -529,7 +533,7 @@ mkCorrectionsTable = int64Cell <$> view (_dbrOutput . _4 . _2 . _unValue) ] - validator = def & defaultSorting [("term",SortDesc),("school",SortAsc),("course",SortAsc),("sheet",SortAsc)] + validator = def & defaultSorting [SortDescBy "term", SortAscBy "school", SortAscBy "course", SortAscBy "sheet"] dbtSorting = Map.fromList [ ( "term" , SortColumn $ withType $ \(crse `E.InnerJoin` _ `E.InnerJoin` _ ) -> crse E.^. CourseTerm ) , ( "school", SortColumn $ withType $ \(crse `E.InnerJoin` _ `E.InnerJoin` _ ) -> crse E.^. CourseSchool ) @@ -543,6 +547,7 @@ mkCorrectionsTable = , ( "course", FilterColumn $ withType $ \(crse `E.InnerJoin` _ `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseShorthand) ] dbtFilterUI = mempty + dbtParams = def in \uid -> let dbtSQLQuery = dbtSQLQuery' uid in dbTableWidget' validator DBTable{..} diff --git a/src/Handler/Sheet.hs b/src/Handler/Sheet.hs index a1ec6ad96..ccacabe32 100644 --- a/src/Handler/Sheet.hs +++ b/src/Handler/Sheet.hs @@ -201,7 +201,7 @@ getSheetListR tid ssh csh = do ] psValidator = def - & defaultSorting [("submission-since", SortAsc)] + & defaultSorting [SortAscBy "submission-since"] (table,raw_statistics) <- runDB $ liftA2 (,) (dbTableWidget' psValidator DBTable @@ -236,6 +236,7 @@ getSheetListR tid ssh csh = do , dbtFilter = mempty , dbtFilterUI = mempty , dbtStyle = def + , dbtParams = def , dbtIdent = "sheets" :: Text } ) ( @@ -298,7 +299,7 @@ getSShowR tid ssh csh shn = do , sortable (Just "time") "Modifikation" $ \(_,E.Value modified,_) -> cell $ formatTime SelFormatDateTime (modified :: UTCTime) >>= toWidget ] let psValidator = def - & defaultSorting [("type", SortAsc), ("path", SortAsc)] + & defaultSorting [SortAscBy "type", SortAscBy "path"] (Any hasFiles, fileTable) <- runDB $ dbTable psValidator DBTable { dbtSQLQuery = fileData , dbtColonnade = colonnadeFiles @@ -319,6 +320,7 @@ getSShowR tid ssh csh shn = do , SortColumn $ \(_sheet `E.InnerJoin` _sheetFile `E.InnerJoin` file) -> file E.^. FileModified ) ] + , dbtParams = def } (hasHints, hasSolution) <- runDB $ do hasHints <- (/= 0) <$> count [ SheetFileSheet ==. sid, SheetFileType ==. SheetHint ] diff --git a/src/Handler/Submission.hs b/src/Handler/Submission.hs index 7129dfeeb..a38b191e1 100644 --- a/src/Handler/Submission.hs +++ b/src/Handler/Submission.hs @@ -312,6 +312,7 @@ submissionHelper tid ssh csh shn (SubmissionMode mcid) = do ] , dbtFilter = mempty , dbtFilterUI = mempty + , dbtParams = def } mFileTable <- traverse (runDB . dbTableWidget' def) . fmap smid2ArchiveTable $ (,) <$> msmid <*> mcid diff --git a/src/Handler/SystemMessage.hs b/src/Handler/SystemMessage.hs index a71104eff..96fe43cf7 100644 --- a/src/Handler/SystemMessage.hs +++ b/src/Handler/SystemMessage.hs @@ -13,6 +13,8 @@ import Handler.Utils import Utils.Lens +import qualified Database.Esqueleto as E + htmlField' :: Field (HandlerT UniWorX IO) Html htmlField' = htmlField @@ -154,7 +156,7 @@ postMessageListR = do let dbtSQLQuery = return dbtColonnade = mconcat - [ dbSelect id $ \DBRow{ dbrOutput = (Entity smId _, _) } -> encrypt smId + [ dbSelect _2 id $ \DBRow{ dbrOutput = (Entity smId _, _) } -> encrypt smId , dbRow , sortable Nothing (i18nCell MsgSystemMessageId) $ \DBRow{ dbrOutput = (Entity smId _, _) } -> anchorCellM' (encrypt smId) MessageR (toWidget . tshow . ciphertext) , sortable (Just "from") (i18nCell MsgSystemMessageFrom) $ \DBRow{ dbrOutput = (Entity _ SystemMessage{..}, _) } -> cell $ maybe mempty (formatTimeW SelFormatDateTime) systemMessageFrom @@ -173,28 +175,46 @@ postMessageListR = do { dbrOutput = (smE, smT) , .. } - psValidator = def :: PSValidator (MForm (HandlerT UniWorX IO)) (FormResult (DBFormResult MessageListData CryptoUUIDSystemMessage Bool)) - tableForm <- runDB $ dbTable psValidator DBTable + psValidator = def :: PSValidator (MForm (HandlerT UniWorX IO)) (FormResult (Last ActionSystemMessageData, DBFormResult MessageListData CryptoUUIDSystemMessage Bool)) + (tableRes', tableView) <- runDB $ dbTable psValidator DBTable { dbtSQLQuery , dbtColonnade , dbtProj - , dbtSorting = mempty -- TODO: from, to, authenticated, severity + , dbtSorting = Map.fromList + [ ( "from" + , SortColumn $ \systemMessage -> systemMessage E.^. SystemMessageFrom + ) + , ( "to" + , SortColumn $ \systemMessage -> systemMessage E.^. SystemMessageTo + ) + , ( "authenticated" + , SortColumn $ \systemMessage -> systemMessage E.^. SystemMessageAuthenticatedOnly + ) + , ( "severity" + , SortColumn $ \systemMessage -> systemMessage E.^. SystemMessageSeverity + ) + ] , dbtFilter = mempty , dbtFilterUI = mempty , dbtStyle = def + , dbtParams = def + { dbParamsFormAction = Just $ SomeRoute MessageListR + , dbParamsFormAddSubmit = True + , dbParamsFormAdditional = \frag -> do + now <- liftIO getCurrentTime + let actions = Map.fromList + [ (SMDelete, pure SMDDelete) + , (SMActivate, SMDActivate <$> aopt utcTimeField (fslI MsgSystemMessageTimestamp) (Just $ Just now)) + , (SMDeactivate, SMDDeactivate <$> aopt utcTimeField (fslI MsgSystemMessageTimestamp) (Just Nothing)) + ] + (actionRes, action) <- multiAction actions (Just SMActivate) + return ((, mempty) . Last . Just <$> actionRes, toWidget frag <> action) + } , dbtIdent = "messages" :: Text } - ((tableRes, tableView), tableEncoding) <- runFormPost . identForm FIDSystemMessageTable $ \csrf -> do - (fmap $ Map.keysSet . Map.filter id . getDBFormResult (const False) -> selectionRes, table) <- tableForm csrf - now <- liftIO getCurrentTime - let actions = Map.fromList - [ (SMDelete, pure SMDDelete) - , (SMActivate, SMDActivate <$> aopt utcTimeField (fslI MsgSystemMessageTimestamp) (Just $ Just now)) - , (SMDeactivate, SMDDeactivate <$> aopt utcTimeField (fslI MsgSystemMessageTimestamp) (Just Nothing)) - ] - (actionRes, action) <- multiAction actions (Just SMActivate) - $logDebugS "SystemMessage" $ tshow (actionRes, selectionRes) - return ((,) <$> actionRes <*> selectionRes, table <> action) + + let tableRes = tableRes' & mapped._2 %~ Map.keysSet . Map.filter id . getDBFormResult (const False) + & mapped._1 %~ fromMaybe (error "By construction the form should always return an action") . getLast case tableRes of FormMissing -> return () diff --git a/src/Handler/Term.hs b/src/Handler/Term.hs index 0b1e67100..358d31ef8 100644 --- a/src/Handler/Term.hs +++ b/src/Handler/Term.hs @@ -128,6 +128,7 @@ getTermShowR = do ] , dbtFilterUI = mempty , dbtStyle = def + , dbtParams = def , dbtIdent = "terms" :: Text } defaultLayout $ do diff --git a/src/Handler/Users.hs b/src/Handler/Users.hs index d3a9a1d50..e2f0fbbdd 100644 --- a/src/Handler/Users.hs +++ b/src/Handler/Users.hs @@ -67,7 +67,7 @@ getUsersR = do |] ] psValidator = def - & defaultSorting [("name", SortAsc),("display-name", SortAsc)] + & defaultSorting [SortAscBy "name", SortAscBy "display-name"] ((), userList) <- runDB $ dbTable psValidator DBTable { dbtSQLQuery = return :: E.SqlExpr (Entity User) -> E.SqlQuery (E.SqlExpr (Entity User)) @@ -87,6 +87,7 @@ getUsersR = do , dbtFilter = mempty , dbtFilterUI = mempty , dbtStyle = def + , dbtParams = def , dbtIdent = "users" :: Text } diff --git a/src/Handler/Utils/Table/Pagination.hs b/src/Handler/Utils/Table/Pagination.hs index 170d52bbd..872294986 100644 --- a/src/Handler/Utils/Table/Pagination.hs +++ b/src/Handler/Utils/Table/Pagination.hs @@ -1,15 +1,18 @@ module Handler.Utils.Table.Pagination - ( SortColumn(..), SortDirection(..) + ( module Handler.Utils.Table.Pagination.Types + , SortColumn(..), SortDirection(..) + , pattern SortAscBy, pattern SortDescBy , FilterColumn(..), IsFilterColumn , DBRow(..), _dbrOutput, _dbrIndex, _dbrCount , DBStyle(..), DBEmptyStyle(..) , DBTable(..), IsDBTable(..), DBCell(..) + , DBParams(..) , cellAttrs, cellContents , PaginationSettings(..), PaginationInput(..), piIsUnset , PSValidator(..) , defaultFilter, defaultSorting , restrictFilter, restrictSorting - , ToSortable(..), Sortable(..), sortable + , ToSortable(..), Sortable(..) , dbTable , dbTableWidget, dbTableWidget' , widgetColonnade, formColonnade, dbColonnade @@ -38,9 +41,6 @@ import qualified Data.Binary.Builder as Builder import qualified Network.Wai as Wai -import Data.CaseInsensitive (CI) -import qualified Data.CaseInsensitive as CI - import Control.Monad.RWS hiding ((<>), mapM_) import Control.Monad.Writer hiding ((<>), mapM_) import Control.Monad.Reader (ReaderT(..), mapReaderT) @@ -65,18 +65,21 @@ import Data.Aeson (Options(..), defaultOptions, decodeStrict') import Data.Aeson.Text import Data.Aeson.TH (deriveJSON) +import qualified Data.Text as Text + data SortColumn t = forall a. PersistField a => SortColumn { getSortColumn :: t -> E.SqlExpr (E.Value a) } data SortDirection = SortAsc | SortDesc - deriving (Eq, Ord, Enum, Show, Read) + deriving (Eq, Ord, Enum, Bounded, Show, Read) + +instance Universe SortDirection +instance Finite SortDirection + instance PathPiece SortDirection where toPathPiece SortAsc = "asc" toPathPiece SortDesc = "desc" - fromPathPiece (CI.mk -> t) - | t == "asc" = Just SortAsc - | t == "desc" = Just SortDesc - | otherwise = Nothing + fromPathPiece = finiteFromPathPiece deriveJSON defaultOptions { constructorTagModifier = camelToPathPiece' 1 @@ -87,6 +90,29 @@ sqlSortDirection t (SortColumn e, SortAsc ) = E.asc $ e t sqlSortDirection t (SortColumn e, SortDesc) = E.desc $ e t +data SortingSetting = SortingSetting + { sortKey :: SortingKey + , sortDir :: SortDirection + } deriving (Eq, Ord, Show, Read) + +deriveJSON defaultOptions + { fieldLabelModifier = camelToPathPiece' 1 + } ''SortingSetting + +instance PathPiece SortingSetting where + toPathPiece SortingSetting{..} = toPathPiece sortKey <> "-" <> toPathPiece sortDir + fromPathPiece str = do + let sep = "-" + let (Text.dropEnd (Text.length sep) -> key, dir) = Text.breakOnEnd sep str + SortingSetting <$> fromPathPiece key <*> fromPathPiece dir + +pattern SortAscBy :: SortingKey -> SortingSetting +pattern SortAscBy key = SortingSetting key SortAsc + +pattern SortDescBy :: SortingKey -> SortingSetting +pattern SortDescBy key = SortingSetting key SortDesc + + data FilterColumn t = forall a. IsFilterColumn t a => FilterColumn a filterColumn :: FilterColumn t -> [Text] -> t -> E.SqlExpr (E.Value Bool) @@ -111,8 +137,8 @@ instance {-# OVERLAPPABLE #-} (PathPiece (Element l), IsFilterColumn t cont, Mon | otherwise = go (acc, is3 . (i:)) is2 data PaginationSettings = PaginationSettings - { psSorting :: [(CI Text, SortDirection)] - , psFilter :: Map (CI Text) [Text] + { psSorting :: [SortingSetting] + , psFilter :: Map FilterKey [Text] , psLimit :: Int64 , psPage :: Int64 } @@ -132,8 +158,8 @@ deriveJSON defaultOptions } ''PaginationSettings data PaginationInput = PaginationInput - { piSorting :: Maybe [(CI Text, SortDirection)] - , piFilter :: Maybe (Map (CI Text) [Text]) + { piSorting :: Maybe [SortingSetting] + , piFilter :: Maybe (Map FilterKey [Text]) , piLimit :: Maybe Int64 , piPage :: Maybe Int64 } deriving (Eq, Ord, Show, Read, Generic) @@ -194,29 +220,29 @@ instance Default (PSValidator m x) where asks piPage >>= maybe (return ()) (\p -> modify $ \ps -> ps { psPage = p }) -defaultFilter :: Map (CI Text) [Text] -> PSValidator m x -> PSValidator m x +defaultFilter :: Map FilterKey [Text] -> PSValidator m x -> PSValidator m x defaultFilter psFilter (runPSValidator -> f) = PSValidator $ \dbTable' -> injectDefault <*> f dbTable' where injectDefault x = case x >>= piFilter of Just _ -> id Nothing -> set (_2._psFilter) psFilter -defaultSorting :: [(CI Text, SortDirection)] -> PSValidator m x -> PSValidator m x +defaultSorting :: [SortingSetting] -> PSValidator m x -> PSValidator m x defaultSorting psSorting (runPSValidator -> f) = PSValidator $ \dbTable' -> injectDefault <*> f dbTable' where injectDefault x = case x >>= piSorting of Just _ -> id Nothing -> set (_2._psSorting) psSorting -restrictFilter :: (CI Text -> [Text] -> Bool) -> PSValidator m x -> PSValidator m x +restrictFilter :: (FilterKey -> [Text] -> Bool) -> PSValidator m x -> PSValidator m x restrictFilter restrict (runPSValidator -> f) = PSValidator $ \dbTable' ps -> over _2 restrict' $ f dbTable' ps where restrict' p = p { psFilter = Map.filterWithKey restrict $ psFilter p } -restrictSorting :: (CI Text -> SortDirection -> Bool) -> PSValidator m x -> PSValidator m x +restrictSorting :: (SortingKey -> SortDirection -> Bool) -> PSValidator m x -> PSValidator m x restrictSorting restrict (runPSValidator -> f) = PSValidator $ \dbTable' ps -> over _2 restrict' $ f dbTable' ps where - restrict' p = p { psSorting = filter (uncurry restrict) $ psSorting p } + restrict' p = p { psSorting = filter (\SortingSetting{..} -> restrict sortKey sortDir) $ psSorting p } data DBEmptyStyle = DBESNoHeading | DBESHeading @@ -244,9 +270,6 @@ instance Default DBStyle where , dbsLayoutFilter = \filterWgdt filterEnctype filterAction scrolltable -> $(widgetFile "table/layout-filter-default") } -type FilterKey = CI Text -type SortingKey = CI Text - data DBTable m x = forall a r r' h i t. ( ToSortable h, Functor h , E.SqlSelect a r @@ -260,10 +283,12 @@ data DBTable m x = forall a r r' h i t. , dbtFilter :: Map FilterKey (FilterColumn t) , dbtFilterUI :: AForm (ReaderT SqlBackend (HandlerT UniWorX IO)) (Map FilterKey [Text]) , dbtStyle :: DBStyle + , dbtParams :: DBParams m x , dbtIdent :: i } -class (MonadHandler m, Monoid x, Monoid (DBCell m x)) => IsDBTable (m :: * -> *) (x :: *) where +class (MonadHandler m, Monoid x, Monoid (DBCell m x), Default (DBParams m x)) => IsDBTable (m :: * -> *) (x :: *) where + data DBParams m x :: * type DBResult m x :: * -- type DBResult' m x :: * @@ -275,7 +300,7 @@ class (MonadHandler m, Monoid x, Monoid (DBCell m x)) => IsDBTable (m :: * -> *) dbWidget :: forall m'. (MonadHandler m', HandlerSite m' ~ UniWorX) => DBTable m x -> PaginationInput -> DBResult m x -> m' Widget -- | Format @DBTable@ when not short-circuiting dbHandler :: forall m'. (MonadHandler m', HandlerSite m' ~ UniWorX) => DBTable m x -> PaginationInput -> (Widget -> Widget) -> DBResult m x -> m' (DBResult m x) - runDBTable :: forall m'. (MonadHandler m', HandlerSite m' ~ UniWorX) => m (x, Widget) -> ReaderT SqlBackend m' (DBResult m x) + runDBTable :: forall m'. (MonadHandler m', HandlerSite m' ~ UniWorX) => DBTable m x -> PaginationInput -> m (x, Widget) -> ReaderT SqlBackend m' (DBResult m x) cellAttrs :: IsDBTable m x => Lens' (DBCell m x) [(Text, Text)] cellAttrs = dbCell . _1 @@ -284,6 +309,7 @@ cellContents :: IsDBTable m x => Lens' (DBCell m x) (WriterT x m Widget) cellContents = dbCell . _2 instance Monoid x => IsDBTable (HandlerT UniWorX IO) x where + data DBParams (HandlerT UniWorX IO) x = DBParamsWidget type DBResult (HandlerT UniWorX IO) x = (x, Widget) -- type DBResult' (WidgetT UniWorX IO) () = () @@ -299,13 +325,17 @@ instance Monoid x => IsDBTable (HandlerT UniWorX IO) x where -- dbWidget Proxy Proxy = iso (, ()) $ view _1 dbWidget _ _ = return . snd dbHandler _ _ f = return . over _2 f - runDBTable = liftHandlerT + runDBTable _ _ = liftHandlerT instance Monoid x => Monoid (DBCell (HandlerT UniWorX IO) x) where mempty = WidgetCell mempty $ return mempty (WidgetCell a c) `mappend` (WidgetCell a' c') = WidgetCell (mappend a a') (mappend <$> c <*> c') +instance Default (DBParams (HandlerT UniWorX IO) x) where + def = DBParamsWidget + instance Monoid x => IsDBTable (ReaderT SqlBackend (HandlerT UniWorX IO)) x where + data DBParams (ReaderT SqlBackend (HandlerT UniWorX IO)) x = DBParamsDB type DBResult (ReaderT SqlBackend (HandlerT UniWorX IO)) x = (x, Widget) data DBCell (ReaderT SqlBackend (HandlerT UniWorX IO)) x = DBCell @@ -320,15 +350,25 @@ instance Monoid x => IsDBTable (ReaderT SqlBackend (HandlerT UniWorX IO)) x wher dbWidget _ _ = return . snd dbHandler _ _ f = return . over _2 f -- runDBTable :: forall m. (MonadHandler m, HandlerSite m ~ UniWorX) => ReaderT SqlBackend (HandlerT UniWorX IO) ((), Widget) -> m (Widget) - runDBTable = mapReaderT liftHandlerT + runDBTable _ _ = mapReaderT liftHandlerT instance Monoid x => Monoid (DBCell (ReaderT SqlBackend (HandlerT UniWorX IO)) x) where mempty = DBCell mempty $ return mempty (DBCell a c) `mappend` (DBCell a' c') = DBCell (mappend a a') (mappend <$> c <*> c') +instance Default (DBParams (ReaderT SqlBackend (HandlerT UniWorX IO)) x) where + def = DBParamsDB + instance Monoid a => IsDBTable (RWST (Maybe (Env, FileEnv), UniWorX, [Lang]) Enctype Ints (HandlerT UniWorX IO)) (FormResult a) where - -- type DBResult (RWST (Maybe (Env, FileEnv), UniWorX, [Lang]) Enctype Ints (HandlerT UniWorX IO)) (FormResult a) = ((FormResult a, Widget), Enctype) - type DBResult (RWST (Maybe (Env, FileEnv), UniWorX, [Lang]) Enctype Ints (HandlerT UniWorX IO)) (FormResult a) = Form a + data DBParams (RWST (Maybe (Env, FileEnv), UniWorX, [Lang]) Enctype Ints (HandlerT UniWorX IO)) (FormResult a) = DBParamsForm + { dbParamsFormMethod :: StdMethod + , dbParamsFormAction :: Maybe (SomeRoute UniWorX) + , dbParamsFormAttrs :: [(Text, Text)] + , dbParamsFormAddSubmit :: Bool + , dbParamsFormAdditional :: Form a + , dbParamsFormEvaluate :: forall m'. (MonadHandler m', HandlerSite m' ~ UniWorX, MonadResource m') => Form a -> m' ((FormResult a, Widget), Enctype) + } + type DBResult (RWST (Maybe (Env, FileEnv), UniWorX, [Lang]) Enctype Ints (HandlerT UniWorX IO)) (FormResult a) = (FormResult a, Widget) -- type DBResult' (RWST (Maybe (Env, FileEnv), UniWorX, [Lang]) Enctype Ints (HandlerT UniWorX IO)) (FormResult a) = (FormResult a, Enctype) data DBCell (RWST (Maybe (Env, FileEnv), UniWorX, [Lang]) Enctype Ints (HandlerT UniWorX IO)) (FormResult a) = FormCell @@ -345,15 +385,37 @@ instance Monoid a => IsDBTable (RWST (Maybe (Env, FileEnv), UniWorX, [Lang]) Enc -- dbWidget Proxy Proxy = iso ((,) <$> view (_1._2) <*> ((,) <$> view (_1._1) <*> view _2)) -- ((,) <$> ((,) <$> view (_2._1) <*> view _1) <*> view (_2._2)) - dbWidget dbtable pi = liftHandlerT . fmap (view $ _1 . _2) . runFormPost . addPIHiddenField dbtable pi - dbHandler dbtable pi f form = return $ fmap (over _2 f) . addPIHiddenField dbtable pi form + dbWidget _ _ = return . snd + dbHandler _ _ f = return . over _2 f -- runDBTable :: MForm (HandlerT UniWorX IO) (FormResult a, Widget) -> m ((FormResult a, Widget), Enctype) -- runDBTable form = liftHandlerT . runFormPost $ \html -> over _2 (<> toWidget html) <$> form -- runDBTable :: MForm (HandlerT UniWorX IO) (FormResult a, Widget) -> m (Html -> MForm (HandleT UniWorX IO) (FormResult a, Widget)) - runDBTable = return . withFragment + runDBTable dbtable pi = fmap (view _1) . dbParamsFormEvaluate (dbtParams dbtable) . (dbParamsFormWrap (dbtParams dbtable)) . addPIHiddenField dbtable pi . withFragment + +instance Monoid a => Default (DBParams (RWST (Maybe (Env, FileEnv), UniWorX, [Lang]) Enctype Ints (HandlerT UniWorX IO)) (FormResult a)) where + def = DBParamsForm + { dbParamsFormMethod = POST + , dbParamsFormAction = Nothing + , dbParamsFormAttrs = [] + , dbParamsFormAddSubmit = False + , dbParamsFormAdditional = \_ -> return mempty + , dbParamsFormEvaluate = liftHandlerT . runFormPost + } + +dbParamsFormWrap :: Monoid a => DBParams (RWST (Maybe (Env, FileEnv), UniWorX, [Lang]) Enctype Ints (HandlerT UniWorX IO)) (FormResult a) -> Form a -> Form a +dbParamsFormWrap DBParamsForm{..} tableForm frag = do + let form = mappend <$> tableForm frag <*> dbParamsFormAdditional mempty + ((res, fWidget), enctype) <- listen form + return . (res,) $ do + btnId <- newIdent + act <- traverse toTextUrl dbParamsFormAction + let submitField = buttonField BtnSubmit + enctype' = bool id (mappend $ fieldEnctype submitField) dbParamsFormAddSubmit enctype + $(widgetFile "table/form-wrap") addPIHiddenField :: DBTable m x -> PaginationInput -> Form a -> Form a addPIHiddenField DBTable{ dbtIdent = (toPathPiece -> dbtIdent) } pi form fragment = form $ fragment <> [shamlet| + $newline never |] where @@ -373,10 +435,10 @@ dbTable :: forall m x. IsDBTable m x => PSValidator m x -> DBTable m x -> DB (DB dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> dbtIdent), dbtStyle = DBStyle{..}, .. } = do let sortingOptions = mkOptionList - [ Option t' (t, d) t' + [ Option t' (SortingSetting t d) t' | (t, _) <- mapToList dbtSorting , d <- [SortAsc, SortDesc] - , let t' = CI.foldedCase t <> "-" <> toPathPiece d + , let t' = toPathPiece $ SortingSetting t d ] wIdent n | not $ null dbtIdent = dbtIdent <> "-" <> n @@ -394,7 +456,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 $ CI.foldedCase k) dbtFilter) + <*> (assertM' (not . Map.null) . Map.mapMaybe (assertM $ not . null) <$> Map.traverseWithKey (\k _ -> iopt multiTextField . wIdent $ toPathPiece k) dbtFilter) <*> iopt intField (wIdent "pagesize") <*> iopt intField (wIdent "page") @@ -427,7 +489,7 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db = pi | otherwise = def - psSorting' = map (first (dbtSorting !)) psSorting + psSorting' = map (\SortingSetting{..} -> (dbtSorting ! sortKey, sortDir)) psSorting mapM_ (addMessageI Warning) errs @@ -454,7 +516,7 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db filterAction = tblLink $ setParam (wIdent "page") Nothing - . Map.foldrWithKey (\k _ f -> setParam (wIdent $ CI.foldedCase k) Nothing . f) id dbtFilter + . Map.foldrWithKey (\k _ f -> setParam (wIdent $ toPathPiece k) Nothing . f) id dbtFilter table' :: WriterT x m Widget table' = do @@ -463,7 +525,7 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db genHeaders SortableP{..} = forM (toSortable . oneColonnadeHead <$> getColonnade dbtColonnade) $ \Sortable{..} -> do widget <- sortableContent ^. cellContents let - directions = [dir | (k, dir) <- psSorting, Just k == sortableKey ] + directions = [dir | SortingSetting k dir <- psSorting, Just k == sortableKey ] isSortable = isJust sortableKey isSorted = (`elem` directions) attrs = sortableContent ^. cellAttrs @@ -485,7 +547,7 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db return $(widgetFile "table/layout") - bool (dbHandler dbtable paginationInput $ (\table -> $(widgetFile "table/layout-wrapper")) . dbsLayoutFilter filterWdgt filterEnc filterAction) (sendResponse <=< tblLayout . dbsLayoutFilter filterWdgt filterEnc filterAction <=< dbWidget dbtable paginationInput) psShortcircuit <=< runDBTable . fmap swap $ runWriterT table' + bool (dbHandler dbtable paginationInput $ (\table -> $(widgetFile "table/layout-wrapper")) . dbsLayoutFilter filterWdgt filterEnc filterAction) (sendResponse <=< tblLayout . dbsLayoutFilter filterWdgt filterEnc filterAction <=< dbWidget dbtable paginationInput) psShortcircuit <=< runDBTable dbtable paginationInput . fmap swap $ runWriterT table' where tblLayout :: forall m'. (MonadHandler m', HandlerSite m' ~ UniWorX) => Widget -> m' Html tblLayout tbl' = do @@ -585,16 +647,17 @@ instance Ord i => Monoid (DBFormResult r i a) where getDBFormResult :: forall r i a. Ord i => (r -> a) -> DBFormResult r i a -> Map i a getDBFormResult initial (DBFormResult m) = Map.map (\(r, f) -> f $ initial r) m -formCell :: forall r i a. Ord i - => (r -> MForm (HandlerT UniWorX IO) i) +formCell :: forall res r i a. (Ord i, Monoid res) + => Lens' res (DBFormResult r i a) + -> (r -> MForm (HandlerT UniWorX IO) i) -> (r -> i -> MForm (HandlerT UniWorX IO) (FormResult (a -> a), Widget)) - -> (r -> DBCell (RWST (Maybe (Env, FileEnv), UniWorX, [Lang]) Enctype Ints (HandlerT UniWorX IO)) (FormResult (DBFormResult r i a))) -formCell genIndex genForm input = FormCell + -> (r -> DBCell (MForm (HandlerT UniWorX IO)) (FormResult res)) +formCell resLens genIndex genForm input = FormCell { formCellAttrs = [] , formCellContents = do -- MForm (HandlerT UniWorX IO) (FormResult (Map i (Endo a)), Widget) i <- genIndex input (edit, w) <- genForm input i - return (DBFormResult . Map.singleton i . (input,) <$> edit, w) + return (flip (set resLens) mempty . DBFormResult . Map.singleton i . (input,) <$> edit, w) } @@ -604,10 +667,11 @@ formCell genIndex genForm input = FormCell dbRow :: forall h r m a. (Headedness h, IsDBTable m a) => Colonnade h (DBRow r) (DBCell m a) dbRow = Colonnade.singleton (headednessPure $ i18nCell MsgNrColumn) $ \DBRow{ dbrIndex } -> textCell $ tshow dbrIndex -dbSelect :: forall h r i a. (Headedness h, Ord i, PathPiece i) - => Setter' a Bool +dbSelect :: forall res h r i a. (Headedness h, Ord i, PathPiece i, Monoid res) + => Lens' res (DBFormResult r i a) + -> Setter' a Bool -> (r -> MForm (HandlerT UniWorX IO) i) - -> Colonnade h r (DBCell (RWST (Maybe (Env, FileEnv), UniWorX, [Lang]) Enctype Ints (HandlerT UniWorX IO)) (FormResult (DBFormResult r i a))) -dbSelect resLens genIndex = Colonnade.singleton (headednessPure $ i18nCell MsgSelectColumn) $ \r -> flip (formCell genIndex) r $ \_ i -> do + -> Colonnade h r (DBCell (MForm (HandlerT UniWorX IO)) (FormResult res)) +dbSelect resLens selLens genIndex = Colonnade.singleton (headednessPure $ i18nCell MsgSelectColumn) $ \r -> flip (formCell resLens genIndex) r $ \_ i -> do (selResult, selWidget) <- mreq checkBoxField ("" { fsName = Just $ "select-" <> toPathPiece i }) (Just False) - return (set resLens <$> selResult, [whamlet|^{fvInput selWidget}|]) + return (set selLens <$> selResult, [whamlet|^{fvInput selWidget}|]) diff --git a/src/Handler/Utils/Table/Pagination/Types.hs b/src/Handler/Utils/Table/Pagination/Types.hs index 6bc9e1286..58884b3da 100644 --- a/src/Handler/Utils/Table/Pagination/Types.hs +++ b/src/Handler/Utils/Table/Pagination/Types.hs @@ -1,4 +1,12 @@ -module Handler.Utils.Table.Pagination.Types where +{-# LANGUAGE GeneralizedNewtypeDeriving #-} + +module Handler.Utils.Table.Pagination.Types + ( FilterKey, SortingKey + , Sortable(..) + , sortable + , ToSortable(..) + , SortableP(..) + ) where import Import hiding (singleton) @@ -7,12 +15,23 @@ import Colonnade.Encode import Data.CaseInsensitive (CI) +import Data.Aeson (FromJSON, ToJSON, FromJSONKey, ToJSONKey) + + +newtype FilterKey = FilterKey { _unFilterKey :: CI Text } + deriving (Show, Read) + deriving newtype (Ord, Eq, PathPiece, IsString, FromJSON, ToJSON, FromJSONKey, ToJSONKey) +newtype SortingKey = SortingKey { _unSortingKey :: CI Text } + deriving (Show, Read) + deriving newtype (Ord, Eq, PathPiece, IsString, FromJSON, ToJSON, FromJSONKey, ToJSONKey) + + data Sortable a = Sortable - { sortableKey :: Maybe (CI Text) + { sortableKey :: Maybe SortingKey , sortableContent :: a } -sortable :: Maybe (CI Text) -> c -> (a -> c) -> Colonnade Sortable a c +sortable :: Maybe SortingKey -> c -> (a -> c) -> Colonnade Sortable a c sortable k h = singleton (Sortable k h) instance Headedness Sortable where diff --git a/src/Import/NoFoundation.hs b/src/Import/NoFoundation.hs index 868ba4b67..3227bbeb8 100644 --- a/src/Import/NoFoundation.hs +++ b/src/Import/NoFoundation.hs @@ -41,6 +41,7 @@ import Data.Hashable as Import import Data.List.NonEmpty as Import (NonEmpty(..)) import Data.Text.Encoding.Error as Import(UnicodeException(..)) import Data.Semigroup as Import (Semigroup) +import Data.Monoid as Import (Last(..), First(..)) import Data.Monoid.Instances as Import () import Control.Monad.Morph as Import (MFunctor(..)) diff --git a/templates/corrections-grade.hamlet b/templates/corrections-grade.hamlet index f68d51e69..2d2943787 100644 --- a/templates/corrections-grade.hamlet +++ b/templates/corrections-grade.hamlet @@ -1,5 +1,2 @@
-
- ^{table} -