formlets 0.6.1 → 0.7

raw patch · 5 files changed

+189/−60 lines, 5 filesdep +sybdep ~basePVP ok

version bump matches the API change (PVP)

Dependencies added: syb

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• LICENSE +0/−2
• README +4/−3
• Text/Formlets.hs +168/−46
• Text/Formlets/MassInput.hs +3/−0
• formlets.cabal +14/−9

@@ -1,5 +1,3 @@-Copyright (c) 2008, Tupil- All rights reserved.  Redistribution and use in source and binary forms, with or without

@@ -1,8 +1,9 @@-The original author of this library is Jeremy Yallop. It is currently maintained-by Chris Eidhof.+The original author of this library is Jeremy Yallop. It was packaged by Chris+Eidhof, and is currently maintained by Doug Beardsley.  Other contributors:-* MightyByte * Eelco Lempsink+* Jeremy Shaw+* Judah Jacobson  The formlets repository is hosted on github: http://github.com/chriseidhof/formlets/

@@ -1,19 +1,23 @@-module Text.Formlets ( input', inputM', optionalInput, inputFile, fmapFst, nothingIfNull+{-# LANGUAGE DeriveDataTypeable, ScopedTypeVariables #-}+module Text.Formlets ( input', inputM', optionalInput, generalInput, generalInputMulti, inputFile, fmapFst, nothingIfNull                      , check, ensure, ensures                      , ensureM, checkM, pureM                      , runFormState                       , massInput-                     , xml, plug, plug'+                     , xml, plug, plug2, plug'                      , Env , Form , Formlet                      , File (..), ContentType (..), FormContentType (..)+                     , Rect, stringRect                      )                      where +import Data.Generics+import Data.Either (partitionEithers) import Data.Monoid import Control.Applicative import Control.Applicative.Error import Control.Applicative.State-import Data.Maybe (isJust)+import Data.Maybe (isJust, fromMaybe) import Data.List (intercalate) import qualified Text.Formlets.FormResult as FR import qualified Data.ByteString.Lazy as BS@@ -27,14 +31,25 @@ type S a = State FormState a type Validator a = S (FR.FormResult a) data FormContentType = UrlEncoded | MultiPart deriving (Eq, Show, Read)-newtype Form xml m a = Form { deform :: Env -> S (m (Validator a), m xml, FormContentType) }-data File = File {content :: BS.ByteString, fileName :: String, contentType :: ContentType} deriving (Eq, Show, Read)+newtype Form xml m a = Form { deform :: Env -> S (m (Validator a), xml, FormContentType) }+data File = File {content :: BS.ByteString, fileName :: String, contentType :: ContentType} deriving (Eq, Show, Read, Data, Typeable) data ContentType = ContentType { ctType :: String                                , ctSubtype :: String                                , ctParameters :: [(String, String)]                                }-                               deriving (Eq, Show, Read)+                               deriving (Eq, Show, Read, Data, Typeable)+                                        +data Rect = Rect {rectCols :: Int, rectRows :: Int}+          deriving (Eq, Ord, Show, Read, Data, Typeable) +-- |Choose a good number of rows for a textarea input.  Uses the+-- number of newlines in the string and the number of lines that+-- are too long for the desired width.+stringRect :: Int -> String -> Rect+stringRect cols s =+    Rect {rectCols = cols,+          rectRows = foldr (+) 0 (map (\ line -> 1 + (length line) `div` cols) (lines s))}+ -- | Apply a predicate to a value and return FR.Success or FR.Failure as appropriate ensure :: Show a         => (a -> Bool) -- ^ The predicate@@ -62,34 +77,122 @@     where errors = [ err | (p, err) <- ps, not $ p x ]  -- | Helper function for genereting input components based forms.-input' :: Monad m => (String -> String -> xml) -> Maybe String -> Form xml m String-input' i = inputM' (\n -> return . i n)+--          +-- see also 'optionalInput', 'generalInput', and 'generalInputMulti'+input' :: Monad m +       => (String -> String -> xml) -- ^ function which takes the control name, the initial value, and returns the control markup+       -> Maybe String -- ^ optional default value+       -> Form xml m String+input' i defaultValue = generalInput' i' fromLeft -- `check` maybe (Failure ["not in the data"]) Success+   where i' n v = i n (fromMaybe (fromMaybe "" defaultValue) v)+         fromLeft n Nothing          = FR.NotAvailable $ n ++ " is not in the data"+         fromLeft n (Just (Left x))  = FR.Success x+         fromLeft n (Just (Right _)) = FR.Failure [n ++ " is a file, but should not have been."] -inputM' :: Monad m => (String -> String -> m xml) -> Maybe String -> Form xml m String-inputM' i defaultValue = Form $ \env -> mkInput env <$> freshName-   where mkInput env name = (lookupFreshName fromLeft env, i name (value name env), UrlEncoded)-         value name env = maybe (maybe "" id defaultValue) fromLeft' (lookup name env)-         fromLeft' (Left x) = x-         fromLeft' _        = ""-         fromLeft n Nothing         = FR.NotAvailable $ n ++ " is not in the data"-         fromLeft n (Just (Left x)) = FR.Success x-         fromLeft n _               = FR.Failure [n ++ " is a file."]+{-# DEPRECATED inputM' "You can just use input'"#-}+-- |deprecated. See 'input''+inputM' :: Monad m => (String -> String -> xml) -> Maybe String -> Form xml m String+inputM' = input' +-- | Create a form control which is not required to be successful+--+-- There is no way to provide a default value, because that would+-- result in the control being successful.+-- +-- For more information on successful controls see:+--+-- <http://www.w3.org/TR/html401/interact/forms.html#successful-controls>+--+-- see also 'input'', 'generalInput', and 'generalInputMulti'+optionalInput :: Monad m +              => (String -> xml) -- ^ function which takes the form name and produces the control markup+              -> Form xml m (Maybe String)+optionalInput i = generalInput' (\n _ -> i n) fromLeft+  where+    fromLeft n Nothing          = FR.Success Nothing+    fromLeft n (Just (Left x))  = FR.Success (Just x)+    fromLeft n (Just (Right _)) = FR.Failure [n ++ " is a file, but should not have been."]++-- |generate a form control+--     +-- see also 'input'', 'optionalInput', 'generalInputMulti'.+generalInput :: Monad m =>+                (String -> Maybe String -> xml) -- ^ function which takes the control name, an initial value if one was found in the environment and returns control markup+             -> Form xml m (Maybe String)+generalInput i = generalInput' (\n v -> i n v) fromLeft+  where+    fromLeft n Nothing          = FR.Success Nothing+    fromLeft n (Just (Left x))  = FR.Success (Just x)+    fromLeft n (Just (Right _)) = FR.Failure [n ++ " is a file, but should not have been."]++-- a combination of lookup and freshName. +--  1. generate a fresh name+--  2. lookup that name in the environment (returns a Maybe value)+--  3. pass the name and the Maybe value to the function 'f', which returns a value of type 'a'+lookupFreshName :: (Monad m) => (String -> Maybe (Either String File) -> a) -> Env -> m (State FormState a) lookupFreshName f env = return $ (freshName >>= \name -> return $ f name $ (lookup name env))  -optionalInput :: Monad m => (String -> xml) -> Form xml m (Maybe String)-optionalInput i = Form $ \env -> mkInput env <$> freshName-   where mkInput env name = (lookupFreshName fromLeft env, return (i name), UrlEncoded)-         fromLeft n Nothing         = FR.Success Nothing-         fromLeft n (Just (Left x)) = FR.Success (Just x)-         fromLeft n _               = FR.Failure [n ++ " could not be recognized."]+-- |generate a form control+-- +-- see also 'input'', 'optionalInput', 'generalInputMulti'.+generalInput' :: Monad m =>+                (String -> Maybe String -> xml) -- ^ function which takes the control name, an initial value if one was found in the environment and returns control markup+             -> (String -> Maybe (Either String File) -> FR.FormResult a)+             -> Form xml m a+generalInput' i fromLeft = Form $ \env -> mkInput env <$> freshName+   where mkInput env name = (lookupFreshName fromLeft env, -- return . result name,+                             i name (value name env), UrlEncoded)+         -- A function to obtain the initial value used to compute the+         -- representation.  The environment is the one passed to+         -- runFormState.  It typically reflects the initial value of+         -- the datatype which the form is meant to represent.+         value name env =+             case lookup name env of+               Just (Left x) -> Just x+               Just (Right _) -> error $ name ++ " is a file."+               Nothing -> Nothing+         -- A function to obtain the form's return value from the+         -- environment returned after the form is run. +-- |generate a form control which can return multiple values+--+-- Useful for controls such as checkboxes and multiple select .+--+-- see also 'input'', 'optionalInput', 'generalInput'.+generalInputMulti :: forall m xml. Monad m =>+                (String -> [String] -> xml)+             -> Form xml m [String]+generalInputMulti i = Form $ \env -> mkInput env <$> freshName+   where mkInput :: Env -> String -> (m (Validator [String]), xml, FormContentType)+         mkInput env name = (return (result env),+                             i name (value name env), UrlEncoded)+         -- A function to obtain the initial value used to compute the+         -- representation.  The environment is the one passed to+         -- runFormState.  It typically reflects the initial value of+         -- the datatype which the form is meanto to represent.+         value :: String -> Env -> [String]+         value name env =+             case partitionEithers $ lookups name env of+               (xs,[]) -> xs+               _ -> error $ name ++ " is a file."+         -- A function to obtain the form's return value from the+         -- environment returned after the form is run.+         result :: Env -> Validator [String]+         result env =+           do name <- freshName+              return $ case partitionEithers $ lookups name env of+                ([],[]) -> FR.NotAvailable $ name ++ " is not in the data."+                (xs,[]) -> FR.Success xs+                _ -> FR.Failure [name ++ " is a file."]+         lookups :: (Eq a) => a -> [(a, b)] -> [b]+         lookups k = map snd . filter ((k ==) . fst)+ -- | A File input widget. inputFile :: Monad m            => (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    = (lookupFreshName fromRight env, return (i name), MultiPart)+  where  mkInput env name    = (lookupFreshName fromRight env, i name, MultiPart)          fromRight n Nothing          = FR.NotAvailable $ n ++ " is not in the data"          fromRight n (Just (Right x)) = FR.Success x          fromRight n _                = FR.Failure [n ++ " is not a file"]@@ -98,7 +201,7 @@ runFormState :: Monad m               => Env               -- ^ A previously filled environment (may be empty)              -> Form xml m a      -- ^ The form-             -> (m (Failing a), m xml, FormContentType)+             -> (m (Failing a), xml, FormContentType) runFormState e (Form f) = fmapFst3 (liftM FR.toE . liftM es) (es (f e))   where es = flip evalState [0] @@ -120,14 +223,14 @@                           --return x         transform :: Monad m => (a -> m (Failing b)) -> m (Validator a) -> FormState -> m (Validator b)-       transform f source st = x' (x f) source-        where x   :: Monad m => (a -> m (Failing b)) -> a -> m (Validator b)-              x f = fmap (liftM (return . FR.fromE)) f-              x'  :: Monad m => (a -> m (Validator b)) -> m (Validator a) -> m (Validator b)-              x' f a = do a' <- a-                          let (a'', st') = runState a' st-                          val <- combine f a''-                          return (changeState st' val)+       transform f source st = transform' (makeValidator f) source+        where makeValidator   :: Monad m => (a -> m (Failing b)) -> a -> m (Validator b)+              makeValidator f = fmap (liftM (return . FR.fromE)) f+              transform'  :: Monad m => (a -> m (Validator b)) -> m (Validator a) -> m (Validator b)+              transform' f a = do a' <- a+                                  let (a'', st') = runState a' st+                                  val <- combine f a''+                                  return (changeState st' val)               changeState :: st -> State st a -> State st a               changeState st' mComp = do result <- mComp                                          put st'@@ -152,14 +255,34 @@  -- | Pure xml xml :: Monad m => xml -> Form xml m ()-xml x = Form $ \env -> pure (return (return $ FR.Success ()), return x, UrlEncoded)+xml x = Form $ \env -> pure (return (return $ FR.Success ()), x, UrlEncoded)  -- | Transform the XML component-plug :: (Monad m, Monoid xml) => (xml -> xml1) -> Form xml m a -> Form xml1 m a+plug :: (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, liftM f x, t)+   where plugin (c, x, t) = (c, f x, t) -plug' :: (Monad m, Monoid xml1) => (xml1 -> xml2) -> Formlet xml1 m a -> Formlet xml2 m a+-- | Combine the XML components of two forms using f, and combine the+-- values using g.+plug2 :: (Monad m) => (xml -> xml1 -> xml2) -> (a -> b -> Failing c) -> Form xml m a -> Form xml1 m b -> Form xml2 m c+plug2 f g (Form m) (Form n) =+  Form $ \env -> plugin <$> m env <*> n env+    where+      plugin (c1, x1, t1) (c2, x2, t2) = (combineCollectors c1 c2, f x1 x2, t2)+--      combineCollectors :: (Monad m) => m (State FormState (FR.FormResult a)) -> m (State FormState (FR.FormResult b)) -> m (State FormState (FR.FormResult c))+      combineCollectors c1 c2 =+              do a' <- c1+                 b' <- c2+                 return $ combiner <$> a' <*> b'+--       combiner :: (FR.FormResult a) -> (FR.FormResult b) -> (FR.FormResult c)+      combiner (FR.Failure a)        (FR.Failure b)        = FR.Failure (a ++ b)+      combiner (FR.Failure a)        _                     = FR.Failure a+      combiner _                     (FR.Failure b)        = FR.Failure b+      combiner (FR.NotAvailable str) _                     = FR.NotAvailable str+      combiner _                     (FR.NotAvailable str) = FR.NotAvailable str+      combiner (FR.Success a)        (FR.Success b)        = FR.fromE (g a b)++plug' :: (xml1 -> xml2) -> Formlet xml1 m a -> Formlet xml2 m a plug' transformer formlet value = plug transformer (formlet value)  -- | This generates a single (or more) forms for a, and a parser function for a list of a's.@@ -180,12 +303,11 @@        [] -> return (newCollector, xml', contentType)        xs -> do resetCurrentLevel                 xmls <- mapM (generateXml single env) xs-                let xmls' = sequence xmls -                return (newCollector, liftM mconcat xmls', contentType)+                return (newCollector, mconcat xmls, contentType)   modify (tail.tail)   return x -generateXml :: Monad m => (Maybe a -> Form xml m a) -> Env -> a -> S (m xml)+generateXml :: Monad m => (Maybe a -> Form xml m a) -> Env -> a -> S xml generateXml form env value = do (_, xml, _) <- (deform $ form $ Just value) env                                 modify nextItem                                 return xml@@ -194,14 +316,14 @@ resetCurrentLevel = do modify (tail . tail)                        modify (\x -> 0:0:x) -generateListXml :: (Applicative m, Monad m, Monoid xml) => Form xml m a -> Env -> S (m xml)+generateListXml :: (Applicative m, Monad m, Monoid xml) => Form xml m a -> Env -> S xml generateListXml form env = do n <- currentName                               case lookup n env of-                                Nothing -> return $ return mempty+                                Nothing -> return mempty                                 Just _  -> do (_, xml, _) <- (deform form) env                                               modify nextItem                                               rest <- generateListXml form env-                                              return $ mappend <$> xml <*> rest+                                              return $ mappend xml rest  liftCollector :: (Monad m) => FormState -> m (Validator a) -> m (Validator [a]) liftCollector st coll = do coll' <- coll@@ -250,14 +372,14 @@ orT x y          = x  pureF :: (Monad m, Monoid xml) => a -> Form xml m a-pureF v = Form $ \env -> pure (return (return $ FR.Success v), return mempty, UrlEncoded)+pureF v = Form $ \env -> pure (return (return $ FR.Success v), mempty, UrlEncoded)  pureM :: (Monad m, Monoid xml) => m a -> Form xml m a-pureM v = Form $ \env -> pure (liftM (return . FR.Success) v, return mempty, UrlEncoded)+pureM v = Form $ \env -> pure (liftM (return . FR.Success) v, mempty, UrlEncoded)  applyF :: (Monad m, Applicative m, Monoid 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, (mappend <$> xml1 <*> xml2), t1 `orT` t2)+  where combine (v1, xml1, t1) (v2, xml2, t2) = (first v1 v2, (mappend xml1 xml2), t1 `orT` t2)         first :: Monad m               => m (Validator (a -> b))                -> m (Validator (a     )) 

@@ -41,6 +41,9 @@   ,"    }"   ,"  ));"   ,""+-- Uncomment the following line if you want the newly added fields to+-- be empty.+--  ,"  newItem.children('input').attr('value','');"   ,"  newItem.appendTo(item.parent());"   ,"}"   ,"function removeItem(button) {"

@@ -1,8 +1,8 @@ Name:            formlets-Version:         0.6.1+Version:         0.7 Synopsis:        Formlets implemented in Haskell-Description:     A modular way to build forms based on applicative functors, as-                 described in:+Description:     A modular way to build forms based on applicative functors,+                 based on the work described in:                  .                   * Ezra Cooper, Samuel Lindley, Philip Wadler and Jeremy Yallop                     \"An idiom's guide to formlets\"@@ -11,21 +11,26 @@ Category:        XML, Web, User Interfaces, Text License:         BSD3 License-file:    LICENSE-Copyright:       (c) Jeremy Yallop / Tupil-Author:          Jeremy Yallop / Chris Eidhof Homepage:        http://github.com/chriseidhof/formlets/tree/master-Maintainer:      Chris Eidhof <ce+hackage@tupil.com>+Maintainer:      Doug Beardsley <mightybyte@gmail.com> Build-Type:      Simple Cabal-Version: >= 1.6 Extra-Source-Files: README +Flag base4+    Description: Choose the even newer, even smaller, split-up base package.+ Library-  Build-Depends:   base >= 2 && < 5, -                   haskell98, -                   mtl, +  Build-Depends:   haskell98, +                   mtl,                    xhtml,                     applicative-extras >= 0.1.3,                     bytestring+  if flag(base4)+    Build-Depends: base >= 4 && < 5, syb+  else+    Build-Depends: base >= 2 && < 4+                                         Exposed-Modules:   Text.Formlets                    , Text.Formlets.MassInput                    , Text.XHtml.Strict.Formlets