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

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

@ -24,6 +24,7 @@ module Handler.Utils.Table.Pagination
, PSValidator(..) , PSValidator(..)
, Sortable(..), sortable , Sortable(..), sortable
, dbTable , dbTable
, widgetColonnade, formColonnade
, textCell, stringCell, anchorCell , textCell, stringCell, anchorCell
) where ) 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)) dbWidget Proxy Proxy = iso ((,) <$> view (_1._2) <*> ((,) <$> view (_1._1) <*> view _2))
((,) <$> ((,) <$> view (_2._1) <*> view _1) <*> view (_2._2)) ((,) <$> ((,) <$> view (_2._1) <*> view _1) <*> view (_2._2))
-- runDBTable :: MForm (HandlerT UniWorX IO) (Widget, FormResult a) -> m ((FormResult a, Widget), Enctype) -- 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 instance IsDBTable m a => IsString (DBCell m a) where
fromString = cell . fromString fromString = cell . fromString
@ -316,6 +317,16 @@ dbTable PSValidator{..} dbtable@(DBTable{ dbtIdent = (toPathPiece -> dbtIdent),
--- DBCell utility functions --- 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 textCell, stringCell :: (RenderMessage UniWorX msg, IsDBTable m a) => msg -> DBCell m a
stringCell = textCell stringCell = textCell
textCell msg = cell [whamlet|_{msg}|] textCell msg = cell [whamlet|_{msg}|]