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/shell.nix b/shell.nix index 1274430f9..3c37a979e 100644 --- a/shell.nix +++ b/shell.nix @@ -1,11 +1,11 @@ -{ nixpkgs ? import {}, compiler ? "ghc822" }: +{ nixpkgs ? import {}, compiler ? null }: let inherit (nixpkgs) pkgs; haskellPackages = if isNull compiler then pkgs.haskellPackages - else pkgs.haskell.packages.${compiler}; + else pkgs.haskell.packages."${compiler}"; drv = haskellPackages.callPackage ./uniworx.nix {}; diff --git a/src/Foundation.hs b/src/Foundation.hs index 4efca5572..1ca4de6fa 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/stack.nix b/stack.nix index 720dc860f..93d072683 100644 --- a/stack.nix +++ b/stack.nix @@ -2,12 +2,13 @@ let inherit (nixpkgs) haskell pkgs; + haskellPackages = if ghc.version == pkgs.haskellPackages.ghc.version then pkgs.haskellPackages else pkgs.haskell.packages."ghc${builtins.replaceStrings ["."] [""] ghc.version}"; in haskell.lib.buildStackProject { inherit ghc; name = "stackenv"; buildInputs = (with pkgs; [ postgresql zlib openldap cyrus_sasl.dev - ]) ++ (with haskell.packages."ghc${builtins.replaceStrings ["."] [""] ghc.version}"; + ]) ++ (with haskellPackages; [ yesod-bin ]); } diff --git a/templates/home.hamlet b/templates/home.hamlet index a0b39a8ef..77d84ad80 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..a46c06ad9 100644 --- a/templates/widgets/asidenav.hamlet +++ b/templates/widgets/asidenav.hamlet @@ -1,7 +1,7 @@ $newline never