diff --git a/.directory b/.directory
new file mode 100644
index 000000000..59c2c250d
--- /dev/null
+++ b/.directory
@@ -0,0 +1,6 @@
+[Dolphin]
+Timestamp=2018,3,14,10,57,55
+Version=4
+
+[Settings]
+HiddenFilesShown=true
diff --git a/.kateproject b/.kateproject
new file mode 100644
index 000000000..1d90b01b0
--- /dev/null
+++ b/.kateproject
@@ -0,0 +1,4 @@
+{
+ "name": "ReWorX"
+, "files": [ { "git": 1, "filters": ["*.hs", "*.hamlet", "*.lucius", "*.cassius", "*.julius"], "recursive": 1 } ]
+}
diff --git a/FragenSJ.txt b/FragenSJ.txt
new file mode 100644
index 000000000..3f8319750
--- /dev/null
+++ b/FragenSJ.txt
@@ -0,0 +1,11 @@
+** i18n:
+
+ - Was ist mit einfachen Text Feldern, z.B. die Beschriftung von Knöpfen wie in Handler.Course.getCourseListTermR, Zeile 66 "pageActions" für menuItemLabel?
+ - Was ist mit PageTitles, z.B. in Handler.Term.termEditHandler:
+ -- setTitle [whamlet| _{MsgTermNewTitle} |] -- TODO, does not work
+
+
+** FORMS
+
+ - Handler.Utils.Form.FormIdentifier: Still needed?
+ - Verification of Ownership during Edit?
diff --git a/README.md b/README.md
index 2fbf8207f..e0296b226 100644
--- a/README.md
+++ b/README.md
@@ -52,7 +52,7 @@ Assuming Ubuntu or similar
Build the app:
`stack build`
- Run the app (with environment variable DUMMY_LUGIN set to true):
+ Run the app (with environment variable DUMMY_LOGIN set to true):
`env DUMMY_LOGIN=true stack exec -- yesod devel`
`Devel application launched: http://localhost:3000`
@@ -86,5 +86,19 @@ psql -U uniworx -d uniworx -h 127.0.0.1 -w
--Zeige Tabellen
\dt
+--Zeige Tabellen Inhalt:
+TABEL "user";
+-- Die Anführungszeichen können manchmal weggelassen werden, aber
+-- bei user sind sie notwendig, da es auch Schlüsselwort in sql ist.
+
--Lösche Tabelle "course" und alle davon abhängigen:
DROP TABLE "course" CASCADE;
+
+-- UserId 5 zum Lecturer in SchoolId 1 machen (27 ist laufende Nummer)
+INSERT INTO "user_lecturer" (id,"user",school) VALUES (27,5,1);
+
+-- Beenden:
+\q
+
+-- Hilfe:
+\help
diff --git a/messages/de.msg b/messages/de.msg
index 0981f3971..b894e9ce2 100644
--- a/messages/de.msg
+++ b/messages/de.msg
@@ -1,3 +1,9 @@
SummerTerm year@Integer: Sommersemester #{tshow year}
WinterTerm year@Integer: Wintersemester #{tshow year}/#{tshow $ succ year}
-SemesterEdited tid@TermIdentifier: Semester #{termToText tid} erfolgreich editiert.
+TermEdited tid@TermIdentifier: Semester #{termToText tid} erfolgreich editiert.
+TermNewTitle: Semester editiere/anlegen.
+InvalidInput: Eingaben bitte korrigieren.
+CourseNewOk tid@TermIdentifier courseShortHand@Text: Kurs #{termToText tid}-#{courseShortHand} wurde erfolgreich erstellt.
+CourseEditOk tid@TermIdentifier courseShortHand@Text: Kurs #{termToText tid}-#{courseShortHand} wurde erfolgreich geändert.
+CourseNewDupShort tid@TermIdentifier courseShortHand@Text: Kurs #{termToText tid}-#{courseShortHand} konnte nicht erstellt werden: Es gibt bereits einen anderen Kurs mit dem Kürzel #{courseShortHand} in diesem Semester.
+CourseEditDupShort tid@TermIdentifier courseShortHand@Text: Kurs #{termToText tid}-#{courseShortHand} konnte nicht geändert werden: Es gibt bereits einen anderen Kurs mit dem Kürzel #{courseShortHand} in diesem Semester.
diff --git a/models b/models
index b910cb843..82094fab7 100644
--- a/models
+++ b/models
@@ -30,8 +30,8 @@ StudyTerms
name Text Maybe
Primary key
Term json
- name TermIdentifier
- start Day
+ name TermIdentifier -- unTermKey :: TermId -> TermIdentifier
+ start Day -- TermKey :: TermIdentifier -< TermId
end Day
holidays [Day]
lectureStart Day
diff --git a/routes b/routes
index 8c074546b..04c5c77c9 100644
--- a/routes
+++ b/routes
@@ -13,10 +13,10 @@
/term/#TermId/edit TermEditExistR GET
/course/ CourseListR GET
-!/course/new CourseEditR GET POST
-!/course/#TermId CourseListTermR GET
-/course/#TermId/#Text/edit CourseEditExistR GET
-/course/#TermId/#Text/show CourseShowR GET POST
+!/course/new CourseNewR GET POST
+!/course/#TermId CourseListTermR GET
+/course/#TermId/#Text/edit CourseEditR GET
+/course/#TermId/#Text/show CourseShowR GET POST
/course/#TermId/#Text/sheet/ SheetListR GET
/course/#TermId/#Text/sheet/#Text/show SheetShowR GET
@@ -34,4 +34,4 @@
!/#UUID CryptoUUIDDispatchR GET
-- For demonstration
-/course/#CryptoUUIDCourse/edit CourseEditExistIDR GET
+/course/#CryptoUUIDCourse/edit CourseEditIDR GET
diff --git a/src/Foundation.hs b/src/Foundation.hs
index 0bc8713fc..dff753a63 100644
--- a/src/Foundation.hs
+++ b/src/Foundation.hs
@@ -198,10 +198,10 @@ isAuthorizedDB (SubmissionDownloadSingleR cID _) _ = submissionAccess $ Right cI
isAuthorizedDB (SubmissionDownloadArchiveR (splitExtension -> (baseName, _))) _ = submissionAccess . Left . CryptoID $ CI.mk baseName
isAuthorizedDB TermEditR _ = adminAccess Nothing
isAuthorizedDB (TermEditExistR _) _ = adminAccess Nothing
-isAuthorizedDB CourseEditR _ = lecturerAccess Nothing
-isAuthorizedDB (CourseEditExistR t c) _ = courseLecturerAccess . entityKey =<< getBy404 (CourseTermShort t c)
+isAuthorizedDB CourseNewR _ = lecturerAccess Nothing
+isAuthorizedDB (CourseEditR t c) _ = courseLecturerAccess . entityKey =<< getBy404 (CourseTermShort t c)
isAuthorizedDB (SheetNewR t c) _ = courseLecturerAccess . entityKey =<< getBy404 (CourseTermShort t c)
-isAuthorizedDB (CourseEditExistIDR cID) _ = do
+isAuthorizedDB (CourseEditIDR cID) _ = do
courseId <- decrypt cID
courseLecturerAccess courseId
isAuthorizedDB _route _isWrite = return $ Unauthorized "No access to this route." -- Calling isAuthorized here creates infinite loop!
@@ -255,11 +255,11 @@ instance YesodBreadcrumbs UniWorX where
breadcrumb TermEditR = return ("Neu", Just TermShowR)
breadcrumb (TermEditExistR _) = return ("Editieren", Just TermShowR)
- breadcrumb CourseListR = return ("Kurs", Just HomeR)
- breadcrumb (CourseListTermR term) = return (toPathPiece term, Just TermShowR)
+ breadcrumb CourseListR = return ("Kurs", Just HomeR)
+ breadcrumb (CourseListTermR term) = return (toPathPiece term, Just TermShowR)
breadcrumb (CourseShowR term course) = return (course, Just $ CourseListTermR term)
- breadcrumb CourseEditR = return ("Neu", Just CourseListR)
- breadcrumb (CourseEditExistR _ _) = return ("Editieren", Just CourseListR)
+ breadcrumb CourseNewR = return ("Neu", Just CourseListR)
+ breadcrumb (CourseEditR _ _) = return ("Editieren", Just CourseListR)
breadcrumb (SheetListR tid csh) = return ("Kurs", Just $ CourseShowR tid csh)
breadcrumb (SheetShowR tid csh _shn) = return ("Übungen", Just $ SheetListR tid csh)
diff --git a/src/Handler/Course.hs b/src/Handler/Course.hs
index 28250fb7d..d287e2da4 100644
--- a/src/Handler/Course.hs
+++ b/src/Handler/Course.hs
@@ -54,26 +54,26 @@ getCourseListTermR tidini = do
shd = courseShorthand c
tid = courseTermId c
in do
- adminLink <- handlerToWidget $ isAuthorized (CourseEditExistR tid shd ) False
- -- if (adminLink==Authorized) then linkButton "Ändern" BCWarning (CourseEditExistR tid shd) else ""
+ adminLink <- handlerToWidget $ isAuthorized (CourseEditR tid shd ) False
+ -- if (adminLink==Authorized) then linkButton "Ändern" BCWarning (CourseEditR tid shd) else ""
[whamlet|
$if adminLink == Authorized
-
+
editieren
|]
)
]
- let pageLinks =
+ let pageActions =
[ NavbarLeft $ MenuItem
{ menuItemLabel = "Neuer Kurs"
- , menuItemRoute = CourseEditR
- , menuItemAccessCallback = (== Authorized) <$> isAuthorized CourseEditR False
+ , menuItemRoute = CourseNewR
+ , menuItemAccessCallback = (== Authorized) <$> isAuthorized CourseNewR False
}
]
- defaultLinkLayout pageLinks $ do
+ defaultLinkLayout pageActions $ do
-- defaultLayout $ do
setTitle "Semesterkurse"
- linkButton "Neuen Kurs anlegen" BCPrimary CourseEditR
+ linkButton "Neuen Kurs anlegen" BCPrimary CourseNewR
encodeWidgetTable tableDefault colonnadeTerms courses -- (map entityVal courses)
getCourseShowR :: TermId -> Text -> Handler Html
@@ -124,101 +124,107 @@ postCourseShowR tid csh = do
-- redirect or not?! I guess not, since we want GET now
getCourseShowR tid csh
-getCourseEditR :: Handler Html
-getCourseEditR = do
+getCourseNewR :: Handler Html
+getCourseNewR = do
-- TODO: Defaults für Semester hier ermitteln und übergeben
courseEditHandler Nothing
+
+postCourseNewR :: Handler Html
+postCourseNewR = courseEditHandler Nothing
-postCourseEditR :: Handler Html
-postCourseEditR = courseEditHandler Nothing
-
-getCourseEditExistR :: TermId -> Text -> Handler Html
-getCourseEditExistR tid csh = do
+getCourseEditR :: TermId -> Text -> Handler Html
+getCourseEditR tid csh = do
course <- runDB $ getBy $ CourseTermShort tid csh
courseEditHandler course
-getCourseEditExistIDR :: CryptoUUIDCourse -> Handler Html
-getCourseEditExistIDR cID = do
+getCourseEditIDR :: CryptoUUIDCourse -> Handler Html
+getCourseEditIDR cID = do
cIDKey <- getsYesod appCryptoIDKey
courseID <- UUID.decrypt cIDKey cID
courseEditHandler =<< runDB (getEntity courseID)
-
-courseEditHandler :: Maybe (Entity Course) -> Handler Html
-courseEditHandler course = do
- aid <- requireAuthId
- ((result, formWidget), formEnctype) <- runFormPost $ newCourseForm $ courseToForm <$> course
- action <- lookupPostParam "formaction"
- case (result,action) of
- (FormSuccess res, fAct)
- | fAct == formActionDelete
- , Just cid <- cfCourseId res -> do
+
+courseDeleteHandler :: Handler Html -- not called anywhere yet
+courseDeleteHandler = undefined
+{- TODO
+ | False -- DELETE -- TODO: This no longer works that way!!! See new way in Handler.Term.termEditHandler
+ , Just cid <- cfCourseId res -> do
runDB $ deleteCascade cid -- TODO Sicherheitsabfrage einbauen!
let cti = toPathPiece $ cfTerm res
addMessage "info" [shamlet| Kurs #{cti}/#{cfShort res} wurde gelöscht!|]
redirect $ CourseListTermR $ cfTerm res
- | fAct == formActionSave
- , Just cid <- cfCourseId res -> do
- let tid = cfTerm res
- actTime <- liftIO getCurrentTime
- updateokay <- runDB $ do
- exists <- getBy $ CourseTermShort tid $ cfShort res
- let upokay = isNothing exists
- when upokay $ update cid
- [ CourseName =. cfName res
- , CourseDescription =. cfDesc res
- , CourseLinkExternal =. cfLink res
- , CourseShorthand =. cfShort res -- TODO: change here should generate a warning, or only allowed for Admins?!
- , CourseTermId =. tid -- TODO: change here should generate a warning, or only allowed for Admins?!
- , CourseSchoolId =. cfSchool res
- , CourseCapacity =. cfCapacity res
- , CourseRegisterFrom =. cfRegFrom res
- , CourseRegisterTo =. cfRegTo res
- , CourseChangedBy =. aid
- , CourseChanged =. actTime
- ]
- return upokay
- let cti = toPathPiece $ cfTerm res
- if updateokay
- then do
- addMessage "info" [shamlet| Kurs #{cti}/#{cfShort res} wurde geändert. |]
- redirect $ CourseListTermR $ cfTerm res
- else do
- addMessage "danger" [shamlet| Kurs #{cti}/#{cfShort res} konnte nicht geändert werden.
- \ Es gibt bereits einen anderen Kurs mit diesem Kürzel in diesem Semester.|]
- | fAct == formActionSave
- , Nothing <- cfCourseId res -> do
- actTime <- liftIO getCurrentTime
- insertOkay <- runDB $ insertUnique $ 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
- , courseCreated = actTime
- , courseChanged = actTime
- , courseCreatedBy = aid
- , courseChangedBy = aid
- }
- case insertOkay of
- (Just cid) -> do
- runDB $ insert_ $ Lecturer aid cid
- let cti = toPathPiece $ cfTerm res
- addMessage "info" [shamlet|Kurs #{cti}/#{cfShort res} wurde angelegt.|]
- redirect $ CourseListTermR $ cfTerm res
- Nothing -> do
- let cti = toPathPiece $ cfTerm res
- addMessage "danger" [shamlet|Es gibt bereits einen Kurs #{cfShort res} in Semester #{cti}.|]
- (FormFailure _,_) -> addMessage "warning" "Bitte Eingabe korrigieren."
- _other -> return ()
+-}
+
+courseEditHandler :: Maybe (Entity Course) -> Handler Html
+courseEditHandler course = do
+ aid <- requireAuthId -- TODO: Verify that Editor is owner of the Course to be Edited!!!
+ ((result, formWidget), formEnctype) <- runFormPost $ newCourseForm $ courseToForm <$> course
+ case result of
+ (FormSuccess res@(
+ CourseForm { cfCourseId = Nothing
+ , cfShort = csh
+ , cfTerm = tid
+ })) -> do -- create new course
+ let tident = unTermKey tid
+ actTime <- liftIO getCurrentTime
+ insertOkay <- runDB $ insertUnique $ 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
+ , courseCreated = actTime
+ , courseChanged = actTime
+ , courseCreatedBy = aid
+ , courseChangedBy = aid
+ }
+ case insertOkay of
+ (Just cid) -> do
+ runDB $ insert_ $ Lecturer aid cid
+ addMessageI "info" $ MsgCourseNewOk tident csh
+ redirect $ CourseListTermR tid
+ Nothing ->
+ addMessageI "danger" $ MsgCourseNewDupShort tident csh
+
+ (FormSuccess res@(
+ CourseForm { cfCourseId = Just cid
+ , cfShort = csh
+ , cfTerm = tid
+ })) -> do -- edit existing course
+ let tident = unTermKey tid
+ actTime <- liftIO getCurrentTime
+ addMessage "info" [shamlet| #{show res}|]
+ runDB $ do
+ -- existing <- getBy $ CourseTermShort tid csh
+ -- if ((entityKey <$> existing) /= Just cid)
+ -- then addMessageI "danger" $ MsgCourseEditDupShort tident csh
+ -- else do
+ addMessage "info" $ fromMaybe [shamlet|No description given.|] $ cfDesc res
+ update cid
+ [ CourseName =. cfName res
+ , CourseDescription =. cfDesc res
+ , CourseLinkExternal =. cfLink res
+ , CourseShorthand =. cfShort res -- TODO: change here should generate a warning, or only allowed for Admins?!
+ , CourseTermId =. tid -- TODO: change here should generate a warning, or only allowed for Admins?!
+ , CourseSchoolId =. cfSchool res
+ , CourseCapacity =. cfCapacity res
+ , CourseRegisterFrom =. cfRegFrom res
+ , CourseRegisterTo =. cfRegTo res
+ , CourseChangedBy =. aid
+ , CourseChanged =. actTime
+ ]
+ addMessageI "info" $ MsgCourseEditOk tident csh
+ redirect $ CourseListTermR tid
+
+ (FormFailure _) -> addMessageI "warning" MsgInvalidInput
+ other -> addMessage "error" $ [shamlet| Error: #{show other}|]
let formTitle = "Kurs editieren/anlegen" :: Text
- let actionUrl = CourseEditR
- let formActions = defaultFormActions
+ let actionUrl = CourseNewR -- CourseEditR -- TODO
defaultLayout $ do
setTitle [shamlet| #{formTitle} |]
$(widgetFile "formPage")
@@ -282,7 +288,7 @@ newCourseForm template = identForm FIDcourse $ \html -> do
<*> areq checkBoxField (fsb "Anmeldung") (cfHasReg <$> template)
<*> aopt utcTimeField (fsb "Anmeldung von:") (cfRegFrom <$> template)
<*> aopt utcTimeField (fsb "Anmeldung bis:") (cfRegTo <$> template)
- -- <* bootstrapSubmit (bsSubmit (show cid))
+ <* submitButton
return $ case result of
FormSuccess courseResult
| errorMsgs <- validateCourse courseResult
diff --git a/src/Handler/Term.hs b/src/Handler/Term.hs
index e547cabb9..d7b15ad9f 100644
--- a/src/Handler/Term.hs
+++ b/src/Handler/Term.hs
@@ -12,7 +12,7 @@ module Handler.Term where
import Import
import Handler.Utils
-import qualified Data.Text as T
+-- import qualified Data.Text as T
import Yesod.Form.Bootstrap3
import Colonnade hiding (bool)
@@ -67,8 +67,15 @@ getTermShowR = do
, headed "Feiertage im Semester" $ \(Entity _ Term{..},_) ->
fromString $ (intercalate ", ") $ map formatTimeGerWD termHolidays
]
- defaultLayout $ do
- setTitle "Freigeschaltete Semester"
+ let pageActions =
+ [ NavbarLeft $ MenuItem
+ { menuItemLabel = "Neues Semester"
+ , menuItemRoute = TermEditR
+ , menuItemAccessCallback = (== Authorized) <$> isAuthorized TermEditR True
+ }
+ ]
+ defaultLinkLayout pageActions $ do
+ setTitle "Freigeschaltete Semester"
encodeWidgetTable tableDefault colonnadeTerms termData
@@ -98,14 +105,15 @@ termEditHandler term = do
-- let msg = "Semester " `T.append` tid `T.append` " erfolgreich editiert."
-- addMessage "success" [shamlet| #{msg} |]
-- MIT INTERNATIONALISIERUNG:
- addMessageI "success" $ MsgSemesterEdited $ termName res
+ addMessageI "success" $ MsgTermEdited $ termName res
redirect TermShowR
(FormMissing ) -> return ()
- (FormFailure _) -> addMessage "warning" "Bitte Eingabe korrigieren."
+ (FormFailure _) -> addMessageI "warning" MsgInvalidInput
let formTitle = "Semester editieren/anlegen" :: Text
let actionUrl = TermEditR
defaultLayout $ do
setTitle [shamlet| #{formTitle} |]
+ -- setTitle [whamlet| _{MsgTermNewTitle} |] -- TODO, does not work
$(widgetFile "formPage")
newTermForm :: Maybe Term -> Form Term
diff --git a/src/Handler/Utils/Form.hs b/src/Handler/Utils/Form.hs
index 9bfadd553..0bd3ec14c 100644
--- a/src/Handler/Utils/Form.hs
+++ b/src/Handler/Utils/Form.hs
@@ -28,14 +28,14 @@ import qualified Text.Blaze.Internal as Blaze (null)
import Web.PathPieces (showToPathPiece, readFromPathPiece)
------------------------------------------------
--- Unique Form Identifiers to avoid accidents --
+-- Unique Form Identifiers to avoid aSccidents --
------------------------------------------------
data FormIdentifier = FIDcourse | FIDsheet
deriving (Enum, Eq, Ord, Bounded, Read, Show)
-identForm :: FormIdentifier -> Form a -> Form a
+identForm :: FormIdentifier -> Form a -> Form a -- TODO: Still needed?
identForm fid = identifyForm (T.pack $ show fid)
-------------------
@@ -244,6 +244,9 @@ postButtonForm lblId = identifyForm lblId buttonF
natField :: (Monad m, Integral i, RenderMessage (HandlerSite m) FormMessage) => Text -> Field m i
natField d = checkBool (>= 0) (T.append d " muss eine natürliche Zahl sein.") $ intField
+natIntField ::(Monad m, RenderMessage (HandlerSite m) FormMessage) => Text -> Field m Integer
+natIntField = natField
+
posIntField :: (Monad m, Integral i, RenderMessage (HandlerSite m) FormMessage) => Text -> Field m i
posIntField d = checkBool (>= 1) (T.append d " muss eine positive Zahl sein.") $ intField
diff --git a/src/Model/Types.hs b/src/Model/Types.hs
index 23bf23a57..d5966efdf 100644
--- a/src/Model/Types.hs
+++ b/src/Model/Types.hs
@@ -96,6 +96,10 @@ data TermIdentifier = TermIdentifier
, season :: Season
} deriving (Show, Read, Eq, Ord, Generic, Typeable)
+-- Conversion TermId <-> TermIdentifier::
+-- from_TermId_to_TermIdentifier = unTermKey
+-- from_TermIdentifier_to_TermId = TermKey
+
--TODO: Enforce the number of digits within year, with parsing filling in the current leading digits? Goal: short urls
termToText :: TermIdentifier -> Text
termToText TermIdentifier{..} = Text.pack $ seasonToChar season : show year
diff --git a/templates/home.hamlet b/templates/home.hamlet
index 27d174a8b..b8d51f3d9 100644
--- a/templates/home.hamlet
+++ b/templates/home.hamlet
@@ -61,7 +61,7 @@
- Kurse anlegen
+ Kurse anlegen
editieren und anzeigen
@@ -77,6 +77,6 @@
^{btnWdgt}
- Kurse anlegen
+ Kurse anlegen
editieren und anzeigen