Favourites working now (without PageActions).
This commit is contained in:
SJost
parent
951af369c8
commit
380c57c578
1
.gitignore
vendored
1
.gitignore
vendored
@ -25,6 +25,7 @@ uniworx.nix
|
||||
.gup/
|
||||
.dbsettings.yml
|
||||
*.kate-swp
|
||||
.kateproject
|
||||
src/Handler/Assist.bak
|
||||
src/Handler/Course.SnapCustom.hs
|
||||
*.orig
|
||||
|
||||
@ -1,4 +0,0 @@
|
||||
{
|
||||
"name": "ReWorX"
|
||||
, "files": [ { "git": 1, "filters": ["*.hs", "*.hamlet", "*.lucius", "*.cassius", "*.julius"], "recursive": 1 } ]
|
||||
}
|
||||
22
fill-db.hs
22
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
|
||||
|
||||
11
models
11
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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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")
|
||||
|
||||
|
||||
|
||||
@ -1,5 +1,5 @@
|
||||
<div .container>
|
||||
<h1>ReWorX - Demo
|
||||
<h1>UniworkY - Demo
|
||||
<h3>
|
||||
Testumgebung für die Re-Implementierung von <a href="https://uniworx.ifi.lmu.de/">UniWorX</a>
|
||||
<p>
|
||||
|
||||
@ -17,6 +17,12 @@ $newline never
|
||||
<h3 .asidenav__box-title>
|
||||
WiSe 17/18
|
||||
<ul .asidenav__list>
|
||||
$forall (Entity _ Course{..}) <- favourites
|
||||
<li .asidenav__list-item>
|
||||
<a .asidenav__link-wrapper href=@{CourseR courseTermId courseShorthand CourseShowR}>
|
||||
<div .asidenav__link-triple>#{courseShorthand}
|
||||
<div .asidenav__link-label>#{courseName}
|
||||
|
||||
<li .asidenav__list-item>
|
||||
<a .asidenav__link-wrapper href="/course/S2018/ixd/show">
|
||||
<div .asidenav__link-triple>IXD
|
||||
|
||||
Loading…
Reference in New Issue
Block a user