formlets 0.2.1 → 0.3

raw patch · 3 files changed

+53/−30 lines, 3 filesdep +bytestringPVP ok

version bump matches the API change (PVP)

Dependencies added: bytestring

API changes (from Hackage documentation)

Files

• Text/Formlets.hs +47/−27
• Text/XHtml/Strict/Formlets.hs +4/−1
• formlets.cabal +2/−2

@@ -1,8 +1,9 @@-module Text.Formlets ( input', fmapFst+module Text.Formlets ( input', inputFile, fmapFst                      , check, ensure, ensures                      , runFormState                       , xml, plug                      , Env , Form , Plus (..)+                     , File (..), ContentType (..), FormContentType (..)                      )                      where @@ -10,7 +11,23 @@ import Control.Applicative.Error import Control.Applicative.State import Data.Maybe (isJust)+import qualified Data.ByteString.Lazy as BS +-- Form stuff+type Env = [(String, Either String File)]+type FormState = Names+type Names = Integer+type Name = String+type Collector a = Env -> a+data FormContentType = UrlEncoded | MultiPart deriving (Eq, Show, Read)+newtype Form xml a = Form { deform :: Env -> State FormState (Collector (Failing a), xml, FormContentType) }+data File = File {content :: BS.ByteString, fileName :: String, contentType :: ContentType} deriving (Eq, Show, Read)+data ContentType = ContentType { ctType :: String+                               , ctSubtype :: String+                               , ctParameters :: [(String, String)]+                               }+                               deriving (Eq, Show, Read)+ class Plus a where   zero :: a   plus :: a -> a -> a@@ -36,64 +53,67 @@ -- | Helper function for genereting input components based forms. input' :: (String -> String -> xml) -> Maybe String -> Form xml String input' i defaultValue = Form $ \env -> mkInput env <$> freshName-   where mkInput env name = (Success . (`queryParam` (name)),-                             i name (value name env))-         value name env = maybe (maybe "" id defaultValue) id (lookup name env)+   where mkInput env name = (fromLeft name . (lookup name),+                             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."] +inputFile :: (String -> xml) -> Form xml File+inputFile i = Form $ \env -> mkInput env <$> freshName+  where  mkInput env name    = (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 :: Env             -- ^ A previously filled environment (may be empty)              -> Form xml a      -- ^ The form-             -> (Collector (Failing a), xml)+             -> (Collector (Failing a), xml, FormContentType) runFormState e (Form f) = evalState (f e) 0  -- | Add additional validation to an already validated component check :: Form xml a -> (a -> Failing b) -> Form xml b check (Form frm) f = Form $ \e -> checker (frm e)- where checker = fmap $ fmapFst (f' .)+ where checker = fmap $ fmapFst3 (f' .)        f' (Failure x) = Failure x        f' (Success x) = f x ---- Form stuff-type Env = [(String, String)]-type FormState = Names-type Names = Integer-type Name = String -queryParam :: Env -> Name -> String-queryParam env name = case (name `lookup` env) of-                           Nothing -> error $ "Couldn't find " ++ name-                           Just x  -> x---newtype Form xml a = Form { deform :: Env -> State FormState (Collector (Failing a), xml) }- instance Functor (Form xml) where-  fmap f (Form a) = Form $ \env -> (fmap . fmapFst . fmap . fmap) f (a env)--fmapFst f (a, b) = (f a, b)+  fmap f (Form a) = Form $ \env -> (fmap . fmapFst3 . fmap . fmap) f (a env) -type Collector a = Env -> a+fmapFst  f (a, b)    = (f a, b)+fmapFst3 f (a, b, c) = (f a, b, c)  instance Plus xml => Applicative (Form xml) where    pure = pureF    (<*>) = applyF  pureF :: Plus xml => a -> Form xml a-pureF v = Form $ \env -> pure (const (Success v), zero) -- K+pureF v = Form $ \env -> pure (const (Success v), zero, UrlEncoded)  applyF :: Plus xml => Form xml (a -> b) -> Form xml a -> Form xml b (Form f) `applyF` (Form v) = Form $ \env -> pure combine <*> f env <*> v env-  where combine (v1, xml1) (v2, xml2) = (\e -> v1 e <*> v2 e, xml1 `plus` xml2)+  where combine (v1, xml1, t1) (v2, xml2, t2) = (\e -> v1 e <*> v2 e, xml1 `plus` xml2, t1 `orT` t2) +orT UrlEncoded x = x+orT x UrlEncoded = x+orT x y          = x + -- | Component: just some xml xml :: xml -> Form xml ()-xml x = Form $ \env -> pure (const $ Success (), x)+xml x = Form $ \env -> pure (const $ Success (), x, UrlEncoded)  -- | Transform the XML component plug :: Plus xml => (xml -> xml) -> Form xml a -> Form xml a f `plug` (Form m) = Form $ \env -> pure plugin <*> m env-   where plugin (c, x) = (c, f x)+   where plugin (c, x, t) = (c, f x, t)  ----------------------------------------------- -- Private methods

@@ -1,4 +1,4 @@-module Text.XHtml.Strict.Formlets ( input, textarea, password+module Text.XHtml.Strict.Formlets ( input, textarea, password, file                                   , hidden, inputInteger, radio, enumRadio                                   , XHtmlForm                                   , module Text.Formlets@@ -33,6 +33,9 @@ -- | A validated integer component inputInteger :: Maybe Integer -> XHtmlForm Integer inputInteger x = input (fmap show x) `check` asInteger ++file :: XHtmlForm File+file = inputFile X.afile  -- | A radio choice radio :: [(String, String)] -> Maybe String -> XHtmlForm String

@@ -1,5 +1,5 @@ Name:            formlets-Version:         0.2.1+Version:         0.3 Synopsis:        Formlets implemented in Haskell Description:     A modular way to build forms based on applicative functors, as                  described in:@@ -17,4 +17,4 @@ Exposed-Modules:   Text.Formlets                  , Text.XHtml.Strict.Formlets Build-Type:      Simple-Build-Depends:   base, haskell98, mtl, xhtml, applicative-extras+Build-Depends:   base, haskell98, mtl, xhtml, applicative-extras, bytestring