Merge branch 'master' of gitlab.cip.ifi.lmu.de:jost/UniWorX into feat/exercises
This commit is contained in:
Gregor Kleen
commit
584d711cbc
@ -1,3 +1,6 @@
|
||||
* Version 10.07.2018
|
||||
Bugfixes, wählbares Format für Datum
|
||||
|
||||
* Version 04.07.2018
|
||||
|
||||
Hinweis eingefügt, dass alle Daten des Systems spätestens im Dezember 2018
|
||||
|
||||
@ -40,7 +40,11 @@ ldap:
|
||||
password: "_env:LDAPPW:"
|
||||
basename: "_env:LDAPBN:"
|
||||
|
||||
userDefaultFavourites: 12
|
||||
default-favourites: 12
|
||||
default-theme: Default
|
||||
default-date-time-format: "%a %d %b %Y %R"
|
||||
default-date-format: "%d.%m.%Y"
|
||||
default-time-format: "%R"
|
||||
|
||||
cryptoid-keyfile: "_env:CRYPTOID_KEYFILE:cryptoid_key.bf"
|
||||
|
||||
|
||||
19
db.hs
19
db.hs
@ -5,6 +5,7 @@
|
||||
{-# LANGUAGE PackageImports #-}
|
||||
{-# LANGUAGE NoImplicitPrelude #-}
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
|
||||
import "uniworx" Import hiding (Option(..))
|
||||
import "uniworx" Application (db, getAppDevSettings)
|
||||
@ -47,7 +48,7 @@ main = do
|
||||
|
||||
fillDb :: DB ()
|
||||
fillDb = do
|
||||
defaultFavourites <- getsYesod $ appDefaultFavourites . appSettings
|
||||
AppSettings{..} <- getsYesod appSettings
|
||||
now <- liftIO getCurrentTime
|
||||
let
|
||||
summer2017 = TermIdentifier 2017 Summer
|
||||
@ -60,7 +61,10 @@ fillDb = do
|
||||
, userEmail = "G.Kleen@campus.lmu.de"
|
||||
, userDisplayName = "Gregor Kleen"
|
||||
, userMaxFavourites = 6
|
||||
, userTheme = AberdeenReds
|
||||
, userTheme = Default
|
||||
, userDateTimeFormat = appDefaultDateTimeFormat
|
||||
, userDateFormat = appDefaultDateFormat
|
||||
, userTimeFormat = appDefaultTimeFormat
|
||||
}
|
||||
fhamann <- insert User
|
||||
{ userPlugin = "LDAP"
|
||||
@ -68,8 +72,11 @@ fillDb = do
|
||||
, userMatrikelnummer = Nothing
|
||||
, userEmail = "felix.hamann@campus.lmu.de"
|
||||
, userDisplayName = "Felix Hamann"
|
||||
, userMaxFavourites = defaultFavourites
|
||||
, userMaxFavourites = appDefaultMaxFavourites
|
||||
, userTheme = Default
|
||||
, userDateTimeFormat = appDefaultDateTimeFormat
|
||||
, userDateFormat = appDefaultDateFormat
|
||||
, userTimeFormat = appDefaultTimeFormat
|
||||
}
|
||||
jost <- insert User
|
||||
{ userPlugin = "LDAP"
|
||||
@ -79,6 +86,9 @@ fillDb = do
|
||||
, userDisplayName = "Steffen Jost"
|
||||
, userMaxFavourites = 14
|
||||
, userTheme = MossGreen
|
||||
, userDateTimeFormat = appDefaultDateTimeFormat
|
||||
, userDateFormat = appDefaultDateFormat
|
||||
, userTimeFormat = appDefaultTimeFormat
|
||||
}
|
||||
void . insert $ User
|
||||
{ userPlugin = "LDAP"
|
||||
@ -88,6 +98,9 @@ fillDb = do
|
||||
, userDisplayName = "Max Musterstudent"
|
||||
, userMaxFavourites = 7
|
||||
, userTheme = AberdeenReds
|
||||
, userDateTimeFormat = appDefaultDateTimeFormat
|
||||
, userDateFormat = appDefaultDateFormat
|
||||
, userTimeFormat = appDefaultTimeFormat
|
||||
}
|
||||
void . insert $ Term
|
||||
{ termName = summer2017
|
||||
|
||||
@ -76,6 +76,7 @@ CorrectionHead tid@TermId courseShortHand@Text sheetName@Text cid@CryptoFileName
|
||||
SubmissionMember g@Int: Mitabgebende(r) ##{display g}
|
||||
SubmissionArchive: Zip-Archiv der Abgabedatei(en)
|
||||
SubmissionFile: Datei zur Abgabe
|
||||
SubmissionFiles: Abgegebene Dateien
|
||||
SubmissionAlreadyExistsFor user@Text: #{user} hat bereits eine Abgabe zu diesem bÜbungsblatt.
|
||||
|
||||
CorrectionsTitle: Zugewiesene Korrekturen
|
||||
@ -195,4 +196,14 @@ NoUpcomingSheetDeadlines: Keine anstehenden Übungsblätter
|
||||
|
||||
AdminFor: Administrator
|
||||
LecturerFor: Dozent
|
||||
UserListTitle: Komprehensive Benutzerliste
|
||||
UserListTitle: Komprehensive Benutzerliste
|
||||
|
||||
DateTimeFormat: Datums- und Uhrzeitformat
|
||||
DateFormat: Datumsformat
|
||||
TimeFormat: Uhrzeitformat
|
||||
|
||||
InvalidDateTimeFormat: Ungültiges Datums- und Zeitformat, JJJJ-MM-TTTHH:MM[:SS] Format erwartet
|
||||
AmbiguousUTCTime: Der angegebene Zeitpunkt lässt sich nicht eindeutig zu UTC konvertieren
|
||||
|
||||
LastEdits: Letzte Änderungen
|
||||
EditedBy name@Text time@Text: Durch #{name} um #{time}
|
||||
9
models
9
models
@ -4,8 +4,11 @@ User json
|
||||
matrikelnummer Text Maybe
|
||||
email Text
|
||||
displayName Text
|
||||
maxFavourites Int default=12
|
||||
theme Theme default='default'
|
||||
maxFavourites Int default=12
|
||||
theme Theme default='Default'
|
||||
dateTimeFormat DateTimeFormat "default='%a %d %b %Y %R'"
|
||||
dateFormat DateTimeFormat "default='%d.%m.%Y'"
|
||||
timeFormat DateTimeFormat "default='%R'"
|
||||
UniqueAuthentication plugin ident
|
||||
UniqueEmail email
|
||||
deriving Show
|
||||
@ -67,7 +70,7 @@ Course
|
||||
registerTo UTCTime Maybe
|
||||
deregisterUntil UTCTime Maybe
|
||||
registerSecret Text Maybe -- Falls ein Passwort erforderlich ist
|
||||
materialFree Bool default=true
|
||||
materialFree Bool
|
||||
CourseTermShort term shorthand
|
||||
CourseEdit
|
||||
user UserId
|
||||
|
||||
@ -83,6 +83,9 @@ dependencies:
|
||||
- MonadRandom
|
||||
- email-validate
|
||||
- scientific
|
||||
- tz
|
||||
- system-locale
|
||||
- th-lift-instances
|
||||
|
||||
# The library contains all of our application code. The executable
|
||||
# defined below is just a thin wrapper.
|
||||
|
||||
4
routes
4
routes
@ -64,10 +64,10 @@
|
||||
/subs SSubsR GET POST
|
||||
/subs/new SubmissionNewR GET POST !timeANDregistered
|
||||
/subs/own SubmissionOwnR GET !free -- just redirect
|
||||
/sub/#CryptoFileNameSubmission SubmissionR !corrector:
|
||||
/sub/#CryptoFileNameSubmission SubmissionR !correctorANDisRead:
|
||||
/ SubShowR GET POST !ownerANDtime !ownerANDisRead
|
||||
/archive/#{ZIPArchiveName SubmissionFileType} SubArchiveR GET !owner
|
||||
/correction CorrectionR GET POST !ownerANDisRead
|
||||
/correction CorrectionR GET POST !corrector !ownerANDisRead
|
||||
!/#SubmissionFileType/*FilePath SubDownloadR GET !owner
|
||||
/correctors SCorrR GET POST
|
||||
!/#SheetFileType/*FilePath SFileR GET !timeANDregistered !timeANDmaterials !corrector
|
||||
|
||||
@ -72,8 +72,8 @@ import System.FilePath
|
||||
|
||||
import Handler.Utils.Templates
|
||||
import Handler.Utils.StudyFeatures
|
||||
import Handler.Utils.DateTime
|
||||
import Control.Lens
|
||||
import Utils
|
||||
import Utils.Lens
|
||||
|
||||
import Data.Aeson
|
||||
@ -88,9 +88,6 @@ import Text.Shakespeare.Text (st)
|
||||
instance DisplayAble TermId where
|
||||
display = termToText . unTermKey
|
||||
|
||||
instance DisplayAble UTCTime where
|
||||
display = pack . formatTimeGerDT2 -- default Time Format to be used: 00.00.00 00:00
|
||||
|
||||
instance (PathPiece b) => DisplayAble (Data.CryptoID.CryptoID a b) where
|
||||
display = toPathPiece -- requires import of Data.CryptoID here
|
||||
-- -- MOVE ABOVE
|
||||
@ -184,6 +181,13 @@ instance RenderMessage UniWorX SheetFileType where
|
||||
SheetMarking -> renderMessage' MsgSheetMarking
|
||||
where renderMessage' = renderMessage foundation ls
|
||||
|
||||
getTimeLocale' :: [Lang] -> TimeLocale
|
||||
getTimeLocale' = $(timeLocaleMap [("de", "de_DE.utf8")])
|
||||
|
||||
appTZ :: TZ
|
||||
appTZ = $(includeSystemTZ "Europe/Berlin")
|
||||
|
||||
|
||||
-- Access Control
|
||||
data AccessPredicate
|
||||
= APPure (Route UniWorX -> Bool -> Reader MsgRenderer AuthResult)
|
||||
@ -600,7 +604,7 @@ instance YesodBreadcrumbs UniWorX where
|
||||
breadcrumb UsersR = return ("Benutzer", Just HomeR)
|
||||
breadcrumb AdminTestR = return ("Test" , Just HomeR)
|
||||
breadcrumb (AdminUserR _) = return ("Users" , Just UsersR)
|
||||
breadcrumb VersionR = return ("Info" , Just HomeR)
|
||||
breadcrumb VersionR = return ("Impressum" , Just HomeR)
|
||||
|
||||
breadcrumb ProfileR = return ("Profile" , Just HomeR)
|
||||
breadcrumb ProfileDataR = return ("Data" , Just ProfileR)
|
||||
@ -999,9 +1003,14 @@ instance YesodAuth UniWorX where
|
||||
userEmail <- maybe (throwError $ ServerError "Could not retrieve user email") return userEmail'
|
||||
userDisplayName <- maybe (throwError $ ServerError "Could not retrieve user name") return userDisplayName'
|
||||
|
||||
AppSettings{..} <- getsYesod appSettings
|
||||
|
||||
let
|
||||
userMaxFavourites = 12 -- TODO: appDefaultFavourites appSettings
|
||||
userTheme = Default -- TODO: appDefaultFavourites appSettings
|
||||
userMaxFavourites = appDefaultMaxFavourites
|
||||
userTheme = appDefaultTheme
|
||||
userDateTimeFormat = appDefaultDateTimeFormat
|
||||
userDateFormat = appDefaultDateFormat
|
||||
userTimeFormat = appDefaultTimeFormat
|
||||
newUser = User{..}
|
||||
userUpdate = [ UserMatrikelnummer =. userMatrikelnummer
|
||||
, UserDisplayName =. userDisplayName
|
||||
|
||||
@ -62,8 +62,8 @@ getTermCourseListR tid = do
|
||||
[ sortable (Just "shorthand") (textCell MsgCourse) $ anchorCell'
|
||||
(\(Entity _ Course{..}, _) -> CourseR courseTerm courseShorthand CShowR)
|
||||
(\(Entity _ Course{..}, _) -> toWidget courseShorthand)
|
||||
, sortable (Just "register-from") (textCell MsgRegisterFrom) $ \(Entity _ Course{..}, _) -> textCell $ display courseRegisterFrom
|
||||
, sortable (Just "register-to") (textCell MsgRegisterTo) $ \(Entity _ Course{..}, _) -> textCell $ display courseRegisterTo
|
||||
, sortable (Just "register-from") (textCell MsgRegisterFrom) $ \(Entity _ Course{..}, _) -> cell $ traverse (formatTime SelFormatDateTime) courseRegisterFrom >>= maybe mempty toWidget
|
||||
, sortable (Just "register-to") (textCell MsgRegisterTo) $ \(Entity _ Course{..}, _) -> cell $ traverse (formatTime SelFormatDateTime) courseRegisterTo >>= maybe mempty toWidget
|
||||
, sortable (Just "members") (textCell MsgCourseMembers) $ \(Entity _ Course{..}, E.Value num) -> textCell $ case courseCapacity of
|
||||
Nothing -> MsgCourseMembersCount num
|
||||
Just max -> MsgCourseMembersCountLimited num max
|
||||
@ -110,6 +110,8 @@ getCShowR tid csh = do
|
||||
let course = entityVal courseEnt
|
||||
(regWidget, regEnctype) <- generateFormPost $ identifyForm "registerBtn" $ registerForm registered $ courseRegisterSecret course
|
||||
registrationOpen <- (==Authorized) <$> isAuthorized (CourseR tid csh CRegisterR) True
|
||||
mRegFrom <- traverse (formatTime SelFormatDateTime) $ courseRegisterFrom course
|
||||
mRegTo <- traverse (formatTime SelFormatDateTime) $ courseRegisterTo course
|
||||
defaultLayout $ do
|
||||
setTitle $ [shamlet| #{toPathPiece tid} - #{csh}|]
|
||||
$(widgetFile "course")
|
||||
|
||||
@ -16,7 +16,7 @@ import Handler.Utils
|
||||
|
||||
import qualified Data.Map as Map
|
||||
|
||||
import Data.Time
|
||||
import Data.Time hiding (formatTime)
|
||||
-- import qualified Data.Text as T
|
||||
-- import Yesod.Form.Bootstrap3
|
||||
|
||||
@ -73,7 +73,7 @@ homeAnonymous = do
|
||||
, sortable (Just "term") (textCell MsgTerm) $ \DBRow{ dbrOutput=(Entity {entityVal = course}) } ->
|
||||
textCell $ display $ courseTerm course
|
||||
, sortable (Just "deadline") (textCell MsgRegisterTo) $ \DBRow{ dbrOutput=(Entity {entityVal = course}) } ->
|
||||
textCell $ display $ courseRegisterTo course
|
||||
cell $ traverse (formatTime SelFormatDateTime) (courseRegisterTo course) >>= maybe mempty toWidget
|
||||
]
|
||||
courseTable <- dbTable def $ DBTable
|
||||
{ dbtSQLQuery = tableData
|
||||
@ -150,7 +150,7 @@ homeUser uid = do
|
||||
, sortable (Just "sheet") (textCell MsgSheet) $ \DBRow{ dbrOutput=(E.Value tid, E.Value csh, E.Value shn, _, _) } ->
|
||||
cell [whamlet|<a href=@{CSheetR tid csh shn SShowR}>#{display shn}|]
|
||||
, sortable (Just "deadline") (textCell MsgDeadline) $ \DBRow{ dbrOutput=(_, _, _, E.Value deadline, _) } ->
|
||||
textCell $ display deadline
|
||||
cell $ formatTime SelFormatDateTime deadline >>= toWidget
|
||||
, sortable (Just "done") (textCell MsgDone) $ \(DBRow{ dbrOutput=(E.Value tid, E.Value csh, E.Value shn, _, E.Value mbsid) }) ->
|
||||
case mbsid of
|
||||
Nothing -> mempty
|
||||
|
||||
@ -22,6 +22,9 @@ import Database.Esqueleto ((^.))
|
||||
data SettingsForm = SettingsForm
|
||||
{ stgMaxFavourties :: Int
|
||||
, stgTheme :: Theme
|
||||
, stgDateTime :: DateTimeFormat
|
||||
, stgDate :: DateTimeFormat
|
||||
, stgTime :: DateTimeFormat
|
||||
}
|
||||
|
||||
makeSettingForm :: Maybe SettingsForm -> Form SettingsForm
|
||||
@ -32,6 +35,9 @@ makeSettingForm template = identForm FIDsettings $ \html -> do
|
||||
(fslpI MsgFavoriten "Anzahl Favoriten") (stgMaxFavourties <$> template)
|
||||
<*> areq (selectFieldList themeList)
|
||||
(fslpI MsgTheme "theme-select" ) (stgTheme <$> template) -- TODO: pass theme-select as id-attribute or similar.
|
||||
<*> areq (selectField $ dateTimeFormatOptions SelFormatDateTime) (fslI MsgDateTimeFormat) (stgDateTime <$> template)
|
||||
<*> areq (selectField $ dateTimeFormatOptions SelFormatDate) (fslI MsgDateFormat) (stgDate <$> template)
|
||||
<*> areq (selectField $ dateTimeFormatOptions SelFormatTime) (fslI MsgTimeFormat) (stgTime <$> template)
|
||||
<* submitButton
|
||||
return (result, widget) -- no validation required here
|
||||
|
||||
@ -43,13 +49,19 @@ getProfileR = do
|
||||
let settingsTemplate = Just $ SettingsForm
|
||||
{ stgMaxFavourties = userMaxFavourites
|
||||
, stgTheme = userTheme
|
||||
, stgDateTime = userDateTimeFormat
|
||||
, stgDate = userDateFormat
|
||||
, stgTime = userTimeFormat
|
||||
}
|
||||
((res,formWidget), formEnctype) <- runFormPost $ makeSettingForm settingsTemplate
|
||||
case res of
|
||||
(FormSuccess SettingsForm{..}) -> do
|
||||
runDB $ do
|
||||
update uid [ UserMaxFavourites =. stgMaxFavourties
|
||||
, UserTheme =. stgTheme
|
||||
update uid [ UserMaxFavourites =. stgMaxFavourties
|
||||
, UserTheme =. stgTheme
|
||||
, UserDateTimeFormat =. stgDateTime
|
||||
, UserDateFormat =. stgDate
|
||||
, UserTimeFormat =. stgTime
|
||||
]
|
||||
when (stgMaxFavourties < userMaxFavourites) $ do
|
||||
-- prune Favourites to user-defined size
|
||||
|
||||
@ -165,8 +165,8 @@ getSheetListR tid csh = do
|
||||
let tid = courseTerm course
|
||||
let colBase = mconcat
|
||||
[ headed "Blatt" $ \(sid,sheet,_) -> simpleLink (toWgt $ sheetName sheet) $ CSheetR tid csh (sheetName sheet) SShowR
|
||||
, headed "Abgabe ab" $ toWgt . formatTimeGerWD . sheetActiveFrom . snd3
|
||||
, headed "Abgabe bis" $ toWgt . formatTimeGerWD . sheetActiveTo . snd3
|
||||
, headed "Abgabe ab" $ \(_,Sheet{..},_) -> formatTime SelFormatDateTime sheetActiveFrom >>= toWidget
|
||||
, headed "Abgabe bis" $ \(_,Sheet{..},_) -> formatTime SelFormatDateTime sheetActiveTo >>= toWidget
|
||||
, headed "Bewertung" $ toWgt . display . sheetType . snd3
|
||||
]
|
||||
let colAdmin = mconcat -- only show edit button for allowed course assistants
|
||||
@ -227,7 +227,7 @@ getSShowR tid csh shn = do
|
||||
SheetExercise -> textCell $ display $ sheetActiveFrom sheet
|
||||
SheetHint -> textCell $ display $ sheetHintFrom sheet
|
||||
SheetSolution -> textCell $ display $ sheetSolutionFrom sheet
|
||||
, sortable (Just "time") "Modifikation" $ \(_,E.Value modified,_) -> stringCell $ formatTimeGerWDT (modified :: UTCTime)
|
||||
, sortable (Just "time") "Modifikation" $ \(_,E.Value modified,_) -> cell $ formatTime SelFormatDateTime (modified :: UTCTime) >>= toWidget
|
||||
]
|
||||
fileTable <- dbTable def $ DBTable
|
||||
{ dbtSQLQuery = fileData
|
||||
@ -249,8 +249,9 @@ getSShowR tid csh shn = do
|
||||
}
|
||||
defaultLayout $ do
|
||||
setTitle $ toHtml $ T.append "Übung " $ sheetName sheet
|
||||
sheetFrom <- formatTime SelFormatDateTime $ sheetActiveFrom sheet
|
||||
sheetTo <- formatTime SelFormatDateTime $ sheetActiveTo sheet
|
||||
$(widgetFile "sheetShow")
|
||||
[whamlet| Under Construction !!! |] -- TODO
|
||||
|
||||
getSFileR :: TermId -> Text -> Text -> SheetFileType -> FilePath -> Handler TypedContent
|
||||
getSFileR tid csh shn typ title = do
|
||||
|
||||
@ -160,7 +160,7 @@ submissionHelper tid csh shn (SubmissionMode mcid) = do
|
||||
E.orderBy [E.desc $ submissionEdit E.^. SubmissionEditTime]
|
||||
E.limit numberOfSubmissionEditDates
|
||||
return $ (user E.^. UserDisplayName, submissionEdit E.^. SubmissionEditTime)
|
||||
let lastEdits = map (bimap E.unValue E.unValue) lastEditValues
|
||||
lastEdits <- forM lastEditValues $ \(E.Value name, E.Value time) -> (name, ) <$> formatTime SelFormatDateTime time
|
||||
return (sheet,buddies,lastEdits)
|
||||
let unpackZips = True -- undefined -- TODO
|
||||
((res,formWidget), formEnctype) <- runFormPost $ makeSubmissionForm msmid unpackZips sheetGrouping $ map E.unValue buddies
|
||||
@ -246,6 +246,8 @@ submissionHelper tid csh shn (SubmissionMode mcid) = do
|
||||
Nothing -> return ()
|
||||
|
||||
actionUrl <- Data.Maybe.fromJust <$> getCurrentRoute
|
||||
maySubmit <- (== Authorized) <$> isAuthorized actionUrl True
|
||||
|
||||
-- Maybe construct a table to display uploaded archive files
|
||||
let colonnadeFiles :: _ -> Colonnade Sortable _ (DBCell (WidgetT UniWorX IO) ())
|
||||
colonnadeFiles cid = mconcat
|
||||
@ -355,7 +357,8 @@ getSubArchiveR tid csh shn cID@CryptoID{..} (ZIPArchiveName sfType) = do
|
||||
|
||||
fileSource' = do
|
||||
fileSource .| Conduit.map entityVal
|
||||
maybe (return ()) (yieldM . ratingFile cID) rating
|
||||
when (sfType == SubmissionCorrected) $
|
||||
maybe (return ()) (yieldM . ratingFile cID) rating
|
||||
|
||||
zipComment = Text.encodeUtf8 . pack $ CI.foldedCase ciphertext
|
||||
|
||||
|
||||
@ -46,19 +46,25 @@ getTermShowR = do
|
||||
anchorCell' (\(Entity tid _, _) -> TermCourseListR tid)
|
||||
(\(Entity tid _, _) -> [whamlet|#{display tid}|])
|
||||
, sortable (Just "lecture-start") (i18nCell MsgLectureStart) $ \(Entity _ Term{..},_) ->
|
||||
stringCell $ formatTimeGerWD termLectureStart
|
||||
cell $ formatTime SelFormatDate termLectureStart >>= toWidget
|
||||
, sortable (Just "lecture-end") "Ende Vorlesungen" $ \(Entity _ Term{..},_) ->
|
||||
stringCell $ formatTimeGerWD termLectureEnd
|
||||
cell $ formatTime SelFormatDate termLectureEnd >>= toWidget
|
||||
, sortable Nothing "Aktiv" $ \(Entity _ Term{..},_) ->
|
||||
textCell $ (bool "" tickmark termActive :: Text)
|
||||
, sortable Nothing "Kurse" $ \(_, E.Value numCourses) ->
|
||||
cell [whamlet|_{MsgNumCourses numCourses}|]
|
||||
, sortable (Just "start") "Semesteranfang" $ \(Entity _ Term{..},_) ->
|
||||
stringCell $ formatTimeGerWD termStart
|
||||
cell $ formatTime SelFormatDate termStart >>= toWidget
|
||||
, sortable (Just "end") "Semesterende" $ \(Entity _ Term{..},_) ->
|
||||
stringCell $ formatTimeGerWD termEnd
|
||||
cell $ formatTime SelFormatDate termEnd >>= toWidget
|
||||
, sortable Nothing "Feiertage im Semester" $ \(Entity _ Term{..},_) ->
|
||||
stringCell $ (intercalate ", ") $ map formatTimeGerWD termHolidays
|
||||
cell $ do
|
||||
termHolidays' <- mapM (formatTime SelFormatDate) termHolidays
|
||||
[whamlet|
|
||||
<ul .list--inline .list--comma-separated>
|
||||
$forall holiday <- termHolidays'
|
||||
<li>#{holiday}
|
||||
|]
|
||||
]
|
||||
-- let adminColonnade =
|
||||
-- [ sortable Nothing "Edit" $ \(Entity tid Term{..},_) -> cell $ do
|
||||
|
||||
@ -34,6 +34,12 @@ getUsersR = do
|
||||
, sortable (Just "display-name") (i18nCell MsgName) $ \DBRow{ dbrOutput = Entity uid User{..} } -> anchorCellM
|
||||
(AdminUserR <$> encrypt uid)
|
||||
(toWidget . display $ userDisplayName)
|
||||
, sortable (Just "matriculation") (i18nCell MsgMatrikelNr) $ \DBRow{ dbrOutput = Entity uid User{..} } -> anchorCellM
|
||||
(AdminUserR <$> encrypt uid)
|
||||
(toWidget . display $ userMatrikelnummer)
|
||||
-- , sortable (Just "last-name") (i18nCell MsgName) $ \DBRow{ dbrOutput = Entity uid User{..} } -> anchorCellM
|
||||
-- (AdminUserR <$> encrypt uid)
|
||||
-- (toWidget . display $ last $ impureNonNull $ words $ userDisplayName)
|
||||
, sortable Nothing (i18nCell MsgAdminFor) $ \DBRow{ dbrOutput = Entity uid _ } -> mempty
|
||||
{ dbCellContents = do
|
||||
schools <- E.select . E.from $ \(school `E.InnerJoin` userAdmin) -> do
|
||||
@ -78,6 +84,12 @@ getUsersR = do
|
||||
[ ( "display-name"
|
||||
, SortColumn $ \user -> user E.^. UserDisplayName
|
||||
)
|
||||
, ( "matriculation"
|
||||
, SortColumn $ \user -> user E.^. UserMatrikelnummer
|
||||
)
|
||||
-- , ( "last-name"
|
||||
-- , SortColumn $ \user -> (last . impureNonNull . words) <$> (user E.^. UserDisplayName)
|
||||
-- )
|
||||
]
|
||||
, dbtFilter = mempty
|
||||
, dbtStyle = def
|
||||
|
||||
@ -1,60 +1,127 @@
|
||||
module Handler.Utils.DateTime where
|
||||
{-# LANGUAGE NoImplicitPrelude
|
||||
, TemplateHaskell
|
||||
, OverloadedStrings
|
||||
, RecordWildCards
|
||||
, TypeFamilies
|
||||
#-}
|
||||
|
||||
import Data.Time
|
||||
module Handler.Utils.DateTime
|
||||
( utcToLocalTime
|
||||
, localTimeToUTC, TZ.LocalToUTCResult(..)
|
||||
, formatTime'
|
||||
, formatTime
|
||||
, getTimeLocale, getDateTimeFormat
|
||||
, validDateTimeFormats, dateTimeFormatOptions
|
||||
) where
|
||||
|
||||
import Import
|
||||
|
||||
germanTimeLocale :: TimeLocale
|
||||
germanTimeLocale = TimeLocale
|
||||
{ wDays = [("Sonntag" ,"So")
|
||||
,("Montag" ,"Mo")
|
||||
,("Dienstag" ,"Di")
|
||||
,("Mittwoch" ,"Mi")
|
||||
,("Donnerstag" ,"Do")
|
||||
,("Freitag" ,"Fr")
|
||||
,("Samstag" ,"Sa")
|
||||
]
|
||||
, months = [("Januar" ,"Jan")
|
||||
,("Februar" ,"Feb")
|
||||
,("März" ,"Mär")
|
||||
,("April" ,"Apr")
|
||||
,("Mai" ,"Mai")
|
||||
,("Juni" ,"Jun")
|
||||
,("Juli" ,"Jul")
|
||||
,("August" ,"Aug")
|
||||
,("September" ,"Sep")
|
||||
,("Oktober" ,"Okt")
|
||||
,("November" ,"Nov")
|
||||
,("Dezember" ,"Dez")
|
||||
]
|
||||
, amPm = ("am","pm")
|
||||
, dateTimeFmt = "%a %e.%m.%y %k:%M"
|
||||
, dateFmt = "%e.%m.%y"
|
||||
, timeFmt = "%k:%M"
|
||||
, time12Fmt = "%H:%M"
|
||||
, knownTimeZones = [] -- TODO?
|
||||
}
|
||||
import Data.Time.Zones hiding (localTimeToUTCFull)
|
||||
import qualified Data.Time.Zones as TZ
|
||||
|
||||
formatTimeGer :: FormatTime t => String -> t -> String
|
||||
formatTimeGer = formatTime germanTimeLocale
|
||||
import Data.Time hiding (formatTime, localTimeToUTC, utcToLocalTime)
|
||||
import qualified Data.Time.Format as Time
|
||||
|
||||
formatTimeGerDTlong :: FormatTime t => t -> String
|
||||
formatTimeGerDTlong = formatTimeGer "%A, %e. %B %Y, %k:%M:%S"
|
||||
import Data.Set (Set)
|
||||
import qualified Data.Set as Set
|
||||
|
||||
formatTimeGerWDT :: FormatTime t => t -> String
|
||||
formatTimeGerWDT = formatTimeGer $ dateTimeFmt germanTimeLocale
|
||||
utcToLocalTime :: UTCTime -> LocalTime
|
||||
utcToLocalTime = TZ.utcToLocalTimeTZ appTZ
|
||||
|
||||
formatTimeGerDT :: FormatTime t => t -> String -- 0.00.00 0:00
|
||||
formatTimeGerDT = formatTimeGer "%e.%m.%y %k:%M" -- leading spaces at start, otherwise 0 padding
|
||||
localTimeToUTC :: LocalTime -> LocalToUTCResult
|
||||
localTimeToUTC = TZ.localTimeToUTCFull appTZ
|
||||
|
||||
-- the following is used by DisplayAble's display:
|
||||
formatTimeGerDT2 :: FormatTime t => t -> String -- Day 00.00.00 00:00
|
||||
formatTimeGerDT2 = formatTimeGer "%a %d.%m.%y %H:%M" -- always padding with 0
|
||||
class FormatTime t => HasLocalTime t where
|
||||
toLocalTime :: t -> LocalTime
|
||||
|
||||
formatTimeGerWD :: FormatTime t => t -> String
|
||||
formatTimeGerWD = formatTimeGer "%a %e.%m.%y"
|
||||
instance HasLocalTime LocalTime where
|
||||
toLocalTime = id
|
||||
|
||||
formatTimeGerD :: FormatTime t => t -> String
|
||||
formatTimeGerD = formatTimeGer $ dateFmt germanTimeLocale
|
||||
instance HasLocalTime Day where
|
||||
toLocalTime d = LocalTime d midnight
|
||||
|
||||
formatTimeGerT :: FormatTime t => t -> String
|
||||
formatTimeGerT = formatTimeGer $ timeFmt germanTimeLocale
|
||||
instance HasLocalTime UTCTime where
|
||||
toLocalTime t = utcToLocalTime t
|
||||
|
||||
formatTime' :: (HasLocalTime t, MonadHandler m, HandlerSite m ~ UniWorX) => String -> t -> m Text
|
||||
formatTime' fmtStr t = fmap fromString $ Time.formatTime <$> getTimeLocale <*> pure fmtStr <*> pure (toLocalTime t)
|
||||
|
||||
-- formatTime :: (FormatTime t, MonadHandler m, HandlerSite m ~ UniWorX, IsString str) => (DateTimeFormat -> String) -> t -> m str
|
||||
-- Restricted type for safety
|
||||
formatTime :: (HasLocalTime t, MonadHandler m, HandlerSite m ~ UniWorX) => SelDateTimeFormat -> t -> m Text
|
||||
formatTime proj t = flip formatTime' t =<< (unDateTimeFormat <$> getDateTimeFormat proj)
|
||||
|
||||
getTimeLocale :: (MonadHandler m, HandlerSite m ~ UniWorX) => m TimeLocale
|
||||
getTimeLocale = getTimeLocale' <$> languages
|
||||
|
||||
getDateTimeFormat :: (MonadHandler m, HandlerSite m ~ UniWorX) => SelDateTimeFormat -> m DateTimeFormat
|
||||
getDateTimeFormat sel = do
|
||||
mauth <- liftHandlerT maybeAuth
|
||||
AppSettings{..} <- getsYesod appSettings
|
||||
let
|
||||
fmt
|
||||
| Just (Entity _ User{..}) <- mauth
|
||||
= case sel of
|
||||
SelFormatDateTime -> userDateTimeFormat
|
||||
SelFormatDate -> userDateFormat
|
||||
SelFormatTime -> userTimeFormat
|
||||
| otherwise
|
||||
= case sel of
|
||||
SelFormatDateTime -> appDefaultDateTimeFormat
|
||||
SelFormatDate -> appDefaultDateFormat
|
||||
SelFormatTime -> appDefaultTimeFormat
|
||||
return fmt
|
||||
|
||||
validDateTimeFormats :: TimeLocale -> SelDateTimeFormat -> Set DateTimeFormat
|
||||
-- ^ We use a whitelist instead of just letting the user specify their own format string since vulnerabilities in printf-like functions are not uncommon
|
||||
validDateTimeFormats _ SelFormatDateTime = Set.fromList $
|
||||
[ DateTimeFormat "%a %d %b %Y %R"
|
||||
, DateTimeFormat "%a %b %d %Y %R"
|
||||
, DateTimeFormat "%A, %d %B %Y %R"
|
||||
, DateTimeFormat "%A, %B %d %Y %R"
|
||||
, DateTimeFormat "%a %d %b %Y %T"
|
||||
, DateTimeFormat "%a %b %d %Y %T"
|
||||
, DateTimeFormat "%A, %d %B %Y %T"
|
||||
, DateTimeFormat "%A, %B %d %Y %T"
|
||||
, DateTimeFormat "%d.%m.%Y %R"
|
||||
, DateTimeFormat "%d.%m.%Y %T"
|
||||
, DateTimeFormat "%R %d.%m.%Y"
|
||||
, DateTimeFormat "%T %d.%m.%Y"
|
||||
, DateTimeFormat "%Y-%m-%d %R"
|
||||
, DateTimeFormat "%Y-%m-%d %T"
|
||||
, DateTimeFormat "%Y-%m-%dT%T"
|
||||
]
|
||||
validDateTimeFormats _ SelFormatDate = Set.fromList $
|
||||
[ DateTimeFormat "%a %d %b %Y"
|
||||
, DateTimeFormat "%a %b %d %Y"
|
||||
, DateTimeFormat "%A, %d %B %Y"
|
||||
, DateTimeFormat "%A, %B %d %Y"
|
||||
, DateTimeFormat "%d.%m.%Y"
|
||||
, DateTimeFormat "%Y-%m-%d"
|
||||
]
|
||||
validDateTimeFormats TimeLocale{..} SelFormatTime = Set.fromList . concat . catMaybes $
|
||||
[ Just
|
||||
[ DateTimeFormat "%R"
|
||||
, DateTimeFormat "%T"
|
||||
]
|
||||
, do
|
||||
guard $ uncurry (/=) amPm
|
||||
Just
|
||||
[ DateTimeFormat "%I:%M %p"
|
||||
, DateTimeFormat "%I:%M %P"
|
||||
, DateTimeFormat "%I:%M:%S %p"
|
||||
, DateTimeFormat "%I:%M:%S %P"
|
||||
]
|
||||
]
|
||||
|
||||
dateTimeFormatOptions :: (MonadHandler m, HandlerSite m ~ UniWorX) => SelDateTimeFormat -> m (OptionList DateTimeFormat)
|
||||
dateTimeFormatOptions sel = do
|
||||
now <- liftIO getCurrentTime
|
||||
tl <- getTimeLocale
|
||||
|
||||
let
|
||||
toOption fmt@DateTimeFormat{..} = do
|
||||
dateTime <- formatTime' unDateTimeFormat now
|
||||
return $ (dateTime, fmt)
|
||||
|
||||
optionsPairs <=< mapM toOption . Set.toList $ validDateTimeFormats tl sel
|
||||
|
||||
@ -17,6 +17,7 @@ import Handler.Utils.Form.Types
|
||||
import Handler.Utils.Templates
|
||||
|
||||
import Handler.Utils.DateTime
|
||||
import qualified Data.Time as Time
|
||||
|
||||
import Import
|
||||
import qualified Data.Char as Char
|
||||
@ -404,15 +405,16 @@ dayTimeField fs mutc = do
|
||||
-}
|
||||
|
||||
|
||||
utcTimeField :: (Monad m, RenderMessage (HandlerSite m) FormMessage) => Field m UTCTime
|
||||
utcTimeField :: (MonadHandler m, HandlerSite m ~ UniWorX) => Field m UTCTime
|
||||
-- StackOverflow: dayToUTC <$> (areq (jqueryDayField def {...}) settings Nothing)
|
||||
-- TODO: Verify whether this is UTC or local time from Browser
|
||||
-- Browser returns LocalTime
|
||||
utcTimeField = Field
|
||||
{ fieldParse = parseHelper $ readTime
|
||||
, fieldView = \theId name attrs val isReq ->
|
||||
{ fieldParse = parseHelperGen $ readTime
|
||||
, fieldView = \theId name attrs val isReq -> do
|
||||
val' <- either id id <$> traverse (formatTime' fieldTimeFormat) val
|
||||
[whamlet|
|
||||
$newline never
|
||||
<input id="#{theId}" name="#{name}" *{attrs} type="datetime-local" :isReq:required value="#{either id showTime val}">
|
||||
<input id="#{theId}" name="#{name}" *{attrs} type="datetime-local" :isReq:required value="#{val'}">
|
||||
|]
|
||||
, fieldEnctype = UrlEncoded
|
||||
}
|
||||
@ -420,15 +422,15 @@ utcTimeField = Field
|
||||
fieldTimeFormat :: String
|
||||
--fieldTimeFormat = "%e.%m.%y %k:%M"
|
||||
fieldTimeFormat = "%Y-%m-%dT%H:%M"
|
||||
|
||||
readTime :: Text -> Either FormMessage UTCTime
|
||||
|
||||
-- `defaultTimeLocale` is okay here, since `fieldTimeFormat` does not contain any
|
||||
readTime :: Text -> Either UniWorXMessage UTCTime
|
||||
readTime t =
|
||||
case parseTimeM True germanTimeLocale fieldTimeFormat (T.unpack t) of
|
||||
(Just time) -> Right time
|
||||
Nothing -> Left $ MsgInvalidEntry $ "Datum/Zeit Format: tt.mm.yy hh:mm " ++ t
|
||||
|
||||
showTime :: UTCTime -> Text
|
||||
showTime = fromString . (formatTime germanTimeLocale fieldTimeFormat)
|
||||
case localTimeToUTC <$> parseTimeM True defaultTimeLocale fieldTimeFormat (T.unpack t) of
|
||||
(Just (LTUUnique time _)) -> Right time
|
||||
(Just (LTUNone time _)) -> Right time -- FIXME: Should this be an error, too?
|
||||
(Just (LTUAmbiguous _ _ _ _)) -> Left MsgAmbiguousUTCTime
|
||||
Nothing -> Left MsgInvalidDateTimeFormat
|
||||
|
||||
|
||||
fsm :: RenderMessage UniWorX msg => msg -> FieldSettings UniWorX -- DEPRECATED
|
||||
|
||||
@ -117,7 +117,7 @@ formatRating cID Rating{ ratingValues = Rating'{..}, ..} = let
|
||||
doc = renderPretty 1 45 $ foldr (<$$>) mempty
|
||||
[ "= Bitte nur Bewertung und Kommentare ändern ="
|
||||
, "============================================="
|
||||
, "========== UniWorx Bewertungsdatei =========="
|
||||
, "========== Uni2work Bewertungsdatei =========="
|
||||
, "======= diese Datei ist UTF8 encodiert ======"
|
||||
, "Informationen zum Übungsblatt:"
|
||||
, indent 2 $ foldr (<$$>) mempty
|
||||
|
||||
@ -3,20 +3,19 @@ module Import.NoFoundation
|
||||
( module Import
|
||||
) where
|
||||
|
||||
import ClassyPrelude.Yesod as Import
|
||||
import Model as Import
|
||||
import Settings as Import
|
||||
import Settings.StaticFiles as Import
|
||||
import Yesod.Auth as Import
|
||||
import Yesod.Core.Types as Import (loggerSet)
|
||||
import Yesod.Default.Config2 as Import
|
||||
import Utils as Import
|
||||
import ClassyPrelude.Yesod as Import hiding (formatTime)
|
||||
import Model as Import
|
||||
import Settings as Import
|
||||
import Settings.StaticFiles as Import
|
||||
import Yesod.Auth as Import
|
||||
import Yesod.Core.Types as Import (loggerSet)
|
||||
import Yesod.Default.Config2 as Import
|
||||
import Utils as Import
|
||||
|
||||
|
||||
import Data.Fixed as Import
|
||||
import Data.Fixed as Import
|
||||
|
||||
import CryptoID as Import
|
||||
import Data.UUID as Import (UUID)
|
||||
import CryptoID as Import
|
||||
import Data.UUID as Import (UUID)
|
||||
|
||||
|
||||
import Text.Lucius as Import
|
||||
import Text.Lucius as Import
|
||||
|
||||
@ -3,7 +3,7 @@
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
{-# LANGUAGE NoImplicitPrelude #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE DeriveGeneric, DeriveDataTypeable #-}
|
||||
{-# LANGUAGE DeriveGeneric, DeriveDataTypeable, GeneralizedNewtypeDeriving #-}
|
||||
{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
|
||||
{-# LANGUAGE ViewPatterns #-}
|
||||
{-- # LANGUAGE ExistentialQuantification #-} -- for DA type
|
||||
@ -285,12 +285,15 @@ instance Default Theme where
|
||||
derivePersistField "Theme"
|
||||
|
||||
|
||||
newtype ZIPArchiveName obj = ZIPArchiveName obj
|
||||
newtype ZIPArchiveName obj = ZIPArchiveName { unZIPArchiveName :: obj }
|
||||
deriving (Show, Read, Eq)
|
||||
|
||||
instance PathPiece obj => PathPiece (ZIPArchiveName obj) where
|
||||
fromPathPiece (map CI.mk . unpack -> s)
|
||||
| Just s' <- stripSuffix (map CI.mk ".zip") s = fromPathPiece . pack $ map CI.original s'
|
||||
| otherwise = Nothing
|
||||
fromPathPiece = fmap ZIPArchiveName . fromPathPiece <=< (stripSuffix `on` CI.foldCase) ".zip"
|
||||
toPathPiece = (<> ".zip") . toPathPiece . unZIPArchiveName
|
||||
|
||||
toPathPiece (ZIPArchiveName obj) = toPathPiece obj <> ".zip"
|
||||
newtype DateTimeFormat = DateTimeFormat { unDateTimeFormat :: String }
|
||||
deriving (Eq, Ord, Read, Show, ToJSON, FromJSON, PersistField, PersistFieldSql)
|
||||
|
||||
data SelDateTimeFormat = SelFormatDateTime | SelFormatDate | SelFormatTime
|
||||
deriving (Eq, Ord, Read, Show, Enum, Bounded)
|
||||
|
||||
@ -24,6 +24,8 @@ import Yesod.Default.Util (WidgetFileSettings,
|
||||
widgetFileNoReload,
|
||||
widgetFileReload)
|
||||
|
||||
import Model
|
||||
|
||||
-- | Runtime settings to configure this application. These settings can be
|
||||
-- loaded from various sources: defaults, environment variables, config files,
|
||||
-- theoretically even a database.
|
||||
@ -59,8 +61,11 @@ data AppSettings = AppSettings
|
||||
, appSkipCombining :: Bool
|
||||
-- ^ Perform no stylesheet/script combining
|
||||
|
||||
, appDefaultFavourites :: Int
|
||||
-- ^ Initial Value for remembered Favourites
|
||||
, appDefaultTheme :: Theme
|
||||
, appDefaultMaxFavourites :: Int
|
||||
, appDefaultDateTimeFormat :: DateTimeFormat
|
||||
, appDefaultDateFormat :: DateTimeFormat
|
||||
, appDefaultTimeFormat :: DateTimeFormat
|
||||
|
||||
-- Example app-specific configuration values.
|
||||
, appCopyright :: Text
|
||||
@ -75,6 +80,7 @@ data AppSettings = AppSettings
|
||||
-- ^ If set authenticate against a local password file
|
||||
, appAllowDeprecated :: Bool
|
||||
-- ^ Indicate if deprecated routes are accessible for everyone
|
||||
|
||||
}
|
||||
|
||||
instance FromJSON AppSettings where
|
||||
@ -101,7 +107,11 @@ instance FromJSON AppSettings where
|
||||
appMutableStatic <- o .:? "mutable-static" .!= defaultDev
|
||||
appSkipCombining <- o .:? "skip-combining" .!= defaultDev
|
||||
|
||||
appDefaultFavourites <- o .: "userDefaultFavourites"
|
||||
appDefaultMaxFavourites <- o .: "default-favourites"
|
||||
appDefaultTheme <- o .: "default-theme"
|
||||
appDefaultDateTimeFormat <- o .: "default-date-time-format"
|
||||
appDefaultDateFormat <- o .: "default-date-format"
|
||||
appDefaultTimeFormat <- o .: "default-time-format"
|
||||
|
||||
appCopyright <- o .: "copyright"
|
||||
appAnalytics <- o .:? "analytics"
|
||||
|
||||
@ -19,6 +19,7 @@ import qualified Data.Char as Char
|
||||
|
||||
import Utils.DB as Utils
|
||||
import Utils.Common as Utils
|
||||
import Utils.DateTime as Utils
|
||||
|
||||
import Text.Blaze (Markup, ToMarkup)
|
||||
|
||||
|
||||
57
src/Utils/DateTime.hs
Normal file
57
src/Utils/DateTime.hs
Normal file
@ -0,0 +1,57 @@
|
||||
{-# LANGUAGE NoImplicitPrelude
|
||||
, TemplateHaskell
|
||||
, QuasiQuotes
|
||||
, StandaloneDeriving
|
||||
, DeriveLift
|
||||
#-}
|
||||
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
||||
|
||||
module Utils.DateTime
|
||||
( timeLocaleMap
|
||||
, TimeLocale(..)
|
||||
, module Data.Time.Zones
|
||||
, module Data.Time.Zones.TH
|
||||
) where
|
||||
|
||||
import ClassyPrelude.Yesod hiding (lift)
|
||||
import System.Locale.Read
|
||||
|
||||
import Data.Time (TimeZone(..), TimeLocale(..))
|
||||
import Data.Time.Zones (TZ)
|
||||
import Data.Time.Zones.TH (includeSystemTZ)
|
||||
|
||||
import Language.Haskell.TH
|
||||
import Language.Haskell.TH.Syntax (Lift(..))
|
||||
import Instances.TH.Lift ()
|
||||
|
||||
deriving instance Lift TimeZone
|
||||
deriving instance Lift TimeLocale
|
||||
|
||||
-- $(timeLocaleMap _) :: [Lang] -> TimeLocale
|
||||
timeLocaleMap :: [(Lang, String)] -- ^ Languages and matching locales, first is taken as default
|
||||
-> ExpQ
|
||||
timeLocaleMap [] = fail "Need at least one (language, locale)-pair"
|
||||
timeLocaleMap extra@((_, defLocale):_) = do
|
||||
localeMap <- newName "localeMap"
|
||||
|
||||
let
|
||||
localeMap' = funD localeMap $ map matchLang extra ++ [reduceLangList, defaultLang]
|
||||
|
||||
defaultLang :: ClauseQ
|
||||
defaultLang =
|
||||
clause [listP []] (normalB $ localeExp defLocale) []
|
||||
|
||||
reduceLangList :: ClauseQ
|
||||
reduceLangList = do
|
||||
ls <- newName "ls"
|
||||
clause [[p|(_ : $(varP ls))|]] (normalB [e|$(varE localeMap) $(varE ls)|]) []
|
||||
|
||||
matchLang :: (Lang, String) -> ClauseQ
|
||||
matchLang (lang, localeStr) = do
|
||||
lang' <- newName "lang"
|
||||
clause [[p|($(varP lang') : _)|]] (guardedB [(,) <$> normalG [e|$(varE lang') == lang|] <*> localeExp localeStr]) []
|
||||
|
||||
localeExp :: String -> ExpQ
|
||||
localeExp = lift <=< runIO . getLocale . Just
|
||||
|
||||
letE [localeMap'] (varE localeMap)
|
||||
@ -3,10 +3,10 @@
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||
{-# LANGUAGE FunctionalDependencies #-}
|
||||
module Utils.Lens where
|
||||
module Utils.Lens ( module Utils.Lens ) where
|
||||
|
||||
import Import.NoFoundation
|
||||
import Control.Lens
|
||||
import Control.Lens as Utils.Lens
|
||||
|
||||
makeClassy_ ''Entity
|
||||
|
||||
|
||||
@ -25,6 +25,10 @@ packages:
|
||||
git: https://github.com/pngwjpgh/encoding.git
|
||||
commit: 67bb87ceff53f0178c988dd4e15eeb2daee92b84
|
||||
extra-dep: true
|
||||
- location:
|
||||
git: https://github.com/pngwjpgh/system-locale.git
|
||||
commit: d803ce3607ac6813ac1a065acb423220f57dab3c
|
||||
extra-dep: true
|
||||
|
||||
extra-deps:
|
||||
- colonnade-1.2.0
|
||||
|
||||
@ -22,13 +22,13 @@
|
||||
#{participants}
|
||||
$maybe capacity <- courseCapacity course
|
||||
\ von #{capacity}
|
||||
$maybe regFrom <- courseRegisterFrom course
|
||||
$maybe regFrom <- mRegFrom
|
||||
<dt .deflist__dt>Anmeldezeitraum
|
||||
<dd .deflist__dd>
|
||||
<div>
|
||||
Ab #{formatTimeGerWD regFrom}
|
||||
$maybe regTo <- courseRegisterTo course
|
||||
\ bis #{formatTimeGerWD regTo}
|
||||
Ab #{regFrom}
|
||||
$maybe regTo <- mRegTo
|
||||
\ bis #{regTo}
|
||||
$if registrationOpen
|
||||
<dt .deflist__dt>
|
||||
<dd .deflist__dd>
|
||||
|
||||
@ -24,6 +24,7 @@
|
||||
box-sizing: border-box;
|
||||
padding: 0;
|
||||
margin: 0;
|
||||
-webkit-font-smoothing: antialiased;
|
||||
}
|
||||
|
||||
body {
|
||||
@ -152,13 +153,16 @@ h4 {
|
||||
|
||||
/* LAYOUT */
|
||||
.main {
|
||||
position: relative;
|
||||
min-height: calc(100vh - var(--header-height));
|
||||
padding: 20px;
|
||||
}
|
||||
|
||||
@media (max-width: 768px) {
|
||||
|
||||
.main {
|
||||
min-height: calc(100vh - var(--header-height-collapsed));
|
||||
padding: 10px;
|
||||
}
|
||||
}
|
||||
|
||||
@ -166,7 +170,6 @@ h4 {
|
||||
position: relative;
|
||||
background-color: white;
|
||||
overflow: hidden;
|
||||
padding-left: 24%;
|
||||
transition: padding-left .2s ease-out;
|
||||
|
||||
> .container {
|
||||
@ -182,42 +185,36 @@ h4 {
|
||||
}
|
||||
}
|
||||
|
||||
@media (max-width: 768px) {
|
||||
.logged-in {
|
||||
.main__content {
|
||||
padding-left: 60px;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
@media (max-width: 425px) {
|
||||
.logged-in {
|
||||
.main__content {
|
||||
padding-left: 0;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
@media (min-width: 769px) {
|
||||
.logged-in {
|
||||
.main__content {
|
||||
padding-left: calc(24% + 30px);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
@media (min-width: 1200px) {
|
||||
|
||||
.main__content {
|
||||
padding-left: 300px;
|
||||
}
|
||||
}
|
||||
|
||||
@media (max-width: 768px) {
|
||||
|
||||
.main__content {
|
||||
padding-left: 50px;
|
||||
}
|
||||
}
|
||||
|
||||
@media (max-width: 425px) {
|
||||
|
||||
.main__content {
|
||||
padding-left: 0;
|
||||
}
|
||||
}
|
||||
|
||||
.main__content-body {
|
||||
padding: 30px 40px 60px;
|
||||
}
|
||||
|
||||
@media (max-width: 768px) {
|
||||
|
||||
.main__content-body {
|
||||
padding: 30px 20px 60px;
|
||||
}
|
||||
}
|
||||
|
||||
@media (max-width: 425px) {
|
||||
|
||||
.main__content-body {
|
||||
padding: 20px 10px 60px;
|
||||
.logged-in {
|
||||
.main__content {
|
||||
padding-left: 320px;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
@ -419,7 +416,7 @@ input[type="button"].btn-info:hover,
|
||||
}
|
||||
|
||||
/* LIST MODIFIERS */
|
||||
.list--inline > li {
|
||||
.list--inline li {
|
||||
display: inline-block;
|
||||
}
|
||||
|
||||
|
||||
@ -1,30 +1,23 @@
|
||||
<div .masthead>
|
||||
<div .container>
|
||||
<div .row>
|
||||
<h1 .header>
|
||||
#{sheetName sheet}
|
||||
<div .container>
|
||||
<div .bs-docs-section>
|
||||
<div .row>
|
||||
<div .col-lg-12>
|
||||
<div .page-header>
|
||||
$maybe descr <- sheetDescription sheet
|
||||
<h2 #description>Hinweise
|
||||
<p> #{descr}
|
||||
|
||||
$maybe descr <- sheetDescription sheet
|
||||
<h2 #description>Hinweise
|
||||
<p> #{descr}
|
||||
<h3>Bewertung
|
||||
<p> #{display $ sheetType sheet}
|
||||
$maybe marking <- sheetMarkingText sheet
|
||||
<p> #{marking}
|
||||
<br>
|
||||
Freigeschaltet ab:
|
||||
\ #{formatTimeGerWD $ sheetActiveFrom sheet}
|
||||
\ Abgabe bis:
|
||||
\ #{formatTimeGerWD $ sheetActiveTo sheet}
|
||||
<h3>Bewertung
|
||||
<p>
|
||||
#{display $ sheetType sheet}
|
||||
|
||||
<div .row>
|
||||
<div .col-lg-12>
|
||||
<h2>Dateien
|
||||
^{fileTable}
|
||||
<hr>
|
||||
$maybe marking <- sheetMarkingText sheet
|
||||
<p>
|
||||
#{marking}
|
||||
|
||||
<p>
|
||||
Freigeschaltet ab
|
||||
#{sheetFrom}
|
||||
|
||||
<p>
|
||||
Abgabe bis
|
||||
#{sheetTo}
|
||||
|
||||
<h2>Dateien
|
||||
^{fileTable}
|
||||
|
||||
@ -43,10 +43,7 @@
|
||||
padding-left: 20px;
|
||||
margin-left: 20px;
|
||||
animation: slide-in-alert .2s ease-out forwards;
|
||||
|
||||
+ .alert:not(.alert--invisible) {
|
||||
margin-top: 20px;
|
||||
}
|
||||
margin-bottom: 20px;
|
||||
|
||||
&:hover {
|
||||
|
||||
@ -100,13 +97,14 @@
|
||||
font-weight: 600;
|
||||
justify-content: flex-end;
|
||||
align-items: center;
|
||||
text-align: left;
|
||||
}
|
||||
|
||||
@media (max-width: 768px) {
|
||||
|
||||
.alert__content {
|
||||
padding: 4px 7px;
|
||||
padding-left: 20px;
|
||||
padding-left: 25px;
|
||||
}
|
||||
}
|
||||
|
||||
@ -190,4 +188,6 @@
|
||||
.alert--invisible {
|
||||
max-height: 0;
|
||||
transform: translateX(120%);
|
||||
margin-bottom: 0;
|
||||
overflow: hidden;
|
||||
}
|
||||
|
||||
@ -59,6 +59,7 @@
|
||||
resetFileLabel();
|
||||
input.classList.add('file-input__input--hidden');
|
||||
input.addEventListener('change', function() {
|
||||
input.dispatchEvent(new Event('input'));
|
||||
if (isMulti) {
|
||||
renderFileList(input.files);
|
||||
}
|
||||
|
||||
@ -1,13 +1,18 @@
|
||||
$maybe cID <- mcid
|
||||
<section style="padding-bottom:1em; margin-bottom:1em; border-bottom:1px solid black;">
|
||||
<section>
|
||||
<h2>
|
||||
<a href=@{CSubmissionR tid csh shn cID (SubArchiveR (ZIPArchiveName SubmissionCorrected))}>Archiv
|
||||
$forall (name,time) <- lastEdits
|
||||
<div>last edited by #{name} at #{formatTimeGerDTlong time}
|
||||
(<a href=@{CSubmissionR tid csh shn cID (SubArchiveR (ZIPArchiveName SubmissionOriginal))}>Original</a>)
|
||||
$if not (null lastEdits)
|
||||
<h3>_{MsgLastEdits}
|
||||
<ul>
|
||||
$forall (name,time) <- lastEdits
|
||||
<li>_{MsgEditedBy name time}
|
||||
$maybe fileTable <- mFileTable
|
||||
<h3>Enthaltene Dateien:
|
||||
<h3>_{MsgSubmissionFiles}
|
||||
^{fileTable}
|
||||
|
||||
<section>
|
||||
<form .form-horizontal method=post action=@{actionUrl} enctype=#{formEnctype}>
|
||||
^{formWidget}
|
||||
$if maySubmit
|
||||
<section>
|
||||
<form .form-horizontal method=post action=@{actionUrl} enctype=#{formEnctype}>
|
||||
^{formWidget}
|
||||
|
||||
@ -9,12 +9,12 @@ $newline never
|
||||
$nothing
|
||||
<tbody>
|
||||
$if null wRows && (dbsEmptyStyle == DBESHeading)
|
||||
<tr>
|
||||
<td colspan=#{show columnCount}>
|
||||
<tr .table__row>
|
||||
<td .table__td colspan=#{show columnCount}>
|
||||
_{dbsEmptyMessage}
|
||||
$else
|
||||
$forall row <- wRows
|
||||
<tr .table__row>
|
||||
$forall widget <- row
|
||||
$# cell/body.hamlet
|
||||
$# cell/body.hamlet
|
||||
^{widget}
|
||||
|
||||
@ -3,27 +3,21 @@
|
||||
|
||||
document.addEventListener('DOMContentLoaded', function DOMContentLoaded() {
|
||||
|
||||
var ASC = 'asc';
|
||||
var DESC = 'desc';
|
||||
|
||||
function setupAsync(wrapper) {
|
||||
|
||||
var table = wrapper.querySelector('#' + #{String $ dbtIdent});
|
||||
var ths = Array.from(table.querySelectorAll('th.sortable'));
|
||||
if (ths) {
|
||||
// attach click handler to each sortable column if any
|
||||
ths.forEach(function(th) {
|
||||
th.addEventListener('click', clickHandler);
|
||||
});
|
||||
}
|
||||
|
||||
var pagination = wrapper.querySelector('#' + #{String $ dbtIdent} + '-pagination');
|
||||
|
||||
ths.forEach(function(th) {
|
||||
th.addEventListener('click', clickHandler);
|
||||
});
|
||||
|
||||
if (pagination) {
|
||||
var paginationLinks = Array.from(pagination.querySelectorAll('.pagination-link'));
|
||||
// attach click handler to pagination links if any
|
||||
paginationLinks.forEach(function(p) {
|
||||
p.addEventListener('click', clickHandler);
|
||||
});
|
||||
Array.from(pagination.querySelectorAll('.pagination-link'))
|
||||
.forEach(function(p) {
|
||||
p.addEventListener('click', clickHandler);
|
||||
});
|
||||
}
|
||||
|
||||
function clickHandler(event) {
|
||||
@ -31,12 +25,20 @@
|
||||
var url = new URL(window.location.origin + window.location.pathname + getClickDestination(this));
|
||||
url.searchParams.set(#{String $ wIdent "table-only"}, 'yes');
|
||||
updateTableFrom(url);
|
||||
|
||||
|
||||
ths.forEach(function(th) {
|
||||
// th.removeEventListener('click', clickHandler);
|
||||
console.log('removed handler from', th);
|
||||
});
|
||||
}
|
||||
|
||||
function getClickDestination(el) {
|
||||
var link = el.querySelector('a');
|
||||
if (!link) { return false; }
|
||||
return link.getAttribute('href');
|
||||
console.log(el);
|
||||
if (!el.querySelector('a')) {
|
||||
return false;
|
||||
}
|
||||
return el.querySelector('a').getAttribute('href');
|
||||
}
|
||||
|
||||
// fetches new sorted table from url with params and replaces contents of current table
|
||||
@ -47,14 +49,19 @@
|
||||
'Accept': 'text/html'
|
||||
}
|
||||
}).then(function(response) {
|
||||
var contentType = response.headers.get("content-type");
|
||||
if (!response.ok) {
|
||||
throw ('Looks like there was a problem fetching ' + url.toString() + '. Status Code: ' + response.status);
|
||||
}
|
||||
return response.text();
|
||||
}).then(function(data) {
|
||||
// remove listeners
|
||||
ths.forEach(function(th) {
|
||||
th.removeEventListener('click', clickHandler);
|
||||
});
|
||||
|
||||
// replace contents of table body
|
||||
wrapper.innerHTML = data;
|
||||
|
||||
// set up async functionality again
|
||||
setupAsync(wrapper);
|
||||
table.querySelector('tbody').innerHTML = data;
|
||||
|
||||
@ -10,6 +10,17 @@
|
||||
Uni2work ist noch nicht abgeschlossen.
|
||||
^{features}
|
||||
|
||||
<p>
|
||||
<h2>
|
||||
Bekannte Bugs
|
||||
<ul>
|
||||
<li>
|
||||
Umlaute in Benutzernamen werden durch externes LDAP-Plugin entfernt
|
||||
<li>
|
||||
Auswahlbox "alle markieren" fehlt noch
|
||||
<li>
|
||||
Tabellen über mehrere Seiten müssen vor Seitenwechsel manuell sortiert werden
|
||||
|
||||
<p>
|
||||
<h2>
|
||||
Versionsgeschichte
|
||||
|
||||
@ -8,6 +8,7 @@
|
||||
function init() {
|
||||
var favoritesBtn = document.querySelector('.navbar__list-item--favorite');
|
||||
favoritesBtn.addEventListener('click', function(event) {
|
||||
favoritesBtn.classList.toggle('navbar__list-item--active');
|
||||
asideEl.classList.toggle('main__aside--expanded');
|
||||
event.preventDefault();
|
||||
}, true);
|
||||
@ -19,21 +20,6 @@
|
||||
document.addEventListener('DOMContentLoaded', function() {
|
||||
|
||||
var asidenavEl = document.querySelector('.main__aside');
|
||||
var mainContentEl = document.querySelector('.main__content');
|
||||
|
||||
function adjustHeight() {
|
||||
window.requestAnimationFrame(function() {
|
||||
asidenavEl.style.height = mainContentEl.clientHeight + 'px';
|
||||
});
|
||||
}
|
||||
|
||||
// unbeknownst to the user (below the fold), this happes slightly delayed
|
||||
// because of dynamic changes to the styles inside the main__content
|
||||
setTimeout(function() {
|
||||
adjustHeight();
|
||||
}, 10);
|
||||
|
||||
window.addEventListener('resize', adjustHeight);
|
||||
|
||||
window.utils.aside(asidenavEl);
|
||||
|
||||
|
||||
@ -1,12 +1,22 @@
|
||||
.main__aside {
|
||||
position: absolute;
|
||||
display: none;
|
||||
background-color: var(--color-dark);
|
||||
box-shadow: 0 0 10px rgba(0, 0, 0, 0.3);
|
||||
z-index: 1;
|
||||
top: 0;
|
||||
left: 0;
|
||||
flex: 0 0 300px;
|
||||
min-height: calc(100% - var(--header-height));
|
||||
transition: all .2s ease-out;
|
||||
width: 24%;
|
||||
height: 100%;
|
||||
}
|
||||
|
||||
.logged-in {
|
||||
.main__aside {
|
||||
display: block;
|
||||
}
|
||||
}
|
||||
|
||||
/* maximum width of 300px for wide screens */
|
||||
@ -168,7 +178,6 @@
|
||||
color: var(--color-font);
|
||||
transform: translateX(0);
|
||||
opacity: 0;
|
||||
transition: all .2s ease-out;
|
||||
width: 0;
|
||||
overflow: hidden;
|
||||
z-index: -1;
|
||||
|
||||
@ -1,26 +1,9 @@
|
||||
.breadcrumbs__container {
|
||||
position: relative;
|
||||
color: var(--color-font);
|
||||
margin-left: 40px;
|
||||
margin-top: 25px;
|
||||
margin-bottom: 10px;
|
||||
}
|
||||
|
||||
@media (max-width: 768px) {
|
||||
|
||||
.breadcrumbs__container {
|
||||
margin-left: 20px;
|
||||
}
|
||||
}
|
||||
|
||||
@media (max-width: 425px) {
|
||||
|
||||
.breadcrumbs__container {
|
||||
margin-left: 10px;
|
||||
margin-top: 10px;
|
||||
}
|
||||
}
|
||||
|
||||
.breadcrumbs__link {
|
||||
|
||||
&:hover {
|
||||
|
||||
@ -56,7 +56,6 @@
|
||||
min-width: 70px;
|
||||
height: calc(100% - 4px);
|
||||
padding: 0 6px 4px;
|
||||
box-shadow: 0 0 0 1px inset var(--color-lmu-box-border);
|
||||
}
|
||||
|
||||
&::after {
|
||||
@ -70,7 +69,14 @@
|
||||
width: 100%;
|
||||
height: calc(100% - 4px);
|
||||
padding: 0 6px 4px;
|
||||
box-shadow: 0 0 0 1px inset var(--color-lmu-box-border);
|
||||
}
|
||||
}
|
||||
|
||||
@media (min-width: 769px) {
|
||||
|
||||
.navbar__logo::before,
|
||||
.navbar__logo::after {
|
||||
border: 1px solid var(--color-lmu-box-border);
|
||||
}
|
||||
}
|
||||
|
||||
@ -114,7 +120,10 @@
|
||||
min-width: 90px;
|
||||
color: var(--color-lightwhite);
|
||||
transition: height .2s cubic-bezier(0.03, 0.43, 0.58, 1);
|
||||
box-shadow: 0 0 0 1px inset var(--color-lmu-box-border);
|
||||
|
||||
&:hover {
|
||||
color: var(--color-lightwhite);
|
||||
}
|
||||
}
|
||||
|
||||
.navbar__link-label {
|
||||
@ -123,6 +132,13 @@
|
||||
text-transform: uppercase;
|
||||
}
|
||||
|
||||
@media (min-width: 769px) {
|
||||
|
||||
.navbar__link-wrapper {
|
||||
border: 1px solid var(--color-lmu-box-border);
|
||||
}
|
||||
}
|
||||
|
||||
@media (max-width: 768px) {
|
||||
|
||||
.navbar__link-wrapper {
|
||||
@ -217,20 +233,33 @@
|
||||
}
|
||||
}
|
||||
|
||||
/* "Favorites" list item, only visible on small screens */
|
||||
.navbar__list {
|
||||
|
||||
.navbar__list-item--favorite {
|
||||
/* "Favorites" list item, only visible on small screens and logged in */
|
||||
.navbar__list-item {
|
||||
&.navbar__list-item--favorite {
|
||||
display: none;
|
||||
background-color: var(--color-primary);
|
||||
}
|
||||
}
|
||||
.navbar__list-item--favorite {
|
||||
display: none;
|
||||
background-color: var(--color-primary);
|
||||
}
|
||||
|
||||
.logged-in {
|
||||
.navbar__list {
|
||||
li.navbar__list-item--favorite,
|
||||
.navbar__list-item--favorite {
|
||||
display: inline-block;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
@media (max-width: 425px) {
|
||||
@media (min-width: 426px) {
|
||||
|
||||
.navbar__list {
|
||||
.navbar__list-item--favorite {
|
||||
display: inline-block;
|
||||
.logged-in {
|
||||
.navbar__list {
|
||||
.navbar__list-item--favorite {
|
||||
display: none !important;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
@ -241,7 +270,15 @@
|
||||
|
||||
.navbar__link-wrapper {
|
||||
color: var(--color-grey);
|
||||
box-shadow: 0 0 0 1px inset var(--color-grey);
|
||||
}
|
||||
}
|
||||
|
||||
@media (min-width: 769px) {
|
||||
|
||||
.navbar__list-item--secondary {
|
||||
.navbar__link-wrapper {
|
||||
border: 1px solid var(--color-grey);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user