<% a %>+q a =
<% a %>+ +-- 'br' +br :: XMLGenerator m => GenXML m +br =
+ +-- 'button' +-- perhaps there should be more to this? + +button :: EmbedAsChild m a => a -> GenXML m +button a = + +{- + +-- The
tags
+-- These should be simulated with style!
+
+em, strong, dfn, code, samp, kbd, var, cite ::
+-}
+
+-- 'del' and 'ins'
+
+del, ins :: (StringType m s) => s -> GenXML m
+del str = <% str %>
+ins str = <% str %>
+
+-- 'div', 'span' and 'p'
+
+div, span, p :: EmbedAsChild m a => a -> GenXML m
+div a = <% a %>
+span a = <% a %>
+p a = <% a %>
+
+-- Definition lists: 'dl', 'dt' and 'dd'
+
+dl :: (EmbedAsChild m a, EmbedAsChild m b) => [(a,[b])] -> GenXML m
+dl entries = <% concatMap mkDef entries %>
+ where mkDef (a, bs) = <% a %> : map (\b -> <% b %> ) bs
+
+-- 'fieldset' and 'legend'
+
+--fieldset :: IsXMLs c => Legend -> c -> HSP XML
+fieldset :: (LegendType m l, EmbedAsChild m a) => l -> a -> GenXML m
+fieldset lgd conts =
+
+
+-- 'form'
+
+form :: (StringType m s, EmbedAsChild m a) => s -> a -> GenXML m
+form url conts =
+
+-- 'head' and 'title'
+
+head :: (StringType m s, EmbedAsChild m a) => s -> a -> GenXML m
+head ttl conts =
+ <% ttl %> <% conts %>
+
+
+
+-- 'h1' - 'h6'
+
+-- This one would do well with some way of defining
+-- tag names from expressions!
+h :: EmbedAsChild m a => Int -> a -> GenXML m
+h n a = genElement (Nothing, ("h" ++ show n)) [] [asChild a]
+
+h1,h2,h3,h4,h5,h6 :: EmbedAsChild m a => a -> GenXML m
+h1 = h 1
+h2 = h 2
+h3 = h 3
+h4 = h 4
+h5 = h 5
+h6 = h 6
+
+-- 'hr'
+
+hr :: XMLGenerator m => GenXML m
+hr =
+
+-- 'img' and 'map'
+
+img :: (StringType m alt, StringType m url) => alt -> url -> GenXML m
+img altTxt url = 
+
+imgmap :: (StringType m alt, StringType m url, StringType m map,
+ StringType m aalt, StringType m aurl, ShapeType m sh)
+ => alt -> url -> (map, [(aalt, sh, aurl)]) -> GenXMLList m
+imgmap altTxt url (im,areas) =
+ do ix <-
+ mp <-
+ return $ [ix,mp]
+
+
+-- 'input' and 'label'
+
+label :: (StringType m s, EmbedAsChild m a) => s -> a -> GenXML m
+label inp a =
+
+
+--input :: InputType -> String -> HSP XML
+input :: (InputType m i, StringType m s) => i -> s -> GenXML m
+input itype n =
+
+data Input c s
+ = Checkbox c
+ | File
+ | Image s s
+ | Hidden
+ | Button s
+ | Password
+ | Text
+ | Radio c
+ | Submit s
+ | Reset s
+
+type CInput c = Input c String
+type SInput s = Input Checked s
+
+data Checked = Checked | Unchecked
+
+instance XMLGenerator m => EmbedAsAttr m Checked where
+ asAttr Checked = asAttr ("checked" := "checked")
+ asAttr Unchecked = return []
+
+instance XMLGenerator m => CheckedType m Checked
+
+instance (XMLGenerator m, CheckedType m c, StringType m s) => EmbedAsAttr m (Input c s) where
+ asAttr inp = do
+ t <- asAttr $ typeOf inp
+ es <- extras inp
+ return $ t ++ es
+ where typeOf i = let t = case i of
+ Checkbox _ -> "checkbox"
+ File -> "file"
+ Image _ _ -> "image"
+ Hidden -> "hidden"
+ Button _ -> "button"
+ Password -> "password"
+ Text -> "text"
+ Radio _ -> "radio"
+ Submit _ -> "submit"
+ Reset _ -> "reset"
+ in "type" := t
+ extras i = case i of
+ Checkbox b -> asAttr b
+ Radio b -> asAttr b
+ Image altText url -> asAttr ["alt" := altText, "src" := url]
+ Button val -> asAttr ["value" := val]
+ Submit val -> asAttr ["value" := val]
+ Reset val -> asAttr ["value" := val]
+ _ -> return []
+
+instance (XMLGenerator m, CheckedType m c, StringType m s) => InputType m (Input c s)
+
+submitButton, resetButton :: forall m n v . (StringType m n, StringType m v) => n -> v -> GenXML m
+submitButton n val = input (Submit val :: SInput v) n
+resetButton n val = input (Reset val :: SInput v) n
+
+
+--checkbox :: Bool -> String -> String -> HSP [XML]
+
+checkbox :: forall m c s1 s2 . (CheckedType m c, StringType m s1, StringType m s2) => c -> s1 -> s2 -> GenXMLList m
+checkbox check n lbl =
+ sequence $ [input (Checkbox check :: CInput c) n, label lbl n]
+
+-- TODO: Should be more fancy stuff in here
+
+-- 'meta'
+
+data HTTPEquiv
+ = ContentType
+ | Expires
+ | Refresh
+ | SetCookie
+
+instance XMLGenerator m => EmbedAsAttr m HTTPEquiv where
+ asAttr he = asAttr ("http-equiv" := toStr he)
+ where toStr ContentType = "content-type"
+ toStr Expires = "expires"
+ toStr Refresh = "refresh"
+ toStr SetCookie = "set-cookie"
+
+instance XMLGenerator m => HTTPEquivType m HTTPEquiv
+
+data MetaName
+ = Author
+ | Description
+ | Keywords
+ | Generator
+ | Revised
+ | Others String
+
+instance XMLGenerator m => EmbedAsAttr m MetaName where
+ asAttr mn = asAttr ("name" := toStr mn)
+ where toStr Author = "author"
+ toStr Description = "description"
+ toStr Keywords = "keywords"
+ toStr Generator = "generator"
+ toStr Revised = "revised"
+ toStr (Others s) = s
+
+instance XMLGenerator m => MetaNameType m MetaName
+
+httpEquiv :: (HTTPEquivType m h, StringType m s) => h -> s -> GenXML m
+httpEquiv equiv conts =
+
+meta :: (MetaNameType m mn, StringType m s) => mn -> s -> GenXML m
+meta mn conts =
+
+-- 'object' and 'param'
+
+-- This one is rather difficult to standardise, I'll leave that to
+-- libs to fix.
+
+--object :: IsXMLs a => [(String,String)] -> a -> HSP XML
+object :: (EmbedAsChild m a, StringType m s1, StringType m s2)
+ => [(s1, s2)] -> a -> GenXML m
+object pars alt =
+
+param :: (StringType m s1, StringType m s2) => s1 -> s2 -> GenXML m
+param n v =
+
+
+-- 'ol', 'ul' and 'li'
+
+ol, orderedList, ul, unorderedList :: (EmbedAsChild m a) => [a] -> GenXML m
+ol items = <% mapM listItem items %>
+orderedList = ol
+ul items = <% mapM listItem items %>
+unorderedList = ul
+
+listItem :: EmbedAsChild m a => a -> GenXML m
+listItem a = <% a %>
+
+-- 'pre'
+
+pre :: EmbedAsChild m a => a -> GenXML m
+pre a = <% a %>
+
+-- 'script' and 'noscript'
+
+--script :: IsXMLs a => Script -> a -> [HSP XML]
+script :: (ScriptType m s, EmbedAsChild m a) => s -> a -> GenXMLList m
+script sc alt = sequence [, ]
+
+-- TODO: import HSP.JavaScript
+
+data JavaScript s = JavaScript s
+
+instance XMLGenerator m => EmbedAsAttr m (JavaScript s) where
+ asAttr _ = asAttr ("type" := "text/javascript")
+
+instance EmbedAsChild m s => EmbedAsChild m (JavaScript s) where
+ asChild (JavaScript s) = asChild s
+
+instance (XMLGenerator m, EmbedAsChild m s) => ScriptType m (JavaScript s)
+
+
+-- 'select', 'option' and 'optgroup'
+
+data Option s
+ = Selected s s
+ | Unselected s s
+
+mkOption :: StringType m s => s -> s -> Bool -> Option s
+mkOption conts val sel = case sel of
+ True -> Selected conts val
+ _ -> Unselected conts val
+
+instance StringType m s => EmbedAsAttr m (Option s) where
+ asAttr (Selected v _) = asAttr ("selected":="selected") >>=
+ \ss -> asAttr ("value":=v) >>=
+ \vs -> return $ ss ++ vs
+ asAttr (Unselected v _) = asAttr ("value":=v)
+
+
+
+
+instance StringType m s => EmbedAsChild m (Option s) where
+ asChild (Selected _ c) = asChild c
+ asChild (Unselected _ c) = asChild c
+
+instance StringType m s => OptionType m (Option s)
+
+select' :: OptionType m o => [GenAttributeList m] -> [o] -> GenXML m
+select' attrs opts =
+
+select :: forall m o . OptionType m o => [o] -> GenXML m
+select = select' [return []]
+
+multiSelect :: forall m o . OptionType m o => [o] -> GenXML m
+multiSelect = select' [asAttr $ "multiple" := "multiple"]
+
+sizedSelect :: (IntType m i, OptionType m o) => i -> [o] -> GenXML m
+sizedSelect n = select' [asAttr $ "size" := n]
+
+sizedMultiSelect :: (IntType m i, OptionType m o) => i -> [o] -> GenXML m
+sizedMultiSelect n = select' [asAttr $ "multiple" := "multiple", asAttr $ "size" := n]
+
+option :: OptionType m o => o -> GenXML m
+option opt =
+
+type OptGroup s o = (s, [o])
+
+groupSelect :: (StringType m s, OptionType m o) => [OptGroup s o] -> GenXML m
+groupSelect gs =
+
+optgroup :: (StringType m s, OptionType m o) => s -> [o] -> GenXML m
+optgroup s opts =
+
+-- 'style'
+
+-- I'll leave this for later, need to implement styles first.
+
+-- 'sub' and 'sup'
+
+sub, sup :: EmbedAsChild m a => a -> GenXML m
+sub a = <% a %>
+sup a = <% a %>
+
+-- 'table', 'tr', 'td', 'th' and 'caption',
+-- 'colgroup' and 'col',
+-- 'thead', 'tfoot' and 'tbody'
+
+
+data Caption a
+ = Caption a
+ | NoCaption
+
+capt :: a -> Caption a
+capt = Caption
+noCapt :: Caption a
+noCapt = NoCaption
+
+instance EmbedAsChild m c => EmbedAsChild m (Caption c) where
+ asChild NoCaption = return []
+ asChild (Caption a) = asChild $ caption a
+
+instance (XMLGenerator m, EmbedAsChild m c) => CaptionType m (Caption c)
+
+caption :: EmbedAsChild m c => c -> GenXML m
+caption a = <% a %>
+
+
+colgroup :: (EmbedAsAttr m a, IntType m i) => i -> [[a]] -> GenXML m
+colgroup spancols colattrs =
+ <% mapM col colattrs %>
+
+col :: EmbedAsAttr m a => [a] -> GenXML m
+col ats = <% cap %><% mapM tableRow rows %>
+
+tableRow :: EmbedAsChild m a => [a] -> GenXML m
+tableRow cells = <% mapM tableCell cells %>
+
+tableCell :: EmbedAsChild m a => a -> GenXML m
+tableCell a = <% a %>
+
+headFootTable :: (EmbedAsChild m h, EmbedAsChild m b, EmbedAsChild m f) => h -> [[b]] -> f -> GenXML m
+headFootTable hs body fs =
+
+ <% hs %>
+ <% fs %>
+ <% mapM tableRow body %>
+
}