hplayground 0.1.0.5 → 0.1.1.0

raw patch · 3 files changed

+575/−411 lines, 3 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• hplayground.cabal +1/−1
• src/Haste/HPlay/Cell.hs +197/−32
• src/Haste/HPlay/View.hs +377/−378

@@ -1,5 +1,5 @@ name: hplayground
-version: 0.1.0.5
+version: 0.1.1.0
 cabal-version: >=1.8
 build-type: Simple
 license: BSD3

@@ -11,63 +11,228 @@ -- |
 --
 -----------------------------------------------------------------------------
-
+{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}
 module Haste.HPlay.Cell  where
 import Haste.HPlay.View
 import Control.Monad.IO.Class
 import Haste
 import Data.Typeable
 import Unsafe.Coerce
-
+import qualified Data.Map as M hiding ((!))
+import System.IO.Unsafe
+import Data.IORef
+import Control.Monad
+import Data.Maybe
+import Control.Exception
+import Data.List
 
 data Cell  a = Cell { mk :: Maybe a -> Widget a
-                    , setter ::  a -> IO()
-                    , getter ::  IO a}
+                    , setter ::  a -> IO ()
+                    , getter ::  IO (Maybe a)}
 
 --instance Functor Cell where
 --  fmap f cell = cell{setter= \c x ->  c .= f x, getter = \cell -> get cell >>= return . f}
 
 
-
+-- a box cell with polimorphic value, identified by a strig
+boxCell :: (Show a, Read a, Typeable a) => ElemID -> Cell a
 boxCell id = Cell{ mk= \mv -> getParam (Just id) "text" mv
-                 , setter= \ x -> withElem id $ \e -> setProp e "value" (show1 x)
-                 , getter= get}
-     where
-     show1 x= if typeOf x== typeOf (undefined :: String)
-                                then unsafeCoerce x
-                                else show x
+                 , setter= \x -> withElem id $ \e -> setProp e "value" (show1 x)
 
-     get= r where r= withElem id $ \e -> getProp e "value" >>= return . read
-                  read1 s= if typeOf(typeIO r) /= typeOf (undefined :: String)
-                                then read s
-                                else unsafeCoerce s
-                  typeIO :: IO a -> a
-                  typeIO = undefined
+                 , getter= getit}
+    where
+    getit= withElem id $ \e -> getProp e "value" >>= return . read1
+    read1 s= if typeOf(typeIO getit) /= typeOf (undefined :: String)
+               then case readsPrec 0 s  of
+                   [(v,_)] ->  Just v
+                   _  -> Nothing
+               else unsafeCoerce s
+    typeIO :: IO(Maybe a) -> a
+    typeIO = undefined
+    show1 x= if typeOf x== typeOf (undefined :: String)
+            then unsafeCoerce x
+            else show x
 
+
+
+
+
+-- | Cell assignment
+(.=) :: MonadIO m =>  Cell a -> a -> m ()
 (.=) cell x = liftIO $ (setter cell )  x
 
-get cell = liftIO $ getter cell
+get cell =  View $ liftIO $ getter cell >>= return . FormElm noHtml
 
-(..=) cell cell'= get cell' >>= (.=) . cell
 
-infixr 0 .=, ..=
+---- |  a cell value assigned to other cell
+--(..=) :: Cell a -> Cell a -> Widget ()
+--(..=) cell cell'= get cell' >>= (cell .= )
 
+infixr 0 .=  -- , ..=
+
 -- experimental: to permit cell arithmetic
 
-instance Num a => Num (Cell a) where
-  c + c'= Cell undefined undefined  $
-            do r1 <- get c
-               r2 <- get c'
-               return $ r1 + r2
+--instance Num a => Num (Cell a) where
+--  c + c'= Cell undefined undefined  $
+--            do r1 <- getter c
+--               r2 <- getter c'
+--               return $  liftA2 (+) r1  r2
+--
+--  c * c'= Cell undefined undefined $
+--            do r1 <- getter c
+--               r2 <- getter c'
+--               return $ liftA2 (+) r1  r2
+--
+--  abs c= c{getter=  getter c >>= return . fmap abs}
+--
+--  signum c= c{getter=  getter c >>= return . fmap signum}
+--
+--  fromInteger i= Cell  undefined undefined  . return $ Just $ fromInteger i
 
-  c * c'= Cell undefined undefined $
-            do r1 <- get c
-               r2 <- get c'
-               return $ r1 * r2
 
-  abs c= c{getter=  get c >>= return . abs}
+-- *  spradsheet type cells
 
-  signum c= c{getter=  get c >>= return . signum}
+-- The recursive Cell calculation DSL BELOW ------
 
-  fromInteger i= Cell  undefined undefined  . return $ fromInteger i
+-- http://blog.sigfpe.com/2006/11/from-l-theorem-to-spreadsheet.html
+-- loeb ::  Functor f => f (t -> a) -> f a
+loeb :: M.Map String (Expr a) -> M.Map String a
+loeb x = fmap (\a -> a (loeb  x)) x
 
