module SimpleForm.Digestive (
SimpleForm,
simpleForm,
simpleForm',
input,
input_,
choiceInput,
choiceInput_,
toForm,
withFields,
wrap,
fieldset
) where
import Data.Monoid
import Control.Monad.Trans.Reader
import Control.Monad.Trans.Writer
import Control.Monad.Trans.Class
import Data.Text (Text)
import qualified Data.Text.Lazy as TL
import Text.Blaze.Html (Html, ToMarkup, toHtml)
import Text.Blaze.Html.Renderer.Text (renderHtml)
import qualified Text.Blaze.XHtml5 as HTML
import Text.Digestive.View
import SimpleForm
import SimpleForm.Render
import SimpleForm.Digestive.Internal
simpleForm :: (ToMarkup v) =>
Renderer
-> (View v, Maybe a)
-> SimpleForm a ()
-> Html
simpleForm render viewVal = snd . simpleForm' render viewVal
simpleForm' :: (ToMarkup v) =>
Renderer
-> (View v, Maybe a)
-> SimpleForm a r
-> (r, Html)
simpleForm' render (view, val) (SimpleForm form) =
runWriter $ runReaderT form (val, fmap toHtml view, render)
toForm :: (ToMarkup h) => h -> SimpleForm a ()
toForm = SimpleForm . lift . tell . toHtml
choiceInput ::
Text
-> (r -> Maybe a)
-> (GroupedCollection -> Widget a)
-> InputOptions
-> SimpleForm r ()
choiceInput n sel w opt = SimpleForm $ ReaderT $ \(env, view, render) ->
let
textView = fmap (TL.toStrict . renderHtml) view
collection = fieldInputChoiceGroup' [n] textView
in
tell $ input' n sel (w collection) opt (env, view, render)
choiceInput_ ::
Text
-> (r -> Maybe Text)
-> SimpleForm r ()
choiceInput_ n sel = choiceInput n sel select mempty
input ::
Text
-> (r -> Maybe a)
-> Widget a
-> InputOptions
-> SimpleForm r ()
input n sel w opt = SimpleForm $ ReaderT $ tell . input' n sel w opt
input_ :: (DefaultWidget a) =>
Text
-> (r -> Maybe a)
-> SimpleForm r ()
input_ n sel = input n sel wdef mempty
withFields ::
Maybe Text
-> (r' -> r)
-> SimpleForm r a
-> SimpleForm r' a
withFields n f (SimpleForm reader) = SimpleForm $
withReaderT (\(r, view, render) ->
(fmap f r, maybe view (`subView'` view) (fmap (:[]) n), render)
) reader
wrap :: (Html -> Html) -> SimpleForm r a -> SimpleForm r a
wrap f (SimpleForm reader) = SimpleForm $ ReaderT $ \env ->
let (a, w) = runWriter (runReaderT reader env) in
tell (f w) >> return a
fieldset :: Maybe Text -> (r' -> r) -> SimpleForm r a -> SimpleForm r' a
fieldset n f form = wrap HTML.fieldset $ do
maybe (return ()) (toForm . HTML.legend . toHtml . humanize) n
withFields n f form