haskellyesodapplicativeyesod-forms

Nested form result in Haskell


I have the following handler/template combination:

handler/automation.hs

data AutomationRequest = AutomationRequest {
    arEnabled :: Bool
  , arTemplate :: Text
  , arSchedules :: Textarea
}

getAutomationR :: Handler Html
getAutomationR = do
    (formWidget, formEnctype) <- generateFormPost form
    defaultLayout $(widgetFile "automation")

form :: Form AutomationRequest
form extra = do
    (enabledRes, enabledView) <- mreq checkBoxField "" Nothing
    (templateRes, templateView) <- mreq textField (withPlaceholder "..." $ bfs (""::Text)) Nothing
    (schedulesRes, schedulesView) <- mreq textareaField (withPlaceholder "..." $ bfs (""::Text)) Nothing
    (_, submitView) <- mbootstrapSubmit $ BootstrapSubmit ("Save"::Text) ("btn-primary"::Text) []
    let requestRes = AutomationRequest <$> enabledRes <*> templateRes <*> schedulesRes
        widget = $(widgetFile "automation-form")
    return (requestRes, widget)

templates/automation.hamlet

<form method=post role=form action=@{AutomationR} enctype=#{formEnctype}>
    ^{formWidget}

templates/automation-form.hamlet

#{extra}

<div .panel .panel-default>
    <div .panel-heading>^{fvInput enabledView} ...
    <div .panel-body>
        ^{fvInput templateView}
        ^{fvInput schedulesView}

^{fvInput submitView}

This works as expected, but I want additional functionality:

a) I want to be able to nest data structures like:

data AutomationRequestCollection = AutomationRequestCollection {
    arcItemAbc :: AutomationRequest
  , arcItemDef :: AutomationRequest
  ... -- 10 Items

}

data AutomationRequest = AutomationRequest {
    arEnabled :: Bool
  , arTemplate :: Text
  , arSchedules :: Textarea
}

I don't know how to apply the nesting to let requestRes = AutomationRequest <$> enabledRes <*> templateRes <*> schedulesRes

b) Reuse the HTML panel for itemAbc, itemDef, ...:

-- loop somehow
<div .panel .panel-default>
    <div .panel-heading>^{fvInput enabledView} ...
    <div .panel-body>
        ^{fvInput templateView}
        ^{fvInput schedulesView}

Any ideas that could push me into the right direction?


Solution

  • I'm not sure about (b), but (a) should be straightforward Applicative composition, e.g.:

    Foo <$> (Bar <$> baz <*> bin) <*> qux
    

    It can also be easier to see if you break this into multiple functions:

    bar = Bar <$> baz <*> bin
    foo = Foo <$> bar <*> qux