formlets 0.5 → 0.6
raw patch · 5 files changed
+271/−121 lines, 5 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
- Text.Formlets: withPrefix :: String -> Form xml m a -> Form xml m a
+ Text.Formlets: plug' :: (Monad m, Monoid xml1) => (xml1 -> xml2) -> Formlet xml1 m a -> Formlet xml2 m a
+ Text.Formlets: type Formlet xml m a = Maybe a -> Form xml m a
+ Text.Formlets.MassInput: massInput :: (Applicative m, Monad m) => (XHtmlFormlet m a) -> (Html -> Html) -> (Html -> Html) -> XHtmlFormlet m [a]
+ Text.XHtml.Strict.Formlets: type XHtmlFormlet m a = Formlet Html m a
- Text.Formlets: massInput :: (Monoid xml, Applicative m, Monad m) => (Form xml m (Maybe String)) -> Form xml m a -> ([String] -> xml) -> Form xml m [a]
+ Text.Formlets: massInput :: (Applicative m, Monad m, Monoid xml) => (Formlet xml m a) -> Formlet xml m [a]
- Text.Formlets: runFormState :: (Monad m) => Env -> String -> Form xml m a -> (m (Failing a), m xml, FormContentType)
+ Text.Formlets: runFormState :: (Monad m) => Env -> Form xml m a -> (m (Failing a), m xml, FormContentType)
- Text.XHtml.Strict.Formlets: checkbox :: (Monad m) => Maybe Bool -> XHtmlForm m Bool
+ Text.XHtml.Strict.Formlets: checkbox :: (Monad m) => XHtmlFormlet m Bool
- Text.XHtml.Strict.Formlets: enumRadio :: (Monad m, Enum a) => [(a, String)] -> Maybe a -> XHtmlForm m a
+ Text.XHtml.Strict.Formlets: enumRadio :: (Monad m, Enum a) => [(a, String)] -> XHtmlFormlet m a
- Text.XHtml.Strict.Formlets: enumSelect :: (Enum a, Bounded a, Show a, Eq a, Monad m) => [HtmlAttr] -> Maybe a -> Form Html m a
+ Text.XHtml.Strict.Formlets: enumSelect :: (Enum a, Bounded a, Show a, Eq a, Monad m) => [HtmlAttr] -> XHtmlFormlet m a
- Text.XHtml.Strict.Formlets: hidden :: (Monad m) => Maybe String -> XHtmlForm m String
+ Text.XHtml.Strict.Formlets: hidden :: (Monad m) => XHtmlFormlet m String
- Text.XHtml.Strict.Formlets: input :: (Monad m) => Maybe String -> XHtmlForm m String
+ Text.XHtml.Strict.Formlets: input :: (Monad m) => XHtmlFormlet m String
- Text.XHtml.Strict.Formlets: inputInteger :: (Monad m) => Maybe Integer -> XHtmlForm m Integer
+ Text.XHtml.Strict.Formlets: inputInteger :: (Monad m) => XHtmlFormlet m Integer
- Text.XHtml.Strict.Formlets: password :: (Monad m) => Maybe String -> XHtmlForm m String
+ Text.XHtml.Strict.Formlets: password :: (Monad m) => XHtmlFormlet m String
- Text.XHtml.Strict.Formlets: radio :: (Monad m) => [(String, String)] -> Maybe String -> XHtmlForm m String
+ Text.XHtml.Strict.Formlets: radio :: (Monad m) => [(String, String)] -> XHtmlFormlet m String
- Text.XHtml.Strict.Formlets: select :: (Eq a, Monad m, HTML h) => [HtmlAttr] -> [(a, h)] -> Maybe a -> Form Html m a
+ Text.XHtml.Strict.Formlets: select :: (Eq a, Monad m, HTML h) => [HtmlAttr] -> [(a, h)] -> XHtmlFormlet m a
- Text.XHtml.Strict.Formlets: selectRaw :: (Monad m, HTML h) => [HtmlAttr] -> [(String, h)] -> Maybe String -> Form Html m String
+ Text.XHtml.Strict.Formlets: selectRaw :: (Monad m, HTML h) => [HtmlAttr] -> [(String, h)] -> XHtmlFormlet m String
- Text.XHtml.Strict.Formlets: textarea :: (Monad m) => Maybe Int -> Maybe Int -> Maybe String -> XHtmlForm m String
+ Text.XHtml.Strict.Formlets: textarea :: (Monad m) => Maybe Int -> Maybe Int -> XHtmlFormlet m String
Files
- Text/Formlets.hs +123/−96
- Text/Formlets/FormResult.hs +54/−0
- Text/Formlets/MassInput.hs +56/−0
- Text/XHtml/Strict/Formlets.hs +17/−16
- formlets.cabal +21/−9
Text/Formlets.hs view
@@ -3,9 +3,8 @@ , ensureM, checkM, pureM , runFormState , massInput- , xml, plug- , withPrefix- , Env , Form+ , xml, plug, plug'+ , Env , Form , Formlet , File (..), ContentType (..), FormContentType (..) ) where@@ -15,16 +14,20 @@ import Control.Applicative.Error import Control.Applicative.State import Data.Maybe (isJust)+import Data.List (intercalate)+import qualified Text.Formlets.FormResult as FR import qualified Data.ByteString.Lazy as BS import qualified Data.Traversable as T -- Form stuff type Env = [(String, Either String File)]-type FormState = (Integer, String)+type FormState = [Integer]+type Formlet xml m a = Maybe a -> Form xml m a type Name = String-type Collector a = Env -> a+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 -> State FormState (Collector (m (Failing a)), m xml, FormContentType) }+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) data ContentType = ContentType { ctType :: String , ctSubtype :: String@@ -32,7 +35,7 @@ } deriving (Eq, Show, Read) --- | Apply a predicate to a value and return Success or Failure as appropriate+-- | Apply a predicate to a value and return FR.Success or FR.Failure as appropriate ensure :: Show a => (a -> Bool) -- ^ The predicate -> String -- ^ The error message, in case the predicate fails@@ -49,7 +52,7 @@ 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+-- | Apply multiple predicates to a value, return FR.Success or all the FR.Failure messages ensures :: Show a => [(a -> Bool, String)] -- ^ List of predicate functions and error messages, in case the predicate fails -> a -- ^ The value@@ -60,64 +63,68 @@ -- | Helper function for genereting input components based forms. input' :: Monad m => (String -> String -> xml) -> Maybe String -> Form xml m String-input' i = inputM' (\n v -> return $ i n v)+input' i = inputM' (\n -> return . i n) 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),- i name (value name env), UrlEncoded)+ 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 = Failure [n ++ " is not in the data"]- fromLeft n (Just (Left x)) = Success x- fromLeft n _ = Failure [n ++ " is a file."]+ 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."] +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 = (return . fromLeft name . (lookup name),- return (i name), UrlEncoded)- fromLeft n Nothing = Success Nothing- fromLeft n (Just (Left x)) = Success (Just x)- fromLeft n _ = Failure [n ++ " could not be recognized."]+ 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."] -- | 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 = (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"]+ where mkInput env name = (lookupFreshName fromRight env, return (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"] -- | Runs the form state runFormState :: Monad m => Env -- ^ A previously filled environment (may be empty)- -> String -- ^ A prefix for the names -> Form xml m a -- ^ The form -> (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)+runFormState e (Form f) = fmapFst3 (liftM FR.toE . liftM es) (es (f e))+ where es = flip evalState [0] -- | Check a condition or convert a result 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')- f' (Failure x) = Failure x- f' (Success x) = f x+ where checker = fmap $ fmapFst3 (liftM $ liftM $ f')+ f' (FR.Failure x) = FR.Failure x+ f' (FR.NotAvailable x) = FR.NotAvailable x+ f' (FR.Success x) = FR.fromE $ f x -- | Monadically check a condition or convert a result 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')- f' v' = do v <- v'- case v of- Failure msg -> return $ Failure msg- Success x -> f x+checkM (Form frm) f = Form $ \env -> checker f (frm env)+ where checker f frm = do currentState <- get+ frm' <- frm+ return $ fmapFst3 (transform f. liftM (flip evalState currentState)) frm'+ transform f source = source >>= \x -> case x of + FR.Success x -> liftM return (convert f x)+ FR.NotAvailable x -> return . return $ FR.NotAvailable x+ FR.Failure x -> return . return $ FR.Failure x+ convert :: Monad m => (a -> m (Failing b)) -> (a -> m (FR.FormResult b))+ convert f = fmap (liftM FR.fromE) f instance (Functor m, Monad m) => Functor (Form xml m) where- fmap f (Form a) = Form $ \env -> (fmap . fmapFst3 . liftM . fmap . fmap) f (a env)+ fmap f (Form a) = Form $ \env -> (fmap . fmapFst3 . liftM . liftM . fmap) f (a env) fmapFst f (a, b) = (f a, b) fmapFst3 f (a, b, c) = (f a, b, c)@@ -128,98 +135,118 @@ -- | Pure xml xml :: Monad m => xml -> Form xml m ()-xml x = Form $ \env -> pure (const $ return $ Success (), return x, UrlEncoded)+xml x = Form $ \env -> pure (return (return $ FR.Success ()), return x, UrlEncoded) -- | Transform the XML component plug :: (Monad m, Monoid 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, liftM f x, t) --- | Takes a hidden-input field, a form of a and produces a list of a.--- | --- | The hidden input field contains a prefix, which is the pointer to the next form. --- | 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 h f showErrors = massInputHelper form showErrors- where form = (,) <$> f <*> h+plug' :: (Monad m, Monoid xml1) => (xml1 -> xml2) -> Formlet xml1 m a -> Formlet xml2 m a+plug' transformer formlet value = plug transformer (formlet value) -massInputHelper :: (Monoid xml, Applicative m, Monad m) - => 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 :: (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 f e = do currentState <- get- --todo use v- 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- return $ \e -> calculate p f e (maybe (x e) (\x -> x e) v) currentState- calculate p f e v (n,_) = do x <- v- case x of- Success (x, Nothing) -> return $ Success [x]- Success (v, Just cont) -> do if cont `elem` p then return $ Failure ["Infinite loop"] else do- x <- (evalState (combineIt (cont:p) f Nothing) (n, cont)) e- case x of- Success ls -> return $ Success (v:ls)- Failure msg -> return $ Failure msg- Failure msg -> return $ Failure msg- findLinkedList f = fst3 . evalState f+-- | This generates a single (or more) forms for a, and a parser function for a list of a's.+massInput :: (Applicative m, Monad m, Monoid xml)+ => (Formlet xml m a) -- ^ A formlet for a single a+ -> Formlet xml m [a]+massInput single defaults = Form $ \env -> do+ modify (\x -> 0:0:x)+ st <- get+ (collector, xml, contentType) <- (deform $ single Nothing) env+ resetCurrentLevel+ listXml <- generateListXml (single Nothing) env+ let newCollector = liftCollector st collector + xml' = case env of+ [] -> xml+ _ -> listXml+ x <- case maybe [] id defaults of+ [] -> return (newCollector, xml', contentType)+ xs -> do resetCurrentLevel+ xmls <- mapM (generateXml single env) xs+ let xmls' = sequence xmls + return (newCollector, liftM mconcat xmls', contentType)+ modify (tail.tail)+ return x -fst3 (a, b, c) = a+generateXml :: Monad m => (Maybe a -> Form xml m a) -> Env -> a -> S (m xml)+generateXml form env value = do (_, xml, _) <- (deform $ form $ Just value) env+ modify nextItem+ return xml +resetCurrentLevel :: S ()+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 form env = do n <- currentName+ case lookup n env of+ Nothing -> return $ return mempty+ Just _ -> do (_, xml, _) <- (deform form) env+ modify nextItem+ rest <- generateListXml form env+ return $ mappend <$> xml <*> rest++liftCollector :: (Monad m) => FormState -> m (Validator a) -> m (Validator [a])+liftCollector st coll = do coll' <- coll+ let st' = nextItem st+ computeRest = liftCollector st' coll+ case evalState coll' st of+ FR.Success x -> do rest <- computeRest+ return (fmap (fmap (x:)) rest)+ FR.NotAvailable x -> return (return (FR.Success []))+ FR.Failure x -> do rest <- computeRest+ return $ combineFailures x rest++nextItem st = flip execState st $ modify tail >> freshName >> modify (0:) >> get++combineFailures :: [String] -> Validator [a] -> Validator [a]+combineFailures msgs s = do x <- s+ case x of+ FR.Success x -> return $ FR.Failure msgs+ FR.Failure f -> return $ FR.Failure (msgs ++ f)++ -- | Returns Nothing if the result is the empty String. nothingIfNull :: (Monad m, Functor m) => Form xml m String -> Form xml m (Maybe String) nothingIfNull frm = nullToMaybe <$> frm where nullToMaybe [] = Nothing nullToMaybe x = Just x -withPrefix :: String -> Form xml m a -> Form xml m a-withPrefix prefix (Form f) = Form $ \env -> (modify (const (0, prefix)) >> f env)- ----------------------------------------------- -- Private methods ----------------------------------------------- -freshName :: State FormState String+freshName :: S String freshName = do n <- currentName- modify (\(n,prefix) -> (n+1, prefix))+ modify (changeHead (+1)) return n -currentName :: State FormState String-currentName = gets $ \(n, prefix) -> prefix ++ "fval" ++ show n+-- TODO: think of a good name+changeHead f [] = error "changeHead: there is no head"+changeHead f (x:xs) = (f x) : xs -changePrefix :: String -> State FormState ()-changePrefix p = modify (\(n,_) -> (n, p))+currentName :: S String+currentName = gets $ \xs -> "fval[" ++ (intercalate "." $ reverse $ map show xs) ++ "]" orT UrlEncoded x = x orT x UrlEncoded = x orT x y = x pureF :: (Monad m, Monoid xml) => a -> Form xml m a-pureF v = Form $ \env -> pure (const (return $ Success v), return mempty, UrlEncoded)+pureF v = Form $ \env -> pure (return (return $ FR.Success v), return mempty, UrlEncoded) pureM :: (Monad m, Monoid xml) => m a -> Form xml m a-pureM v = Form $ \env -> pure (const (liftM Success v), return mempty, UrlEncoded)+pureM v = Form $ \env -> pure (liftM (return . FR.Success) v, return 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)- first v1 v2 e = do x <- v1 e - y <- v2 e- return $ x <*> y+ first :: Monad m+ => m (Validator (a -> b)) + -> m (Validator (a )) + -> m (Validator (b )) + first v1 v2 = do x <- v1+ y <- v2+ return $ do x'' <- x+ y'' <- y+ return (x'' <*> y'')
+ Text/Formlets/FormResult.hs view
@@ -0,0 +1,54 @@+{-# LANGUAGE PatternGuards #-}+module Text.Formlets.FormResult ({-maybeRead, maybeRead', asInteger, tryToEnum,-} toE, fromE, FormResult (..)) where++import Control.Applicative+import qualified Control.Applicative.Error as E++toE :: FormResult a -> E.Failing a+toE (Success a) = E.Success a+toE (Failure f) = E.Failure f+toE (NotAvailable e) = E.Failure [e]++fromE :: E.Failing a -> FormResult a+fromE (E.Success a) = Success a+fromE (E.Failure f) = Failure f+++data FormResult a+ = Success a+ | Failure [String]+ | NotAvailable String+ deriving (Show) -- DEBUG++instance Applicative FormResult where+ pure = Success+ Failure msgs <*> Failure msgs' = Failure (msgs ++ msgs')+ Success _ <*> Failure msgs' = Failure msgs'+ Failure msgs' <*> Success _ = Failure msgs'+ Success f <*> Success x = Success (f x)+ NotAvailable x <*> _ = NotAvailable x+ _ <*> NotAvailable x = NotAvailable x++instance Functor FormResult where+ fmap f (Success a) = Success (f a)+ fmap f (Failure msgs) = Failure msgs+ fmap f (NotAvailable x) = NotAvailable x++-- maybeRead :: Read a => String -> Maybe a+-- maybeRead s | [(i, "")] <- readsPrec 0 s = Just i+-- | otherwise = Nothing+-- +-- -- | Tries to read a value. Shows an error message when reading fails.+-- maybeRead' :: Read a => String -> String -> FormResult a+-- maybeRead' s msg | Just x <- maybeRead s = Success x+-- | otherwise = Failure [msg]+-- +-- -- | Tries to read an Integer+-- asInteger :: String -> FormResult Integer+-- asInteger s = maybeRead' s (s ++ " is not a valid integer")+-- +-- -- | Tries conversion to an enum+-- tryToEnum :: Enum a => Int -> FormResult a+-- tryToEnum x | value <- toEnum x = Success value+-- | otherwise = Failure ["Conversion error"]+--
+ Text/Formlets/MassInput.hs view
@@ -0,0 +1,56 @@+module Text.Formlets.MassInput where++import Text.XHtml.Strict.Formlets+import qualified Text.Formlets as F+import Text.XHtml.Strict ((!), (+++), (<<))+import Control.Applicative+import qualified Text.XHtml.Strict as X+import Data.Monoid++massInput :: (Applicative m, Monad m)+ => (XHtmlFormlet m a) -- ^ A formlet for a single a+ -> (X.Html -> X.Html) -- ^ This should add at least one wrapper tag around every item+ -> (X.Html -> X.Html) -- ^ This will add an optional wrapper tag around the whole list+ -> XHtmlFormlet m [a]+massInput formlet itemWrapper listWrapper defaults = + plug (wrapperDiv . buttons . listWrapper) $ F.massInput (plug' (itemWrapper ! [X.theclass "massInputItem"]) formlet) defaults++wrapperDiv = X.thediv ! [X.theclass "massInput"]++buttons x = (X.thediv+ ((X.input ! [X.thetype "button", X.strAttr "onclick" "addItem(this); return false;", X.value "Add Item"]) ++++ (X.input ! [X.thetype "button", X.strAttr "onclick" "removeItem(this); return false;", X.value "Remove Last Item"]))) +++ x++jsMassInputCode = unlines+ ["function findItems(button) {"+ ," var mainDiv = $(button).parent();"+ ," while ( !mainDiv.hasClass('massInput') ) {"+ ," mainDiv = $(mainDiv).parent();"+ ," }"+ ," return $('.massInputItem', mainDiv);"+ ,"}"+ ,"function addItem(button) {"+ ," var items = findItems(button);"+ ," var item = $(items[items.length-1]);"+ ," var newItem = item.clone(true);"+ ,""+ ," newItem.html(newItem.html().replace(/fval\\[(\\d+\\.)*(\\d+)\\.(\\d+)\\]/g, "+ ," function(a, b, c, d) {"+ ," var newC = parseInt(c)+1;"+ ," return a.replace(/\\d+\\.\\d+\\]/, newC+'.'+d+']');"+ ," }"+ ," ));"+ ,""+ ," newItem.appendTo(item.parent());"+ ,"}"+ ,"function removeItem(button) {"+ ," var items = findItems(button);"+ ," if ( items.length > 1 ) {"+ ," var item = $(items[items.length-1]);"+ ," item.remove();"+ ," } else {"+ ," alert('Cannot remove any more rows');"+ ," }"+ ,"}"+ ]+
Text/XHtml/Strict/Formlets.hs view
@@ -2,40 +2,43 @@ , hidden, inputInteger, radio, enumRadio , label , selectXHtml, selectRaw, select, enumSelect- , XHtmlForm+ , XHtmlForm, XHtmlFormlet , module Text.Formlets ) where -import Text.Formlets+import Text.Formlets hiding (massInput)+import qualified Text.Formlets as F import qualified Text.XHtml.Strict as X import Text.XHtml.Strict ((!), (+++), (<<)) import Control.Applicative import Control.Applicative.Error import Data.List (elemIndex) -type XHtmlForm m a = Form X.Html m a+type XHtmlForm m a = Form X.Html m a+type XHtmlFormlet m a = Formlet X.Html m a -- | An input field with an optional value-input :: Monad m => Maybe String -> XHtmlForm m String+input :: Monad m => XHtmlFormlet m String input = input' (\n v -> X.textfield n ! [X.value v]) + -- | A textarea with optional rows and columns, and an optional value-textarea :: Monad m => Maybe Int -> Maybe Int -> Maybe String -> XHtmlForm m String+textarea :: Monad m => Maybe Int -> Maybe Int -> XHtmlFormlet 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+password :: Monad m => XHtmlFormlet m String password = input' (\n v -> X.password n ! [X.value v]) -- | A hidden input field-hidden :: Monad m => Maybe String -> XHtmlForm m String+hidden :: Monad m => XHtmlFormlet m String hidden = input' X.hidden -- | A validated integer component-inputInteger :: Monad m => Maybe Integer -> XHtmlForm m Integer+inputInteger :: Monad m => XHtmlFormlet m Integer inputInteger x = input (fmap show x) `check` asInteger -- | A file upload form@@ -43,7 +46,7 @@ file = inputFile X.afile -- | A checkbox with an optional default value-checkbox :: Monad m => Maybe Bool -> XHtmlForm m Bool+checkbox :: Monad m => XHtmlFormlet m Bool checkbox d = (optionalInput (xml d)) `check` asBool where asBool (Just _) = Success True asBool Nothing = Success False@@ -51,7 +54,7 @@ xml _ n = X.checkbox n "on" -- | A radio choice-radio :: Monad m => [(String, String)] -> Maybe String -> XHtmlForm m String+radio :: Monad m => [(String, String)] -> XHtmlFormlet 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..])@@ -62,7 +65,7 @@ ident = name ++ "_" ++ show idx -- | An radio choice for Enums-enumRadio :: (Monad m, Enum a) => [(a, String)] -> Maybe a -> XHtmlForm m a+enumRadio :: (Monad m, Enum a) => [(a, String)] -> XHtmlFormlet m a enumRadio values defaultValue = radio (map toS values) (fmap (show . fromEnum) defaultValue) `check` convert `check` tryToEnum where toS = fmapFst (show . fromEnum)@@ -87,12 +90,11 @@ 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+ -> XHtmlFormlet 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, X.HTML h) => [X.HtmlAttr] -> [(a, h)] -> Maybe a -> Form X.Html m a+select :: (Eq a, Monad m, X.HTML h) => [X.HtmlAttr] -> [(a, h)] -> XHtmlFormlet 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)@@ -103,6 +105,5 @@ -- | 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+ -> XHtmlFormlet m a enumSelect attrs = select attrs (zip items (map show items)) where items = [minBound..maxBound]
formlets.cabal view
@@ -1,5 +1,5 @@ Name: formlets-Version: 0.5+Version: 0.6 Synopsis: Formlets implemented in Haskell Description: A modular way to build forms based on applicative functors, as described in:@@ -13,14 +13,26 @@ 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>-Exposed-Modules: Text.Formlets- , Text.XHtml.Strict.Formlets Build-Type: Simple-Build-Depends: base >= 2 && < 5, - haskell98, - mtl, - xhtml, - applicative-extras >= 0.1.3, - bytestring+Cabal-Version: >= 1.6 Extra-Source-Files: README++Library+ Build-Depends: base >= 2 && < 5, + haskell98, + mtl, + xhtml, + applicative-extras >= 0.1.3, + bytestring+ Exposed-Modules: Text.Formlets+ , Text.Formlets.MassInput+ , Text.XHtml.Strict.Formlets+ Other-Modules: Text.Formlets.FormResult+ +++source-repository head+ type: git+ location: git://github.com/chriseidhof/formlets.git