Fix for buttons does not work either
This commit is contained in:
parent
c71910f22e
commit
faf5c1b2dc
@ -47,21 +47,24 @@ buttonForm html = do
|
|||||||
view id name attrs _val _ = do
|
view id name attrs _val _ = do
|
||||||
[whamlet|
|
[whamlet|
|
||||||
#{html}
|
#{html}
|
||||||
<button type=submit name=#{name} value=#{toPathPiece b} *{attrs} ##{id}>^{label b}
|
<button .btn .btn-default type=submit name=#{name} value=#{toPathPiece b} *{attrs} ##{id}>^{label b}
|
||||||
|]
|
|]
|
||||||
|
|
||||||
buttonIdent <- newFormIdent
|
buttonIdent <- newFormIdent
|
||||||
resultWidgetMap <- forM buttonMap $ \val -> mopt (button val) ("" { fsName = Just buttonIdent }) Nothing
|
resultWidgetMap <- forM buttonMap $ \val -> mopt (button val) ("" { fsName = Just buttonIdent }) Nothing
|
||||||
|
|
||||||
let result = case (asum $ fst <$> resultWidgetMap) of
|
let result = asum $ nothing2miss <$> fst <$> Map.elems resultWidgetMap
|
||||||
FormSuccess (Just x) -> FormSuccess x
|
|
||||||
FormSuccess Nothing -> FormMissing
|
|
||||||
_other -> FormMissing
|
|
||||||
let viewF = (Map.!) (snd <$> resultWidgetMap)
|
let viewF = (Map.!) (snd <$> resultWidgetMap)
|
||||||
|
|
||||||
|
|
||||||
return (result, viewF)
|
return (result, viewF)
|
||||||
|
|
||||||
|
nothing2miss :: FormResult (Maybe a) -> FormResult a
|
||||||
|
nothing2miss (FormSuccess Nothing) = FormMissing
|
||||||
|
nothing2miss (FormSuccess (Just r)) = FormSuccess r
|
||||||
|
nothing2miss (FormFailure msgs) = FormFailure msgs
|
||||||
|
nothing2miss (FormMissing) = FormMissing
|
||||||
|
|
||||||
|
|
||||||
----------------------------
|
----------------------------
|
||||||
-- Buttons (old version ) --
|
-- Buttons (old version ) --
|
||||||
----------------------------
|
----------------------------
|
||||||
|
|||||||
Reference in New Issue
Block a user