formlets 0.3 → 0.4

raw patch · 3 files changed

+54/−33 lines, 3 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Text/Formlets.hs +44/−23
• Text/XHtml/Strict/Formlets.hs +9/−9
• formlets.cabal +1/−1

@@ -1,5 +1,5 @@ module Text.Formlets ( input', inputFile, fmapFst-                     , check, ensure, ensures+                     , check, ensure, ensures, ensureM, checkM                      , runFormState                       , xml, plug                      , Env , Form , Plus (..)@@ -12,6 +12,7 @@ import Control.Applicative.State import Data.Maybe (isJust) import qualified Data.ByteString.Lazy as BS+import qualified Data.Traversable as T  -- Form stuff type Env = [(String, Either String File)]@@ -20,7 +21,7 @@ type Name = String type Collector a = Env -> a data FormContentType = UrlEncoded | MultiPart deriving (Eq, Show, Read)-newtype Form xml a = Form { deform :: Env -> State FormState (Collector (Failing a), xml, FormContentType) }+newtype Form xml m a = Form { deform :: Env -> State FormState (Collector (m (Failing a)), xml, FormContentType) } data File = File {content :: BS.ByteString, fileName :: String, contentType :: ContentType} deriving (Eq, Show, Read) data ContentType = ContentType { ctType :: String                                , ctSubtype :: String@@ -41,6 +42,14 @@ ensure p msg x | p x = Success x                | otherwise = Failure [msg] +ensureM :: (Monad m, Show a)+       => (a -> m Bool) -- ^ The predicate+       -> String      -- ^ The error message, in case the predicate fails+       -> a           -- ^ The value+       -> m (Failing a)+ensureM p msg x = do result <- p x+                     return $ if result then Success x else 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@@ -51,9 +60,9 @@     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' :: Monad m => (String -> String -> xml) -> Maybe String -> Form xml m String input' i defaultValue = Form $ \env -> mkInput env <$> freshName-   where mkInput env name = (fromLeft name . (lookup name),+   where mkInput env name = (return . fromLeft name . (lookup name),                              i name (value name env), UrlEncoded)          value name env = maybe (maybe "" id defaultValue) fromLeft' (lookup name env)          fromLeft' (Left x) = x@@ -62,44 +71,56 @@          fromLeft n (Just (Left x)) = Success x          fromLeft n _               = Failure [n ++ " is a file."] -inputFile :: (String -> xml) -> Form xml File+inputFile :: Monad m => (String -> xml) -> Form xml m File inputFile i = Form $ \env -> mkInput env <$> freshName-  where  mkInput env name    = (fromRight name . (lookup name), i name, MultiPart)+  where  mkInput env name    = (return . fromRight name . (lookup name), i name, MultiPart)          fromRight n Nothing          = Failure [n ++ " is not in the data"]          fromRight n (Just (Right x)) = Success x          fromRight n _                = Failure [n ++ " is not a file"]   -- | Runs the form state-runFormState :: Env             -- ^ A previously filled environment (may be empty)-             -> Form xml a      -- ^ The form-             -> (Collector (Failing a), xml, FormContentType)+runFormState :: Monad m +             => Env             -- ^ A previously filled environment (may be empty)+             -> Form xml m a      -- ^ The form+             -> (Collector (m (Failing a)), xml, FormContentType) 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 $ fmapFst3 (f' .)+check :: (Monad m) => Form xml m a -> (a -> Failing b) -> Form xml m b+check (Form frm) f = Form $ fmap checker frm+ where checker = fmap $ fmapFst3 (fmap . liftM $ f') -- fmap $ fmapFst3 (fmap (f' f .))        f' (Failure x) = Failure x-       f' (Success x) = f x+       f' (Success x)  = f x +-- | Add additional validation to an already validated component+checkM :: (Monad m) => Form xml m a -> (a -> m (Failing b)) -> Form xml m b+checkM (Form frm) f = Form $ fmap checker frm+ where checker = fmap $ fmapFst3 (fmap f') -- fmap $ fmapFst3 (fmap (f' f .))+       f' v' = do v <- v'+                  case v of+                       Failure msg -> return $ Failure msg+                       Success x   -> f x -instance Functor (Form xml) where-  fmap f (Form a) = Form $ \env -> (fmap . fmapFst3 . fmap . fmap) f (a env)+instance (Functor m, Monad m) => Functor (Form xml m) where+  fmap f (Form a) = Form $ \env -> (fmap . fmapFst3 . liftM . fmap . fmap) f (a env)  fmapFst  f (a, b)    = (f a, b) fmapFst3 f (a, b, c) = (f a, b, c) -instance Plus xml => Applicative (Form xml) where+instance (Monad m, Applicative m, Plus xml) => Applicative (Form xml m) where    pure = pureF    (<*>) = applyF -pureF :: Plus xml => a -> Form xml a-pureF v = Form $ \env -> pure (const (Success v), zero, UrlEncoded)+pureF :: (Monad m, Plus xml) => a -> Form xml m a+pureF v = Form $ \env -> pure (const (return $ Success v), zero, UrlEncoded) -applyF :: Plus xml => Form xml (a -> b) -> Form xml a -> Form xml b+applyF :: (Monad m, Applicative m, Plus xml) => Form xml m (a -> b) -> Form xml m a -> Form xml m b (Form f) `applyF` (Form v) = Form $ \env -> pure combine <*> f env <*> v env-  where combine (v1, xml1, t1) (v2, xml2, t2) = (\e -> v1 e <*> v2 e, xml1 `plus` xml2, t1 `orT` t2)+  where combine (v1, xml1, t1) (v2, xml2, t2) = (first v1 v2, xml1 `plus` xml2, t1 `orT` t2)+        first v1 v2 e = do x <- v1 e +                           y <- v2 e+                           return $ x <*> y  orT UrlEncoded x = x orT x UrlEncoded = x@@ -107,11 +128,11 @@   -- | Component: just some xml-xml :: xml -> Form xml ()-xml x = Form $ \env -> pure (const $ Success (), x, UrlEncoded)+xml :: Monad m => xml -> Form xml m ()+xml x = Form $ \env -> pure (const $ return $ Success (), x, UrlEncoded)  -- | Transform the XML component-plug :: Plus xml => (xml -> xml) -> Form xml a -> Form xml a+plug :: Plus xml => (xml -> xml) -> Form xml m a -> Form xml m a f `plug` (Form m) = Form $ \env -> pure plugin <*> m env    where plugin (c, x, t) = (c, f x, t) 

@@ -9,36 +9,36 @@ import Text.XHtml.Strict ((!), (+++)) import Control.Applicative.Error -type XHtmlForm a = Form X.Html a+type XHtmlForm m a = Form X.Html m a  instance Plus X.Html where   zero = X.noHtml   plus = (+++)  -- | An input field with an optional value-input :: Maybe String -> XHtmlForm String+input :: Monad m => Maybe String -> XHtmlForm m String input = input' (\n v -> X.textfield n ! [X.value v]) -textarea :: Maybe String -> XHtmlForm String+textarea :: Monad m => Maybe String -> XHtmlForm m 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 :: Monad m => Maybe String -> XHtmlForm m String password = input' (\n v -> X.password n ! [X.value v])  -- | A hidden input field-hidden  :: Maybe String -> XHtmlForm String+hidden  :: Monad m => Maybe String -> XHtmlForm m String hidden  =  input' X.hidden  -- | A validated integer component-inputInteger :: Maybe Integer -> XHtmlForm Integer+inputInteger :: Monad m => Maybe Integer -> XHtmlForm m Integer inputInteger x = input (fmap show x) `check` asInteger  -file :: XHtmlForm File+file :: Monad m => XHtmlForm m File file = inputFile X.afile  -- | A radio choice-radio :: [(String, String)] -> Maybe String -> XHtmlForm String+radio :: Monad m => [(String, String)] -> Maybe String -> XHtmlForm m 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..])@@ -48,7 +48,7 @@                     | otherwise = []               ident = name ++ "_" ++ show idx -enumRadio :: (Enum a) => [(a, String)] -> Maybe a -> XHtmlForm a+enumRadio :: (Monad m, Enum a) => [(a, String)] -> Maybe a -> XHtmlForm m a enumRadio values defaultValue = radio (map toS values) (fmap (show . fromEnum) defaultValue)                                  `check` convert `check` tryToEnum  where toS = fmapFst (show . fromEnum)

@@ -1,5 +1,5 @@ Name:            formlets-Version:         0.3+Version:         0.4 Synopsis:        Formlets implemented in Haskell Description:     A modular way to build forms based on applicative functors, as                  described in: