formlets 0.2 → 0.2.1

raw patch · 5 files changed

+161/−164 lines, 5 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• Text/Formlets.hs +107/−3
• Text/Formlets/Base.hs +0/−110
• Text/Formlets/Widgets.hs +0/−48
• Text/XHtml/Strict/Formlets.hs +52/−0
• formlets.cabal +2/−3

@@ -1,4 +1,108 @@-module Text.Formlets (module W, module B) where+module Text.Formlets ( input', fmapFst+                     , check, ensure, ensures+                     , runFormState +                     , xml, plug+                     , Env , Form , Plus (..)+                     )+                     where -import Text.Formlets.Widgets as W-import Text.Formlets.Base as B+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 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

@@ -1,110 +0,0 @@-{-# 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

@@ -1,48 +0,0 @@-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" 

@@ -0,0 +1,52 @@+module Text.XHtml.Strict.Formlets ( input, textarea, password+                                  , hidden, inputInteger, radio, enumRadio+                                  , XHtmlForm+                                  , module Text.Formlets+                                  ) where++import Text.Formlets+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+inputInteger :: Maybe Integer -> XHtmlForm Integer+inputInteger 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" 

@@ -1,5 +1,5 @@ Name:            formlets-Version:         0.2+Version:         0.2.1 Synopsis:        Formlets implemented in Haskell Description:     A modular way to build forms based on applicative functors, as                  described in:@@ -15,7 +15,6 @@ Author:          Jeremy Yallop / Chris Eidhof Maintainer:      Chris Eidhof <ce+hackage@tupil.com> Exposed-Modules:   Text.Formlets-                 , Text.Formlets.Base-                 , Text.Formlets.Widgets+                 , Text.XHtml.Strict.Formlets Build-Type:      Simple Build-Depends:   base, haskell98, mtl, xhtml, applicative-extras