digestive-functors-blaze (empty) → 0.0.2.0
raw patch · 4 files changed
+214/−0 lines, 4 filesdep +basedep +blaze-htmldep +digestive-functorssetup-changed
Dependencies added: base, blaze-html, digestive-functors
Files
- LICENSE +31/−0
- Setup.hs +2/−0
- digestive-functors-blaze.cabal +21/−0
- src/Text/Digestive/Blaze/Html5.hs +160/−0
+ LICENSE view
@@ -0,0 +1,31 @@+Copyright (c) 2010, Jasper Van der Jeugt+ +All rights reserved.+ +Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are+met:+ + * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.+ + * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.+ + * Neither the name of Jasper Van der Jeugt nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.+ +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ digestive-functors-blaze.cabal view
@@ -0,0 +1,21 @@+Name: digestive-functors-blaze+Version: 0.0.2.0+Synopsis: Snap backend for the digestive-functors library+Description: This is a blaze frontend for the digestive-functors library.++Homepage: http://github.com/jaspervdj/digestive-functors+License: BSD3+License-file: LICENSE+Author: Jasper Van der Jeugt+Maintainer: jaspervdj@gmail.com+Category: Web+Build-type: Simple+Cabal-version: >=1.6+++Library+ 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
+ src/Text/Digestive/Blaze/Html5.hs view
@@ -0,0 +1,160 @@+{-# LANGUAGE OverloadedStrings #-}+module Text.Digestive.Blaze.Html5+ ( BlazeFormHtml+ , inputText+ , inputTextArea+ , inputTextRead+ , inputPassword+ , inputCheckBox+ , inputRadio+ , inputFile+ , submit+ , label+ , errors+ , childErrors+ , module Text.Digestive.Forms.Html+ ) where++import Control.Monad (forM_, unless, when)+import Data.Maybe (fromMaybe)+import Data.Monoid (mempty)++import Text.Blaze.Html5 (Html, (!))+import qualified Text.Blaze.Html5 as H+import qualified Text.Blaze.Html5.Attributes as A++import Text.Digestive.Types+import Text.Digestive.Forms (FormInput (..))+import qualified Text.Digestive.Forms as Forms+import qualified Text.Digestive.Common as Common+import Text.Digestive.Forms.Html++-- | Form HTML generated by blaze+--+type BlazeFormHtml = FormHtml Html++-- | 'applyClasses' instantiated for blaze+--+applyClasses' :: [FormHtmlConfig -> [String]] -- ^ Labels to apply+ -> FormHtmlConfig -- ^ Label configuration+ -> Html -- ^ HTML element+ -> Html -- ^ Resulting element+applyClasses' = applyClasses $ \element value ->+ element ! A.class_ (H.stringValue value)++-- | Checks the input element when the argument is true+--+checked :: Bool -> Html -> Html+checked False x = x+checked True x = x ! A.checked "checked"++inputText :: (Monad m, Functor m, FormInput i f)+ => Maybe String+ -> Form 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)++inputTextArea :: (Monad m, Functor m, FormInput i f)+ => Maybe Int -- ^ Rows+ -> Maybe Int -- ^ Columns+ -> Maybe String -- ^ Default input+ -> 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+ where+ rows Nothing = id+ rows (Just x) = (! A.rows (H.stringValue $ show x))+ cols Nothing = id+ cols (Just x) = (! A.cols (H.stringValue $ show x))++inputTextRead :: (Monad m, Functor m, FormInput i f, Show a, Read a)+ => e+ -> Maybe a+ -> Form m i e BlazeFormHtml a+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)++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)++inputCheckBox :: (Monad m, Functor m, FormInput i f)+ => Bool+ -> Form m i e BlazeFormHtml Bool+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')++inputRadio :: (Monad m, Functor m, FormInput i f, Eq a)+ => Bool -- ^ Use @<br>@ tags+ -> a -- ^ Default option+ -> [(a, Html)] -- ^ Choices with their names+ -> Form m i e BlazeFormHtml a -- ^ Resulting form+inputRadio br def choices = Forms.inputChoice toView def (map fst choices)+ where+ 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')+ $ fromMaybe mempty $ lookup val choices+ when br H.br++inputFile :: (Monad m, Functor m, FormInput i f)+ => Form m i e BlazeFormHtml (Maybe f) -- ^ Form+inputFile = Forms.inputFile toView+ where+ 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')++submit :: Monad m+ => String -- ^ Text on the submit button+ -> Form m String e BlazeFormHtml () -- ^ Submit button+submit text = view $ createFormHtml $ \cfg ->+ applyClasses' [htmlInputClasses, htmlSubmitClasses] cfg $+ H.input ! A.type_ "submit"+ ! A.value (H.stringValue 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++errorList :: [Html] -> BlazeFormHtml+errorList errors' = createFormHtml $ \cfg -> unless (null errors') $+ applyClasses' [htmlErrorListClasses] cfg $+ H.ul $ forM_ errors' $ applyClasses' [htmlErrorClasses] cfg . H.li++errors :: Monad m+ => Form m i Html BlazeFormHtml ()+errors = Common.errors errorList++childErrors :: Monad m+ => Form m i Html BlazeFormHtml ()+childErrors = Common.childErrors errorList