fraport/fradrive
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

runDbTable & slight cleanup

Browse Source
This commit is contained in:
Gregor Kleen 2018-06-27 08:45:15 +02:00
parent 7b336dd5a6
commit 146abce346
2 changed files with 39 additions and 30 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

56
src/Handler/Term.hs
View File

@ -41,35 +41,33 @@ getTermShowR = do
selectRep $ do
provideRep $ toJSON . map fst <$> runDB (E.select $ E.from termData)
provideRep $ do
let
colonnadeTerms :: Colonnade Sortable _ (DBCell (WidgetT UniWorX IO) ())
colonnadeTerms = mconcat
[ sortable Nothing "Kürzel" $ \(Entity tid Term{..},_) -> cell $ do
-- Scrap this if to slow, create term edit page instead
adminLink <- handlerToWidget $ isAuthorized (TermEditExistR tid) False
[whamlet|
$if adminLink == Authorized
<a href=@{TermEditExistR tid}>
#{termToText termName}
$else
#{termToText termName}
|]
, sortable (Just "lecture-start") "Beginn Vorlesungen" $ \(Entity _ Term{..},_) ->
stringCell $ formatTimeGerWD termLectureStart
, sortable (Just "lecture-end") "Ende Vorlesungen" $ \(Entity _ Term{..},_) ->
stringCell $ formatTimeGerWD termLectureEnd
, sortable Nothing "Aktiv" $ \(Entity _ Term{..},_) ->
textCell $ (bool "" tickmark termActive :: Text)
, sortable Nothing "Kursliste" $ anchorCell
(\(Entity tid _, _) -> TermCourseListR tid)
(\(_, E.Value numCourses) -> [whamlet|_{MsgNumCourses numCourses}|])
, sortable (Just "start") "Semesteranfang" $ \(Entity _ Term{..},_) ->
stringCell $ formatTimeGerWD termStart
, sortable (Just "end") "Semesterende" $ \(Entity _ Term{..},_) ->
stringCell $ formatTimeGerWD termEnd
, sortable Nothing "Feiertage im Semester" $ \(Entity _ Term{..},_) ->
stringCell $ (intercalate ", ") $ map formatTimeGerWD termHolidays
]
let colonnadeTerms = widgetColonnade $ mconcat
[ sortable Nothing "Kürzel" $ \(Entity tid Term{..},_) -> cell $ do
-- Scrap this if to slow, create term edit page instead
adminLink <- handlerToWidget $ isAuthorized (TermEditExistR tid) False
[whamlet|
$if adminLink == Authorized
<a href=@{TermEditExistR tid}>
#{termToText termName}
$else
#{termToText termName}
|]
, sortable (Just "lecture-start") "Beginn Vorlesungen" $ \(Entity _ Term{..},_) ->
stringCell $ formatTimeGerWD termLectureStart
, sortable (Just "lecture-end") "Ende Vorlesungen" $ \(Entity _ Term{..},_) ->
stringCell $ formatTimeGerWD termLectureEnd
, sortable Nothing "Aktiv" $ \(Entity _ Term{..},_) ->
textCell $ (bool "" tickmark termActive :: Text)
, sortable Nothing "Kursliste" $ anchorCell
(\(Entity tid _, _) -> TermCourseListR tid)
(\(_, E.Value numCourses) -> [whamlet|_{MsgNumCourses numCourses}|])
, sortable (Just "start") "Semesteranfang" $ \(Entity _ Term{..},_) ->
stringCell $ formatTimeGerWD termStart
, sortable (Just "end") "Semesterende" $ \(Entity _ Term{..},_) ->
stringCell $ formatTimeGerWD termEnd
, sortable Nothing "Feiertage im Semester" $ \(Entity _ Term{..},_) ->
stringCell $ (intercalate ", ") $ map formatTimeGerWD termHolidays
]
table <- dbTable def $ DBTable
{ dbtSQLQuery = termData
, dbtColonnade = colonnadeTerms

13
src/Handler/Utils/Table/Pagination.hs
View File

@ -24,6 +24,7 @@ module Handler.Utils.Table.Pagination
, PSValidator(..)
, Sortable(..), sortable
, dbTable
, widgetColonnade, formColonnade
, textCell, stringCell, anchorCell
) where
@ -209,7 +210,7 @@ instance Monoid a => IsDBTable (RWST (Maybe (Env, FileEnv), UniWorX, [Lang]) Enc
dbWidget Proxy Proxy = iso ((,) <$> view (_1._2) <*> ((,) <$> view (_1._1) <*> view _2))
((,) <$> ((,) <$> view (_2._1) <*> view _1) <*> view (_2._2))
-- runDBTable :: MForm (HandlerT UniWorX IO) (Widget, FormResult a) -> m ((FormResult a, Widget), Enctype)
runDBTable = undefined -- use runFormPost
runDBTable form = liftHandlerT . runFormPost $ \html -> over _2 (<> toWidget html) . swap <$> form
instance IsDBTable m a => IsString (DBCell m a) where
fromString = cell . fromString
@ -316,6 +317,16 @@ dbTable PSValidator{..} dbtable@(DBTable{ dbtIdent = (toPathPiece -> dbtIdent),
--- DBCell utility functions
widgetColonnade :: Headedness h
=> Colonnade h r (DBCell (WidgetT UniWorX IO) ())
-> Colonnade h r (DBCell (WidgetT UniWorX IO) ())
widgetColonnade = id
formColonnade :: (Headedness h, Monoid a)
=> Colonnade h r (DBCell (RWST (Maybe (Env, FileEnv), UniWorX, [Lang]) Enctype Ints (HandlerT UniWorX IO)) (FormResult a))
-> Colonnade h r (DBCell (RWST (Maybe (Env, FileEnv), UniWorX, [Lang]) Enctype Ints (HandlerT UniWorX IO)) (FormResult a))
formColonnade = id
textCell, stringCell :: (RenderMessage UniWorX msg, IsDBTable m a) => msg -> DBCell m a
stringCell = textCell
textCell msg = cell [whamlet|_{msg}|]