formlets 0.4.5 → 0.4.6

raw patch · 2 files changed

+23/−18 lines, 2 files

Files

Text/Formlets.hs +22/−17
formlets.cabal +1/−1

Text/Formlets.hs view

@@ -22,7 +22,7 @@ type Name = String type Collector a = Env -> a data FormContentType = UrlEncoded | MultiPart deriving (Eq, Show, Read)-newtype Form xml m a = Form { deform :: Env -> State FormState (Collector (m (Failing a)), xml, FormContentType) }+newtype Form xml m a = Form { deform :: Env -> State FormState (Collector (m (Failing a)), m xml, FormContentType) } data File = File {content :: BS.ByteString, fileName :: String, contentType :: ContentType} deriving (Eq, Show, Read) data ContentType = ContentType { ctType :: String                                , ctSubtype :: String@@ -64,7 +64,7 @@ input' :: Monad m => (String -> String -> xml) -> Maybe String -> Form xml m String input' i defaultValue = Form $ \env -> mkInput env <$> freshName    where mkInput env name = (return . fromLeft name . (lookup name),-                             i name (value name env), UrlEncoded)+                             return (i name (value name env)), UrlEncoded)          value name env = maybe (maybe "" id defaultValue) fromLeft' (lookup name env)          fromLeft' (Left x) = x          fromLeft' _        = ""@@ -74,10 +74,10 @@  -- | A File input widget. inputFile :: Monad m -          => (String -> xml)  -- | Generates the xml for the file-upload widget based on the name+          => (String -> xml)  -- ^ Generates the xml for the file-upload widget based on the name           -> Form xml m File inputFile i = Form $ \env -> mkInput env <$> freshName-  where  mkInput env name    = (return . fromRight name . (lookup name), i name, MultiPart)+  where  mkInput env name    = (return . fromRight name . (lookup name), return (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"]@@ -87,8 +87,9 @@              => Env               -- ^ A previously filled environment (may be empty)              -> String            -- ^ A prefix for the names              -> Form xml m a      -- ^ The form-             -> (Collector (m (Failing a)), xml, FormContentType)-runFormState e prefix (Form f) = evalState (f e) (0, prefix)+             -> (m (Failing a), m xml, FormContentType)+runFormState e prefix (Form f) = let (coll, xml, typ) = evalState (f e) (0, prefix)+                                 in (coll e, xml, typ)  -- | Check a condition or convert a result check :: (Monad m) => Form xml m a -> (a -> Failing b) -> Form xml m b@@ -118,12 +119,12 @@  -- | Pure xml xml :: Monad m => xml -> Form xml m ()-xml x = Form $ \env -> pure (const $ return $ Success (), x, UrlEncoded)+xml x = Form $ \env -> pure (const $ return $ Success (), return x, UrlEncoded)  -- | Transform the XML component-plug :: Plus xml => (xml -> xml1) -> Form xml m a -> Form xml1 m a+plug :: (Monad m, Plus xml) => (xml -> xml1) -> Form xml m a -> Form xml1 m a f `plug` (Form m) = Form $ \env -> pure plugin <*> m env-   where plugin (c, x, t) = (c, f x, t)+   where plugin (c, x, t) = (c, liftM f x, t)  -- | Takes a hidden-input field, a form of a and produces a list of a. -- | @@ -131,14 +132,15 @@ -- | This form has to have the same variable-names as the original form, but prefixed by the prefix. -- |  -- | Typically, some client-side code is needed to duplicate the original form and generate a unique prefix.-massInput :: (Plus xml, Applicative m, Monad m) => (Form xml m (Maybe String)) -> Form xml m a -> Form xml m [a]-massInput h f = massInputHelper form+massInput :: (Plus xml, Applicative m, Monad m) => (Form xml m (Maybe String)) -> Form xml m a -> ([String] -> xml) -> Form xml m [a]+massInput h f showErrors = massInputHelper form showErrors  where form = (,) <$> f <*> h  massInputHelper :: (Plus xml, Applicative m, Monad m) -                => Form xml m (a, Maybe String) -> Form xml m [a]-massInputHelper f = - join f+                => Form xml m (a, Maybe String)  -- The form+                -> ([String] -> xml)             -- How to show errors+                -> Form xml m [a]+massInputHelper f showErrors = join f   where join :: (Plus xml, Applicative m, Monad m) => Form xml m (a, Maybe String) -> Form xml m [a]         join (Form f) = Form $ \env -> start (f env) env         start :: (Monad m) => State FormState (Collector (m (Failing (a, Maybe String))), xml, FormContentType) -> Env -> State FormState (Collector (m (Failing [a])), xml, FormContentType)@@ -169,6 +171,9 @@  where nullToMaybe [] = Nothing        nullToMaybe x  = Just x +withPrefix :: String -> Form xml m a -> Form xml m a+withPrefix prefix (Form f) = Form $ \env -> (changePrefix prefix >> f env)+ ----------------------------------------------- -- Private methods -----------------------------------------------@@ -189,14 +194,14 @@ orT x y          = x  pureF :: (Monad m, Plus xml) => a -> Form xml m a-pureF v = Form $ \env -> pure (const (return $ Success v), zero, UrlEncoded)+pureF v = Form $ \env -> pure (const (return $ Success v), return zero, UrlEncoded)  pureM :: (Monad m, Plus xml) => m a -> Form xml m a-pureM v = Form $ \env -> pure (const (liftM Success v), zero, UrlEncoded)+pureM v = Form $ \env -> pure (const (liftM Success v), return zero, UrlEncoded)  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 -> combine <$> f env <*> v env-  where combine (v1, xml1, t1) (v2, xml2, t2) = (first v1 v2, xml1 `plus` xml2, t1 `orT` t2)+  where combine (v1, xml1, t1) (v2, xml2, t2) = (first v1 v2, (plus <$> xml1 <*> xml2), t1 `orT` t2)         first v1 v2 e = do x <- v1 e                             y <- v2 e                            return $ x <*> y

formlets.cabal view

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