+gcell ::  Num a => String -> M.Map String a -> a
+gcell n= \vars -> case M.lookup n vars of
+    Just exp -> inc n  exp
+    Nothing -> error $ "cell error in: "++n
+  where
+  inc n exp= unsafePerformIO $ do
+     tries <- readIORef rtries
+     if tries <= maxtries
+       then  do
+          writeIORef rtries  (tries+1)
+          return exp
+
+       else  error n
+
+circular n= "loop detected in cell: "++ n  ++ " please fix the error"
+
+type Expr a = M.Map String a -> a
+
+rtries= unsafePerformIO $ newIORef $ (0::Int)
+maxtries=  3* (M.size $ unsafePerformIO $ readIORef rexprs)
+
+rexprs :: IORef (M.Map String (Expr Float))
+rexprs= unsafePerformIO $ newIORef M.empty
+
+rmodified :: IORef (M.Map String (Expr Float))
+rmodified= unsafePerformIO $ newIORef M.empty
+
+mkscell :: String -> Maybe Float -> Expr Float -> Widget ()
+mkscell name val expr=  static $ do
+   liftIO $ do
+     exprs <- readIORef rexprs
+     writeIORef rexprs $ M.insert name expr exprs
+   r <- mk (boxCell name) val  `fire` OnChange
+   liftIO $ do
+        mod <- readIORef rmodified
+        writeIORef rmodified  $ M.insert  name (const r)  mod
+ `continuePerch`  name
+
+-- mkscell name val expr= mk (scell name expr) val
+
+scell id  expr= Cell{ mk= \mv-> static $ do
+                           liftIO $ do
+                             exprs <- readIORef rexprs
+                             writeIORef rexprs $ M.insert id expr exprs
+
+                           r <- getParam (Just id) "text" mv
+                           liftIO $ do
+                                mod <- readIORef rmodified
+                                writeIORef rmodified  $ M.insert  id (const r)  mod
+                           return r
+                         `continuePerch`  id
+
+
+
+                 , setter= \x -> withElem id $ \e -> setProp e "value" (show1 x)
+
+                 , getter= getit}
+    where
+
+    getit= withElem id $ \e -> getProp e "value" >>= return . read1
+    read1 s= if typeOf(typeIO getit) /= typeOf (undefined :: String)
+               then case readsPrec 0 s  of
+                   [(v,_)] ->  Just v
+                   _  -> Nothing
+               else unsafeCoerce s
+    typeIO :: IO(Maybe a) -> a
+    typeIO = undefined
+    show1 x= if typeOf x== typeOf (undefined :: String)
+            then unsafeCoerce x
+            else show x
+
+continuePerch :: Widget a -> ElemID -> Widget a
+continuePerch w eid= View $ do
+  FormElm f mx <- runView w
+  return $ FormElm (c f) mx
+  where
+  c f =Perch $ \e' ->  do
+     build f e'
+     elemid eid
+
+  elemid id= elemById id >>= return . fromJust
+
+
+calc :: Widget ()
+calc= do
+  nvs <- liftIO $ readIORef rmodified
+  when (not $ M.null nvs) $ do
+    values <-liftIO $ handle doit calc1
+    mapM_ (\(n,v) -> boxCell n .= v)  values
+  liftIO $ writeIORef rmodified M.empty
+  where
+  calc1  :: IO [(String,Float)]
+  calc1=do
+    writeIORef rtries 0
+    cells <- liftIO $ readIORef rexprs
+    nvs   <- liftIO $ readIORef rmodified
+    let mvalues = M.union nvs  cells
+        evalues = loeb mvalues
+
+    toStrict $ M.toList evalues
+
+  toStrict xs = print xs >> return xs
+
+  doit :: SomeException -> IO [(String,Float)]
+  doit e= do
+    nvs <- readIORef rmodified
+    exprs <- readIORef rexprs
+    case  M.keys exprs \\ M.keys nvs of
+      [] -> do
+         let Just (ErrorCall n)= fromException e
+         let err= circular n
+         alert err
+         error err
+      (name:_) -> do
+         mv <- getter $ boxCell name
+         case mv of
+            Nothing -> return []
+            Just v -> do
+                writeIORef rmodified  $ M.insert name (const v) nvs
+                calc1
+
+instance Show (Expr a)
+
+instance Eq (Expr a)
+
+instance (Num a,Eq a,Fractional a) =>Fractional (x -> a)where
+     f / g = \x -> f x / g x
+     fromRational = error "fromRational not implemented"
+
+
+instance (Num a,Eq a) => Num (x -> a) where
+     fromInteger = const . fromInteger
+     f + g = \x -> f x + g x
+     f * g = \x -> f x * g x
+     negate = (negate .)
+     abs = (abs .)
+     signum = (signum .)

@@ -8,7 +8,7 @@ -- Stability   :  experimental
 -- Portability :
 --
--- |
+-- | The haste-hplayground framework.  <http://github.com/agocorona/hplayground>
 --
 -----------------------------------------------------------------------------
 
@@ -16,50 +16,52 @@     , TypeFamilies, DeriveDataTypeable, UndecidableInstances, ExistentialQuantification
     , GADTs
     #-}
