i18n MenuItems & Semantic support-referer

Addresses #228
This commit is contained in:
Gregor Kleen 2018-11-09 22:43:45 +01:00
parent b9afc667fe
commit 7bf3a52599
11 changed files with 352 additions and 202 deletions

View File

@ -483,4 +483,36 @@ ErrMsgInvalidBase64 base64Err@String: Verschlüsselte Daten nicht korrekt base64
ErrMsgCouldNotDecodeNonce: Konnte secretbox-nonce nicht dekodieren
ErrMsgCouldNotOpenSecretbox: Konnte libsodium-secretbox nicht öffnen (Verschlüsselte Daten sind nicht authentisch)
ErrMsgCouldNotDecodePlaintext utf8Err@Text: Konnte Klartext nicht UTF8-dekodieren: #{utf8Err}
ErrMsgHeading: Fehlermeldung entschlüsseln
ErrMsgHeading: Fehlermeldung entschlüsseln
InvalidRoute: Konnte URL nicht interpretieren
MenuHome: Aktuell
MenuVersion: Impressum
MenuHelp: Hilfe
MenuProfile: Anpassen
MenuLogin: Login
MenuLogout: Logout
MenuCourseList: Kurse
MenuTermShow: Semester
MenuCorrection: Korrektur
MenuUsers: Benutzer
MenuAdminTest: Admin-Demo
MenuMessageList: Systemnachrichten
MenuAdminErrMsg: Fehlermeldung entschlüsseln
MenuProfileData: Persönliche Daten
MenuTermCreate: Neues Semester anlegen
MenuCourseNew: Neuen Kurs anlegen
MenuTermEdit: Semester editieren
MenuSheetList: Übungsblätter
MenuCorrections: Abgaben
MenuSheetNew: Neues Übungsblatt anlegen
MenuCourseEdit: Kurs editieren
MenuCourseNewTemplate: Als neuen Kurs klonen
MenuSubmissionNew: Abgabe anlegen
MenuSubmissionOwn: Abgabe
MenuCorrectors: Korrektoren
MenuSheetEdit: Übungsblatt editieren
MenuCorrectionsUpload: Korrekturen hochladen
MenuCorrectionsCreate: Abgaben registrieren
MenuCorrectionsGrade: Abgaben bewerten

View File

