fraport/fradrive
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Accumulate button result correctly

Browse Source
This commit is contained in:
Gregor Kleen 2017-11-15 13:06:50 +01:00
parent faf5c1b2dc
commit 261f064d4e
1 changed files with 11 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
src/Handler/Utils/Form.hs
View File

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