diff --git a/yesod-form/Yesod/Form/Input.hs b/yesod-form/Yesod/Form/Input.hs index dbc88ade..1643547e 100644 --- a/yesod-form/Yesod/Form/Input.hs +++ b/yesod-form/Yesod/Form/Input.hs @@ -1,8 +1,12 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE FlexibleContexts #-} +-- | Provides for getting input from either GET or POST params without +-- generating HTML forms. For more information, see: +-- . module Yesod.Form.Input ( FormInput (..) , runInputGet + , runInputGetResult , runInputPost , runInputPostResult , ireq @@ -13,12 +17,15 @@ import Yesod.Form.Types import Data.Text (Text) import Control.Applicative (Applicative (..)) import Yesod.Core -import Control.Monad (liftM) +import Control.Monad (liftM, (<=<)) import qualified Data.Map as Map import Data.Maybe (fromMaybe) import Control.Arrow ((***)) type DText = [Text] -> [Text] + +-- | Type for a form which parses a value of type @a@ with the base monad @m@ +-- (usually your @Handler@). Can can compose this using its @Applicative@ instance. newtype FormInput m a = FormInput { unFormInput :: HandlerSite m -> [Text] -> Env -> FileEnv -> m (Either DText a) } instance Monad m => Functor (FormInput m) where fmap a (FormInput f) = FormInput $ \c d e e' -> liftM (either Left (Right . a)) $ f c d e e' @@ -33,8 +40,12 @@ instance Monad m => Applicative (FormInput m) where (_, Left b) -> Left b (Right a, Right b) -> Right $ a b +-- | Promote a @Field@ into a @FormInput@, requiring that the value be present +-- and valid. ireq :: (Monad m, RenderMessage (HandlerSite m) FormMessage) - => Field m a -> Text -> FormInput m a + => Field m a + -> Text -- ^ name of the field + -> FormInput m a ireq field name = FormInput $ \m l env fenv -> do let filteredEnv = fromMaybe [] $ Map.lookup name env filteredFEnv = fromMaybe [] $ Map.lookup name fenv @@ -44,6 +55,8 @@ ireq field name = FormInput $ \m l env fenv -> do Right Nothing -> Left $ (:) $ renderMessage m l $ MsgInputNotFound name Right (Just a) -> Right a +-- | Promote a @Field@ into a @FormInput@, with its presence being optional. If +-- the value is present but does not parse correctly, the form will still fail. iopt :: Monad m => Field m a -> Text -> FormInput m (Maybe a) iopt field name = FormInput $ \m l env fenv -> do let filteredEnv = fromMaybe [] $ Map.lookup name env @@ -53,32 +66,38 @@ iopt field name = FormInput $ \m l env fenv -> do Left (SomeMessage e) -> Left $ (:) $ renderMessage m l e Right x -> Right x +-- | Run a @FormInput@ on the GET parameters (i.e., query string). If parsing +-- fails, calls 'invalidArgs'. runInputGet :: MonadHandler m => FormInput m a -> m a -runInputGet (FormInput f) = do +runInputGet = either invalidArgs return <=< runInputGetHelper + +-- | Run a @FormInput@ on the GET parameters (i.e., query string). Does /not/ +-- throw exceptions on failure. +-- +-- Since 1.4.1 +runInputGetResult :: MonadHandler m => FormInput m a -> m (FormResult a) +runInputGetResult = fmap (either FormFailure FormSuccess) . runInputGetHelper + +runInputGetHelper :: MonadHandler m => FormInput m a -> m (Either [Text] a) +runInputGetHelper (FormInput f) = do env <- liftM (toMap . reqGetParams) getRequest m <- getYesod l <- languages emx <- f m l env Map.empty - case emx of - Left errs -> invalidArgs $ errs [] - Right x -> return x + return $ either (Left . ($ [])) Right emx toMap :: [(Text, a)] -> Map.Map Text [a] toMap = Map.unionsWith (++) . map (\(x, y) -> Map.singleton x [y]) +-- | Run a @FormInput@ on the POST parameters (i.e., request body). If parsing +-- fails, calls 'invalidArgs'. runInputPost :: MonadHandler m => FormInput m a -> m a -runInputPost fi = do - emx <- runInputPostHelper fi - case emx of - Left errs -> invalidArgs errs - Right x -> return x +runInputPost = either invalidArgs return <=< runInputPostHelper +-- | Run a @FormInput@ on the POST parameters (i.e., request body). Does /not/ +-- throw exceptions on failure. runInputPostResult :: MonadHandler m => FormInput m a -> m (FormResult a) -runInputPostResult fi = do - emx <- runInputPostHelper fi - case emx of - Left errs -> return $ FormFailure errs - Right x -> return $ FormSuccess x +runInputPostResult = fmap (either FormFailure FormSuccess) . runInputPostHelper runInputPostHelper :: MonadHandler m => FormInput m a -> m (Either [Text] a) runInputPostHelper (FormInput f) = do diff --git a/yesod-form/yesod-form.cabal b/yesod-form/yesod-form.cabal index 15bfa857..d741014f 100644 --- a/yesod-form/yesod-form.cabal +++ b/yesod-form/yesod-form.cabal @@ -1,5 +1,5 @@ name: yesod-form -version: 1.4.0.2 +version: 1.4.1 license: MIT license-file: LICENSE author: Michael Snoyman