diff --git a/digestive-functors-heist.cabal b/digestive-functors-heist.cabal
--- a/digestive-functors-heist.cabal
+++ b/digestive-functors-heist.cabal
@@ -1,5 +1,5 @@
Name: digestive-functors-heist
-Version: 0.5.1.1
+Version: 0.6.0.0
Synopsis: Heist frontend for the digestive-functors library
Description: Heist frontend for the digestive-functors library
Homepage: http://github.com/jaspervdj/digestive-functors
@@ -18,7 +18,7 @@
Build-depends:
base >= 4 && < 5,
- digestive-functors >= 0.5 && < 0.6,
+ digestive-functors >= 0.6 && < 0.7,
heist >= 0.10.2 && < 0.11,
mtl >= 2,
text >= 0.11 && < 0.12,
diff --git a/src/Text/Digestive/Heist.hs b/src/Text/Digestive/Heist.hs
--- a/src/Text/Digestive/Heist.hs
+++ b/src/Text/Digestive/Heist.hs
@@ -30,11 +30,13 @@
-- * Main splices
, dfInput
+ , dfInputList
, dfInputText
, dfInputTextArea
, dfInputPassword
, dfInputHidden
, dfInputSelect
+ , dfInputSelectGroup
, dfInputRadio
, dfInputCheckbox
, dfInputSubmit
@@ -51,6 +53,7 @@
--------------------------------------------------------------------------------
import Control.Monad (liftM, mplus)
+import Control.Monad.Trans
import Data.Function (on)
import Data.List (unionBy)
import Data.Maybe (fromMaybe)
@@ -63,33 +66,36 @@
--------------------------------------------------------------------------------
+import Text.Digestive.Form.List
import Text.Digestive.View
--------------------------------------------------------------------------------
-bindDigestiveSplices :: Monad m => View Text -> HeistState m -> HeistState m
+bindDigestiveSplices :: MonadIO m => View Text -> HeistState m -> HeistState m
bindDigestiveSplices = bindSplices . digestiveSplices
--------------------------------------------------------------------------------
-digestiveSplices :: Monad m => View Text -> [(Text, Splice m)]
+digestiveSplices :: MonadIO m => View Text -> [(Text, Splice m)]
digestiveSplices view =
- [ ("dfInput", dfInput view)
- , ("dfInputText", dfInputText view)
- , ("dfInputTextArea", dfInputTextArea view)
- , ("dfInputPassword", dfInputPassword view)
- , ("dfInputHidden", dfInputHidden view)
- , ("dfInputSelect", dfInputSelect view)
- , ("dfInputRadio", dfInputRadio view)
- , ("dfInputCheckbox", dfInputCheckbox view)
- , ("dfInputFile", dfInputFile view)
- , ("dfInputSubmit", dfInputSubmit view)
- , ("dfLabel", dfLabel view)
- , ("dfForm", dfForm view)
- , ("dfErrorList", dfErrorList view)
- , ("dfChildErrorList", dfChildErrorList view)
- , ("dfSubView", dfSubView view)
- , ("dfIfChildErrors", dfIfChildErrors view)
+ [ ("dfInput", dfInput view)
+ , ("dfInputList", dfInputList view)
+ , ("dfInputText", dfInputText view)
+ , ("dfInputTextArea", dfInputTextArea view)
+ , ("dfInputPassword", dfInputPassword view)
+ , ("dfInputHidden", dfInputHidden view)
+ , ("dfInputSelect", dfInputSelect view)
+ , ("dfInputSelectGroup", dfInputSelectGroup view)
+ , ("dfInputRadio", dfInputRadio view)
+ , ("dfInputCheckbox", dfInputCheckbox view)
+ , ("dfInputFile", dfInputFile view)
+ , ("dfInputSubmit", dfInputSubmit view)
+ , ("dfLabel", dfLabel view)
+ , ("dfForm", dfForm view)
+ , ("dfErrorList", dfErrorList view)
+ , ("dfChildErrorList", dfChildErrorList view)
+ , ("dfSubView", dfSubView view)
+ , ("dfIfChildErrors", dfIfChildErrors view)
]
@@ -205,18 +211,40 @@
(ref, attrs) <- getRefAttributes Nothing
let ref' = absoluteRef ref view
choices = fieldInputChoice ref view
- children = map makeOption choices
+ kids = map makeOption choices
value i = ref' `mappend` "." `mappend` i
makeOption (i, c, sel) = X.Element "option"
(attr sel ("selected", "selected") [("value", value i)])
[X.TextNode c]
- return $ makeElement "select" children $ addAttrs attrs
+ return $ makeElement "select" kids $ addAttrs attrs
[("id", ref'), ("name", ref')]
--------------------------------------------------------------------------------
+-- | Generate a select button (also known as a combo box). Example:
+--
+-- >
+dfInputSelectGroup :: Monad m => View Text -> Splice m
+dfInputSelectGroup view = do
+ (ref, attrs) <- getRefAttributes Nothing
+ let ref' = absoluteRef ref view
+ choices = fieldInputChoiceGroup ref view
+ kids = map makeGroup choices
+ value i = ref' `mappend` "." `mappend` i
+
+ makeGroup (name, options) = X.Element "optgroup"
+ [("label", name)] $ map makeOption options
+ makeOption (i, c, sel) = X.Element "option"
+ (attr sel ("selected", "selected") [("value", value i)])
+ [X.TextNode c]
+
+ return $ makeElement "select" kids $ addAttrs attrs
+ [("id", ref'), ("name", ref')]
+
+
+--------------------------------------------------------------------------------
-- | Generate a number of radio buttons. Example:
--
-- >
@@ -226,7 +254,7 @@
let ref' = absoluteRef ref view
choices = fieldInputChoice ref view
- children = concatMap makeOption choices
+ kids = concatMap makeOption choices
value i = ref' `mappend` "." `mappend` i
makeOption (i, c, sel) =
@@ -238,7 +266,7 @@
, X.Element "label" [("for", value i)] [X.TextNode c]
]
- return children
+ return kids
--------------------------------------------------------------------------------
@@ -374,16 +402,83 @@
-- >
-- >
-- >
-dfSubView :: Monad m => View Text -> Splice m
+dfSubView :: MonadIO m => View Text -> Splice m
dfSubView view = do
(ref, _) <- getRefAttributes Nothing
- content <- getContent
let view' = subView ref view
- nodes <- localHS (bindDigestiveSplices view') $ runNodeList content
+ nodes <- localHS (bindDigestiveSplices view') runChildren
return nodes
--------------------------------------------------------------------------------
+-- | This splice allows variable length lists. It binds several attribute
+-- splices providing functionality for dynamically manipulating the list. The
+-- following descriptions will use the example of a form named \"foo\" with a
+-- list subform named \"items\".
+--
+-- Splices:
+-- dfListItem - This tag must surround the markup for a single list item.
+-- It surrounds all of its children with a div with id \"foo.items\" and
+-- class \"inputList\".
+--
+-- Attribute Splices:
+-- itemAttrs - Attribute you should use on div, span, etc that surrounds all
+-- the markup for a single list item. This splice expands to an id of
+-- \"foo.items.ix\" (where ix is the index of the current item) and a
+-- class of \"inputListItem\".
+-- addControl - Use this attribute on the tag you use to define a control
+-- for adding elements to the list (usually a button or anchor). It adds
+-- an onclick attribute that calls a javascript function addInputListItem.
+-- removeControl - Use this attribute on the control for removing individual
+-- items. It adds an onclick attribute that calls removeInputListItem.
+dfInputList :: MonadIO m => View Text -> Splice m
+dfInputList view = do
+ (ref, _) <- getRefAttributes Nothing
+ let listRef = absoluteRef ref view
+ listAttrs =
+ [ ("id", listRef)
+ , ("class", "inputList")
+ ]
+ addControl _ = return
+ [ ("onclick", T.concat [ "addInputListItem(this, '"
+ , listRef
+ , "'); return false;"] ) ]
+ removeControl _ = return
+ [ ("onclick", T.concat [ "removeInputListItem(this, '"
+ , listRef
+ , "'); return false;"] ) ]
+ itemAttrs v _ = return
+ [ ("id", T.concat [listRef, ".", last $ "0" : viewContext v])
+ , ("class", T.append listRef ".inputListItem")
+ ]
+ templateAttrs v _ = return
+ [ ("id", T.concat [listRef, ".", last $ "-1" : viewContext v])
+ , ("class", T.append listRef ".inputListTemplate")
+ , ("style", "display: none;")
+ ]
+ items = listSubViews ref view
+ f attrs v = localHS (bindAttributeSplices [("itemAttrs", attrs v)] .
+ bindDigestiveSplices v) runChildren
+ dfListItem = do
+ template <- f templateAttrs (makeListSubView ref (-1) view)
+ res <- mapSplices (f itemAttrs) items
+ return $ template ++ res
+ attrSplices = [ ("addControl", addControl)
+ , ("removeControl", removeControl)
+ ]
+ nodes <- localHS (bindSplices [("dfListItem", dfListItem)] .
+ bindAttributeSplices attrSplices) runChildren
+ let indices = [X.Element "input"
+ [ ("type", "hidden")
+ , ("name", T.intercalate "." [listRef, indicesRef])
+ , ("value", T.intercalate "," $ map
+ (last . ("0":) . viewContext) items)
+ ] []
+ ]
+ return [X.Element "div" listAttrs (indices ++ nodes)]
+
+
+--------------------------------------------------------------------------------
-- | Render some content only if there are any errors. This is useful for markup
-- purposes.
--
@@ -395,7 +490,6 @@
dfIfChildErrors :: Monad m => View v -> Splice m
dfIfChildErrors view = do
(ref, _) <- getRefAttributes $ Just ""
- content <- getContent
if null (childErrors ref view)
then return []
- else runNodeList content
+ else runChildren