-module Haste.HPlay.View(-Widget,---- * widget combinators and modifiers--wcallback, (<+>), (**>), (<**), validate-,firstOf, manyOf, allOf-,(<<<),(<<),(<++),(++>),(<!)---- * basic widgets--,getString,inputString, getInteger,inputInteger,-getInt, inputInt,getPassword,inputPassword,-setRadio,setRadioActive,getRadio-,setCheckBox, getCheckBoxes-,getTextBox, getMultilineText,textArea,getBool-,getSelect,setOption,setSelectedOption, wlabel,-resetButton,inputReset, submitButton,-inputSubmit, wlink, noWidget, stop,wraw, isEmpty---- * out of flow updates-,at, UpdateMethod(..)---- * Session data storage-,getSessionData,getSData,setSessionData,setSData-,delSessionData,delSData---- * reactive and events-,resetEventData,getEventData,EventData(..),EvData(..)-,raiseEvent, fire, wake, react, pass-,continueIf, wtimeout, Event(..)---- * running it-,runWidget, runWidgetId, runBody, addHeader---- * Perch is reexported-,module Haste.Perch---- * low level and internals-,getNextId,genNewId-,getParam-,FormInput(..)-,View(..),FormElm(..)-+module Haste.HPlay.View(
+Widget,
+-- * re-exported
+module Control.Applicative,
+
+-- * widget combinators and modifiers
+
+static, dynamic, wcallback, (<+>), (**>), (<**), validate
+,firstOf, manyOf, allOf
+,(<<<),(<<),(<++),(++>),(<!)
+
+-- * basic widgets
+,wprint
+,getString,inputString, getInteger,inputInteger,
+getInt, inputInt,inputFloat, inputDouble,getPassword,inputPassword,
+setRadio,setRadioActive,getRadio
+,setCheckBox, getCheckBoxes
+,getTextBox, getMultilineText,textArea,getBool
+,getSelect,setOption,setSelectedOption, wlabel,
+resetButton,inputReset, submitButton,
+inputSubmit, wbutton, wlink, noWidget, stop,wraw, isEmpty
+
+-- * out of flow updates
+,at, UpdateMethod(..)
+
+-- * Session data storage
+,getSessionData,getSData,setSessionData,setSData
+,delSessionData,delSData
+
+-- * reactive and events
+,resetEventData,getEventData,EventData(..),EvData(..)
+,raiseEvent, fire, wake, react, pass
+,continueIf, wtimeout, Event(..)
+
+-- * running it
+,runWidget,runWidgetId, runBody, addHeader
+
+-- * Perch is reexported
+,module Haste.Perch
+
+-- * low level and internals
+,getNextId,genNewId
+,getParam
+,FormInput(..)
+,View(..),FormElm(..)
+
 )  where
 import Control.Applicative
 import Data.Monoid
@@ -68,7 +70,7 @@ import Data.Typeable
 import Unsafe.Coerce
 import Data.Maybe
-import Haste+import Haste
 import Haste.Prim
 import Haste.Foreign(ffi)
 import Unsafe.Coerce
@@ -78,57 +80,18 @@ import Control.Monad.Trans.Maybe
 import Prelude hiding(id)
 import Haste.Perch
--- | @View v m a@ is a widget (formlet)  with formatting `v`  running the monad `m` (usually `IO`) and which return a value of type `a`
---
--- It has 'Applicative', 'Alternative' and 'Monad' instances.
---
--- Things to know about these instances:
---
---   If the View expression does not validate, ask will present the page again.
---
--- /Alternative instance/: Both alternatives are executed. The rest is as usual
---
--- /Monad Instance/:
---
---  The rendering of each statement is added to the previous. If you want to avoid this, use 'wcallback'
---
---  The execution is stopped when the statement has a formlet-widget that does not validate and
--- return an invalid response (So it will present the page again if no other widget in the expression validates).
---
---  The monadic code is executed from the beginning each time the page is presented or refreshed
---
---  use 'pageFlow' if your page has more than one monadic computation with dynamic behaviour
---
--- use 'pageFlow' to identify each subflow branch of a conditional
---
---  For example:
---
---  > pageFlow "myid" $ do
---  >      r <- formlet1
---  >      liftIO $ ioaction1 r
---  >      s <- formlet2
---  >      liftIO $ ioaction2 s
---  >      case s of
---  >       True  -> pageFlow "idtrue" $ do ....
---  >       False -> paeFlow "idfalse" $ do ...
---  >      ...
---
---  Here if  @formlet2@ do not validate, @ioaction2@ is not executed. But if @formLet1@ validates and the
---  page is refreshed two times (because @formlet2@ has failed, see above),then @ioaction1@ is executed two times.
---  use 'cachedByKey' if you want to avoid repeated IO executions.
+
+--import Debug.Trace
+--(!>)= flip trace
+
 data NeedForm= HasForm | HasElems  | NoElems deriving Show
 type SData= ()
 
---instance MonadState (  Widget) where
---  type StateType (  Widget)=  MFlowState
---
---instance MonadState IO where
---  type StateType IO=  MFlowState
 
-data EventF= forall b c.EventF (IO (Maybe b)) (b -> IO (Maybe c)) --
+data EventF= forall b c.EventF (Widget b) [(b -> Widget c,ElemID)]
 
 data MFlowState= MFlowState { mfPrefix :: String,mfSequence :: Int
-                            , needForm :: NeedForm, process :: EventF+                            , needForm :: NeedForm, process :: EventF
                             , fixed :: Bool
                             , mfData :: M.Map TypeRep SData}
 
@@ -138,8 +101,8 @@ data FormElm view a = FormElm view (Maybe a)
 newtype View v m a = View { runView :: WState v m (FormElm v a)}
 
-mFlowState0= MFlowState "" 0 NoElems  (EventF (return Nothing)
-                        (const $ return Nothing) ) False M.empty
+mFlowState0= MFlowState "" 0 NoElems  (EventF empty
+                        [(const $ empty,"noid") ] ) False M.empty
 
 
 instance Functor (FormElm view ) where
@@ -152,26 +115,26 @@ instance  (Monad m,Functor m) => Functor (View view m) where
   fmap f x= View $   fmap (fmap f) $ runView x
 
-  
+
 instance (Monoid view,Functor m, Monad m) => Applicative (View view m) where
   pure a  = View  .  return . FormElm mempty $ Just a
   View f <*> View g= View $
                    f >>= \(FormElm form1 k) ->
                    g >>= \(FormElm form2 x) ->
-                   return $ FormElm (form1 `mappend` form2) (k <*> x) 
+                   return $ FormElm (form1 `mappend` form2) (k <*> x)
 
 instance (Monoid view, Functor m, Monad m) => Alternative (View view m) where
   empty= View $ return $ FormElm mempty Nothing
   View f <|> View g= View $ do
                    FormElm form1 x <- f
                    FormElm form2 y <- g
-                   return $ FormElm (form1 <> form2) (x <|> y) 
+                   return $ FormElm (form1 <> form2) (x <|> y)
 
 
 strip st x= View $ do
     st' <- get
     put st'{mfSequence= mfSequence st}
-    FormElm _ mx <- runView x
+    FormElm f mx <- runView x
     put st'
     return $ FormElm mempty mx
 
@@ -180,99 +143,118 @@    st <- get
    let conf = process st
    case conf of
-     EventF x' f'  -> do
-       let addto f f'= \x -> do
-             mr <- runWidgetId (f x) id
-             case mr of
-               Nothing -> return Nothing
-               Just x' ->  f' x'
-           idx= runWidgetId ( strip st  x) id
-       put st{process= EventF idx (f `addto` unsafeCoerce f') }
+     EventF x' fs  -> do
+--       let f' x = View $ do
+--
+--           --     modify $ \s -> s{process= EventF (strip s $ f x) (unsafeCoerce fs) } --(unsafeCoerce $ tail fs) }
+--                runView $ f x
+
+
+       let idx=  strip st x
+       put st{process= EventF idx ((f,id): unsafeCoerce fs)  }
    return conf
 
+
 resetEventCont cont= modify $ \s -> s {process= cont}
 
 instance Monad (View Perch IO) where
     x >>= f = View $ do
-           id <- genNewId
-           contold <- setEventCont x f  id
-           FormElm form1 mk <- runView x
-           resetEventCont contold-           let span= nelem "span" `attrs` [("id", id)]
-           case mk of
-             Just k  -> do
-                FormElm form2 mk <- runView $ f k-                return $ FormElm (form1 <> (span `child`  form2)) mk
-             Nothing -> 
-                return $ FormElm  (form1 <> span)  Nothing
-                        
+       fixed <- gets fixed
+       id <- genNewId
+       contold <- setEventCont x  f  id
+       FormElm form1 mk <- runView x
+       resetEventCont contold
+       let span= nelem "span" `attrs` [("id", id)]
+       case mk of
+         Just k  -> do
+     --       contold <- setEventCont (f k !> "secondev") (return)    id  !> "build second"
+            FormElm form2 mk <- runView $ f k
+     --       resetEventCont contold
+            case fixed of
+              False ->  return $ FormElm (form1 <> (span `child`  form2)) mk
+              True  ->  return $ FormElm (form1 <> form2) mk
+         Nothing ->
+            case fixed of
+              False -> return $ FormElm  (form1 <> span)  Nothing
+              True  -> return $ FormElm  form1  Nothing
 
+
     return = View .  return . FormElm  mempty . Just
---    fail msg= View . return $ FormElm [inRed msg] Nothing
-+    fail msg= View . return $ FormElm (inred $ fromStr msg) Nothing
 
---static w= View $ do---   modify $ \st -> st{fixed=True}---   runView w
+-- | To produce updates, each line of html produced by a "do" sequence in the Widget monad is included
+-- within a 'span' tag. When the line is reexecuted after a event, the span is updated with the new
+-- rendering.
+--
+-- static tell to the rendering that this widget does not change, so the extra 'span' tag for each
+-- line in the sequence and the rewriting is not necessary. Thus the size of the HTML and the
+-- performance is improved.
 
+static w= View $ do
+   st <- get
+   let was = fixed st
+   put st{fixed=True}
+   r <- runView $ w
+   modify $ \st -> st{fixed= was}
+   return r
+
+-- override static locally to permit dynamic effects inside a static widget. It is useful
+-- when a monadic Widget computation which perform no rendering changes has a to do some update:
+--
+-- > launchMissiles= static $ do
+-- >    t <- armLauncher
+-- >    c <- fixTarget t
+-- >    f <- fire c
+-- >    dynamic $ displayUpdate t c f
+-- >    return ()
+
+dynamic w= View $ do
+   st <- get
+   let was = fixed st
+   put st{fixed= False}
+   r <- runView $ w
+   modify $ \st -> st{fixed= was}
+   return r
+
 instance (FormInput v,Monad (View v m), Monad m, Functor m, Monoid a) => Monoid (View v m a) where
   mappend x y = mappend <$> x <*> y  -- beware that both operands must validate to generate a sum
   mempty= return mempty
 
 
--- | It is a callback in the view monad. The callback rendering substitutes the widget rendering
--- when the latter is validated, without afecting the rendering of other widgets. This allow
--- the simultaneous execution of different behaviours in different widgets in the
--- same page.
+-- | It is a callback in the view monad. The rendering of the second parameter substitutes the rendering
+-- of the first paramenter when the latter validates without afecting the rendering of other widgets.
+-- This allow the simultaneous execution of different dynamic behaviours in different page locations
+-- at the same page.
 wcallback
   ::  Widget a -> (a ->Widget b) -> Widget b
-wcallback  x f = View $ do
-   idhide <- genNewId
-   id <- genNewId-   runView $ identified idhide x >>= delBefore idhide f                        
-   where
-   delBefore id f = \x -> View $ do
-     FormElm render mx <- runView $ f x
-     return $ FormElm (del id <> render ) mx
-     where
-     del id= Perch $ \e' -> do
-           withElem id $ \e -> do
-             par <- parent e
-             removeChild e par
-           return e'
 
+wcallback x f= View $ do
+   nid <-  genNewId
+   FormElm form mx <- runView $ do
+             r <-  at nid Insert x
+             at nid Insert $ f r
+
+   return $ FormElm ((Haste.Perch.span ! atr "id" nid $ noHtml) <> form) mx
+
+
+
 identified id w= View $ do
      let span= nelem "span" `attr` ("id", id)
      FormElm f mx <- runView w
      return $ FormElm (span `child` f) mx
-----wcallback
---  ::  Widget a -> (a -> Widget b) -> Widget b                      
---wcallback  x' f = View $ do
---   id <- genNewId
---   let x = identified id x'
---
---   contold <- setEventCont x f  id
---   FormElm form1 mk <- runView x
---   resetEventCont contold
---   case mk of
---     Just k  -> do
---        FormElm form2 mk <- runView $ f k
---        return $ FormElm  form2 mk
---     Nothing -> 
---        return $ FormElm  form1  Nothing
-- 
+
+
+
+
 instance  (FormInput view,Monad m,Monad (View view m)) => MonadState (View view m) where
   type StateType (View view m)= MFlowState
-  get = View $  get >>=  return . FormElm mempty . Just 
-  put st = View $  put st >>=  return . FormElm mempty . Just 
+  get = View $  get >>=  return . FormElm mempty . Just
+  put st = View $  put st >>=  return . FormElm mempty . Just
 
 
 instance (FormInput view,Monad (View view m),MonadIO m) => MonadIO (View view m) where
-    liftIO io=   let x= liftIO io in x `seq` lift x 
+    liftIO io=   let x= liftIO io in x `seq` lift x
 
 
 ----- some combinators ----
@@ -333,7 +315,7 @@    FormElm form mx <- runView form
    return $ FormElm form $ Just undefined
 
-infixr 1  **>  ,  <** 
+infixr 1  **>  ,  <**
 
 -- | The second elem result (even if it is not validated) is discarded, and the first is returned
 -- . This contrast with the applicative operator '*>' which fails the whole validation if
@@ -379,10 +361,10 @@     fromStrNoEncode :: String -> view
     ftag :: String -> view  -> view
     inred   :: view -> view
-    flink ::  String -> view -> view 
+    flink ::  String -> view -> view
     flink1:: String -> view
-    flink1 verb = flink verb (fromStr  verb) 
-    finput :: Name -> Type -> Value -> Checked -> OnClick -> view 
+    flink1 verb = flink verb (fromStr  verb)
+    finput :: Name -> Type -> Value -> Checked -> OnClick -> view
     ftextarea :: String -> String -> view
     fselect :: String -> view -> view
     foption :: String -> view -> Bool -> view
@@ -417,19 +399,19 @@        case mv of
          Nothing -> return NoParam
          Just v -> do
-           readParam v  
+           readParam v
 
 
 type Params= Attribs
 
 
-  
+
 readParam :: (Monad m, MonadState  m, Typeable a, Read a, FormInput v)
            => String -> m (ParamResult v a)
 readParam x1 = r
  where
  r= maybeRead x1
-      
+
  getType ::  m (ParamResult v a) -> a
  getType= undefined
  x= getType r
@@ -474,7 +456,7 @@           prefseq=  mfPrefix st
       put $ st{mfSequence= n+1}
 
-      return $ 'p':show n++prefseq  
+      return $ 'p':show n++prefseq
 
 
 -- | get the next ideitifier that will be created by genNewId
@@ -516,6 +498,14 @@      Maybe Int -> View view m Int
 inputInt =  getInt
 
+inputFloat :: (StateType (View view m) ~ MFlowState,FormInput view, MonadIO m) =>
+     Maybe Float -> View view m Float
+inputFloat =  getTextBox
+
+inputDouble :: (StateType (View view m) ~ MFlowState,FormInput view, MonadIO m) =>
+     Maybe Double -> View view m Double
+inputDouble =  getTextBox
+
 -- | Display a password box
 getPassword :: (FormInput view,StateType (View view m) ~ MFlowState,
      MonadIO m) =>
@@ -546,14 +536,14 @@        Just e  -> liftIO $   getProp e "checked"
   let strs= if  checked=="true" then Just v else Nothing
 --  let mn= if null strs then False else True
-      ret= fmap  Radio  strs 
+      ret= fmap  Radio  strs
       str = if typeOf v == typeOf(undefined :: String)
                    then unsafeCoerce v else show v
   return $ FormElm
       ( finput id "radio" str ( isJust strs ) Nothing `attrs` [("name",n)])
       ret
- 
 
+
 setRadioActive rs x= setRadio rs x `raiseEvent` OnClick
 
 -- | encloses a set of Radio boxes. Return the option selected
@@ -567,16 +557,16 @@    return $ FormElm render $ fmap (\(Radio r) -> r) mx
 
 
-data CheckBoxes = CheckBoxes [String]
+data CheckBoxes a= CheckBoxes [a]
 
-instance Monoid CheckBoxes where
+instance Monoid (CheckBoxes a) where
   mappend (CheckBoxes xs) (CheckBoxes ys)= CheckBoxes $ xs ++ ys
   mempty= CheckBoxes []
 
 
 -- | Display a text box and return the value entered if it is readable( Otherwise, fail the validation)
-setCheckBox :: (FormInput view,  MonadIO m) =>
-                Bool -> String -> View view m  CheckBoxes
+setCheckBox :: (FormInput view,  MonadIO m, Typeable a , Show a) =>
+                Bool -> a -> View view m  (CheckBoxes a)
 setCheckBox checked' v= View $ do
   n  <- genNewId
   st <- get
@@ -587,24 +577,26 @@        Just e  -> liftIO $  getProp e "checked"
   let strs= if  checked=="true"  then [v] else []
 --  let mn= if null strs then False else True
-      ret= Just $ CheckBoxes  strs 
-
+      ret= Just $ CheckBoxes  strs
+      showv= case typeOf v== typeOf (undefined ::String) of
+               True -> unsafeCoerce v
+               False -> show v
   return $ FormElm
-      ( finput n "checkbox" v ( checked' ) Nothing)
+      ( finput n "checkbox" showv ( checked' ) Nothing)
       ret
- 
 
-getCheckBoxes :: (Monad m, FormInput view) =>  View view m  CheckBoxes ->  View view m  [String]
-getCheckBoxes w= View $ do-   FormElm render mcb <- runView w-   return $ FormElm render $ case mcb of-     Just(CheckBoxes rs) -> Just rs+
+getCheckBoxes :: (Monad m, FormInput view) =>  View view m  (CheckBoxes a) ->  View view m  [a]
+getCheckBoxes w= View $ do
+   FormElm render mcb <- runView w
+   return $ FormElm render $ case mcb of
+     Just(CheckBoxes rs) -> Just rs
      _                   -> Nothing
 
 
 
 whidden :: (MonadIO m, FormInput v,Read a, Show a, Typeable a) => a -> View v m a
-whidden x= res where+whidden x= res where
  res= View $ do
       n <- genNewId
       let showx= case cast x of
@@ -612,8 +604,8 @@                   Nothing -> show x
       r <- getParam1 n `asTypeOf` typef res
       return . FormElm (finput n "hidden" showx False Nothing) $ valToMaybe r
-      where-      typef :: View v m a -> StateT MFlowState m (ParamResult v a)+      where
+      typef :: View v m a -> StateT MFlowState m (ParamResult v a)
       typef = undefined
 
 
@@ -636,7 +628,7 @@       Show a,
       Read a) =>
      Maybe String -> String -> Maybe a -> View view m  a
-getParam  look type1 mvalue= View $ getParamS look type1 mvalue
+getParam look type1 mvalue= View $ getParamS look type1 mvalue
 
 getParamS look type1 mvalue= do
     tolook <- case look of
@@ -651,7 +643,7 @@     st <- get
 
     put st{needForm= HasElems}
-    r <- getParam1 tolook 
+    r <- getParam1 tolook
     case r of
        Validated x        -> return $ FormElm (finput tolook type1 (nvalue $ Just x) False Nothing) $ Just x
        NotValidated s err -> return $ FormElm (finput tolook type1 s False Nothing <> err) $ Nothing
@@ -665,7 +657,7 @@                  ,  MonadIO m)
                    => String
                  ->  View view m String
-getMultilineText nvalue = res where+getMultilineText nvalue = res where
  res= View $ do
     tolook <- genNewId
     r <- getParam1 tolook  `asTypeOf` typef res
@@ -673,16 +665,16 @@        Validated x        -> return $ FormElm (ftextarea tolook  x) $ Just x
        NotValidated s err -> return $ FormElm (ftextarea tolook   s)  Nothing
        NoParam            -> return $ FormElm (ftextarea tolook  nvalue)  Nothing
-    where-    typef :: View v m String -> StateT MFlowState m (ParamResult v a)-    typef = undefined---- | A synonim of getMultilineText+    where
+    typef :: View v m String -> StateT MFlowState m (ParamResult v a)
+    typef = undefined
+
+-- | A synonim of getMultilineText
 textArea :: (FormInput view
                  ,  MonadIO m)
                    => String
                  ->  View view m String
-textArea= getMultilineText+textArea= getMultilineText
 
 
 --getBool :: (FormInput view,
@@ -700,7 +692,7 @@ getSelect :: (FormInput view,
       MonadIO m,Typeable a, Read a) =>
       View view m (MFOption a) ->  View view m  a
-getSelect opts = res where+getSelect opts = res where
   res= View $ do
     tolook <- genNewId
     st <- get
@@ -709,11 +701,11 @@ --    setSessionData $ fmap MFOption $ valToMaybe r
     FormElm form mr <- (runView opts)
 --
-    return $ FormElm (fselect tolook  form)  $ valToMaybe r+    return $ FormElm (fselect tolook  form)  $ valToMaybe r
 
-    where-    typef :: View v m a -> StateT MFlowState m (ParamResult v a)-    typef = undefined+    where
+    typef :: View v m a -> StateT MFlowState m (ParamResult v a)
+    typef = undefined
 
 newtype MFOption a= MFOption a deriving Typeable
 
@@ -755,11 +747,12 @@ wlabel
   :: (Monad m, FormInput view) => view -> View view m a -> View view m a
 wlabel str w =View $ do
-   id <- getNextId+   id <- getNextId
    FormElm render mx <- runView w
    return $ FormElm (ftag "label" str `attrs` [("for",id)] <> render) mx
 
 
+-- passive reset button.
 resetButton :: (FormInput view, Monad m) => String -> View view m ()
 resetButton label= View $ return $ FormElm (finput  "reset" "reset" label False Nothing)
                         $ Just ()
@@ -767,52 +760,38 @@ inputReset :: (FormInput view, Monad m) => String -> View view m ()
 inputReset= resetButton
 
-submitButton :: (StateType (View view m) ~ MFlowState,FormInput view, MonadIO m) => String -> View view m String
-submitButton label= getParam Nothing "submit" $ Just label
+-- passive submit button. Submit a form, but it is not trigger any event.
+-- Unless you attach it with `trigger`
+submitButton :: (Monad (View view m),StateType (View view m) ~ MFlowState,FormInput view, MonadIO m) => String -> View view m String
+submitButton label=  getParam Nothing "submit" $ Just label
 
-inputSubmit :: (StateType (View view m) ~ MFlowState,FormInput view, MonadIO m) => String -> View view m String
+
+inputSubmit :: (Monad (View view m),StateType (View view m) ~ MFlowState,FormInput view, MonadIO m) => String -> View view m String
 inputSubmit= submitButton
---linkPressed= unsafePerformIO $ newMVar Nothing--wlink :: (Show a, Typeable a) => a -> Perch -> Widget a-wlink x v= do-    (a ! href ("#/"++show1 x)   $ v) `pass` OnClick-    return x--   where-   show1 x | typeOf x== typeOf (undefined :: String) = unsafeCoerce x-           | otherwise= show x- 
---wlink x v= View $ do---    ide <- genNewId---    FormElm render _ <- runView $ (wraw $ addEvent(a ! href ("#/"++show1 x)  $ v)---                                          OnClick (setId ide))-----                           `raiseEvent` OnClick------    mi <- liftIO $ readMVar linkPressed---    if mi==  Just ide---     then return $ FormElm render $ Just x---     else return $ FormElm render Nothing
---   where---   addEvent be event action= Perch $ \e -> do
---     e' <- build be e
---     onEvent e' event  action 
---     return e'
------   setId ide _ _= do---     modifyMVar_ linkPressed . const .  return $ Just ide------   show1 x | typeOf x== typeOf (undefined :: String) = unsafeCoerce x---           | otherwise= show x--           
+-- | active button. When clicked, return the label value
+wbutton :: a -> String -> Widget a
+wbutton x label= static $ do
+        input  ! atr "type" "submit" ! atr "value" label `pass` OnClick
+        return x
+
+-- | Present a link. Return the first parameter when clicked
+wlink :: (Show a, Typeable a) => a -> Perch -> Widget a
+wlink x v= static $ do
+    (a ! href ("#/"++show1 x)   $ v) `pass` OnClick
+    return x
+
+   where
+   show1 x | typeOf x== typeOf (undefined :: String) = unsafeCoerce x
+           | otherwise= show x
+
+
+
+
 -- | Concat a list of widgets of the same type, return a the first validated result
 firstOf :: (FormInput view, Monad m, Functor m)=> [View view m a]  -> View view m a
-firstOf xs= Prelude.foldl (<|>) noWidget xs-+firstOf xs= Prelude.foldl (<|>) noWidget xs
+
 -- | from a list of widgets, it return the validated ones.
 manyOf :: (FormInput view, MonadIO m, Functor m)=> [View view m a]  -> View view m [a]
 manyOf xs=  (View $ do
@@ -827,6 +806,10 @@          then return Nothing
          else return $ Just mempty
 
+-- | show something enclosed in the <pre> tag, so ASCII formatting chars are honored
+wprint :: ToElem a => a -> Widget ()
+wprint = wraw . pre
+
 -- | Enclose Widgets within some formating.
 -- @view@ is intended to be instantiated to a particular format
 --
@@ -840,7 +823,7 @@          -> View view m a
          -> View view m a
 (<<<) v form= View $ do
-  FormElm f mx <- runView form 
+  FormElm f mx <- runView form
   return $ FormElm (v  f) mx
 
 
@@ -866,8 +849,8 @@   FormElm f mx <-  runView  form
   return $  FormElm ( f <> v) mx
 
-infixr 6  ++> 
-infixr 6 <++ 
+infixr 6  ++>
+infixr 6 <++
 -- | Prepend formatting code to a widget
 --
 -- @bold << "enter name" ++> getString Nothing @
@@ -877,7 +860,7 @@        => view -> View view m a -> View view m a
 html ++> w =  --  (html <>) <<< digest
  View $ do
-  FormElm f mx <- runView w 
+  FormElm f mx <- runView w
   return $ FormElm (html  <>  f) mx
 
 
@@ -894,14 +877,14 @@ --        _ -> error $ "operator <! : malformed widget: "++ concatMap (unpack. toByteString) fs
 
 
-+
 instance  Attributable (Widget a) where
- (!) widget atrib =View $ do
+ (!) widget atrib = View $ do
       FormElm fs  mx <- runView widget
-      return $ FormElm  (fs `attr` atrib) mx- 
+      return $ FormElm  (fs `attr` atrib) mx
 
 
+
 -- | Empty widget that does not validate. May be used as \"empty boxes\" inside larger widgets.
 --
 -- It returns a non valid value.
@@ -910,7 +893,8 @@      View view m a
 noWidget= Control.Applicative.empty
 
--- | a sinonym of noWidget that can be used in a monadic expression in the View monad does not continue
+-- | a sinonym of noWidget that can be used in a monadic expression in the View monad. it stop the
+-- computation in the Widget monad.
 stop :: (FormInput view,
      Monad m, Functor m) =>
      View view m a
@@ -923,16 +907,16 @@ --wrender x = (fromStr $ show x) ++> return x
 
 -- | Render raw view formatting. It is useful for displaying information.
-wraw :: Monad m => view -> View view m ()
+wraw ::  Perch -> Widget ()
 wraw x= View . return . FormElm x $ Just ()
---- | True if the widget has no valid input+
+-- | True if the widget has no valid input
 isEmpty :: Widget a -> Widget Bool
-isEmpty w= View $ do-  FormElm r mv <- runView w+isEmpty w= View $ do
+  FormElm r mv <- runView w
   return $ FormElm r $ Just $ isNothing mv
--+
+
 -------------------------
 instance   FormInput Perch  where
     fromStr = toElem
@@ -986,7 +970,7 @@     r <- getSessionData
     return $ FormElm mempty r
 
---setSessionData ::  (StateType m ~ MFlowState, Typeable a) => a -> m ()  
+-- | setSessionData ::  (StateType m ~ MFlowState, Typeable a) => a -> m ()
 setSessionData  x=
   modify $ \st -> st{mfData= M.insert  (typeOf x ) (unsafeCoerce x) (mfData st)}
 
@@ -1005,39 +989,39 @@ data EventData= EventData{ evName :: String, evData :: EvData} deriving Show
 
 eventData= unsafePerformIO . newMVar $ EventData "OnLoad" NoData
--resetEventData :: MonadIO m => m ()-resetEventData= liftIO . modifyMVar_ eventData . const . return $ EventData "Onload" NoData 
+resetEventData :: MonadIO m => m ()
+resetEventData= liftIO . modifyMVar_ eventData . const . return $ EventData "Onload" NoData
+
 getEventData :: MonadIO m => m EventData
 getEventData= liftIO $ readMVar eventData
---- triggers the event when it happens in the widget.------ What happens then?------ 1)The event reexecutes all the monadic sentence where the widget is, (with no re-rendering)------ 2) with the result of this reevaluaution, executes the rest of the monadic computation------ 3) update the DOM tree with the rendering of the reevaluation in 2).------ As usual, If one step of the monadic computation return empty, the reevaluation finish--- So the effect of an event can be restricted as much as you may need.------ Neither the computation nor the tree in the upstream flow is touched.--- (unless you use out of stream directives, like `at`)------ monadic computations inside monadic computations are executed following recursively--- the steps mentioned above. So an event in a component deep down could or could not+
+-- | triggers the event when it happens in the widget.
+--
+-- What happens then?
+--
+-- 1)The event reexecutes all the monadic sentence where the widget is, (with no re-rendering)
+--
+-- 2) with the result of this reevaluaution, executes the rest of the monadic computation
+--
+-- 3) update the DOM tree with the rendering of the reevaluation in 2).
+--
+-- As usual, If one step of the monadic computation return empty, the reevaluation finish
+-- So the effect of an event can be restricted as much as you may need.
+--
+-- Neither the computation nor the tree in the upstream flow is touched.
+-- (unless you use out of stream directives, like `at`)
+--
+-- monadic computations inside monadic computations are executed following recursively
+-- the steps mentioned above. So an event in a component deep down could or could not
 -- trigger the reexecution of the rest of the whole.
 raiseEvent ::  Widget a -> Event IO b ->Widget a
 raiseEvent w event = View $ do
  r <- gets process
  case r of
