Generate valid HTML from renderTable
This commit is contained in:
parent
027dfa9d91
commit
99621c17b0
@ -1,4 +1,5 @@
|
|||||||
{-# LANGUAGE QuasiQuotes #-}
|
{-# LANGUAGE QuasiQuotes #-}
|
||||||
|
{-# LANGUAGE TupleSections #-}
|
||||||
{-# LANGUAGE TypeFamilies #-}
|
{-# LANGUAGE TypeFamilies #-}
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
{-# LANGUAGE RecordWildCards #-}
|
{-# LANGUAGE RecordWildCards #-}
|
||||||
@ -356,15 +357,21 @@ type FormRender m a =
|
|||||||
-> MForm m (FormResult a, WidgetT (HandlerSite m) IO ())
|
-> MForm m (FormResult a, WidgetT (HandlerSite m) IO ())
|
||||||
|
|
||||||
renderTable, renderDivs, renderDivsNoLabels :: Monad m => FormRender m a
|
renderTable, renderDivs, renderDivsNoLabels :: Monad m => FormRender m a
|
||||||
|
-- | Render a form into a series of tr tags. Note that, in order to allow
|
||||||
|
-- you to add extra rows to the table, this function does /not/ wrap up
|
||||||
|
-- the resulting HTML in a table tag; you must do that yourself.
|
||||||
renderTable aform fragment = do
|
renderTable aform fragment = do
|
||||||
(res, views') <- aFormToForm aform
|
(res, views') <- aFormToForm aform
|
||||||
let views = views' []
|
let views = views' []
|
||||||
let widget = [whamlet|
|
let widget = [whamlet|
|
||||||
$newline never
|
$newline never
|
||||||
\#{fragment}
|
$if null views
|
||||||
$forall view <- views
|
\#{fragment}
|
||||||
|
$forall (isFirst, view) <- addIsFirst views
|
||||||
<tr :fvRequired view:.required :not $ fvRequired view:.optional>
|
<tr :fvRequired view:.required :not $ fvRequired view:.optional>
|
||||||
<td>
|
<td>
|
||||||
|
$if isFirst
|
||||||
|
\#{fragment}
|
||||||
<label for=#{fvId view}>#{fvLabel view}
|
<label for=#{fvId view}>#{fvLabel view}
|
||||||
$maybe tt <- fvTooltip view
|
$maybe tt <- fvTooltip view
|
||||||
<div .tooltip>#{tt}
|
<div .tooltip>#{tt}
|
||||||
@ -373,6 +380,9 @@ $forall view <- views
|
|||||||
<td .errors>#{err}
|
<td .errors>#{err}
|
||||||
|]
|
|]
|
||||||
return (res, widget)
|
return (res, widget)
|
||||||
|
where
|
||||||
|
addIsFirst [] = []
|
||||||
|
addIsFirst (x:y) = (True, x) : map (False, ) y
|
||||||
|
|
||||||
-- | render a field inside a div
|
-- | render a field inside a div
|
||||||
renderDivs = renderDivsMaybeLabels True
|
renderDivs = renderDivsMaybeLabels True
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user