haskell/yesod
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Factor out some duplicated code

Browse Source
This commit is contained in:
Michael Snoyman 2014-01-31 13:15:05 +02:00
parent a417b95a98
commit cdfd478fcd
1 changed files with 14 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
yesod-form/Yesod/Form/Input.hs
View File

@ -4,6 +4,7 @@ module Yesod.Form.Input
( FormInput (..) ( FormInput (..)
, runInputGet , runInputGet
, runInputPost , runInputPost
, runInputPostResult
, ireq , ireq
, iopt , iopt
) where ) where
@ -65,22 +66,23 @@ runInputGet (FormInput f) = do
toMap :: [(Text, a)] -> Map.Map Text [a] toMap :: [(Text, a)] -> Map.Map Text [a]
toMap = Map.unionsWith (++) . map (\(x, y) -> Map.singleton x [y]) toMap = Map.unionsWith (++) . map (\(x, y) -> Map.singleton x [y])
runInputPost :: MonadHandler m => FormInput m a -> m (FormResult a) runInputPost :: MonadHandler m => FormInput m a -> m a
runInputPost (FormInput f) = do runInputPost fi = do
(env, fenv) <- liftM (toMap *** toMap) runRequestBody emx <- runInputPostHelper fi
m <- getYesod
l <- languages
emx <- f m l env fenv
case emx of case emx of
Left errs -> invalidArgs $ errs [] Left errs -> invalidArgs errs
Right x -> return x Right x -> return x
runInputPostResult :: MonadHandler m => FormInput m a -> m (FormResult a) runInputPostResult :: MonadHandler m => FormInput m a -> m (FormResult a)
runInputPostResult (FormInput f) = do runInputPostResult fi = do
emx <- runInputPostHelper fi
case emx of
Left errs -> return $ FormFailure errs
Right x -> return $ FormSuccess x
runInputPostHelper :: MonadHandler m => FormInput m a -> m (Either [Text] a)
runInputPostHelper (FormInput f) = do
(env, fenv) <- liftM (toMap *** toMap) runRequestBody (env, fenv) <- liftM (toMap *** toMap) runRequestBody
m <- getYesod m <- getYesod
l <- languages l <- languages
emx <- f m l env fenv fmap (either (Left . ($ [])) Right) $ f m l env fenv
case emx of
Left errs -> return $ FormFailure (errs [])
Right x -> return $ FormSuccess x