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

4
src/Handler/Term.hs
View File

@ -41,9 +41,7 @@ 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) ())
colonnadeTerms = mconcat
[ sortable Nothing "Kürzel" $ \(Entity tid Term{..},_) -> cell $ do [ sortable Nothing "Kürzel" $ \(Entity tid Term{..},_) -> cell $ do
-- Scrap this if to slow, create term edit page instead -- Scrap this if to slow, create term edit page instead
adminLink <- handlerToWidget $ isAuthorized (TermEditExistR tid) False adminLink <- handlerToWidget $ isAuthorized (TermEditExistR tid) False

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}|]