packages feed

formlets 0.1 → 0.2

raw patch · 5 files changed

+165/−139 lines, 5 files

Files

Text/Formlets.hs view
@@ -1,78 +1,4 @@-{-# 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+module Text.Formlets (module W, module B) where --- | A validated integer component-inputIntegerF :: Maybe Integer -> FailingForm Integer-inputIntegerF x = validate (input $ fmap show x) `check` asInteger+import Text.Formlets.Widgets as W+import Text.Formlets.Base as B
+ Text/Formlets/Base.hs view
@@ -0,0 +1,110 @@+{-# LANGUAGE TypeOperators #-}+module Text.Formlets.Base (+                     input', fmapFst+                     , check, ensure, ensures+                     , runFormState +                     , xml, plug+                     , Env , Form , Plus (..)+                     )+                     where++import Control.Applicative+import Control.Applicative.Error+import Control.Applicative.State+import Data.Maybe (isJust)++class Plus a where+  zero :: a+  plus :: a -> a -> a++-- | 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]++-- | Apply multiple predicates to a value, return Success or all the Failure messages+ensures :: Show a+        => [(a -> Bool, String)] -- ^ List of predicate functions and error messages, in case the predicate fails+        -> a                     -- ^ The value+        -> Failing a+ensures ps x | null errors = Success x+             | otherwise   = Failure errors+    where errors = [ err | (p, err) <- ps, not $ p x ]++-- | Helper function for genereting input components based forms.+input' :: (String -> String -> xml) -> Maybe String -> Form xml String+input' i defaultValue = Form $ \env -> mkInput env <$> freshName+   where mkInput env name = (Success . (`queryParam` (name)),+                             i name (value name env))+         value name env = maybe (maybe "" id defaultValue) id (lookup name env)++-- | Runs the form state+runFormState :: Env             -- ^ A previously filled environment (may be empty)+             -> Form xml a      -- ^ The form+             -> (Collector (Failing a), xml)+runFormState e (Form f) = evalState (f e) 0++-- | Add additional validation to an already validated component+check :: Form xml a -> (a -> Failing b) -> Form xml b+check (Form frm) f = Form $ \e -> checker (frm e)+ where checker = fmap $ fmapFst (f' .)+       f' (Failure x) = Failure x+       f' (Success x) = f x++--- Form stuff+type Env = [(String, String)]+type FormState = Names+type Names = Integer+type Name = String++queryParam :: Env -> Name -> String+queryParam env name = case (name `lookup` env) of+                           Nothing -> error $ "Couldn't find " ++ name+                           Just x  -> x+++newtype Form xml a = Form { deform :: Env -> State FormState (Collector (Failing a), xml) }++instance Plus xml => Functor (Form xml) where+  fmap f (Form a) = Form $ \env -> (fmap . fmapFst . fmap . fmap) f (a env)++fmapFst f (a, b) = (f a, b)++type Collector a = Env -> a++instance Plus xml => Applicative (Form xml) where+   pure = pureF+   (<*>) = applyF++pureF :: Plus xml => a -> Form xml a+pureF v = Form $ \env -> pure (const (Success v), zero) -- K++applyF :: Plus xml => Form xml (a -> b) -> Form xml a -> Form xml b+(Form f) `applyF` (Form v) = Form $ \env -> pure combine <*> f env <*> v env+  where combine (v1, xml1) (v2, xml2) = (\e -> v1 e <*> v2 e, xml1 `plus` xml2)+++-- | Component: just some xml+xml :: xml -> Form xml ()+xml x = Form $ \env -> pure (const $ Success (), x)++-- | Transform the XML component+plug :: Plus xml => (xml -> xml) -> Form xml a -> Form xml a+f `plug` (Form m) = Form $ \env -> pure plugin <*> m env+   where plugin (c, x) = (c, f x)++-----------------------------------------------+-- Private methods+-----------------------------------------------++freshName :: State FormState String+freshName = do n <- currentName+               modify (+1)+               return n++currentName :: State FormState String+currentName = gets $ (++) "input" . show
− Text/Formlets/Form.hs 
@@ -1,59 +0,0 @@-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)
+ Text/Formlets/Widgets.hs view
@@ -0,0 +1,48 @@+module Text.Formlets.Widgets where++import Text.Formlets.Base+import qualified Text.XHtml.Strict as X+import Text.XHtml.Strict ((!), (+++))+import Control.Applicative.Error++type XHtmlForm a = Form X.Html a++instance Plus X.Html where+  zero = X.noHtml+  plus = (+++)++-- | An input field with an optional value+input :: Maybe String -> XHtmlForm String+input = input' (\n v -> X.textfield n ! [X.value v])++textarea :: Maybe String -> XHtmlForm String+textarea = input' (\n v -> X.textarea (X.toHtml v) ! [X.name n])++-- | A password field with an optional value+password :: Maybe String -> XHtmlForm String+password = input' (\n v -> X.password n ! [X.value v])++-- | A hidden input field+hidden  :: Maybe String -> XHtmlForm String+hidden  =  input' X.hidden++-- | A validated integer component+inputIntegerF :: Maybe Integer -> XHtmlForm Integer+inputIntegerF x = input (fmap show x) `check` asInteger ++-- | A radio choice+radio :: [(String, String)] -> Maybe String -> XHtmlForm String+radio choices = input' mkRadios -- todo: validate that the result was in the choices+ where radio n v i = X.input ! [X.thetype "radio", X.name n, X.identifier i, X.theclass "radio", X.value v]+       mkRadios name selected = X.concatHtml $ map (mkRadio name selected) (zip choices [1..])+       mkRadio  name selected ((value, label), idx) = (radio name value ident) ! attrs +                                                   +++ X.label (X.toHtml label) ! [X.thefor ident, X.theclass "radio"]+        where attrs | selected == value = [X.checked]+                    | otherwise = []+              ident = name ++ "_" ++ show idx++enumRadio :: (Enum a) => [(a, String)] -> Maybe a -> XHtmlForm a+enumRadio values defaultValue = radio (map toS values) (fmap (show . fromEnum) defaultValue) +                                `check` convert `check` tryToEnum+ where toS = fmapFst (show . fromEnum)+       convert v = maybeRead' v "Conversion error"
formlets.cabal view
@@ -1,5 +1,5 @@ Name:            formlets-Version:         0.1+Version:         0.2 Synopsis:        Formlets implemented in Haskell Description:     A modular way to build forms based on applicative functors, as                  described in:@@ -14,7 +14,8 @@ Copyright:       (c) Jeremy Yallop / Tupil Author:          Jeremy Yallop / Chris Eidhof Maintainer:      Chris Eidhof <ce+hackage@tupil.com>-Exposed-Modules:   Text.Formlets.Form-                 , Text.Formlets+Exposed-Modules:   Text.Formlets+                 , Text.Formlets.Base+                 , Text.Formlets.Widgets Build-Type:      Simple Build-Depends:   base, haskell98, mtl, xhtml, applicative-extras