formlets 0.4.2 → 0.4.3
raw patch · 3 files changed
+79/−30 lines, 3 files
Files
- Text/Formlets.hs +77/−29
- Text/XHtml/Strict/Formlets.hs +1/−0
- formlets.cabal +1/−1
Text/Formlets.hs view
@@ -1,7 +1,8 @@-module Text.Formlets ( input', inputFile, fmapFst+module Text.Formlets ( input', inputFile, fmapFst, nothingIfNull , check, ensure, ensures , ensureM, checkM, pureM , runFormState + , massInput , xml, plug , Env , Form , Plus (..) , File (..), ContentType (..), FormContentType (..)@@ -30,8 +31,8 @@ deriving (Eq, Show, Read) class Plus a where- zero :: a- plus :: a -> a -> a+ zero :: a+ plus :: a -> a -> a -- | Apply a predicate to a value and return Success or Failure as appropriate ensure :: Show a @@ -71,14 +72,15 @@ fromLeft n (Just (Left x)) = Success x fromLeft n _ = Failure [n ++ " is a file."] -inputFile :: Monad m => (String -> xml) -> Form xml m File+-- | 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), 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 :: Monad m => Env -- ^ A previously filled environment (may be empty)@@ -87,17 +89,17 @@ -> (Collector (m (Failing a)), xml, FormContentType) runFormState e prefix (Form f) = evalState (f e) (0, prefix) --- | Add additional validation to an already validated component+-- | 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') -- fmap $ fmapFst3 (fmap (f' f .))- f' (Failure x) = Failure x+ where checker = fmap $ fmapFst3 (fmap . liftM $ f')+ f' (Failure x) = Failure x f' (Success x) = f x --- | Add additional validation to an already validated component+-- | 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') -- fmap $ fmapFst3 (fmap (f' f .))+ where checker = fmap $ fmapFst3 (fmap f') f' v' = do v <- v' case v of Failure msg -> return $ Failure msg@@ -113,25 +115,7 @@ pure = pureF (<*>) = applyF -pureF :: (Monad m, Plus xml) => a -> Form xml m a-pureF v = Form $ \env -> pure (const (return $ Success v), zero, UrlEncoded)--pureM :: (Monad m, Plus xml) => m a -> Form xml m a-pureM v = Form $ \env -> pure (const (liftM Success v), 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 -> pure combine <*> f env <*> v env- 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-orT x y = x----- | Component: just some xml+-- | Pure xml xml :: Monad m => xml -> Form xml m () xml x = Form $ \env -> pure (const $ return $ Success (), x, UrlEncoded) @@ -140,6 +124,50 @@ f `plug` (Form m) = Form $ \env -> pure plugin <*> m env where plugin (c, x, t) = (c, 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 :: (Plus xml, Applicative m, Monad m) => (Form xml m (Maybe String)) -> Form xml m a -> Form xml m [a]+massInput h f = massInputHelper form+ 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+ 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)+ start f e = do currentState <- get+ --todo use v+ let (v, xml, t) = evalState f currentState+ let v' = evalState (combineIt [] f (Just v)) currentState+ 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++fst3 (a, b, c) = a++-- | 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+ ----------------------------------------------- -- Private methods -----------------------------------------------@@ -151,3 +179,23 @@ currentName :: State FormState String currentName = gets $ \(n, prefix) -> prefix ++ "input" ++ show n++changePrefix :: String -> State FormState ()+changePrefix p = modify (\(n,_) -> (n, p))++orT UrlEncoded x = x+orT x UrlEncoded = x+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)++pureM :: (Monad m, Plus xml) => m a -> Form xml m a+pureM v = Form $ \env -> pure (const (liftM Success v), 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)+ first v1 v2 e = do x <- v1 e + y <- v2 e+ return $ x <*> y
Text/XHtml/Strict/Formlets.hs view
@@ -48,6 +48,7 @@ | otherwise = [] ident = name ++ "_" ++ show idx +-- | An radio choice for Enums 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
formlets.cabal view
@@ -1,5 +1,5 @@ Name: formlets-Version: 0.4.2+Version: 0.4.3 Synopsis: Formlets implemented in Haskell Description: A modular way to build forms based on applicative functors, as described in: