digestive-functors-heist (empty) → 0.3.0.0
raw patch · 4 files changed
+344/−0 lines, 4 filesdep +basedep +digestive-functorsdep +heistsetup-changed
Dependencies added: base, digestive-functors, heist, text, xmlhtml
Files
- LICENSE +31/−0
- Setup.hs +2/−0
- digestive-functors-heist.cabal +24/−0
- src/Text/Digestive/Heist.hs +287/−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-heist.cabal view
@@ -0,0 +1,24 @@+Name: digestive-functors-heist+Version: 0.3.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+License: BSD3+License-file: LICENSE+Author: Jasper Van der Jeugt <m@jaspervdj.be>+Maintainer: Jasper Van der Jeugt <m@jaspervdj.be>+Category: Web+Build-type: Simple+Cabal-version: >= 1.6++Library+ Hs-source-dirs: src+ GHC-options: -Wall -fwarn-tabs+ Exposed-modules: Text.Digestive.Heist++ Build-depends:+ base >= 4 && < 5,+ digestive-functors >= 0.3.0.1 && < 0.4,+ heist >= 0.8 && < 0.9,+ text >= 0.11 && < 0.12,+ xmlhtml >= 0.1 && < 0.2
+ src/Text/Digestive/Heist.hs view
@@ -0,0 +1,287 @@+-- | This module provides a Heist frontend for the digestive-functors library.+--+-- Disclaimer: this documentation requires very basic familiarity with+-- digestive-functors. You might want to take a quick look at this tutorial+-- first:+--+-- <https://github.com/jaspervdj/digestive-functors/blob/master/examples/tutorial.lhs>+--+-- This module exports the functions 'digestiveSplices' and+-- 'bindDigestiveSplices', and most users will not require anything else.+--+-- These splices are used to create HTML for different form elements. This way,+-- the developer doesn't have to care about setting e.g. the previous values in+-- a text field when something goes wrong.+--+-- For documentation on the different splices, see the different functions+-- exported by this module. All splices have the same name as given in+-- 'digestiveSplices'.+--+-- You can give arbitrary attributes to most of the elements (i.e. where it+-- makes sense). This means you can do e.g.:+--+-- > <dfInputTextArea ref="description" cols="20" rows="3" />+{-# LANGUAGE OverloadedStrings #-}+module Text.Digestive.Heist+ ( -- * Core methods+ digestiveSplices+ , bindDigestiveSplices++ -- * Splices+ , dfInputText+ , dfInputTextArea+ , dfInputPassword+ , dfInputHidden+ , dfInputSelect+ , dfInputRadio+ , dfInputCheckbox+ , dfInputSubmit+ , dfLabel+ , dfForm+ , dfErrorList+ , dfChildErrorList+ , dfSubView+ ) where++import Control.Monad (liftM)+import Data.Maybe (fromMaybe)+import Data.Monoid (mappend)++import Data.Text (Text)+import Text.Digestive.View+import Text.Templating.Heist+import qualified Data.Text as T+import qualified Text.XmlHtml as X++bindDigestiveSplices :: Monad m => View Text -> HeistState m -> HeistState m+bindDigestiveSplices = bindSplices . digestiveSplices++digestiveSplices :: Monad m => View Text -> [(Text, Splice m)]+digestiveSplices view =+ [ ("dfInputText", dfInputText view)+ , ("dfInputTextArea", dfInputTextArea view)+ , ("dfInputPassword", dfInputPassword view)+ , ("dfInputHidden", dfInputHidden view)+ , ("dfInputSelect", dfInputSelect view)+ , ("dfInputRadio", dfInputRadio view)+ , ("dfInputCheckbox", dfInputCheckbox view)+ , ("dfInputSubmit", dfInputSubmit view)+ , ("dfLabel", dfLabel view)+ , ("dfForm", dfForm view)+ , ("dfErrorList", dfErrorList view)+ , ("dfChildErrorList", dfChildErrorList view)+ , ("dfSubView", dfSubView view)+ ]++attr :: Bool -> (Text, Text) -> [(Text, Text)] -> [(Text, Text)]+attr False _ = id+attr True a = (a :)++makeElement :: Text -> [X.Node] -> [(Text, Text)] -> [X.Node]+makeElement name nodes = return . flip (X.Element name) nodes++getRefAttributes :: Monad m => HeistT m (Text, [(Text, Text)])+getRefAttributes = do+ node <- getParamNode+ return $ case node of+ X.Element _ as _ ->+ let ref = fromMaybe (error $ show node ++ ": missing ref") $+ lookup "ref" as+ in (ref, filter ((/= "ref") . fst) as)+ _ -> (error "Wrong type of node!", [])++getContent :: Monad m => HeistT m [X.Node]+getContent = liftM X.childNodes getParamNode++-- | Generate a text input field. Example:+--+-- > <dfInputText ref="user.name" />+dfInputText :: Monad m => View v -> Splice m+dfInputText view = do+ (ref, attrs) <- getRefAttributes+ let ref' = absoluteRef ref view+ value = fieldInputText ref view+ return $ makeElement "input" [] $+ ("type", "text") : ("id", ref') :+ ("name", ref') : ("value", value) : attrs++-- | Generate a text area. Example:+--+-- > <dfInputTextArea ref="user.about" />+dfInputTextArea :: Monad m => View v -> Splice m+dfInputTextArea view = do+ (ref, attrs) <- getRefAttributes+ let ref' = absoluteRef ref view+ value = fieldInputText ref view+ return $ makeElement "textarea" [X.TextNode value] $+ ("id", ref') : ("name", ref') : attrs++-- | Generate a password field. Example:+--+-- > <dfInputPassword ref="user.password" />+dfInputPassword :: Monad m => View v -> Splice m+dfInputPassword view = do+ (ref, attrs) <- getRefAttributes+ let ref' = absoluteRef ref view+ value = fieldInputText ref view+ return $ makeElement "input" [] $+ ("type", "password") : ("id", ref') :+ ("name", ref') : ("value", value) : attrs++-- | Generate a hidden input field. Example:+--+-- > <dfInputHidden ref="user.forgery" />+dfInputHidden :: Monad m => View v -> Splice m+dfInputHidden view = do+ (ref, attrs) <- getRefAttributes+ let ref' = absoluteRef ref view+ value = fieldInputText ref view+ return $ makeElement "input" [] $+ ("type", "hidden") : ("id", ref') :+ ("name", ref') : ("value", value) : attrs++-- | Generate a select button (also known as a combo box). Example:+--+-- > <dfInputSelect ref="user.sex" />+dfInputSelect :: Monad m => View Text -> Splice m+dfInputSelect view = do+ (ref, attrs) <- getRefAttributes+ let ref' = absoluteRef ref view+ (choices, idx) = fieldInputChoice ref view+ children = zipWith makeOption choices [0 ..]+ value i = ref' `mappend` "." `mappend` T.pack (show i)+ makeOption c i = X.Element "option"+ (attr (idx == i) ("selected", "selected") [("value", value i)])+ [X.TextNode c]+ return $ makeElement "select" children $+ ("id", ref') : ("name", ref') : attrs++-- | Generate a number of radio buttons. Example:+--+-- > <dfInputRadio ref="user.sex" />+dfInputRadio :: Monad m => View Text -> Splice m+dfInputRadio view = do+ (ref, attrs) <- getRefAttributes++ let ref' = absoluteRef ref view+ (choices, idx) = fieldInputChoice ref view++ children = concat $ zipWith makeOption choices [0 ..]+ value i = ref' `mappend` "." `mappend` T.pack (show i)+ makeOption c i =+ [ X.Element "input"+ (attr (idx == i) ("checked", "checked") $+ ("type", "radio") : ("value", value i) :+ ("id", value i) : ("name", ref') :+ attrs ) []+ , X.Element "label" [("for", value i)] [X.TextNode c]+ ]++ return children++-- | Generate a checkbox. Example:+--+-- > <dfInputCheckbox ref="user.married" />+dfInputCheckbox :: Monad m => View Text -> Splice m+dfInputCheckbox view = do+ (ref, attrs) <- getRefAttributes+ let ref' = absoluteRef ref view+ value = fieldInputBool ref view+ return $ makeElement "input" [] $ attr value ("checked", "checked") $+ ("type", "checkbox") : ("id", ref') : ("name", ref') : attrs++-- | Generate a submit button. Example:+--+-- > <dfInputSubmit />+dfInputSubmit :: Monad m => View v -> Splice m+dfInputSubmit _ = do+ (_, attrs) <- getRefAttributes+ return $ makeElement "input" [] $ ("type", "submit") : attrs++-- | Generate a label for a field. Example:+--+-- > <dfLabel ref="user.married">Married: </dfLabel>+-- > <dfInputCheckbox ref="user.married" />+dfLabel :: Monad m => View v -> Splice m+dfLabel view = do+ (ref, attrs) <- getRefAttributes+ content <- getContent+ let ref' = absoluteRef ref view+ return $ makeElement "label" content $ ("for", ref') : attrs++-- | Generate a form tag with the @method@ attribute set to @POST@ and the+-- @enctype@ set to the right value (depending on the form). Example:+--+-- > <dfForm action="/users/new">+-- > <dfInputText ... />+-- > ...+-- > <dfInputSubmit />+-- > </dfForm>+dfForm :: Monad m => View v -> Splice m+dfForm view = do+ (_, attrs) <- getRefAttributes+ content <- getContent+ return $ makeElement "form" content $+ ("method", "POST") :+ ("enctype", T.pack (show $ viewEncType view)) :+ attrs++errorList :: [Text] -> [(Text, Text)] -> [X.Node]+errorList [] _ = []+errorList errs attrs = [X.Element "ul" attrs $ map makeError errs]+ where+ makeError e = X.Element "li" [] [X.TextNode e]++-- | Display the list of errors for a certain field. Example:+--+-- > <dfErrorList ref="user.name" />+-- > <dfInputText ref="user.name" />+dfErrorList :: Monad m => View Text -> Splice m+dfErrorList view = do+ (ref, attrs) <- getRefAttributes+ return $ errorList (errors ref view) attrs++-- | Display the list of errors for a certain form and all forms below it. E.g.,+-- if there is a subform called @\"user\"@:+--+-- > <dfChildErrorList ref="user" />+--+-- Or display /all/ errors for the form:+--+-- > <dfChildErrorList ref="" />+dfChildErrorList :: Monad m => View Text -> Splice m+dfChildErrorList view = do+ (ref, attrs) <- getRefAttributes+ return $ errorList (childErrors ref view) attrs++-- | This splice allows reuse of templates by selecting some child of a form+-- tree. While this may sound complicated, it's pretty straightforward and+-- practical. Suppose we have:+--+-- > <dfInputText ref="user.name" />+-- > <dfInputText ref="user.password" />+-- >+-- > <dfInputTextArea ref="comment.body" />+--+-- You may want to abstract the @\"user\"@ parts in some other template so you+-- Don't Repeat Yourself (TM). If you create a template called @\"user-form\"@+-- with the following contents:+-- +-- > <dfInputText ref="name" />+-- > <dfInputText ref="password" />+--+-- You will be able to use:+--+-- > <dfSubView ref="user">+-- > <apply template="user-form" />+-- > </dfSubView>+-- >+-- > <dfInputTextArea ref="comment.body" />+dfSubView :: Monad m => View Text -> Splice m+dfSubView view = do+ (ref, _) <- getRefAttributes+ content <- getContent+ let view' = subView ref view+ nodes <- localTS (bindDigestiveSplices view') $ runNodeList content+ stopRecursion+ return nodes