-  EventF x f  -> do
+  EventF x fs -> do
    FormElm render mx <- runView  w
-   let proc = x `addto` f  >> return ()
+   let proc = runIt x (unsafeCoerce fs)  >> return () -- runWidgetId (x >>= f)id >> return ()
    let nevent= evtName event :: String
    let putevdata dat= modifyMVar_ eventData $ const $ return dat
    let render' =  case event of
@@ -1087,39 +1071,52 @@ 
    return $ FormElm render' mx
    where
-   addto f f'=  do
-     mr <- f
-     case mr of
-       Nothing -> return Nothing
-       Just x' ->  f' x'
+   runIt x fs= runBody $ x >>= compose fs
 
--- A shorter synonym for `raiseEvent`
+      where
+
+      compose []= const empty
+      compose ((f,id): fs)= \x -> at id Insert (f x) >>= compose fs
+
+--   addEvent :: Perch -> Event IO a -> a -> Perch
+--   addEvent be event action= Perch $ \e -> do
+--     e' <- build be e
+--     onEvent e' event  action
+--     return e'
+
+--   addto f f'=  do
+--     mr <- f  !> "addto1"
+--     case mr of
+--       Nothing -> return Nothing  !> "addto1 nothing"
+--       Just x' ->  f' x'       !> "addto1just"
+
+-- | A shorter synonym for `raiseEvent`
 fire ::  Widget a -> Event IO b ->Widget a
