diff --git a/src/Handler/Sheet.hs b/src/Handler/Sheet.hs index f1aa48b5f..1ab2cb169 100644 --- a/src/Handler/Sheet.hs +++ b/src/Handler/Sheet.hs @@ -22,6 +22,7 @@ import System.FilePath (takeFileName) import Handler.Utils -- import Handler.Utils.Zip +import Handler.Utils.Table.Cells -- import Data.Time -- import qualified Data.Text as T @@ -150,27 +151,25 @@ getSheetListR tid ssh csh = do muid <- maybeAuthId Entity cid _ <- runDB . getBy404 $ TermSchoolCourseShort tid ssh csh let + lastSheetEdit sheet = E.sub_select . E.from $ \sheetEdit -> do + E.where_ $ sheetEdit E.^. SheetEditSheet E.==. sheet E.^. SheetId + return . E.max_ $ sheetEdit E.^. SheetEditTime sheetData :: E.SqlExpr (Entity Sheet) `E.LeftOuterJoin` (E.SqlExpr (Maybe (Entity Submission)) `E.InnerJoin` (E.SqlExpr (Maybe (Entity SubmissionUser)))) -> E.SqlQuery (E.SqlExpr (Entity Sheet), E.SqlExpr (E.Value (Maybe UTCTime)),E.SqlExpr (Maybe (Entity Submission))) sheetData (sheet `E.LeftOuterJoin` (submission `E.InnerJoin` submissionUser)) = do E.on $ submission E.?. SubmissionId E.==. submissionUser E.?. SubmissionUserSubmission E.on $ (E.just $ sheet E.^. SheetId) E.==. submission E.?. SubmissionSheet E.&&. submissionUser E.?. SubmissionUserUser E.==. E.val muid - let sheetEdit = E.sub_select . E.from $ \sheetEdit' -> do - E.where_ $ sheetEdit' E.^. SheetEditSheet E.==. sheet E.^. SheetId - return . E.max_ $ sheetEdit' E.^. SheetEditTime E.where_ $ sheet E.^. SheetCourse E.==. E.val cid - return (sheet, sheetEdit, submission) + return (sheet, lastSheetEdit sheet, submission) sheetCol = widgetColonnade . mconcat $ [ sortable (Just "name") (i18nCell MsgSheet) $ \(Entity _ Sheet{..}, _, _) -> anchorCell (CSheetR tid ssh csh sheetName SShowR) (toWidget sheetName) , sortable (Just "last-edit") (i18nCell MsgLastEdit) - $ \(_, E.Value mEditTime, _) -> case mEditTime of - Just editTime -> cell $ formatTime SelFormatDateTime (editTime :: UTCTime) >>= toWidget - Nothing -> mempty + $ \(_, E.Value mEditTime, _) -> maybe mempty timeCell mEditTime , sortable (Just "submission-since") (i18nCell MsgSheetActiveFrom) - $ \(Entity _ Sheet{..}, _, _) -> cell $ formatTime SelFormatDateTime sheetActiveFrom >>= toWidget + $ \(Entity _ Sheet{..}, _, _) -> timeCell sheetActiveFrom , sortable (Just "submission-until") (i18nCell MsgSheetActiveTo) - $ \(Entity _ Sheet{..}, _, _) -> cell $ formatTime SelFormatDateTime sheetActiveTo >>= toWidget + $ \(Entity _ Sheet{..}, _, _) -> timeCell sheetActiveTo , sortable Nothing (i18nCell MsgSheetType) $ \(Entity _ Sheet{..}, _, _) -> textCell $ display sheetType , sortable Nothing (i18nCell MsgSubmission) @@ -203,7 +202,7 @@ getSheetListR tid ssh csh = do in textCell $ textPercent $ realToFrac percent _other -> mempty _other -> mempty - ] + ] psValidator = def & defaultSorting [("submission-since", SortAsc)] (SheetTypeSummary{..}, table) <- dbTable psValidator $ DBTable @@ -216,8 +215,7 @@ getSheetListR tid ssh csh = do , SortColumn $ \(sheet `E.LeftOuterJoin` _) -> sheet E.^. SheetName ) , ( "last-edit" - , SortColumn $ \(sheet `E.LeftOuterJoin` _) -> E.sub_select . E.from $ \sheetEdit -> E.distinctOnOrderBy [E.desc $ sheetEdit E.?. SheetEditTime] $ do - return $ sheetEdit E.?. SheetEditTime + , SortColumn $ \(sheet `E.LeftOuterJoin` _) -> lastSheetEdit sheet ) , ( "submission-since" , SortColumn $ \(sheet `E.LeftOuterJoin` _) -> sheet E.^. SheetActiveFrom diff --git a/src/Handler/Submission.hs b/src/Handler/Submission.hs index a39a5a62e..a11f2a670 100644 --- a/src/Handler/Submission.hs +++ b/src/Handler/Submission.hs @@ -27,36 +27,36 @@ import Handler.Utils.Table.Cells import Network.Mime -import Control.Monad.Trans.Maybe -import Control.Monad.State.Class -import Control.Monad.Trans.State.Strict (StateT) +-- import Control.Monad.Trans.Maybe +-- import Control.Monad.State.Class +-- import Control.Monad.Trans.State.Strict (StateT) import Data.Monoid (Any(..)) import Data.Maybe (fromJust) -import qualified Data.Maybe +-- import qualified Data.Maybe import qualified Data.Text as Text import qualified Data.Text.Encoding as Text import Data.CaseInsensitive (CI) -import qualified Data.CaseInsensitive as CI +-- import qualified Data.CaseInsensitive as CI import qualified Database.Esqueleto as E import qualified Database.Esqueleto.Internal.Sql as E (unsafeSqlFunction) import qualified Data.Conduit.List as Conduit -import Data.Conduit.ResumableSink +-- import Data.Conduit.ResumableSink -import Data.Set (Set) +-- import Data.Set (Set) import qualified Data.Set as Set import Data.Map (Map) import qualified Data.Map as Map -import Data.Bifunctor +-- import Data.Bifunctor import System.FilePath -import Colonnade hiding (bool, fromMaybe) -import qualified Yesod.Colonnade as Yesod -import qualified Text.Blaze.Html5.Attributes as HA +-- import Colonnade hiding (bool, fromMaybe) +-- import qualified Yesod.Colonnade as Yesod +-- import qualified Text.Blaze.Html5.Attributes as HA -- DEPRECATED: We always show all edits! -- numberOfSubmissionEditDates :: Int64 @@ -113,7 +113,7 @@ submissionHelper tid ssh csh shn (SubmissionMode mcid) = do maySubmit <- (== Authorized) <$> isAuthorized actionUrl True -- affects visibility of Edit-Dates, Submission-Button, etc. (Entity shid Sheet{..}, buddies, lastEdits) <- runDB $ do - sheet@(Entity shid Sheet{..}) <- fetchSheet tid ssh csh shn + csheet@(Entity shid Sheet{..}) <- fetchSheet tid ssh csh shn case msmid of Nothing -> do submissions <- E.select . E.from $ \(submission `E.InnerJoin` submissionUser) -> do @@ -127,12 +127,12 @@ submissionHelper tid ssh csh shn (SubmissionMode mcid) = do -- fetch buddies from previous submission in this course buddies <- E.select . E.from $ \(submissionUser `E.InnerJoin` user) -> do E.on (submissionUser E.^. SubmissionUserUser E.==. user E.^. UserId) - let oldids = E.subList_select . E.from $ \(sheet `E.InnerJoin` submission `E.InnerJoin` submissionUser `E.InnerJoin` submissionEdit) -> do - E.on (submissionEdit E.^. SubmissionEditSubmission E.==. submission E.^. SubmissionId) - E.on (submissionUser E.^. SubmissionUserSubmission E.==. submission E.^. SubmissionId) + let oldids = E.subList_select . E.from $ \(sheet `E.InnerJoin` submission `E.InnerJoin` subUser `E.InnerJoin` submissionEdit) -> do + E.on (submissionEdit E.^. SubmissionEditSubmission E.==. submission E.^. SubmissionId) + E.on (subUser E.^. SubmissionUserSubmission E.==. submission E.^. SubmissionId) E.on (sheet E.^. SheetId E.==. submission E.^. SubmissionSheet) - E.where_ $ submissionUser E.^. SubmissionUserUser E.==. E.val uid - E.&&. sheet E.^. SheetCourse E.==. E.val sheetCourse + E.where_ $ subUser E.^. SubmissionUserUser E.==. E.val uid + E.&&. sheet E.^. SheetCourse E.==. E.val sheetCourse E.orderBy [E.desc $ submissionEdit E.^. SubmissionEditTime] E.limit 1 return $ submission E.^. SubmissionId @@ -140,7 +140,7 @@ submissionHelper tid ssh csh shn (SubmissionMode mcid) = do E.&&. submissionUser E.^. SubmissionUserUser E.!=. E.val uid E.orderBy [E.asc $ user E.^. UserEmail] return $ user E.^. UserEmail - return (sheet, map E.unValue buddies, []) + return (csheet, map E.unValue buddies, []) (E.Value smid:_) -> do cID <- encrypt smid addMessageI "info" $ MsgSubmissionAlreadyExists @@ -172,7 +172,7 @@ submissionHelper tid ssh csh shn (SubmissionMode mcid) = do else E.nothing return $ (userName, submissionEdit E.^. SubmissionEditTime) forM raw $ \(E.Value name, E.Value time) -> (name, ) <$> formatTime SelFormatDateTime time - return (sheet,buddies,lastEdits) + return (csheet,buddies,lastEdits) let unpackZips = True -- undefined -- TODO ((res,formWidget), formEnctype) <- runFormPost $ makeSubmissionForm msmid unpackZips sheetGrouping buddies mCID <- runDB $ do diff --git a/src/Handler/Term.hs b/src/Handler/Term.hs index c14b796eb..4247d8a71 100644 --- a/src/Handler/Term.hs +++ b/src/Handler/Term.hs @@ -180,9 +180,9 @@ termEditHandler term = do newTermForm :: Maybe Term -> Form Term newTermForm template html = do - renderMessage <- getMessageRender + mr <- getMessageRender (result, widget) <- flip (renderAForm FormStandard) html $ Term - <$> areq termNewField (fslpI MsgTerm (renderMessage MsgTermPlaceholder)) (termName <$> template) + <$> areq termNewField (fslpI MsgTerm (mr MsgTermPlaceholder)) (termName <$> template) <*> areq dayField (fsl ("Erster Tag" :: Text)) (termStart <$> template) <*> areq dayField (fsl ("Letzer Tag" :: Text)) (termEnd <$> template) <*> pure [] -- TODO: List of Day field required, must probably be done as its own form and then combined diff --git a/src/Handler/Utils.hs b/src/Handler/Utils.hs index 002163a6d..42306d918 100644 --- a/src/Handler/Utils.hs +++ b/src/Handler/Utils.hs @@ -12,7 +12,7 @@ module Handler.Utils import Import import qualified Data.Text as T -import qualified Data.Set (Set) +-- import qualified Data.Set (Set) import qualified Data.Set as Set import Handler.Utils.DateTime as Handler.Utils @@ -62,7 +62,7 @@ warnTermDays tid times = do warnholidays = Set.intersection alldays $ Set.fromList termHolidays outoftermdays = Set.filter (\d -> d < termStart || d > termEnd ) alldays outoflecture = Set.filter (\d -> d < termLectureStart || d > termLectureEnd) alldays - `Set.difference` outoftermdays + `Set.difference` outoftermdays -- out of term implies out of lecture-time warnI msg d = formatTime SelFormatDate d >>= \dt -> addMessageI "warning" $ msg tid dt forM_ warnholidays $ warnI MsgDayIsAHoliday forM_ outoflecture $ warnI MsgDayIsOutOfLecture diff --git a/src/Utils.hs b/src/Utils.hs index c15a0c29a..d8b098139 100644 --- a/src/Utils.hs +++ b/src/Utils.hs @@ -130,7 +130,7 @@ withFragment form html = (flip fmap) form $ \(x, widget) -> (x, toWidget html >> -- Types that can be converted to Text for direct displayed to User! (Show for debugging, Display for Production) -{-# DEPRECATED display "Create RenderMessage Instances instead!" #-} +{- (not so sure we really want to get rid of display?!) DEPRECATED display "Create RenderMessage Instances instead!" -} class DisplayAble a where display :: a -> Text -- Default definitions for types belonging to Show (allows empty instance declarations)