diff --git a/routes b/routes index f311fb480..c04ca7ada 100644 --- a/routes +++ b/routes @@ -12,6 +12,7 @@ /term/edit TermEditR GET POST !adminAny /term/#TermId/edit TermEditExistR GET !adminAny +-- For Pattern Synonyms see Foundation /course/ CourseListR GET !/course/new CourseNewR GET POST !lecturerAny !/course/#TermId CourseListTermR GET diff --git a/src/Foundation.hs b/src/Foundation.hs index 8f547d1db..ac6f25b6c 100644 --- a/src/Foundation.hs +++ b/src/Foundation.hs @@ -350,7 +350,7 @@ instance YesodBreadcrumbs UniWorX where breadcrumb SubmissionListR = return ("Abgaben", Just HomeR) - breadcrumb HomeR = return ("UniworkY", Nothing) + breadcrumb HomeR = return ("Uniworky", Nothing) breadcrumb (AuthR _) = return ("Login", Just HomeR) breadcrumb ProfileR = return ("Profile", Just HomeR) breadcrumb _ = return ("home", Nothing) diff --git a/src/Handler/Home.hs b/src/Handler/Home.hs index bce3b39da..9a08c934b 100644 --- a/src/Handler/Home.hs +++ b/src/Handler/Home.hs @@ -43,7 +43,7 @@ getHomeR :: Handler Html getHomeR = do (btnWdgt, btnEnctype) <- generateFormPost (buttonForm :: Form CreateButton) defaultLayout $ do - setTitle "Willkommen zum UniworkY Test!" + setTitle "Willkommen zum Uniworky Test!" $(widgetFile "home") diff --git a/src/Handler/Sheet.hs b/src/Handler/Sheet.hs index 3baa7ece0..d39e44dca 100644 --- a/src/Handler/Sheet.hs +++ b/src/Handler/Sheet.hs @@ -196,7 +196,15 @@ getSheetShowR tid csh shn = do return $ (file E.^. FileTitle, sheetFile E.^. SheetFileType) let fileLinks = map (\(E.Value fName, E.Value fType) -> CSheetR tid csh (SheetFileR shn fType fName)) fileNameTypes - defaultLayout $ do + let pageActions = + [ PageActionPrime $ MenuItem + { menuItemLabel = "Abgabe" + , menuItemIcon = Nothing + , menuItemRoute = CSheetR tid csh SheetNewR + , menuItemAccessCallback' = return True + } + ] + defaultLinkLayout pageActions $ do setTitle $ toHtml $ T.append "Übung " $ sheetName sheet $(widgetFile "sheetShow") [whamlet| Under Construction !!! |] -- TODO diff --git a/src/Handler/Submission.hs b/src/Handler/Submission.hs index 318551f4b..68c908895 100644 --- a/src/Handler/Submission.hs +++ b/src/Handler/Submission.hs @@ -42,6 +42,7 @@ import Data.Set (Set) import qualified Data.Set as Set import Data.Map (Map) import qualified Data.Map as Map +import Data.Bifunctor import System.FilePath @@ -125,7 +126,7 @@ postSubmissionR tid csh shn (SubmissionMode mcid) = do E.orderBy [E.desc $ submissionEdit E.^. SubmissionEditTime] E.limit 1 return $ (user E.^. UserDisplayName, submissionEdit E.^. SubmissionEditTime) - let lastEdits = map (\(a,b)-> (E.unValue a, E.unValue b)) lastEditValues + let lastEdits = map (bimap E.unValue E.unValue) lastEditValues return (sheet,buddies,oldfiles,lastEdits) let unpackZips = True -- undefined -- TODO ((res,formWidget), formEnctype) <- runFormPost $ makeSubmissionForm unpackZips sheetGrouping $ map E.unValue buddies diff --git a/src/Handler/Utils/Form.hs b/src/Handler/Utils/Form.hs index 9e20dcc92..b01b8376a 100644 --- a/src/Handler/Utils/Form.hs +++ b/src/Handler/Utils/Form.hs @@ -15,9 +15,11 @@ module Handler.Utils.Form where import Handler.Utils.Form.Types + +import Handler.Utils.DateTime + import Import import qualified Data.Char as Char -import Handler.Utils.DateTime import Data.String (IsString(..)) import qualified Data.Foldable as Foldable @@ -328,6 +330,25 @@ sheetGroupAFormReq d _other = -- TODO -- TODO, offer options to choose between Arbitrary/Registered/NoGroups Arbitrary <$> areq (natField "Abgabegruppengröße") d (Just 1) +{- +dayTimeField :: FieldSettings UniWorX -> Maybe UTCTime -> Form Handler UTCTime +dayTimeField fs mutc = do + let (mbDay,mbTime) = case mutcs of + Nothing -> return (Nothing,Nothing) + (Just utc) -> + + (dayResult, dayView) <- mreq dayField fs + + (result, view) <- (,) <$> dayField <*> timeField + where + (mbDay,mbTime) + | (Just utc) <- mutc = + let lt = utcToLocalTime ??? utcs + in (Just $ localDay lt, Just $ localTimeOfDay lt) + | otherwise = (Nothing,Nothing) +-} + + utcTimeField :: (Monad m, RenderMessage (HandlerSite m) FormMessage) => Field m UTCTime -- StackOverflow: dayToUTC <$> (areq (jqueryDayField def {...}) settings Nothing) -- TODO: Verify whether this is UTC or local time from Browser diff --git a/src/Utils.hs b/src/Utils.hs index 25fbe61bb..e1aebc0b6 100644 --- a/src/Utils.hs +++ b/src/Utils.hs @@ -53,10 +53,6 @@ whenIsJust Nothing _ = return () -- Tuples -- ------------ -both :: (a -> b) -> (a,a) -> (b,b) -both f (x,y) = (f x, f y) - - ---------- -- Maps -- ---------- diff --git a/templates/home.hamlet b/templates/home.hamlet index 77d84ad80..23af41335 100644 --- a/templates/home.hamlet +++ b/templates/home.hamlet @@ -1,5 +1,5 @@