-fire = raiseEvent---- A shorter and smoother synonym for `raiseEvent`
+fire = raiseEvent
+
+-- | A shorter and smoother synonym for `raiseEvent`
 wake ::  Widget a -> Event IO b -> Widget a
-wake = raiseEvent---- A professional synonym for `raiseEvent`-react :: Widget a -> Event IO b -> Widget a-react = raiseEvent---- | pass trough only if the event is fired in this DOM element.--- Otherwise, if the code is executing from a previous event, the computation will stop-pass :: Perch -> Event IO b -> Widget EventData-pass v event= do-        resetEventData-        wraw v `wake` event-        e@(EventData typ _) <- getEventData-        continueIf (evtName event== typ) e---- | return empty and the monadic computation stop if the condition is false.--- If true, return the second parameter.-continueIf :: Bool -> a -> Widget a-continueIf True x  = return x-continueIf False _ = empty+wake = raiseEvent
 
+-- | A professional synonym for `raiseEvent`
+react :: Widget a -> Event IO b -> Widget a
+react = raiseEvent
+
+-- | pass trough only if the event is fired in this DOM element.
+-- Otherwise, if the code is executing from a previous event, the computation will stop
+pass :: Perch -> Event IO b -> Widget EventData
+pass v event= static $ do
+        resetEventData
+        wraw v `wake` event
+        e@(EventData typ _) <- getEventData
+        continueIf (evtName event== typ) e
+
+-- | return empty and the monadic computation stop if the condition is false.
+-- If true, return the second parameter.
+continueIf :: Bool -> a -> Widget a
+continueIf True x  = return x
+continueIf False _ = empty
+
 -- | executes a widget each t milliseconds until it validates and return ()
 wtimeout :: Int -> Widget () -> Widget ()
 wtimeout t w= View $ do
