Fix for buttons does not work either

This commit is contained in:
SJost 2017-11-15 12:16:14 +01:00
parent c71910f22e
commit faf5c1b2dc

View File

@ -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 ) --
---------------------------- ----------------------------