module MFlow.Forms.XHtml((<++), (<+>), (++>), (<<<))
where
import MFlow.Forms
import Text.XHtml as X
import Control.Monad.Trans
import Data.Typeable
(<<<) :: Monad m => (Html -> Html) -> View Html m a -> View Html m a
tag <<< d= wrap tag d
infixr 7 <<<
infixr 3 <++
(<++) :: Monad m => Html -> View Html m a -> View Html m a
html <++ digest = (html +++) <<< digest
infix 3 ++>
(++>) :: Monad m => View Html m a -> Html -> View Html m a
digest ++> html = addToForm digest html
infixr 2 <+>
(<+>) :: Monad m
=> View Html m a'
-> View Html m b'
-> View Html m (Either a' b')
(<+>) = mix
instance Typeable X.Html where
typeOf = \_ -> mkTyConApp (mkTyCon3 "XHtml" "Text.XHtml.Strict" "Html") []
instance FormInput Html where
inred = X.bold ![X.thestyle "color:red"]
finput n t v f c= X.input ! ([thetype t ,name n, value v]++ if f then [checked] else []
++ case c of Just s ->[strAttr "onclick" s]; _ -> [] )
ftextarea name text= X.textarea ! [X.name name] << text
foption name list msel= select ![ X.name name] << (concatHtml
$ map (\(n,v) -> X.option ! ([value n] ++ selected msel n) << v ) list)
where
selected msel n= if Just n == msel then [X.selected] else []
fformAction action form = X.form ! [X.action action, method "post"] << form
fromString = stringToHtml
ftable title head rows=
X.table << (
(if not . isNoHtml $ title then caption << title else noHtml ) +++
(if not . null $ head then tr << (concatHtml [th h | h <- head]) else noHtml) +++
(concatHtml[tr << concatHtml[td v| v <- row] | row <- rows]))
flink v str = p << hotlink v << str