formlets 0.4.8 → 0.5

raw patch · 3 files changed

+67/−24 lines, 3 filesdep ~basePVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• Text/Formlets.hs +19/−7
• Text/XHtml/Strict/Formlets.hs +46/−15
• formlets.cabal +2/−2

@@ -1,4 +1,4 @@-module Text.Formlets ( input', optionalInput, inputFile, fmapFst, nothingIfNull+module Text.Formlets ( input', inputM', optionalInput, inputFile, fmapFst, nothingIfNull                      , check, ensure, ensures                      , ensureM, checkM, pureM                      , runFormState @@ -60,9 +60,12 @@  -- | Helper function for genereting input components based forms. input' :: Monad m => (String -> String -> xml) -> Maybe String -> Form xml m String-input' i defaultValue = Form $ \env -> mkInput env <$> freshName+input' i = inputM' (\n v -> return $ i n v)++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 = (return . fromLeft name . (lookup name),-                             return (i name (value name env)), UrlEncoded)+                             i name (value name env), UrlEncoded)          value name env = maybe (maybe "" id defaultValue) fromLeft' (lookup name env)          fromLeft' (Left x) = x          fromLeft' _        = ""@@ -138,7 +141,11 @@ -- | 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 :: (Monoid xml, Applicative m, Monad m) => (Form xml m (Maybe String)) -> Form xml m a -> ([String] -> xml) -> Form xml m [a]+massInput :: (Monoid 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 @@ -149,11 +156,16 @@ massInputHelper f showErrors = join f   where join :: (Monoid 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)+        start :: (Monad m)+          => State FormState (Collector (m (Failing (a, Maybe String))), xml, FormContentType)+          -> Env+          -> State FormState (Collector (m (Failing [a])), xml, FormContentType)         start f e =     do  currentState <- get                             --todo use v-                            let (v, xml, t) = evalState f currentState+                            let (a, s) = runState f currentState+                            let (v, xml, t) = a                             let v' = evalState (combineIt [] f (Just v)) currentState+                            put s                             return (v', xml, t)         combineIt p f v = do currentState <- get                              let x = findLinkedList f currentState@@ -190,7 +202,7 @@                return n  currentName :: State FormState String-currentName = gets $ \(n, prefix) ->  prefix ++ "input" ++ show n+currentName = gets $ \(n, prefix) ->  prefix ++ "fval" ++ show n  changePrefix :: String -> State FormState () changePrefix p = modify (\(n,_) -> (n, p))

@@ -1,7 +1,7 @@-module Text.XHtml.Strict.Formlets ( input, textarea, password, file+module Text.XHtml.Strict.Formlets ( input, textarea, password, file, checkbox                                   , hidden, inputInteger, radio, enumRadio                                   , label-                                  , selectRaw, select, enumSelect+                                  , selectXHtml, selectRaw, select, enumSelect                                   , XHtmlForm                                   , module Text.Formlets                                   ) where@@ -19,8 +19,12 @@ input :: Monad m => Maybe String -> XHtmlForm m String input = input' (\n v -> X.textfield n ! [X.value v]) -textarea :: Monad m => Maybe String -> XHtmlForm m String-textarea = input' (\n v -> X.textarea (X.toHtml v) ! [X.name n])+-- | A textarea with optional rows and columns, and an optional value+textarea :: Monad m => Maybe Int -> Maybe Int -> Maybe String -> XHtmlForm m String+textarea r c = input' (\n v -> X.textarea (X.toHtml v) ! (attrs n))+  where rows = maybe [] (\x -> [X.rows $ show x]) r+        cols = maybe [] (\x -> [X.cols $ show x]) c+        attrs n = [X.name n] ++ rows ++ cols  -- | A password field with an optional value password :: Monad m => Maybe String -> XHtmlForm m String@@ -34,9 +38,18 @@ inputInteger :: Monad m => Maybe Integer -> XHtmlForm m Integer inputInteger x = input (fmap show x) `check` asInteger  +-- | A file upload form file :: Monad m => XHtmlForm m File file = inputFile X.afile +-- | A checkbox with an optional default value+checkbox :: Monad m => Maybe Bool -> XHtmlForm m Bool+checkbox d = (optionalInput (xml d)) `check` asBool+  where asBool (Just _) = Success True+        asBool Nothing = Success False+        xml (Just True) n = X.widget "checkbox" n [X.value "on", X.checked]+        xml _ n = X.checkbox n "on"+ -- | A radio choice radio :: Monad m => [(String, String)] -> Maybe String -> XHtmlForm m String radio choices = input' mkRadios -- todo: validate that the result was in the choices@@ -55,23 +68,41 @@  where toS = fmapFst (show . fromEnum)        convert v = maybeRead' v "Conversion error"  -label str = xml $ X.label $ X.toHtml str+label :: (Monad m, X.HTML h) => h -> Form X.Html m ()+label = xml . X.label . X.toHtml -selectRaw :: Monad m => [(String, String)] -> Maybe String -> XHtmlForm m String-selectRaw choices = input' mkChoices -- todo: validate that the result was in the choices- where mkChoices name selected = X.select ! [X.name name] $ X.concatHtml $ map (mkChoice selected) choices-       mkChoice  selected (value, label) = X.option ! (attrs ++ [X.value value]) << label-        where attrs | selected == value = [X.selected]-                    | otherwise = []+-- | This is a helper function to generate select boxes+selectXHtml :: (X.HTML h) +            => [X.HtmlAttr]  -- ^ Optional attributes for the select-box+            -> [(String, h)] -- ^ The values and their labels+            -> String        -- ^ The name+            -> String        -- ^ The value that is selected+            -> X.Html+selectXHtml attr choices name selected = X.select ! (X.name name:attr) $ X.concatHtml $ map (mkChoice selected) choices+  where mkChoice  selected (value, label) = X.option ! (attrs ++ [X.value value]) << label+         where attrs | selected == value = [X.selected]+                     | otherwise = [] +-- | A drop-down for selecting values+selectRaw :: (Monad m, X.HTML h) +          => [X.HtmlAttr]  -- ^ Optional attributes for the select-element+          -> [(String, h)] -- ^ Pairs of value/label+          -> Maybe String  -- ^ An optional default value+          -> Form X.Html m String+selectRaw attrs choices = input' $ selectXHtml attrs choices -- todo: validate that the result was in the choices+ -- | A drop-down for anything that is an instance of Eq-select :: (Eq a, Monad m) => [(a, String)] -> Maybe a -> XHtmlForm m a-select ls v = selectRaw (map f $ zip [0..] ls) selected `check` asInt `check` convert+select :: (Eq a, Monad m, X.HTML h) => [X.HtmlAttr] -> [(a, h)] -> Maybe a -> Form X.Html m a+select attrs ls v = selectRaw attrs (map f $ zip [0..] ls) selected `check` asInt `check` convert  where selected       = show <$> (v >>= flip elemIndex (map fst ls))        f (idx, (_,l)) = (show idx, l)        convert i      | i >= length ls || i < 0 = Failure ["Out of bounds"]                       | otherwise               = Success $ fst $ ls !! i        asInt   s      = maybeRead' s (s ++ " is not a valid int") -enumSelect :: (Show a, Bounded a, Enum a, Eq a) => Maybe a -> XHtmlForm IO a-enumSelect = select (zip items (map show items)) where items = [minBound ..]+-- | A drop-down for all the options from |a|.+enumSelect :: (Enum a, Bounded a, Show a, Eq a, Monad m) +           => [X.HtmlAttr] -- Optional attributes on the select-box+           -> Maybe a      -- An optional value+           -> Form X.Html m a+enumSelect attrs = select attrs (zip items (map show items)) where items = [minBound..maxBound]

@@ -1,5 +1,5 @@ Name:            formlets-Version:         0.4.8+Version:         0.5 Synopsis:        Formlets implemented in Haskell Description:     A modular way to build forms based on applicative functors, as                  described in:@@ -17,7 +17,7 @@ Exposed-Modules:   Text.Formlets                  , Text.XHtml.Strict.Formlets Build-Type:      Simple-Build-Depends:   base, +Build-Depends:   base >= 2 && < 5,                   haskell98,                   mtl,                   xhtml,