Applicative Form と Monadic Form を併用する

AForm ではレイアウトなどの自由が効かないが、全てを MForm で書くのは意外と大変だということがわかった。AForm で済む部分は極力 AForm で間に合わす一つの方法。
この例では renderBootstrap ベースで、氏名に AForm、生年月日に MForm を使っている。

mformPerson :: MForm App App (FormResult (Text, Day), Widget)
mformPerson = do
    (nameRes, nameWidget) <- flip renderBootstrap "" $ areq textField "氏名" Nothing
    (dobYearRes, dobYearView) <- mreq intField (small "") Nothing
    (dobMonthRes, dobMonthView) <- mreq intField (small "") Nothing
    (dobDayRes, dobDayView) <- mreq intField (small "") Nothing
    let res = (,)
            <$> nameRes
            <*> (fromGregorian
                <$> fmap fromIntegral dobYearRes
                <*> dobMonthRes
                <*> dobDayRes
                )
    let dobErrors = fvErrors dobYearView <|> fvErrors dobMonthView <|> fvErrors dobDayView
    let widget = [whamlet|$newline never
<!-- name -->
^{nameWidget}

<!-- date of birth -->
<div .control-group :has dobErrors:.error .required>
    <label .control-label for=#{fvId dobYearView}>生年月日
    <div .controls>
        ^{fvInput dobYearView} 年
        ^{fvInput dobMonthView} 月
        ^{fvInput dobDayView} 日
        $maybe err <- dobErrors
            <span .help-block>#{err}
|]  

    return (res, widget)
    where
        small lbl = lbl { fsAttrs = [("class", "input-small")] }
        has (Just _) = True
        has Nothing = False