From 380c57c578107d6f32ff47e4450ee0808705760f Mon Sep 17 00:00:00 2001 From: SJost Date: Tue, 10 Apr 2018 10:38:21 +0200 Subject: [PATCH 1/5] Favourites working now (without PageActions). --- .gitignore | 1 + .kateproject | 4 ---- fill-db.hs | 22 ++++++++++++++++++++++ models | 11 +++++++---- run.sh | 1 + src/Foundation.hs | 22 ++++++++++++++++++---- src/Handler/Course.hs | 26 ++++++++++++++++---------- src/Handler/Home.hs | 2 +- templates/home.hamlet | 2 +- templates/widgets/asidenav.hamlet | 6 ++++++ 10 files changed, 73 insertions(+), 24 deletions(-) delete mode 100644 .kateproject create mode 120000 run.sh diff --git a/.gitignore b/.gitignore index 6338c36b4..9abd44d27 100644 --- a/.gitignore +++ b/.gitignore @@ -25,6 +25,7 @@ uniworx.nix .gup/ .dbsettings.yml *.kate-swp +.kateproject src/Handler/Assist.bak src/Handler/Course.SnapCustom.hs *.orig diff --git a/.kateproject b/.kateproject deleted file mode 100644 index 1d90b01b0..000000000 --- a/.kateproject +++ /dev/null @@ -1,4 +0,0 @@ -{ - "name": "ReWorX" -, "files": [ { "git": 1, "filters": ["*.hs", "*.hamlet", "*.lucius", "*.cassius", "*.julius"], "recursive": 1 } ] -} diff --git a/fill-db.hs b/fill-db.hs index cc16924c7..4cc894464 100755 --- a/fill-db.hs +++ b/fill-db.hs @@ -12,6 +12,7 @@ import Data.Time main :: IO () main = db $ do + defaultFavourites <- getsYesod $ appDefaultFavourites . appSettings now <- liftIO getCurrentTime let summer2017 = TermIdentifier 2017 Summer @@ -23,6 +24,7 @@ main = db $ do , userMatrikelnummer = Nothing , userEmail = "G.Kleen@campus.lmu.de" , userDisplayName = "Gregor Kleen" + , userMaxFavourites = 6 } fhamann <- insert User { userPlugin = "LDAP" @@ -30,6 +32,7 @@ main = db $ do , userMatrikelnummer = Nothing , userEmail = "felix.hamann@campus.lmu.de" , userDisplayName = "Felix Hamann" + , userMaxFavourites = defaultFavourites } jost <- insert User { userPlugin = "LDAP" @@ -37,6 +40,7 @@ main = db $ do , userMatrikelnummer = Nothing , userEmail = "jost@tcs.ifi.lmu.de" , userDisplayName = "Steffen Jost" + , userMaxFavourites = 14 } void . insert $ Term { termName = summer2017 @@ -91,6 +95,9 @@ main = db $ do , courseHasRegistration = True , courseRegisterFrom = Just now , courseRegisterTo = Just ((3600 * 24 * 60) `addUTCTime` now ) + , courseDeregisterUntil = Nothing + , courseRegisterSecret = Nothing + , courseMaterialFree = True } insert_ $ CourseEdit jost now ffp void . insert $ DegreeCourse ffp sdBsc sdInf @@ -112,6 +119,9 @@ main = db $ do , courseHasRegistration = False , courseRegisterFrom = Nothing , courseRegisterTo = Nothing + , courseDeregisterUntil = Nothing + , courseRegisterSecret = Nothing + , courseMaterialFree = True } insert_ $ CourseEdit fhamann now eip void . insert $ DegreeCourse eip sdBsc sdInf @@ -128,6 +138,9 @@ main = db $ do , courseHasRegistration = True , courseRegisterFrom = Just now , courseRegisterTo = Just ((3600 * 24 * 60) `addUTCTime` now ) + , courseDeregisterUntil = Nothing + , courseRegisterSecret = Nothing + , courseMaterialFree = True } insert_ $ CourseEdit fhamann now ixd void . insert $ DegreeCourse ixd sdBsc sdInf @@ -144,6 +157,9 @@ main = db $ do , courseHasRegistration = False , courseRegisterFrom = Nothing , courseRegisterTo = Nothing + , courseDeregisterUntil = Nothing + , courseRegisterSecret = Nothing + , courseMaterialFree = True } insert_ $ CourseEdit fhamann now ux3 void . insert $ DegreeCourse ux3 sdBsc sdInf @@ -160,6 +176,9 @@ main = db $ do , courseHasRegistration = False , courseRegisterFrom = Nothing , courseRegisterTo = Nothing + , courseDeregisterUntil = Nothing + , courseRegisterSecret = Nothing + , courseMaterialFree = True } insert_ $ CourseEdit jost now pmo void . insert $ DegreeCourse pmo sdBsc sdInf @@ -176,6 +195,9 @@ main = db $ do , courseHasRegistration = False , courseRegisterFrom = Nothing , courseRegisterTo = Nothing + , courseDeregisterUntil = Nothing + , courseRegisterSecret = Nothing + , courseMaterialFree = True } insert_ $ CourseEdit gkleen now dbs void . insert $ DegreeCourse dbs sdBsc sdInf diff --git a/models b/models index 95b991dc8..de3c17b88 100644 --- a/models +++ b/models @@ -58,10 +58,13 @@ Course termId TermId schoolId SchoolId capacity Int Maybe - hasRegistration Bool -- canRegisterNow = hasRegistration && maybe False (<= currentTime) registerFrom && maybe True (>= currentTime) registerTo - registerFrom UTCTime Maybe - registerTo UTCTime Maybe - CourseTermShort termId shorthand + hasRegistration Bool -- canRegisterNow = hasRegistration && maybe False (<= currentTime) registerFrom && maybe True (>= currentTime) registerTo + registerFrom UTCTime Maybe + registerTo UTCTime Maybe + deregisterUntil UTCTime Maybe + registerSecret Text Maybe -- Falls ein Passwort erforderlich ist + materialFree Bool default=true + CourseTermShort termId shorthand CourseEdit user UserId time UTCTime diff --git a/run.sh b/run.sh new file mode 120000 index 000000000..ebcc7e664 --- /dev/null +++ b/run.sh @@ -0,0 +1 @@ +start.sh \ No newline at end of file diff --git a/src/Foundation.hs b/src/Foundation.hs index 647dc34a9..223e9df81 100644 --- a/src/Foundation.hs +++ b/src/Foundation.hs @@ -47,6 +47,8 @@ import qualified Data.Text.Encoding as Text import Data.Conduit (($$)) import Data.Conduit.List (sourceList) +import qualified Database.Esqueleto as E + import Control.Monad.Except (MonadError(..), runExceptT) import Control.Monad.Trans.Maybe (MaybeT(..)) @@ -153,16 +155,17 @@ instance Yesod UniWorX where case route of CourseR tid csh _ | "updateFavourite" `elem` attrs -> do uid <- MaybeT maybeAuthId + $(logDebug) "Favourites save" now <- liftIO $ getCurrentTime void . lift . runDB . runMaybeT $ do cid <- MaybeT . getKeyBy $ CourseTermShort tid csh user <- MaybeT $ get uid - -- update Favorites + -- update Favourites lift $ upsertBy (UniqueCourseFavourite uid cid) (CourseFavourite uid now cid) [CourseFavouriteTime =. now] - -- prune Favorites to user-defined size + -- prune Favourites to user-defined size oldFavs <- lift $ selectKeysList [ CourseFavouriteUser ==. uid] [ Desc CourseFavouriteTime @@ -340,7 +343,7 @@ instance YesodBreadcrumbs UniWorX where breadcrumb SubmissionListR = return ("Abgaben", Just HomeR) breadcrumb (SubmissionR _) = return ("Abgabe", Just SubmissionListR) - breadcrumb HomeR = return ("ReWorX", Nothing) + breadcrumb HomeR = return ("UniworkY", Nothing) breadcrumb (AuthR _) = return ("Login", Just HomeR) breadcrumb ProfileR = return ("Profile", Just HomeR) breadcrumb _ = return ("home", Nothing) @@ -404,7 +407,7 @@ defaultLinkLayout = defaultMenuLayout . (defaultLinks ++) defaultMenuLayout :: [MenuTypes] -> Widget -> Handler Html defaultMenuLayout menu widget = do master <- getYesod - mmsgs <- getMessages + mmsgs <- getMessages mcurrentRoute <- getCurrentRoute @@ -413,6 +416,17 @@ defaultMenuLayout menu widget = do menuTypes <- filterM (menuItemAccessCallback . menuItem) menu + -- Lookup Favourites if possible + favourites <- do + muid <- maybeAuthId + case muid of + Nothing -> return [] + (Just uid) -> runDB . E.select . E.from $ \(course `E.InnerJoin` courseFavourite) -> do + E.on (course E.^. CourseId E.==. courseFavourite E.^. CourseFavouriteCourse) + E.where_ (courseFavourite E.^. CourseFavouriteUser E.==. E.val uid) + E.orderBy [ E.asc $ course E.^. CourseShorthand ] + return course + -- We break up the default layout into two components: -- default-layout is the contents of the body tag, and -- default-layout-wrapper is the entire page. Since the final diff --git a/src/Handler/Course.hs b/src/Handler/Course.hs index c12cc46af..1d22bc287 100644 --- a/src/Handler/Course.hs +++ b/src/Handler/Course.hs @@ -189,6 +189,9 @@ courseEditHandler course = do , courseHasRegistration = cfHasReg res , courseRegisterFrom = cfRegFrom res , courseRegisterTo = cfRegTo res + , courseDeregisterUntil = Nothing -- TODO + , courseRegisterSecret = Nothing -- TODO + , courseMaterialFree = True -- TODO } case insertOkay of (Just cid) -> do @@ -232,16 +235,19 @@ courseEditHandler course = do -- , CourseChanged =. now -- ] _updOkay <- replace cid ( -- TODO replaceUnique requires Eq?! - Course { courseName = cfName res - , courseDescription = cfDesc res - , courseLinkExternal = cfLink res - , courseShorthand = cfShort res - , courseTermId = cfTerm res - , courseSchoolId = cfSchool res - , courseCapacity = cfCapacity res - , courseHasRegistration = cfHasReg res - , courseRegisterFrom = cfRegFrom res - , courseRegisterTo = cfRegTo res + Course { courseName = cfName res + , courseDescription = cfDesc res + , courseLinkExternal = cfLink res + , courseShorthand = cfShort res + , courseTermId = cfTerm res + , courseSchoolId = cfSchool res + , courseCapacity = cfCapacity res + , courseHasRegistration = cfHasReg res + , courseRegisterFrom = cfRegFrom res + , courseRegisterTo = cfRegTo res + , courseDeregisterUntil = Nothing -- TODO + , courseRegisterSecret = Nothing -- TODO + , courseMaterialFree = True -- TODO } ) insert_ $ CourseEdit aid now cid diff --git a/src/Handler/Home.hs b/src/Handler/Home.hs index d8fb47dd1..bce3b39da 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 ReWorX Test!" + setTitle "Willkommen zum UniworkY Test!" $(widgetFile "home") diff --git a/templates/home.hamlet b/templates/home.hamlet index 0ee62ec29..e5a4a8678 100644 --- a/templates/home.hamlet +++ b/templates/home.hamlet @@ -1,5 +1,5 @@
-

ReWorX - Demo +

UniworkY - Demo

Testumgebung für die Re-Implementierung von UniWorX

diff --git a/templates/widgets/asidenav.hamlet b/templates/widgets/asidenav.hamlet index 7be64444f..2c1cd66fc 100644 --- a/templates/widgets/asidenav.hamlet +++ b/templates/widgets/asidenav.hamlet @@ -17,6 +17,12 @@ $newline never

WiSe 17/18