Fixes #183
This commit is contained in:
SJost
parent
0e6596889a
commit
f914963eb5
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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)
|
||||
|
||||
Loading…
Reference in New Issue
Block a user