@@ -1140,81 +1137,83 @@ 
 globalState= unsafePerformIO $ newMVar mFlowState0
 
--- run the widget as the content of a DOM element, the id is passed as parameter. All the--- content of the element is erased previously
+-- | run the widget as the content of a DOM element, the id is passed as parameter. All the
+-- content of the element is erased previously and it is substituted by the new rendering
 runWidgetId :: Widget b -> ElemID  -> IO (Maybe b)
 runWidgetId ac id =  do
-
-   withElem id $  \e -> do
+   me <- elemById id
+   case me of
+     Just e ->  do
       clearChildren e
       runWidget ac e
+     Nothing -> do
+          st <- takeMVar globalState
+          (FormElm render mx, s) <- runStateT (runView ac) st
+          liftIO $ putMVar globalState s
+          return mx
 
 
--- run the widget as the content of a DOM element
+-- | run the widget as the content of a DOM element
+-- the new rendering is added to the element
 runWidget :: Widget b -> Elem  -> IO (Maybe b)
 runWidget action e = do
      st <- takeMVar globalState
-     (FormElm render mx, s) <- runStateT (runView action') st-     case fixed st of-       False -> build render e-       True  -> build (this `goParent` render)  e
+     (FormElm render mx, s) <- runStateT (runView action) st
+     liftIO $ putMVar globalState s
+     build render e
      return mx
-     where
-     action' = action <** -- force the execution of the code below, even if action fails
-        (View $ do
-          st <- get
-          liftIO $ putMVar globalState st{fixed= False}
-          return $ FormElm mempty Nothing)
---- add a header content-addHeader :: Perch -> IO ()-addHeader format= do-    head <- getHead-    build format head-    return ()-    where-    getHead :: IO Elem-    getHead= ffi $ toJSStr "(function(){return document.head;})"---- | run the widget as the body of the HTML-runBody :: Widget a -> IO (Maybe a)-runBody w= do-  body <- getBody-  (flip runWidget) body w-  where-  getBody :: IO Elem-  getBody= ffi $ toJSStr "(function(){return document.body;})"-+
+
+
+-- | add a header in the <header> tag
+addHeader :: Perch -> IO ()
+addHeader format= do
+    head <- getHead
+    build format head
+    return ()
+    where
+    getHead :: IO Elem
+    getHead= ffi $ toJSStr "(function(){return document.head;})"
+
+-- | run the widget as the body of the HTML
+runBody :: Widget a -> IO (Maybe a)
+runBody w= do
+  body <- getBody
+  (flip runWidget) body w
+  where
+  getBody :: IO Elem
+  getBody= ffi $ toJSStr "(function(){return document.body;})"
+
 data UpdateMethod= Append | Prepend | Insert deriving Show
 
--- | run the widget as the content of the element with the given id. The content can--- be appended, prepended to the previous content or it can be the only content depending on the--- update method.+-- | Run the widget as the content of the element with the given id. The content can
+-- be appended, prepended to the previous content or it can be the only content depending on the
+-- update method.
 at :: ElemID -> UpdateMethod -> Widget a -> Widget  a
 at id method w= View $ do
- FormElm render mx <- (runView w)- return $ FormElm  (set  render)  mx- where- set render= liftIO $ do-         me <- elemById id-         case me of-          Nothing -> return ()-          Just e -> case method of-             Insert -> do-                     clearChildren e-                     build render e-                     return ()-             Append -> do-                     build render e-                     return ()-             Prepend -> do-                     es <- getChildren e-                     case es of-                       [] -> build render e >> return ()-                       e':es -> do-                             span <- newElem "span"-                             addChildBefore span e e'-                             build render span-                             return()-                     
-+ FormElm render mx <- (runView w)
+ return $ FormElm  (set  render)  mx
+ where
+ set render= liftIO $ do
+         me <- elemById id
+         case me of
+          Nothing -> return ()
+          Just e -> case method of
+             Insert -> do
+                     clearChildren e
+                     build render e
+                     return ()
+             Append -> do
+                     build render e
+                     return ()
+             Prepend -> do
+                     es <- getChildren e
+                     case es of
+                       [] -> build render e >> return ()
+                       e':es -> do
+                             span <- newElem "span"
+                             addChildBefore span e e'
+                             build render span
+                             return()
+
+