formlets (empty) → 0.1

raw patch · 5 files changed

+189/−0 lines, 5 filesdep +applicative-extrasdep +basedep +haskell98setup-changed

Dependencies added: applicative-extras, base, haskell98, mtl, xhtml

Files

LICENSE +30/−0
Setup.hs +2/−0
Text/Formlets.hs +78/−0
Text/Formlets/Form.hs +59/−0
formlets.cabal +20/−0

+ LICENSE view

@@ -0,0 +1,30 @@+Copyright (c) 2008, Tupil++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 Tupil 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

+ Text/Formlets.hs view

@@ -0,0 +1,78 @@+{-# LANGUAGE TypeOperators #-}+module Text.Formlets ( module Text.Formlets.Form+                     , input , password , inputF , passwordF,ensure+                     , FailingForm, validate, runFormState, inputIntegerF+                     , check, liftForm+                     )+                     where++import Text.Formlets.Form+import Control.Applicative+import Control.Applicative.Compose+import Control.Applicative.Error+import Control.Applicative.State+import Text.XHtml.Strict ((!))+import qualified Text.XHtml.Strict as X++-- | Apply a predicate to a value and return Success or Failure as appropriate+ensure :: Show a +       => (a -> Bool) -- ^ The predicate+       -> String      -- ^ The error message, in case the predicate fails+       -> a           -- ^ The value+       -> Failing a+ensure p msg x | p x = Success x+               | otherwise = Failure [msg]++-- | Helper function for genereting input components based.+input' :: (String -> String -> X.Html) -> Maybe String -> Form String+input' i defaultValue = Form $ \env -> mkInput env <$> freshName+   where mkInput :: Env -> String -> (Collector String, Xml)+         mkInput env name = (`queryParam` name,+                             i name (value name env))+         value name env = maybe (maybe "" id defaultValue) id (lookup name env)++-- | A form whose output may fail+type FailingForm a = (Form :+: Failing) a++runFormState :: Env             -- ^ A previously filled environment (may be empty)+             -> FailingForm a   -- ^ The form+             -> FormState       -- ^ Initial form state+             -> ((Collector (Failing a), Xml), FormState)+runFormState e f s = (runState (deform (decompose f) e) s)++-- | Lifts a function on a Form to a function on a composed form.+liftForm :: (Form (f a) -> Form (f a)) -> (Form :+: f) a -> (Form :+: f) a+liftForm f = Compose . f . decompose++-- | Lift a form component to a failing form component+validate :: Form a -> FailingForm a+validate f = Compose $ pure Success <*> f++-- | Add additional validation to an already validated component+check :: FailingForm a -> (a -> Failing b) -> FailingForm b+check form f = decompose form `chk` checker f+   where chk :: Form a -> (a -> Failing b) -> FailingForm b+         chk form validator = Compose $ pure validator <*> form+         checker :: (a -> Failing b) -> (Failing a -> Failing b)+         checker f (Failure x) = Failure x+         checker f (Success x) = f x++-- | Component: an input field with an optional value+input :: Maybe String -> Form String+input = input' (\n v -> X.textfield n ! [X.value v])++-- | Component: a password field with an optional value+password :: Maybe String -> Form String+password = input' (\n v -> X.password n ! [X.value v])++-- | A trivially validated input component+inputF :: Maybe String -> FailingForm String+inputF = validate . input++-- | A trivially validated password component+passwordF :: Maybe String -> FailingForm String+passwordF = validate . password++-- | A validated integer component+inputIntegerF :: Maybe Integer -> FailingForm Integer+inputIntegerF x = validate (input $ fmap show x) `check` asInteger

+ Text/Formlets/Form.hs view

@@ -0,0 +1,59 @@+module Text.Formlets.Form where++import Control.Applicative+import Control.Applicative.State+import Text.XHtml.Strict ((+++))+import Text.XHtml.Strict as X++type Env = [(String, String)]+type FormState = Names+type Names = Integer+type Name = String+type Xml = X.Html++queryParam :: Env -> Name -> String+queryParam env name = case (name `lookup` env) of+                           Nothing -> error $ "Couldn't find " ++ name+                           Just x  -> x++newtype Form a = Form { deform :: Env -> State FormState (Collector a, X.Html) }++instance Functor Form where+  fmap f (Form a) = Form $ \env -> (fmap . fmapFst . fmap) f (a env)+   where fmapFst f (a, b) = (f a, b)++type Collector a = Env -> a++instance Applicative Form where+   pure = pureF+   (<*>) = applyF++pureF :: a -> Form a+pureF v = Form $ \env -> pure (const v, X.noHtml) -- K++applyF :: Form (a -> b) -> Form a -> Form b+(Form f) `applyF` (Form v) = Form $ \env -> pure combine <*> f env <*> v env+   where combine (f, x) (v, y) = (\e -> f e (v e), x +++ y)++-- TODO ORYO+freshName :: State FormState String+freshName = do n <- get+               put $ n + 1+               return $ "input_" ++ show n++currentName :: State FormState String+currentName = gets $ (++) "input_" . show++{- component: just some xml -}+xml :: X.Html -> Form ()+xml x = Form $ \env -> pure (const (), x)++{- component: just some text -}+text :: String -> Form ()+text s = Form $ \env -> pure (const (), toHtml s)++{- transform the XML component -}+plug :: (Xml -> Xml) -> Form a -> Form a+f `plug` (Form m) = Form $ \env -> pure plugin <*> m env+   where plugin :: (a, Xml) -> (a, Xml)+         plugin (c, x) = (c, f x)

+ formlets.cabal view

@@ -0,0 +1,20 @@+Name:            formlets+Version:         0.1+Synopsis:        Formlets implemented in Haskell+Description:     A modular way to build forms based on applicative functors, as+                 described in:+                 .+                  * Ezra Cooper, Samuel Lindley, Philip Wadler and Jeremy Yallop+                    \"An idiom's guide to formlets\"+                    Technical Report, EDI-INF-RR-1263.+                    <http://groups.inf.ed.ac.uk/links/formlets/>+Category:        XML, Web, User Interfaces, Text+License:         BSD3+License-file:    LICENSE+Copyright:       (c) Jeremy Yallop / Tupil+Author:          Jeremy Yallop / Chris Eidhof+Maintainer:      Chris Eidhof <ce+hackage@tupil.com>+Exposed-Modules:   Text.Formlets.Form+                 , Text.Formlets+Build-Type:      Simple+Build-Depends:   base, haskell98, mtl, xhtml, applicative-extras