diff --git a/src/Handler/Utils/Form.hs b/src/Handler/Utils/Form.hs index a03e99ede..683ba8c35 100644 --- a/src/Handler/Utils/Form.hs +++ b/src/Handler/Utils/Form.hs @@ -15,6 +15,8 @@ import qualified Data.Map as Map import Handler.Utils.DateTime import Data.String (IsString(..)) +import qualified Data.Foldable as Foldable + -- import Yesod.Core import qualified Data.Text as T -- import Yesod.Form.Types @@ -53,17 +55,19 @@ buttonForm html = do buttonIdent <- newFormIdent resultWidgetMap <- forM buttonMap $ \val -> mopt (button val) ("" { fsName = Just buttonIdent }) Nothing - let result = asum $ nothing2miss <$> fst <$> Map.elems resultWidgetMap + let result = accResult $ fst <$> Map.elems resultWidgetMap let viewF = (Map.!) (snd <$> resultWidgetMap) return (result, viewF) + where + accResult :: Foldable f => f (FormResult (Maybe a)) -> FormResult a + accResult = Foldable.foldr accResult' FormMissing -nothing2miss :: FormResult (Maybe a) -> FormResult a -nothing2miss (FormSuccess Nothing) = FormMissing -nothing2miss (FormSuccess (Just r)) = FormSuccess r -nothing2miss (FormFailure msgs) = FormFailure msgs -nothing2miss (FormMissing) = FormMissing - + accResult' :: FormResult (Maybe a) -> FormResult a -> FormResult a + accResult' (FormSuccess _) (FormSuccess _) = FormFailure ["Ambiguous parse"] + accResult' (FormSuccess (Just x)) _ = FormSuccess x + accResult' (FormFailure errs) _ = FormFailure errs + accResult' _ x = x ---------------------------- -- Buttons (old version ) --