diff --git a/digestive-functors-blaze.cabal b/digestive-functors-blaze.cabal --- a/digestive-functors-blaze.cabal +++ b/digestive-functors-blaze.cabal @@ -1,6 +1,6 @@ Name: digestive-functors-blaze -Version: 0.0.2.2 -Synopsis: Snap backend for the digestive-functors library +Version: 0.1.0.0 +Synopsis: Blaze frontend for the digestive-functors library Description: This is a blaze frontend for the digestive-functors library. Homepage: http://github.com/jaspervdj/digestive-functors @@ -17,5 +17,5 @@ Hs-source-dirs: src Exposed-modules: Text.Digestive.Blaze.Html5 Build-depends: base >= 4 && < 5, - digestive-functors == 0.0.2.*, - blaze-html >= 0.3 && < 0.4 + digestive-functors == 0.1.0.*, + blaze-html >= 0.3 && < 0.6 diff --git a/src/Text/Digestive/Blaze/Html5.hs b/src/Text/Digestive/Blaze/Html5.hs --- a/src/Text/Digestive/Blaze/Html5.hs +++ b/src/Text/Digestive/Blaze/Html5.hs @@ -13,6 +13,8 @@ , label , errors , childErrors + , inputList + , inputListJs , module Text.Digestive.Forms.Html ) where @@ -20,7 +22,7 @@ import Data.Maybe (fromMaybe) import Data.Monoid (mempty) -import Text.Blaze.Html5 (Html, (!)) +import Text.Blaze.Html5 (Html, (!), toValue, toHtml) import qualified Text.Blaze.Html5 as H import qualified Text.Blaze.Html5.Attributes as A @@ -41,7 +43,7 @@ -> Html -- ^ HTML element -> Html -- ^ Resulting element applyClasses' = applyClasses $ \element value -> - element ! A.class_ (H.stringValue value) + element ! A.class_ (toValue value) -- | Checks the input element when the argument is true -- @@ -50,24 +52,22 @@ checked True x = x ! A.checked "checked" inputText :: (Monad m, Functor m, FormInput i f) - => Maybe String - -> Form m i e BlazeFormHtml String + => Formlet m i e BlazeFormHtml String inputText = Forms.inputString $ \id' inp -> createFormHtml $ \cfg -> applyClasses' [htmlInputClasses] cfg $ H.input ! A.type_ "text" - ! A.name (H.stringValue $ show id') - ! A.id (H.stringValue $ show id') - ! A.value (H.stringValue $ fromMaybe "" inp) + ! A.name (toValue $ show id') + ! A.id (toValue $ show id') + ! A.value (toValue $ fromMaybe "" inp) inputHidden :: (Monad m, Functor m, FormInput i f) - => Maybe String - -> Form m i e BlazeFormHtml String + => Formlet m i e BlazeFormHtml String inputHidden = Forms.inputString $ \id' inp -> createFormHtml $ \cfg -> applyClasses' [htmlInputClasses] cfg $ H.input ! A.type_ "hidden" - ! A.name (H.stringValue $ show id') - ! A.id (H.stringValue $ show id') - ! A.value (H.stringValue $ fromMaybe "" inp) + ! A.name (toValue $ show id') + ! A.id (toValue $ show id') + ! A.value (toValue $ fromMaybe "" inp) inputTextArea :: (Monad m, Functor m, FormInput i f) => Maybe Int -- ^ Rows @@ -76,14 +76,14 @@ -> Form m i e BlazeFormHtml String -- ^ Result inputTextArea r c = Forms.inputString $ \id' inp -> createFormHtml $ \cfg -> applyClasses' [htmlInputClasses] cfg $ rows r $ cols c $ - H.textarea ! A.name (H.stringValue $ show id') - ! A.id (H.stringValue $ show id') - $ H.string $ fromMaybe "" inp + H.textarea ! A.name (toValue $ show id') + ! A.id (toValue $ show id') + $ toHtml $ fromMaybe "" inp where rows Nothing = id - rows (Just x) = (! A.rows (H.stringValue $ show x)) + rows (Just x) = (! A.rows (toValue $ show x)) cols Nothing = id - cols (Just x) = (! A.cols (H.stringValue $ show x)) + cols (Just x) = (! A.cols (toValue $ show x)) inputTextRead :: (Monad m, Functor m, FormInput i f, Show a, Read a) => e @@ -92,18 +92,18 @@ inputTextRead error' = flip Forms.inputRead error' $ \id' inp -> createFormHtml $ \cfg -> applyClasses' [htmlInputClasses] cfg $ H.input ! A.type_ "text" - ! A.name (H.stringValue $ show id') - ! A.id (H.stringValue $ show id') - ! A.value (H.stringValue $ fromMaybe "" inp) + ! A.name (toValue $ show id') + ! A.id (toValue $ show id') + ! A.value (toValue $ fromMaybe "" inp) inputPassword :: (Monad m, Functor m, FormInput i f) => Form m i e BlazeFormHtml String inputPassword = flip Forms.inputString Nothing $ \id' inp -> createFormHtml $ \cfg -> applyClasses' [htmlInputClasses] cfg $ H.input ! A.type_ "password" - ! A.name (H.stringValue $ show id') - ! A.id (H.stringValue $ show id') - ! A.value (H.stringValue $ fromMaybe "" inp) + ! A.name (toValue $ show id') + ! A.id (toValue $ show id') + ! A.value (toValue $ fromMaybe "" inp) inputCheckBox :: (Monad m, Functor m, FormInput i f) => Bool @@ -111,8 +111,8 @@ inputCheckBox inp = flip Forms.inputBool inp $ \id' inp' -> createFormHtml $ \cfg -> applyClasses' [htmlInputClasses] cfg $ checked inp' $ H.input ! A.type_ "checkbox" - ! A.name (H.stringValue $ show id') - ! A.id (H.stringValue $ show id') + ! A.name (toValue $ show id') + ! A.id (toValue $ show id') inputRadio :: (Monad m, Functor m, FormInput i f, Eq a) => Bool -- ^ Use @
@ tags @@ -124,10 +124,10 @@ toView group id' sel val = createFormHtml $ \cfg -> do applyClasses' [htmlInputClasses] cfg $ checked sel $ H.input ! A.type_ "radio" - ! A.name (H.stringValue $ show group) - ! A.value (H.stringValue id') - ! A.id (H.stringValue id') - H.label ! A.for (H.stringValue id') + ! A.name (toValue $ show group) + ! A.value (toValue id') + ! A.id (toValue id') + H.label ! A.for (toValue id') $ fromMaybe mempty $ lookup val choices when br H.br @@ -138,8 +138,8 @@ toView id' = createFormHtmlWith MultiPart $ \cfg -> do applyClasses' [htmlInputClasses] cfg $ H.input ! A.type_ "file" - ! A.name (H.stringValue $ show id') - ! A.id (H.stringValue $ show id') + ! A.name (toValue $ show id') + ! A.id (toValue $ show id') submit :: Monad m => String -- ^ Text on the submit button @@ -147,15 +147,15 @@ submit text = view $ createFormHtml $ \cfg -> applyClasses' [htmlInputClasses, htmlSubmitClasses] cfg $ H.input ! A.type_ "submit" - ! A.value (H.stringValue text) + ! A.value (toValue text) label :: Monad m => String -> Form m i e BlazeFormHtml () label string = Common.label $ \id' -> createFormHtml $ \cfg -> applyClasses' [htmlLabelClasses] cfg $ - H.label ! A.for (H.stringValue $ show id') - $ H.string string + H.label ! A.for (toValue $ show id') + $ toHtml string errorList :: [Html] -> BlazeFormHtml errorList errors' = createFormHtml $ \cfg -> unless (null errors') $ @@ -169,3 +169,106 @@ childErrors :: Monad m => Form m i Html BlazeFormHtml () childErrors = Common.childErrors errorList + +-- | Wraps the more generic 'Text.Digestive.Forms.inputList' function to +-- provide a reasonable default for adding add/remove controls to a form. +-- The whole thing is wrapped in another div with the class inputList. For +-- this function to work, the javascript code in 'inputListJs' or something +-- similar must be in scope. +-- +-- The user needs to specify the hidden formlet because transformRead requires +-- an error parameter, and this function can't specify it without loss of +-- generality. The idea is that the extra power of being able to customize +-- the formlet is worth the small amount of extra code compared to having to +-- specify the error. +-- +inputList :: (Monad m, Functor m, FormInput i f) + => Formlet m i e BlazeFormHtml Int + -- ^ The formlet holding the number of items in the list + -> Formlet m i e BlazeFormHtml a + -- ^ The formlet used for each list item. This function surrounds it + -- with a div tag with the inputListItem class. + -> Formlet m i e BlazeFormHtml [a] + -- ^ The dynamic list formlet +inputList hidden single d = + mapView (fmap addControls) $ Forms.inputList hidden s d + where + s def = mapView (fmap (H.div ! A.class_ "inputListItem")) $ single def + addControls form = do + H.div ! A.class_ "inputList" $ do + H.div $ do + H.input ! A.type_ "button" + ! A.onclick "addItem(this); return false;" + ! A.value "Add Item" + H.input ! A.type_ "button" + ! A.onclick "removeItem(this); return false;" + ! A.value "Remove Item" + form + +-- | A string containing the javascript functions needed for inputList. This +-- code requires JQuery. +-- +inputListJs :: String +inputListJs = unlines + ["// Requires that JQuery also be in scope" + ,"function findInputList(button) {" + ," var mainDiv = $(button).parent();" + ," while ( !mainDiv.hasClass('inputList') ) {" + ," mainDiv = $(mainDiv).parent();" + ," }" + ," return mainDiv;" + ,"}" + ,"" + ,"function findItems(button) {" + ," return $('.inputListItem', findInputList(button));" + ,"}" + ,"" + ,"function addItem(button) {" + ," var count = $(':hidden', findInputList(button))[0];" + ," var items = findItems(button);" + ," var item = $(items[items.length-1]);" + ," var newItem = item.clone(true);" + ," var i;" + ,"" + ," // Increment counter" + ," $(count).val(parseInt($(count).val())+1);" + ,"" + ," // We have to change the raw html because IE doesn't allow the" + ," // name field to be changed." + ," newItem.html(newItem.html().replace(/fval\\[(\\d+\\.)*(\\d+)\\.(\\d+)\\]/g," + ," function(a, b, c, d) {" + ," var newC = parseInt(c)+1;" + ," return a.replace(/\\d+\\.\\d+\\]/, newC+'.'+d+']');" + ," }" + ," ));" + ," newItem.appendTo(item.parent());" + ,"" + ," // Copy the values of all children that had the name attribute set." + ," // The direct html insertion does not preserve the most current" + ," // values. It only preserves default values, so if we want values" + ," // copied, we have to use an approach like this." + ," var items2 = findItems(button);" + ," var newLast = $(items2[items2.length-1]);" + ," var c1 = $('[name]', item);" + ," var c2 = $('[name]', newLast);" + ," if ( c1.length == c2.length ) {" + ," for ( i = 0; i < c1.length; i++ ) {" + ," $(c2[i]).val($(c1[i]).val());" + ," }" + ," }" + ,"}" + ,"" + ,"function removeItem(button) {" + ," var items = findItems(button);" + ," if ( items.length > 1 ) {" + ," var count = $(':hidden', findInputList(button))[0];" + ," var item = $(items[items.length-1]);" + ," item.remove();" + ,"" + ," // Decrement counter" + ," $(count).val(parseInt($(count).val())-1);" + ," } else {" + ," alert('Cannot remove any more rows');" + ," }" + ,"}" + ]