@ -146,28 +146,6 @@ pattern CSubmissionR :: TermId -> SchoolId -> CourseShorthand -> SheetName -> Cr
pattern CSubmissionR tid ssh csh shn cid ptn
= CSheetR tid ssh csh shn (SubmissionR cid ptn)
-- Menus and Favourites
data MenuItem = MenuItem
{ menuItemLabel :: Text
, menuItemIcon :: Maybe Text -- currently from: https://fontawesome.com/icons?d=gallery
, menuItemRoute :: Route UniWorX
, menuItemAccessCallback' :: Handler Bool -- Check whether action is shown in ADDITION to authorization (which is always checked)
, menuItemModal :: Bool
}
menuItemAccessCallback :: MenuItem -> Handler Bool
menuItemAccessCallback MenuItem{..} = (&&) <$> ((==) Authorized <$> authCheck) <*> menuItemAccessCallback'
where
authCheck = handleAny (\_ -> return . Unauthorized $ error "authCheck caught exception") $ isAuthorized menuItemRoute False
data MenuTypes -- Semantische Rolle:
= NavbarAside { menuItem :: MenuItem } -- TODO
| NavbarExtra { menuItem :: MenuItem } -- TODO
| NavbarRight { menuItem :: MenuItem } -- Generell, nahezu immer sichtbar
| NavbarSecondary { menuItem :: MenuItem } -- Generell, nahezu immer sichtbar
| PageActionPrime { menuItem :: MenuItem } -- Seitenspezifische Aktion, häufig
| PageActionSecondary { menuItem :: MenuItem } -- Seitenspezifische Aktion, selten (nicht im MouseOver enthalten, immer hinten gelistet)
-- Messages
mkMessage "UniWorX" "messages/uniworx" "de"
mkMessageVariant "UniWorX" "Campus" "messages/campus" "de"
@ -238,6 +216,51 @@ newtype ErrorResponseTitle = ErrorResponseTitle ErrorResponse
embedRenderMessageVariant ''UniWorX ''ErrorResponseTitle ("ErrorResponseTitle" <>)
-- Menus and Favourites
data MenuType = NavbarAside | NavbarRight | NavbarSecondary | PageActionPrime | PageActionSecondary
deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic)
class RedirectUrl site url => HasRoute site url where
urlRoute :: url -> Route site
instance HasRoute site (Route site) where
urlRoute = id
instance (key ~ Text, val ~ Text) => HasRoute site (Route site, Map key val) where
urlRoute = view _1
instance (key ~ Text, val ~ Text) => HasRoute site (Route site, [(key, val)]) where
urlRoute = view _1
instance (HasRoute site a, PathPiece b) => HasRoute site (Fragment a b) where
urlRoute (a :#: _) = urlRoute a
data SomeRoute site = forall url. HasRoute site url => SomeRoute url
instance RedirectUrl site (SomeRoute site) where
toTextUrl (SomeRoute url) = toTextUrl url
instance HasRoute site (SomeRoute site) where
urlRoute (SomeRoute url) = urlRoute url
data MenuItem = MenuItem
{ menuItemLabel :: UniWorXMessage
, menuItemIcon :: Maybe Text -- currently from: https://fontawesome.com/icons?d=gallery
, menuItemRoute :: SomeRoute UniWorX
, menuItemAccessCallback' :: Handler Bool -- Check whether action is shown in ADDITION to authorization (which is always checked)
, menuItemModal :: Bool
, menuItemType :: MenuType
}
instance RedirectUrl UniWorX MenuItem where
toTextUrl MenuItem{..} = toTextUrl menuItemRoute
instance HasRoute UniWorX MenuItem where
urlRoute MenuItem{..} = urlRoute menuItemRoute
menuItemAccessCallback :: MenuItem -> Handler Bool
menuItemAccessCallback MenuItem{..} = (&&) <$> ((==) Authorized <$> authCheck) <*> menuItemAccessCallback'
where
authCheck = handleAny (\_ -> return . Unauthorized $ error "authCheck caught exception") $ isAuthorized (urlRoute menuItemRoute) False
$(return [])
data instance ButtonCssClass UniWorX = BCDefault | BCPrimary | BCSuccess | BCInfo | BCWarning | BCDanger | BCLink
deriving (Enum, Eq, Ord, Bounded, Read, Show)
@ -702,7 +725,6 @@ siteLayout headingOverride widget = do
let AppSettings { appUserDefaults = UserDefaultConf{..}, .. } = appSettings master
isModal <- isJust <$> siteModalId
$logDebugS "siteLayout" $ "isModal = " <> tshow isModal
mmsgs <- if
| isModal -> return []
@ -718,9 +740,11 @@ siteLayout headingOverride widget = do
-- let isParent :: Route UniWorX -> Bool
-- isParent r = r == (fst parents)
let menu = defaultLinks ++ maybe [] pageActions mcurrentRoute
defaultLinks' <- defaultLinks
let menu :: [MenuItem]
menu = defaultLinks' ++ maybe [] pageActions mcurrentRoute
menuTypes <- mapM (\x -> (x, ) <$> newIdent) =<< filterM (menuItemAccessCallback . menuItem) menu
menuTypes <- mapM (\x -> (,,) <$> pure x <*> newIdent <*> toTextUrl x) =<< filterM menuItemAccessCallback menu
isAuth <- isJust <$> maybeAuthId
@ -737,18 +761,20 @@ siteLayout headingOverride widget = do
return course
return (favs, userTheme user)
favourites <- forM favourites' $ \(Entity _ c@Course{..})
-> let
courseRoute = CourseR courseTerm courseSchool courseShorthand CShowR
in (c, courseRoute, ) <$> filterM (menuItemAccessCallback . menuItem) (pageActions courseRoute)
-> let courseRoute = CourseR courseTerm courseSchool courseShorthand CShowR
in do
items <- filterM menuItemAccessCallback (pageActions courseRoute)
items' <- forM items $ \i -> (i, ) <$> toTextUrl i
return (c, courseRoute, items')
let highlight :: Route UniWorX -> Bool -- highlight last route in breadcrumbs, favorites taking priority
highlight = let crumbs = mcons mcurrentRoute $ fst <$> reverse parents
navItems = map snd3 favourites ++ map (menuItemRoute . menuItem . fst) menuTypes
navItems = map snd3 favourites ++ map (urlRoute . menuItemRoute . view _1) menuTypes
highR = find (`elem` navItems) . uncurry (++) $ partition (`elem` map snd3 favourites) crumbs
in \r -> Just r == highR
favouriteTerms :: [TermIdentifier]
favouriteTerms = Set.toDescList $ foldMap (\(Course{..}, _, _) -> Set.singleton $ unTermKey courseTerm) favourites
favouriteTerm :: TermIdentifier -> [(Course, Route UniWorX, [MenuTypes])]
favouriteTerm :: TermIdentifier -> [(Course, Route UniWorX, [(MenuItem, Text)])]
favouriteTerm tid = filter (\(Course{..}, _, _) -> unTermKey courseTerm == tid) favourites
-- We break up the default layout into two components:
@ -770,12 +796,12 @@ siteLayout headingOverride widget = do
pageactionprime :: Widget
pageactionprime = $(widgetFile "widgets/pageactionprime") -- TODO: rename, since it also shows secondary pageActions now
-- functions to determine if there are page-actions (primary or secondary)
isPageActionPrime :: MenuTypes -> Bool
isPageActionPrime (PageActionPrime _) = True
isPageActionPrime (PageActionSecondary _) = True
isPageActionPrime _ = False
isPageAction :: MenuType -> Bool
isPageAction PageActionPrime = True
isPageAction PageActionSecondary = True
isPageAction _ = False
hasPageActions :: Bool
hasPageActions = any (isPageActionPrime . fst) menuTypes
hasPageActions = any (isPageAction . menuItemType . view _1) menuTypes
pc <- widgetToPageContent $ do
addStylesheetRemote "https://fonts.googleapis.com/css?family=Source+Sans+Pro:300,400,600,800,900|Roboto:300,400,600"
@ -892,82 +918,95 @@ submissionList tid csh shn uid = E.select . E.from $ \(course `E.InnerJoin` shee
defaultLinks :: [MenuTypes]
defaultLinks = -- Define the menu items of the header.
[ NavbarAside $ MenuItem
{ menuItemLabel = "Home"
defaultLinks :: (MonadHandler m, HandlerSite m ~ UniWorX) => m [MenuItem]
defaultLinks = fmap catMaybes . mapM runMaybeT $ -- Define the menu items of the header.
[ return MenuItem
{ menuItemType = NavbarAside
, menuItemLabel = MsgMenuHome
, menuItemIcon = Just "home"
, menuItemRoute = HomeR
, menuItemRoute = SomeRoute HomeR
, menuItemModal = False
, menuItemAccessCallback' = return True
}
, NavbarRight $ MenuItem
{ menuItemLabel = "Impressum"
, return MenuItem
{ menuItemType = NavbarRight
, menuItemLabel = MsgMenuVersion
, menuItemIcon = Just "book"
, menuItemRoute = VersionR
, menuItemRoute = SomeRoute VersionR
, menuItemModal = False
, menuItemAccessCallback' = return True
}
, NavbarRight $ MenuItem
{ menuItemLabel = "Hilfe"
, menuItemIcon = Just "question"
, menuItemRoute = HelpR
, menuItemModal = True -- TODO: Does not work yet, issue #212
, menuItemAccessCallback' = return True
}
, NavbarRight $ MenuItem
{ menuItemLabel = "Anpassen"
, do
mCurrentRoute <- getCurrentRoute
return MenuItem
{ menuItemType = NavbarRight
, menuItemLabel = MsgMenuHelp
, menuItemIcon = Just "question"
, menuItemRoute = SomeRoute (HelpR, catMaybes [("site", ) . toPathPiece <$> mCurrentRoute])
, menuItemModal = True
, menuItemAccessCallback' = return True
}
, return MenuItem
{ menuItemType = NavbarRight
, menuItemLabel = MsgMenuProfile
, menuItemIcon = Just "cogs"
, menuItemRoute = ProfileR
, menuItemRoute = SomeRoute ProfileR
, menuItemModal = False
, menuItemAccessCallback' = isJust <$> maybeAuthPair
}
, NavbarSecondary $ MenuItem
{ menuItemLabel = "Login"
, return MenuItem
{ menuItemType = NavbarSecondary
, menuItemLabel = MsgMenuLogin
, menuItemIcon = Just "sign-in-alt"
, menuItemRoute = AuthR LoginR
, menuItemModal = True -- TODO: Does not work yet, issue #212
, menuItemRoute = SomeRoute $ AuthR LoginR
, menuItemModal = True
, menuItemAccessCallback' = isNothing <$> maybeAuthPair
}
, NavbarSecondary $ MenuItem
{ menuItemLabel = "Logout"
, return MenuItem
{ menuItemType = NavbarSecondary
, menuItemLabel = MsgMenuLogout
, menuItemIcon = Just "sign-out-alt"
, menuItemRoute = AuthR LogoutR
, menuItemRoute = SomeRoute $ AuthR LogoutR
, menuItemModal = False
, menuItemAccessCallback' = isJust <$> maybeAuthPair
}
, NavbarAside $ MenuItem
{ menuItemLabel = "Kurse"
, return MenuItem
{ menuItemType = NavbarAside
, menuItemLabel = MsgMenuCourseList
, menuItemIcon = Just "calendar-alt"
, menuItemRoute = CourseListR
, menuItemRoute = SomeRoute CourseListR
, menuItemModal = False
, menuItemAccessCallback' = return True
}
, NavbarAside $ MenuItem
{ menuItemLabel = "Semester"
, return MenuItem
{ menuItemType = NavbarAside
, menuItemLabel = MsgMenuTermShow
, menuItemIcon = Just "graduation-cap"
, menuItemRoute = TermShowR
, menuItemRoute = SomeRoute TermShowR
, menuItemModal = False
, menuItemAccessCallback' = return True
}
, NavbarAside $ MenuItem
{ menuItemLabel = "Korrektur"
, return MenuItem
{ menuItemType = NavbarAside
, menuItemLabel = MsgMenuCorrections
, menuItemIcon = Just "check"
, menuItemRoute = CorrectionsR
, menuItemRoute = SomeRoute CorrectionsR
, menuItemModal = False
, menuItemAccessCallback' = return True
}
, NavbarAside $ MenuItem
{ menuItemLabel = "Benutzer"
, return MenuItem
{ menuItemType = NavbarAside
, menuItemLabel = MsgMenuUsers
, menuItemIcon = Just "users"
, menuItemRoute = UsersR
, menuItemRoute = SomeRoute UsersR
, menuItemModal = False
, menuItemAccessCallback' = return True -- Creates a LOOP: (Authorized ==) <$> isAuthorized UsersR False
}
]
pageActions :: Route UniWorX -> [MenuTypes]
pageActions :: Route UniWorX -> [MenuItem]
{-
Icons: https://fontawesome.com/icons?d=gallery
Guideline: use icons without boxes/frames, only non-pro
@ -983,76 +1022,85 @@ pageActions (HomeR) =
-- , menuItemAccessCallback' = return True
-- }
-- ,
PageActionPrime $ MenuItem
{ menuItemLabel = "Admin-Demo"
MenuItem
{ menuItemType = PageActionPrime
, menuItemLabel = MsgMenuAdminTest
, menuItemIcon = Just "screwdriver"
, menuItemRoute = AdminTestR
, menuItemRoute = SomeRoute AdminTestR
, menuItemModal = False
, menuItemAccessCallback' = return True
}
, PageActionPrime $ MenuItem
{ menuItemLabel = "System-Nachrichten"
, MenuItem
{ menuItemType = PageActionPrime
, menuItemLabel = MsgMenuMessageList
, menuItemIcon = Nothing
, menuItemRoute = MessageListR
, menuItemRoute = SomeRoute MessageListR
, menuItemModal = False
, menuItemAccessCallback' = return True
}
, PageActionPrime $ MenuItem
{ menuItemLabel = "Fehlermeldung entschlüsseln"
, MenuItem
{ menuItemType = PageActionPrime
, menuItemLabel = MsgMenuAdminErrMsg
, menuItemIcon = Nothing
, menuItemRoute = AdminErrMsgR
, menuItemRoute = SomeRoute AdminErrMsgR
, menuItemModal = False
, menuItemAccessCallback' = return True
}
]
pageActions (ProfileR) =
[ PageActionPrime $ MenuItem
{ menuItemLabel = "Gespeicherte Daten"
[ MenuItem
{ menuItemType = PageActionPrime
, menuItemLabel = MsgMenuProfileData
, menuItemIcon = Just "book"
, menuItemRoute = ProfileDataR
, menuItemRoute = SomeRoute ProfileDataR
, menuItemModal = False
, menuItemAccessCallback' = return True
}
]
pageActions TermShowR =
[ PageActionPrime $ MenuItem
{ menuItemLabel = "Neues Semester anlegen"
[ MenuItem
{ menuItemType = PageActionPrime
, menuItemLabel = MsgMenuTermCreate
, menuItemIcon = Nothing
, menuItemRoute = TermEditR
, menuItemRoute = SomeRoute TermEditR
, menuItemModal = False
, menuItemAccessCallback' = return True
}
]
pageActions (TermCourseListR tid) =
[ PageActionPrime $ MenuItem
{ menuItemLabel = "Neuen Kurs anlegen"
[ MenuItem
{ menuItemType = PageActionPrime
, menuItemLabel = MsgMenuCourseNew
, menuItemIcon = Just "book"
, menuItemRoute = CourseNewR
, menuItemRoute = SomeRoute CourseNewR
, menuItemModal = False
, menuItemAccessCallback' = return True
}
, PageActionPrime $ MenuItem
{ menuItemLabel = "Semster editieren"
, MenuItem
{ menuItemType = PageActionPrime
, menuItemLabel = MsgMenuTermEdit
, menuItemIcon = Nothing
, menuItemRoute = TermEditExistR tid
, menuItemRoute = SomeRoute $ TermEditExistR tid
, menuItemModal = False
, menuItemAccessCallback' = return True
}
]
pageActions (CourseListR) =
[ PageActionPrime $ MenuItem
{ menuItemLabel = "Neuen Kurs anlegen"
[ MenuItem
{ menuItemType = PageActionPrime
, menuItemLabel = MsgMenuCourseNew
, menuItemIcon = Just "book"
, menuItemRoute = CourseNewR
, menuItemRoute = SomeRoute CourseNewR
, menuItemModal = False
, menuItemAccessCallback' = return True
}
]
pageActions (CourseR tid ssh csh CShowR) =
[ PageActionPrime $ MenuItem
{ menuItemLabel = "Übungsblätter"
[ MenuItem
{ menuItemType = PageActionPrime
, menuItemLabel = MsgMenuSheetList
, menuItemIcon = Nothing
, menuItemRoute = CourseR tid ssh csh SheetListR
, menuItemRoute = SomeRoute $ CourseR tid ssh csh SheetListR
, menuItemModal = False
, menuItemAccessCallback' = do --TODO always show for lecturer
let sheetRouteAccess shn = (== Authorized) <$> (isAuthorized (CSheetR tid ssh csh shn SShowR) False)
@ -1066,49 +1114,55 @@ pageActions (CourseR tid ssh csh CShowR) =
return (sheets,lecturer)
or2M (return lecturer) $ anyM sheets sheetRouteAccess
}
, PageActionPrime $ MenuItem
{ menuItemLabel = "Abgaben"
, MenuItem
{ menuItemType = PageActionPrime
, menuItemLabel = MsgMenuCorrections
, menuItemIcon = Nothing
, menuItemRoute = CourseR tid ssh csh CCorrectionsR
, menuItemRoute = SomeRoute $ CourseR tid ssh csh CCorrectionsR
, menuItemModal = False
, menuItemAccessCallback' = return True
}
, PageActionPrime $ MenuItem
{ menuItemLabel = "Neues Übungsblatt anlegen"
, MenuItem
{ menuItemType = PageActionPrime
, menuItemLabel = MsgMenuSheetNew
, menuItemIcon = Nothing
, menuItemRoute = CourseR tid ssh csh SheetNewR
, menuItemRoute = SomeRoute $ CourseR tid ssh csh SheetNewR
, menuItemModal = False
, menuItemAccessCallback' = return True
}
, PageActionSecondary $ MenuItem
{ menuItemLabel = "Kurs editieren"
, MenuItem
{ menuItemType = PageActionSecondary
, menuItemLabel = MsgMenuCourseEdit
, menuItemIcon = Nothing
, menuItemRoute = CourseR tid ssh csh CEditR
, menuItemRoute = SomeRoute $ CourseR tid ssh csh CEditR
, menuItemModal = False
, menuItemAccessCallback' = return True
}
, PageActionSecondary $ MenuItem
{ menuItemLabel = "Neuen Kurs klonen"
, MenuItem
{ menuItemType = PageActionSecondary
, menuItemLabel = MsgMenuCourseNewTemplate
, menuItemIcon = Nothing
, menuItemRoute = CourseNewTemplateR (Just tid) (Just ssh) (Just csh)
, menuItemRoute = SomeRoute $ CourseNewTemplateR (Just tid) (Just ssh) (Just csh)
, menuItemModal = False
, menuItemAccessCallback' = return True
}
]
pageActions (CourseR tid ssh csh SheetListR) =
[ PageActionPrime $ MenuItem
{ menuItemLabel = "Neues Übungsblatt anlegen"
[ MenuItem
{ menuItemType = PageActionPrime
, menuItemLabel = MsgMenuSheetNew
, menuItemIcon = Nothing
, menuItemRoute = CourseR tid ssh csh SheetNewR
, menuItemRoute = SomeRoute $ CourseR tid ssh csh SheetNewR
, menuItemModal = False
, menuItemAccessCallback' = return True
}
]
pageActions (CSheetR tid ssh csh shn SShowR) =
[ PageActionPrime $ MenuItem
{ menuItemLabel = "Abgabe anlegen"
[ MenuItem
{ menuItemType = PageActionPrime
, menuItemLabel = MsgMenuSubmissionNew
, menuItemIcon = Nothing
, menuItemRoute = CSheetR tid ssh csh shn SubmissionNewR
, menuItemRoute = SomeRoute $ CSheetR tid ssh csh shn SubmissionNewR
, menuItemModal = True
, menuItemAccessCallback' = runDB . maybeT (return False) $ do
uid <- MaybeT $ liftHandlerT maybeAuthId
@ -1116,10 +1170,11 @@ pageActions (CSheetR tid ssh csh shn SShowR) =
guard $ null submissions
return True
}
, PageActionPrime $ MenuItem
{ menuItemLabel = "Abgabe ansehen"
, MenuItem
{ menuItemType = PageActionPrime
, menuItemLabel = MsgMenuSubmissionOwn
, menuItemIcon = Nothing
, menuItemRoute = CSheetR tid ssh csh shn SubmissionOwnR
, menuItemRoute = SomeRoute $ CSheetR tid ssh csh shn SubmissionOwnR
, menuItemModal = False
, menuItemAccessCallback' = runDB . maybeT (return False) $ do
uid <- MaybeT $ liftHandlerT maybeAuthId
@ -1127,74 +1182,83 @@ pageActions (CSheetR tid ssh csh shn SShowR) =
guard . not $ null submissions
return True
}
, PageActionPrime $ MenuItem
{ menuItemLabel = "Korrektoren"
, MenuItem
{ menuItemType = PageActionPrime
, menuItemLabel = MsgMenuCorrectors
, menuItemIcon = Nothing
, menuItemRoute = CSheetR tid ssh csh shn SCorrR
, menuItemRoute = SomeRoute $ CSheetR tid ssh csh shn SCorrR
, menuItemModal = False
, menuItemAccessCallback' = return True
}
, PageActionPrime $ MenuItem
{ menuItemLabel = "Abgaben"
, MenuItem
{ menuItemType = PageActionPrime
, menuItemLabel = MsgMenuCorrections
, menuItemIcon = Nothing
, menuItemRoute = CSheetR tid ssh csh shn SSubsR
, menuItemRoute = SomeRoute $ CSheetR tid ssh csh shn SSubsR
, menuItemModal = False
, menuItemAccessCallback' = return True
}
, PageActionPrime $ MenuItem
{ menuItemLabel = "Blatt Editieren"
, MenuItem
{ menuItemType = PageActionPrime
, menuItemLabel = MsgMenuSheetEdit
, menuItemIcon = Nothing
, menuItemRoute = CSheetR tid ssh csh shn SEditR
, menuItemRoute = SomeRoute $ CSheetR tid ssh csh shn SEditR
, menuItemModal = False
, menuItemAccessCallback' = return True
}
]
pageActions (CSheetR tid ssh csh shn SSubsR) =
[ PageActionPrime $ MenuItem
{ menuItemLabel = "Korrektoren"
[ MenuItem
{ menuItemType = PageActionPrime
, menuItemLabel = MsgMenuCorrectors
, menuItemIcon = Nothing
, menuItemRoute = CSheetR tid ssh csh shn SCorrR
, menuItemRoute = SomeRoute $ CSheetR tid ssh csh shn SCorrR
, menuItemModal = False
, menuItemAccessCallback' = return True
}
]
pageActions (CSubmissionR tid ssh csh shn cid SubShowR) =
[ PageActionPrime $ MenuItem
{ menuItemLabel = "Korrektur"
[ MenuItem
{ menuItemType = PageActionPrime
, menuItemLabel = MsgMenuCorrection
, menuItemIcon = Nothing
, menuItemRoute = CSubmissionR tid ssh csh shn cid CorrectionR
, menuItemRoute = SomeRoute $ CSubmissionR tid ssh csh shn cid CorrectionR
, menuItemModal = False
, menuItemAccessCallback' = return True
}
]
pageActions (CSheetR tid ssh csh shn SCorrR) =
[ PageActionPrime $ MenuItem
{ menuItemLabel = "Abgaben"
[ MenuItem
{ menuItemType = PageActionPrime
, menuItemLabel = MsgMenuCorrections
, menuItemIcon = Nothing
, menuItemRoute = CSheetR tid ssh csh shn SSubsR
, menuItemRoute = SomeRoute $ CSheetR tid ssh csh shn SSubsR
, menuItemModal = False
, menuItemAccessCallback' = return True
}
, PageActionSecondary $ MenuItem
{ menuItemLabel = "Edit " <> (CI.original shn)
, MenuItem
{ menuItemType = PageActionSecondary
, menuItemLabel = MsgMenuSheetEdit
, menuItemIcon = Nothing
, menuItemRoute = CSheetR tid ssh csh shn SEditR
, menuItemRoute = SomeRoute $ CSheetR tid ssh csh shn SEditR
, menuItemModal = False
, menuItemAccessCallback' = return True
}
]
pageActions (CorrectionsR) =
[ PageActionPrime $ MenuItem
{ menuItemLabel = "Korrekturen hochladen"
[ MenuItem
{ menuItemType = PageActionPrime
, menuItemLabel = MsgMenuCorrectionsUpload
, menuItemIcon = Nothing
, menuItemRoute = CorrectionsUploadR
, menuItemRoute = SomeRoute CorrectionsUploadR
, menuItemModal = True
, menuItemAccessCallback' = return True
}
, PageActionPrime $ MenuItem
{ menuItemLabel = "Abgaben erstellen"
, MenuItem
{ menuItemType = PageActionPrime
, menuItemLabel = MsgMenuCorrectionsCreate
, menuItemIcon = Nothing
, menuItemRoute = CorrectionsCreateR
, menuItemRoute = SomeRoute CorrectionsCreateR
, menuItemModal = True
, menuItemAccessCallback' = runDB $ do
uid <- liftHandlerT requireAuthId
@ -1205,26 +1269,29 @@ pageActions (CorrectionsR) =
return E.countRows
return $ (corrCount :: Int) /= 0
}
, PageActionPrime $ MenuItem
{ menuItemLabel = "Korrekturen eintragen"
, MenuItem
{ menuItemType = PageActionPrime
, menuItemLabel = MsgMenuCorrectionsGrade
, menuItemIcon = Nothing
, menuItemRoute = CorrectionsGradeR
, menuItemRoute = SomeRoute CorrectionsGradeR
, menuItemModal = False
, menuItemAccessCallback' = return True
}
]
pageActions (CorrectionsGradeR) =
[ PageActionPrime $ MenuItem
{ menuItemLabel = "Korrekturen hochladen"
[ MenuItem
{ menuItemType = PageActionPrime
, menuItemLabel = MsgMenuCorrectionsUpload
, menuItemIcon = Nothing
, menuItemRoute = CorrectionsUploadR
, menuItemRoute = SomeRoute CorrectionsUploadR
, menuItemModal = True
, menuItemAccessCallback' = return True
}
, PageActionPrime $ MenuItem
{ menuItemLabel = "Abgaben erstellen"
, MenuItem
{ menuItemType = PageActionPrime
, menuItemLabel = MsgMenuCorrectionsCreate
, menuItemIcon = Nothing
, menuItemRoute = CorrectionsCreateR
, menuItemRoute = SomeRoute CorrectionsCreateR
, menuItemModal = True
, menuItemAccessCallback' = runDB $ do
uid <- liftHandlerT requireAuthId

View File

@ -6,12 +6,9 @@ import Handler.Utils
import qualified Data.Map as Map
import qualified Data.Text as Text
import Data.Text.Encoding (decodeUtf8')
import Data.Time hiding (formatTime)
import Data.Universe.Helpers
import Network.Wai (requestHeaderReferer)
-- import qualified Data.Text as T
-- import Yesod.Form.Bootstrap3
@ -244,14 +241,14 @@ instance RenderMessage UniWorX HelpIdentOptions where
HIAnonymous -> MsgHelpAnonymous
data HelpForm = HelpForm
{ hfReferer:: Maybe Text
{ hfReferer:: Maybe (Route UniWorX)
, hfUserId :: Either (Maybe Address) UserId
, hfRequest:: Text
}
helpForm :: Maybe Text -> Maybe UserId -> AForm _ HelpForm
helpForm :: Maybe (Route UniWorX) -> Maybe UserId -> AForm _ HelpForm
helpForm mReferer mUid = HelpForm
<$> maybe (pure Nothing) (fmap Just . aforced textField (fslI MsgHelpProblemPage)) mReferer
<$> aopt routeField (fslI MsgHelpProblemPage & inputReadonly) (Just <$> mReferer)
<*> multiActionA (fslI MsgHelpAnswer) identActions (HIUser <$ mUid)
<*> (unTextarea <$> areq textareaField (fslI MsgHelpRequest) Nothing)
<* submitButton
@ -270,19 +267,19 @@ getHelpR, postHelpR :: Handler Html
getHelpR = postHelpR
postHelpR = do
mUid <- maybeAuthId
mRefererBS <- requestHeaderReferer <$> waiRequest
let mReferer = maybeRight . decodeUtf8' =<< mRefererBS
mReferer <- flip formResultMaybe return <=< runInputGetResult $ iopt routeField "site"
((res,formWidget),formEnctype) <- runFormPost $ renderAForm FormStandard $ helpForm mReferer mUid
case res of
FormSuccess HelpForm{..} -> do
now <- liftIO getCurrentTime
hfReferer' <- traverse toTextUrl hfReferer
queueJob' JobHelpRequest
{ jSender = hfUserId
, jHelpRequest = hfRequest
, jRequestTime = now
, jReferer = hfReferer
, jReferer = hfReferer'
}
-- redirect $ HelpR
addMessageI Success MsgHelpSent

View File

@ -159,6 +159,11 @@ buttonForm csrf = do
-- ciField moved to Utils.Form
routeField :: ( Monad m
, HandlerSite m ~ UniWorX
) => Field m (Route UniWorX)
routeField = checkMMap (return . maybe (Left MsgInvalidRoute) Right . fromPathPiece) toPathPiece textField
natFieldI :: (Monad m, Integral i, RenderMessage (HandlerSite m) msg, RenderMessage (HandlerSite m) FormMessage) => msg -> Field m i
natFieldI msg = checkBool (>= 0) msg intField

View File

@ -45,6 +45,7 @@ import Control.Monad.Morph as Import (MFunctor(..))
import Control.Monad.Trans.Resource as Import (ReleaseKey)
import Network.Mail.Mime.Instances as Import ()
import Yesod.Core.Instances as Import ()
import Control.Monad.Trans.RWS (RWST)

View File

@ -137,6 +137,12 @@ addDatalist mValues field = field
noValidate :: FieldSettings site -> FieldSettings site
noValidate = addAttr "formnovalidate" ""
inputDisabled :: FieldSettings site -> FieldSettings site
inputDisabled = addAttr "disabled" ""
inputReadonly :: FieldSettings site -> FieldSettings site
inputReadonly = addAttr "readonly" ""
------------------------------------------------
-- Unique Form Identifiers to avoid accidents --
------------------------------------------------

View File

@ -0,0 +1,34 @@
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Yesod.Core.Instances
(
) where
import ClassyPrelude.Yesod
import Utils (assertM')
import Control.Lens
import Data.ByteString.Builder (toLazyByteString)
import System.FilePath ((</>))
instance (RenderRoute site, ParseRoute site) => PathPiece (Route site) where
fromPathPiece
= parseRoute
. over (_2.traverse._2) (fromMaybe "")
. over _2 queryToQueryText
. decodePath
. encodeUtf8
toPathPiece
= pack
. ("/" </>)
. unpack
. decodeUtf8
. toLazyByteString
. uncurry encodePath
. over _2 queryTextToQuery
. over (_2.traverse._2) (assertM' $ not . null)
. renderRoute

View File

@ -98,7 +98,15 @@
});
}
frame.setAttribute('src', dynamicContentURL + "?" + #{String modalParameter});
var url = "";
var i = dynamicContentURL.indexOf('?');
if (i === -1) {
url = dynamicContentURL + "?" + #{String modalParameter};
} else {
url = dynamicContentURL.slice(0,i) + "?" + #{String modalParameter} + "&" + dynamicContentURL.slice(i + 1);
}
frame.setAttribute('src', url);
}
// tell further modals, that this one already got initialized
modal.classList.add('js-modal-initialized');

View File

@ -12,9 +12,9 @@ $newline never
<div .asidenav__link-shorthand>#{courseShorthand}
<div .asidenav__link-label>#{courseName}
<ul .asidenav__nested-list.list--iconless>
$forall action <- pageActions
$case action
$of PageActionPrime (MenuItem{menuItemRoute, menuItemLabel})
$forall (MenuItem{menuItemType, menuItemLabel}, route) <- pageActions
$case menuItemType
$of PageActionPrime
<li .asidenav__nested-list-item>
<a .asidenav__link-wrapper href=@{menuItemRoute}>#{menuItemLabel}
<a .asidenav__link-wrapper href=#{route}>_{menuItemLabel}
$of _

View File

@ -12,34 +12,34 @@ $newline never
<i .fas.fa-star>
<div .navbar__link-label> Favorites
$forall (menuType, menuIdent) <- menuTypes
$case menuType
$of NavbarAside (MenuItem label mIcon route _ isModal)
<li .navbar__list-item :highlight route:.navbar__list-item--active>
$if isModal
$forall (MenuItem{menuItemType, menuItemRoute, menuItemIcon, menuItemLabel, menuItemModal}, menuIdent, route) <- menuTypes
$case menuItemType
$of NavbarAside
<li .navbar__list-item :highlight (urlRoute menuItemRoute):.navbar__list-item--active>
$if menuItemModal
<div .modal.js-modal #modal-#{menuIdent} data-trigger=#{menuIdent} data-closeable=true data-dynamic=True>
<a .navbar__link-wrapper href=@{route} ##{menuIdent}>
<i .fas.fa-#{fromMaybe "none" mIcon}>
<div .navbar__link-label>#{label}
<a .navbar__link-wrapper href=#{route} ##{menuIdent}>
<i .fas.fa-#{fromMaybe "none" menuItemIcon}>
<div .navbar__link-label>_{SomeMessage menuItemLabel}
$of _
<ul .navbar__list.list--inline>
$forall (menuType, menuIdent) <- menuTypes
$case menuType
$of NavbarRight (MenuItem label mIcon route _ isModal)
<li .navbar__list-item :Just route == mcurrentRoute:.navbar__list-item--active>
$if isModal
$forall (MenuItem{menuItemType, menuItemRoute, menuItemIcon, menuItemLabel, menuItemModal}, menuIdent, route) <- menuTypes
$case menuItemType
$of NavbarRight
<li .navbar__list-item :highlight (urlRoute menuItemRoute):.navbar__list-item--active>
$if menuItemModal
<div .modal.js-modal #modal-#{menuIdent} data-trigger=#{menuIdent} data-closeable=true data-dynamic=True>
<a .navbar__link-wrapper href=@{route} ##{menuIdent}>
<i .fas.fa-#{fromMaybe "none" mIcon}>
<div .navbar__link-label>#{label}
$of NavbarSecondary (MenuItem label mIcon route _ isModal)
<li .navbar__list-item.navbar__list-item--secondary :Just route == mcurrentRoute:.navbar__list-item--active>
$if isModal
<a .navbar__link-wrapper href=#{route} ##{menuIdent}>
<i .fas.fa-#{fromMaybe "none" menuItemIcon}>
<div .navbar__link-label>_{SomeMessage menuItemLabel}
$of NavbarSecondary
<li .navbar__list-item.navbar__list-item--secondary :highlight (urlRoute menuItemRoute):.navbar__list-item--active>
$if menuItemModal
<div .modal.js-modal #modal-#{menuIdent} data-trigger=#{menuIdent} data-closeable=true data-dynamic=True>
<a .navbar__link-wrapper href=@{route} ##{menuIdent}>
<i .fas.fa-#{fromMaybe "none" mIcon}>
<div .navbar__link-label>#{label}
<a .navbar__link-wrapper href=#{route} ##{menuIdent}>
<i .fas.fa-#{fromMaybe "none" menuItemIcon}>
<div .navbar__link-label>_{SomeMessage menuItemLabel}
$of _
<div .navbar__pushdown>

View File

@ -2,16 +2,16 @@ $newline never
$if hasPageActions
<div .page-nav-prime>
<ul .pagenav__list>
$forall (menuType, menuIdent) <- menuTypes
$case menuType
$of PageActionPrime (MenuItem label _mIcon route _callback isModal)
$forall (MenuItem{menuItemLabel, menuItemType, menuItemModal}, menuIdent, route) <- menuTypes
$case menuItemType
$of PageActionPrime
<li .pagenav__list-item>
$if isModal
$if menuItemModal
<div .modal.js-modal #modal-#{menuIdent} data-trigger=#{menuIdent} data-closeable=true data-dynamic=True>
<a .pagenav__link-wrapper href=@{route} ##{menuIdent}>#{label}
$of PageActionSecondary (MenuItem label _mIcon route _callback isModal)
<a .pagenav__link-wrapper href=#{route} ##{menuIdent}>_{SomeMessage menuItemLabel}
$of PageActionSecondary
<li .pagenav__list-item>
$if isModal
$if menuItemModal
<div .modal.js-modal #modal-#{menuIdent} data-trigger=#{menuIdent} data-closeable=true data-dynamic=True>
<a .pagenav__link-wrapper href=@{route} ##{menuIdent}>#{label}
<a .pagenav__link-wrapper href=#{route} ##{menuIdent}>_{SomeMessage menuItemLabel}
$of _