RetroSearch Browse

Home - News ( United States | United Kingdom | Italy | Germany ) - Football scores

Showing content from https://www.yesodweb.com/blog/2011/08/yesod-form-overhaul below:

Yesod form overhaul

Yesod form overhaul August 3, 2011 By Michael Snoyman

View source on Github

Motivation

No direct way to do validations like "a number between 1 and 10". It was possible, just not easy.
No way at all to perform monadic validations (is this username taken? is this date in the past?).
To support i18n, we have the concept of message types. However, it hasn't been possible to mix different types for the most part.
Type signatures very quickly become unwieldy.

SomeMessage

class RenderMessage master message where
    renderMessage :: master
                  -> [Text] -- ^ languages
                  -> message
                  -> Text

This lets each application (distinguished by the master datatype) have its own sets of translations. Within yesod-form, we would end up with a msg type variable in a few places, such as for error messages from a field parser. And yesod-form defines a datatype FormMessage which it uses for all its messages.

the user could submit a non-integer. For this we want to use the built-in error message from yesod-form of type FormMessage
the user could enter an integer outside the range. Here we would want to use the application specific message type.

data SomeMessage master = forall msg. RenderMessage master msg => SomeMessage msg

We now have a datatype that represents any message that can be translated for our application. By using this datatype in place of a msg type variable, we get to both achieve our primary goal and make our type signatures a bit shorter. Less General Types Monadic field parser

[Text] -> Either msg (Maybe a)

Fairly simple: take a list of parameters (remember, multiple values can be submitted for each field, like with multi-select fields) and either return an error message, Nothing if the input is missing, or the parsed value on success. (Missing input may or may not be an error, depending on if the field is required or optional.)

data MyAppMessage = BelowOne | AboveTen
withinRange :: Int -> Either MyAppMessage Int
withRange i
    | i < 1 = Left BelowOne
    | i > 10 = Left AboveTen
    | otherwise = Right i

All we need is a way to attach our withinRange to our fieldParse.

data Field sub master a = Field
    { fieldParse :: [Text] -> GGHandler sub master IO (Either (SomeMessage master) (Maybe a))
    , fieldView :: ...
    }

The check functions

check :: RenderMessage master msg
      => (a -> Either msg a) -> Field sub master a -> Field sub master a
check f = checkM $ return . f

-- | Return the given error message if the predicate is false.
checkBool :: RenderMessage master msg
          => (a -> Bool) -> msg -> Field sub master a -> Field sub master a
checkBool b s = check $ \x -> if b x then Right x else Left s

checkM :: RenderMessage master msg
       => (a -> GGHandler sub master IO (Either msg a))
       -> Field sub master a
       -> Field sub master a
checkM f field = field
    { fieldParse = \ts -> do
        e1 <- fieldParse field ts
        case e1 of
            Left msg -> return $ Left msg
            Right Nothing -> return $ Right Nothing
            Right (Just a) -> fmap (either (Left . SomeMessage) (Right . Just)) $ f a
    }

myValidForm = runFormGet $ renderTable $ pure (,,)
    <*> areq (check (\x ->
            if T.length x < 3
                then Left ("Need at least 3 letters" :: Text)
                else Right x
              ) textField)
            "Name" Nothing
    <*> areq (checkBool (>= 18) ("Must be 18 or older" :: Text) intField)
            "Age" Nothing
    <*> areq (checkM inPast dayField) "Anniversary" Nothing
  where
    inPast x = do
        now <- liftIO getCurrentTime
        return $ if utctDay now < x
                    then Left ("Need a date in the past" :: Text)
                    else Right x

The type signatures on the strings are necessary due to our usage of OverloadedStrings. It would be nice if GHC had some defaulting rules when it gets confused, but that's not the case yet.

comments powered by