<div><div>Hi.</div><div><br></div><div>Some time ago I forgot to forward this message to thie<a href="http://www.haskell.org/pipermail/haskell-cafe/2011-January/088060.html"> ur versus Haskell </a>discussion, (as usual)</div>
<div>---</div><div>The most impressive feature (of ur) is the compile time checking of conformance between the form and the form results. This can be done in Haskell using HList magic and </div><div>some class instances, I guess.</div>
<div>----</div><div>Since then I have been playing mentally with this. Recently I found something </div><div>simple an interesting enough to share. (Although crude).</div><div><br></div><div> It is a kind of typed form fields</div>
<div><br></div><div>data Input a= Input String Type a (String -> Either String a)</div><div><br></div><div> </div><div>and a kind of heterogeneous list to aggregate form fields and results with the operator (:*):</div>
<div> Input a :* Input b ;* Input c....</div><div> a :* b :* c</div><div><br></div><div>and a (simulated for the purpose of demonstration) send-receive function that type match the form fields and the results:</div>
<div><br></div><div><br></div><div>*Main> let form = Input "" Text "stringdata" novalidate :* Input "" Text (1::Integer) novalidate</div><div><br></div><div>*Main> ask form >>= \(a :* b) -> return $ a ++ b</div>
<div><br></div><div><interactive>:1:0:</div><div> No instance for (FormDigest</div><div> (Input [Char] :* Input Integer) ([a] :* [a]))</div><div> ......</div><div><br></div><div>notifying that there is no translation defined , because the result requires</div>
<div>two lists of the same type when the form gives a string and an Integer</div><div><br></div><div>But forcing the correct monomorphic types it does pattern match and return the values.</div><div><br></div><div><br></div>
<div>*Main> ask form >>= \ (a :* b) -> print ('s':a) >> print ( fromInteger $ b)</div><div>"sstringdata"</div><div>1</div><div><br></div><div><br></div><div>ask is just a simulation of HTTP one time interaction. It returns the input values.</div>
<div>The whole loop involves the rendering of the form, with render:</div><div><br></div><div>*Main> render form</div><div><input type="Text" name="var1" value="stringdata"/></div><div>
<input type="Text" name="var2" value=1/></div><div><br></div><div>In a real case the results are read and validated from the the post values.They</div><div>are (or can be) ordered sequentially acording with Input field names.</div>
<div>The FormDigest instances do this work. There is no need to define new</div><div>FormDigest instances. (although non one to one field-result can be created)</div><div><br></div><div>The text is in literate haskell. There is a more elaborate example at the end.</div>
<div>I know that the instances are non tail recursive and there are factorization pending</div><div> but this is just a proof of concept:</div><div><br></div><div>> {-# LANGUAGE</div><div>> FlexibleInstances,</div>
<div>> MultiParamTypeClasses,</div><div>> TypeOperators</div><div>> #-}</div><div><br></div><div>> import Control.Monad.State</div><div><br></div><div>The Heterogeneous list agregator. I tried to use GADTs but they does not </div>
<div>easily pattern match</div><div><br></div><div>> data x :* xs = x :* xs deriving (Read, Show, Eq)</div><div>> infixr 5 :*</div><div><br></div><div><br></div><div>> data Type= Hidden | Text deriving (Show, Read) -- to add all the types</div>
<div><br></div><div>the input field, with text formatting, initial value and runtime validator</div><div><br></div><div>> data Input a = Input String Type a (String -> Either [String] a)</div><div><br></div><div>
> instance(Show a)=> Show (Input a) where</div><div>> show (Input _ _ x _) = show x</div><div><br></div><div>rendering of the form need a sequentiation of field names. I use a state monad for this</div><div><br>
</div><div>> class RenderForm a where</div><div>> renderForm :: a -> State Int String</div><div><br></div><div>> instance (Show a) => RenderForm (Input a) where</div><div>> renderForm input = do</div>
<div>> s1 <- render1 input</div><div>> n <- get</div><div>> put $ n + 1</div><div>> return s1</div><div><br></div><div>HList school here:</div><div><br></div><div>> instance (Show a,RenderForm xs) => RenderForm (Input a :* xs) where</div>
<div>> renderForm (input :* xs)= do</div><div>> n <- get</div><div>> put $ n+1</div><div>> h <- render1 input</div><div>> s <- renderForm xs</div><div>> return $ h++s</div><div>
<br></div><div>> render1 (Input msg t x _)= do</div><div>> n <- get</div><div>> put $ n+1</div><div>> return $ msg</div><div>> ++ "<input type=\""</div><div>> ++ show t ++ "\" name="</div>
<div>> ++ "\"var"++show n ++ "\" value="</div><div>> ++ show x ++"/>\n"</div><div>></div><div><br></div><div>> render form= putStrLn $ evalState (renderForm form ) 0</div>
<div><br></div><div>processing of the returned form result, in an ordered String list, according with</div><div>seuquential names of the fields defined in renderForm.</div><div><br></div><div>> class FormDigest a b where</div>
<div>> formDigest :: a -> [String] -> Either [String] b</div><div><br></div><div>"Input a" is diggested into a type "a"</div><div><br></div><div>> instance FormDigest (Input a) (a) where</div>
<div>> formDigest (Input _ _ x f) (s: ss)= case f s of</div><div>> Right x -> Right $ x</div><div>> Left x -> Left x</div><div><br></div><div>recursively add instances for any list of inputs</div>
<div>Input a's are diggested into a's</div><div><br></div><div>> instance FormDigest as bs</div><div>> => FormDigest (Input a :* as) (a :* bs) where</div><div>> formDigest (input :* fs) es@(s:ss) =</div>
<div>> let er = formDigest fs ss</div><div>> e = formDigest input es</div><div>> in case (e, er) of</div><div>> (Right x, Right ys) -> Right $ x :* ys</div><div>> (Right _, Left errs) -> Left errs</div>
<div>> (Left err, Left errs) -> Left (err ++ errs)</div><div><br></div><div><br></div><div><br></div><div>simulated request-response that returns the entered input values</div><div><br></div><div>> sendRec xs= do</div>
<div>> let strs = showValues xs</div><div>> return $ formDigest xs strs</div><div><br></div><div>> class ShowValues a where</div><div>> showValues :: a -> [String]</div><div><br></div><div>> instance Show x => ShowValues (Input x) where</div>
<div>> showValues i = [show i ]</div><div><br></div><div>> instance (Show x,ShowValues xs) => ShowValues (Input x :* xs) where</div><div>> showValues (i :* xs)= show i : showValues xs</div><div><br></div>
<div>end of simulated request response</div><div><br></div><div>> ask :: (ShowValues a, FormDigest a b) => a -> IO b</div><div>> ask form = do</div><div>> er <- sendRec form</div><div>> case er of</div>
<div>> Left errs -> error "" -- shoud be: "ask1 errs form "·to render form and errors</div><div>> Right res -> return res</div><div><br></div><div><br></div><div>EXAMPLE:</div><div>
<br></div><div>> data Emp= Emp{name::String, salary :: Int} deriving Show</div><div><br></div><div>> emp= Emp "Luis" 10000</div><div><br></div><div>toy html operators:</div><div><br></div><div>> b msg = ("<b> " ++ msg ++ " </b>\n")</div>
<div>> p msg = ("<p> " ++ msg ++ " </p>\n")</div><div><br></div><div>> novalidate n= Right $ read n</div><div><br></div><div>> main= do</div><div><br></div><div>></div><div>
> let form = Input</div><div>> ( b "please enter the name"</div><div>> ++ p "mas texto")</div><div>> Text (name emp) novalidate</div>
<div>> :* Input</div><div>> (b "please enter the salary"</div><div>> ++ p "jkjkjk")</div><div>> Text (salary emp) novalidate</div>
<div><br></div><div>> render form </div><div><br></div><div>the matching thing</div><div><br></div><div>> (n :* s ) <- ask form</div><div><br></div><div>> print emp</div><div>> print $ Emp n s</div>
<div><br></div><br><br></div>