CHXHtml 0.1.0 → 0.1.1

raw patch · 5 files changed

+214/−36 lines, 5 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHXHtml.cabal +5/−21
• Text/CHXHtml/XHtml1_strict.hs +27/−15
• demo.hs +53/−0
• demoFastCGI.hs +56/−0
• htmlHelp.hs +73/−0

@@ -1,46 +1,30 @@--- CHXHtml.cabal auto-generated by cabal init. For additional options,--- see--- http://www.haskell.org/cabal/release/cabal-latest/doc/users-guide/authors.html#pkg-descr.--- The name of the package.-Name:                CHXHtml --- The package version. See the Haskell package versioning policy--- (http://www.haskell.org/haskellwiki/Package_versioning_policy) for--- standards guiding when and how versions should be incremented.-Version:             0.1.0+Name:                CHXHtml+Version:             0.1.1 --- A short (one-line) description of the package. Synopsis: A W3C compliant (X)HTML generating library             --- A longer description of the package. Description: An (X)Html generating library providing nearly full W3C compliance.  Non-compliant              content is exposed at compile time and fails type-check.  --- The license under which the package is released. License:             BSD3 --- The file containing the license text. License-file:        LICENSE --- The package author(s). Author:              Paul Talaga --- An email address to which users can send suggestions, bug reports,--- and patches. Maintainer:          paul@fuzzpault.com+homepage:           http://fuzzpault.com/chxhtml  -- A copyright notice.--- Copyright:           +Copyright:           2010 Paul Talaga <paul@fuzzpault.com>  Category:            Web  Build-type:          Simple --- Extra files to be distributed with the package, such as examples or--- a README.--- Extra-source-files:  +Extra-source-files: demo.hs demoFastCGI.hs htmlHelp.hs --- Constraint on the version of Cabal needed to build this package. Cabal-version:       >=1.2 Tested-With:         GHC ==6.10.3 

@@ -9,7 +9,8 @@ -- Maintainer  : paul@fuzzpault.com -- Stability   : experimental -- Portability : portable--- Description : CHXHtml (Compliant Haskell XHtml) produces W3C valid XHTML1 strict content in most cases* by building a datastructure based on the DTD.  Nesting and allowed tags are controlled by recursive types.+--+--  Description : CHXHtml (Compliant Haskell XHtml) produces W3C valid XHTML1 strict content in most cases* by building a datastructure based on the DTD.  Nesting and allowed tags are controlled by recursive types. --  To simplify usage, type classes are used to substitute the corret constructor for the given context, or throw a type error if the tag is not allowed in that context. --  As a result, a single function exists per tag as well as attribute names. --@@ -34,9 +35,9 @@  htmlHelp,     -- * Rendering  render, render_bs,    -- * Tags-pcdata, _html, html_,_a ,a_ ,_abbr ,abbr_ ,_acronym ,acronym_ ,_address ,address_ ,_area ,area_ ,_b ,b_ ,_base ,base_ ,_bdo ,bdo_ ,_big ,big_ ,_blockquote ,blockquote_ ,_body ,body_ ,_br ,br_ ,_button ,button_ ,_caption ,caption_ ,_cite ,cite_ ,_code ,code_ ,_col ,col_ ,_colgroup ,colgroup_ ,_dd ,dd_ ,_del ,del_ ,_dfn ,dfn_ ,_div ,div_ ,_dl ,dl_ ,_dt ,dt_ ,_em ,em_ ,_fieldset ,fieldset_ ,_form ,form_ ,_h1 ,h1_ ,_h2 ,h2_ ,_h3 ,h3_ ,_h4 ,h4_ ,_h5 ,h5_ ,_h6 ,h6_ ,_head ,head_ ,_hr ,hr_ ,_i ,i_ ,_img ,img_ ,_input ,input_ ,_ins ,ins_ ,_kbd ,kbd_ ,_label ,label_ ,_legend ,legend_ ,_li ,li_ ,_link ,link_ ,_map ,map_ ,_meta ,meta_ ,_noscript ,noscript_ ,_object ,object_ ,_ol ,ol_ ,_optgroup ,optgroup_ ,_option ,option_ ,_p ,p_ ,_param ,param_ ,_pre ,pre_ ,_q ,q_ ,_samp ,samp_ ,_script ,script_ ,_select ,select_ ,_small ,small_ ,_span ,span_ ,_strong ,strong_ ,_style ,style_ ,_sub ,sub_ ,_sup ,sup_ ,_table ,table_ ,_tbody ,tbody_ ,_td ,td_ ,_textarea ,textarea_ ,_tfoot ,tfoot_ ,_th ,th_ ,_thead ,thead_ ,_title ,title_ ,_tr ,tr_ ,_tt ,tt_ ,_ul ,ul_ ,_var ,var_ ,+pcdata, pcdata_bs,s2b, _html, html_,_a ,a_ ,_abbr ,abbr_ ,_acronym ,acronym_ ,_address ,address_ ,_area ,area_ ,_b ,b_ ,_base ,base_ ,_bdo ,bdo_ ,_big ,big_ ,_blockquote ,blockquote_ ,_body ,body_ ,_br ,br_ ,_button ,button_ ,_caption ,caption_ ,_cite ,cite_ ,_code ,code_ ,_col ,col_ ,_colgroup ,colgroup_ ,_dd ,dd_ ,_del ,del_ ,_dfn ,dfn_ ,_div ,div_ ,_dl ,dl_ ,_dt ,dt_ ,_em ,em_ ,_fieldset ,fieldset_ ,_form ,form_ ,_h1 ,h1_ ,_h2 ,h2_ ,_h3 ,h3_ ,_h4 ,h4_ ,_h5 ,h5_ ,_h6 ,h6_ ,_head ,head_ ,_hr ,hr_ ,_i ,i_ ,_img ,img_ ,_input ,input_ ,_ins ,ins_ ,_kbd ,kbd_ ,_label ,label_ ,_legend ,legend_ ,_li ,li_ ,_link ,link_ ,_map ,map_ ,_meta ,meta_ ,_noscript ,noscript_ ,_object ,object_ ,_ol ,ol_ ,_optgroup ,optgroup_ ,_option ,option_ ,_p ,p_ ,_param ,param_ ,_pre ,pre_ ,_q ,q_ ,_samp ,samp_ ,_script ,script_ ,_select ,select_ ,_small ,small_ ,_span ,span_ ,_strong ,strong_ ,_style ,style_ ,_sub ,sub_ ,_sup ,sup_ ,_table ,table_ ,_tbody ,tbody_ ,_td ,td_ ,_textarea ,textarea_ ,_tfoot ,tfoot_ ,_th ,th_ ,_thead ,thead_ ,_title ,title_ ,_tr ,tr_ ,_tt ,tt_ ,_ul ,ul_ ,_var ,var_ ,     -- * Attributes-http_equiv_att, http_equiv_att_bs,content_att, content_att_bs,nohref_att, onkeydown_att, onkeydown_att_bs,onkeyup_att, onkeyup_att_bs,onreset_att, onreset_att_bs,onmouseup_att, onmouseup_att_bs,scope_att, onmouseover_att, onmouseover_att_bs,align_att, lang_att, lang_att_bs,valign_att, name_att, name_att_bs,charset_att, charset_att_bs,scheme_att, scheme_att_bs,accept_charset_att, accept_charset_att_bs,onmousedown_att, onmousedown_att_bs,rev_att, rev_att_bs,span_att, span_att_bs,title_att, title_att_bs,onclick_att, onclick_att_bs,width_att, width_att_bs,enctype_att, enctype_att_bs,ismap_att, usemap_att, usemap_att_bs,coords_att, coords_att_bs,frame_att, size_att, size_att_bs,onblur_att, onblur_att_bs,datetime_att, datetime_att_bs,dir_att, summary_att, summary_att_bs,method_att, standby_att, standby_att_bs,tabindex_att, tabindex_att_bs,style_att, style_att_bs,onmousemove_att, onmousemove_att_bs,height_att, height_att_bs,codetype_att, codetype_att_bs,char_att, char_att_bs,multiple_att, codebase_att, codebase_att_bs,xmlns_att, xmlns_att_bs,profile_att, profile_att_bs,rel_att, rel_att_bs,onsubmit_att, onsubmit_att_bs,ondblclick_att, ondblclick_att_bs,axis_att, axis_att_bs,cols_att, cols_att_bs,abbr_att, abbr_att_bs,onchange_att, onchange_att_bs,readonly_att, href_att, href_att_bs,media_att, media_att_bs,id_att, id_att_bs,for_att, for_att_bs,src_att, src_att_bs,value_att, value_att_bs,data_att, data_att_bs,hreflang_att, hreflang_att_bs,checked_att, declare_att, onkeypress_att, onkeypress_att_bs,label_att, label_att_bs,class_att, class_att_bs,type_att, shape_att, accesskey_att, accesskey_att_bs,headers_att, headers_att_bs,disabled_att, rules_att, rows_att, rows_att_bs,onfocus_att, onfocus_att_bs,colspan_att, colspan_att_bs,rowspan_att, rowspan_att_bs,defer_att, cellspacing_att, cellspacing_att_bs,charoff_att, charoff_att_bs,cite_att, cite_att_bs,maxlength_att, maxlength_att_bs,onselect_att, onselect_att_bs,accept_att, accept_att_bs,archive_att, archive_att_bs,alt_att, alt_att_bs,classid_att, classid_att_bs,longdesc_att, longdesc_att_bs,onmouseout_att, onmouseout_att_bs,space_att, border_att, border_att_bs,onunload_att, onunload_att_bs,onload_att, onload_att_bs,action_att, action_att_bs,cellpadding_att, cellpadding_att_bs,valuetype_att, selected_att, +http_equiv_att, http_equiv_att_bs,content_att, content_att_bs,nohref_att, onkeydown_att, onkeydown_att_bs,onkeyup_att, onkeyup_att_bs,onreset_att, onreset_att_bs,onmouseup_att, onmouseup_att_bs,scope_att, onmouseover_att, onmouseover_att_bs,align_att, lang_att, lang_att_bs,valign_att, name_att, name_att_bs,charset_att, charset_att_bs,scheme_att, scheme_att_bs,accept_charset_att, accept_charset_att_bs,onmousedown_att, onmousedown_att_bs,rev_att, rev_att_bs,span_att, span_att_bs,title_att, title_att_bs,onclick_att, onclick_att_bs,width_att, width_att_bs,enctype_att, enctype_att_bs,ismap_att, usemap_att, usemap_att_bs,coords_att, coords_att_bs,frame_att, size_att, size_att_bs,onblur_att, onblur_att_bs,datetime_att, datetime_att_bs,dir_att, summary_att, summary_att_bs,method_att, standby_att, standby_att_bs,tabindex_att, tabindex_att_bs,style_att, style_att_bs,onmousemove_att, onmousemove_att_bs,height_att, height_att_bs,codetype_att, codetype_att_bs,char_att, char_att_bs,multiple_att, codebase_att, codebase_att_bs,xmlns_att, xmlns_att_bs,profile_att, profile_att_bs,rel_att, rel_att_bs,onsubmit_att, onsubmit_att_bs,ondblclick_att, ondblclick_att_bs,axis_att, axis_att_bs,cols_att, cols_att_bs,abbr_att, abbr_att_bs,onchange_att, onchange_att_bs,readonly_att, href_att, href_att_bs,media_att, media_att_bs,id_att, id_att_bs,for_att, for_att_bs,src_att, src_att_bs,value_att, value_att_bs,data_att, data_att_bs,hreflang_att, hreflang_att_bs,checked_att, declare_att, onkeypress_att, onkeypress_att_bs,label_att, label_att_bs,class_att, class_att_bs,type_att, type_att_bs,shape_att, accesskey_att, accesskey_att_bs,headers_att, headers_att_bs,disabled_att, rules_att, rows_att, rows_att_bs,onfocus_att, onfocus_att_bs,colspan_att, colspan_att_bs,rowspan_att, rowspan_att_bs,defer_att, cellspacing_att, cellspacing_att_bs,charoff_att, charoff_att_bs,cite_att, cite_att_bs,maxlength_att, maxlength_att_bs,onselect_att, onselect_att_bs,accept_att, accept_att_bs,archive_att, archive_att_bs,alt_att, alt_att_bs,classid_att, classid_att_bs,longdesc_att, longdesc_att_bs,onmouseout_att, onmouseout_att_bs,space_att, border_att, border_att_bs,onunload_att, onunload_att_bs,onload_att, onload_att_bs,action_att, action_att_bs,cellpadding_att, cellpadding_att_bs,valuetype_att, selected_att,      -- ** Enumerated Attribute Values ValuetypeEnum(..),RulesEnum(..),ShapeEnum(..),MethodEnum(..),DirEnum(..),FrameEnum(..),ValignEnum(..),AlignEnum(..),ScopeEnum(..),   ) where @@ -1936,24 +1937,34 @@  class A_Type a where     type_att :: String -> a+    type_att_bs :: B.ByteString -> a instance A_Type Att40 where-    type_att s =  Type_Att_40 (s2b (show s))+    type_att s =  Type_Att_40 (s2b_escape s)+    type_att_bs =  Type_Att_40  instance A_Type Att31 where-    type_att s =  Type_Att_31 (s2b (show s))+    type_att s =  Type_Att_31 (s2b_escape s)+    type_att_bs =  Type_Att_31  instance A_Type Att21 where-    type_att s =  Type_Att_21 (s2b (show s))+    type_att s =  Type_Att_21 (s2b_escape s)+    type_att_bs =  Type_Att_21  instance A_Type Att20 where-    type_att s =  Type_Att_20 (s2b (show s))+    type_att s =  Type_Att_20 (s2b_escape s)+    type_att_bs =  Type_Att_20  instance A_Type Att16 where-    type_att s =  Type_Att_16 (s2b (show s))+    type_att s =  Type_Att_16 (s2b_escape s)+    type_att_bs =  Type_Att_16  instance A_Type Att10 where-    type_att s =  Type_Att_10 (s2b (show s))+    type_att s =  Type_Att_10 (s2b_escape s)+    type_att_bs =  Type_Att_10  instance A_Type Att9 where-    type_att s =  Type_Att_9 (s2b (show s))+    type_att s =  Type_Att_9 (s2b_escape s)+    type_att_bs =  Type_Att_9  instance A_Type Att8 where-    type_att s =  Type_Att_8 (s2b (show s))+    type_att s =  Type_Att_8 (s2b_escape s)+    type_att_bs =  Type_Att_8  instance A_Type Att7 where-    type_att s =  Type_Att_7 (s2b (show s))+    type_att s =  Type_Att_7 (s2b_escape s)+    type_att_bs =  Type_Att_7   class A_Shape a where     shape_att :: ShapeEnum -> a@@ -6622,13 +6633,14 @@ htmlHelp :: [String] -> [[String]] htmlHelp (x:xs)      | (map toLower x) == "html" = htmlHelp2 0 (toNdx "html") xs-    | otherwise = [["First tag needs to be \"html\"!"]]+    | otherwise = [["First tag needs to be \"html\"!"],[]]      htmlHelp2 :: Int -> Int -> [String] -> [[String]] htmlHelp2 i lst [] = [ (sort (map (\(t,n)->fst (tagList !! t)) (groups !! i))), sort(map (\a->a++"_att") (attList !! (snd (tagList !! lst))))] htmlHelp2 i lst (x:xs)-    | n == -1 = [[x ++ " not a child" ++ show (toNdx x)]]-    | n == 99999 = [[x ++ " can not contain any inner nodes"], sort(map (\a->a++"_att") (attList !! (snd (tagList !! lst))))]+    | n == -1 = [[x ++ " not a child" ],["No attributes"]]+    | n == 99999 && xs == [] = [[x ++ " can not contain any inner nodes"], sort(map (\a->a++"_att") (attList !! (snd (tagList !! (toNdx x)))))]+    | n == 99999 = [[x ++ " can not contain any inner nodes"], []]     | otherwise = htmlHelp2 n (toNdx x) xs     where n = getNext (groups !! i) (toNdx x) 

@@ -0,0 +1,53 @@++import Text.CHXHtml.XHtml1_strict++-- CHXHtml demo.hs+-- +-- Paul Talaga -- June 5, 2010+-- +-- Construct a static Hello World XHTML1 Strict compliant page+-- rendered as a String via render.+--+-- Opionally produce a multiplication table+  +main :: IO ()+main = putStrLn (render helloWorld)+--main = putStrLn (render (helloWorldTable 5))++helloWorld = helloWorldTemplate [] ++-- Simple Hello World template page+helloWorldTemplate content = +    _html [+        _head [+            _title [pcdata "Hello World Page"]+        ],+        _body [_h1 [pcdata "Hello World"],+            _hr,+            div_ [style_att "background-color:blue;"] [pcdata "First Paragraph"],+            -- The <a> tag can not be under <body>, but inside a <div>.+            -- Try > htmlHelp ["html","body"]   to get a list of allowed tags and attributes+            -- Uncomment the following line to cause a type error.+            -- _a [pcdata "Will not work!"],+            _div [a_ [href_att "http://google.com"] [pcdata "Click Me!"]],+            div_ [style_att "background-color:blue;"] [pcdata "Another Paragraph"],+            _div [temp],+            _div [_a [temp]],+            _div  content+        ]+    ]+             +-- Hello World table page with dynamic table multiplication table+-- Because children are specified as a list, we can use Haskell's built-in functions for+-- list manipulation and creation.          +helloWorldTable n = helloWorldTemplate +    [table_ [border_att "1"] +        (map (\i->_tr +                (map (\j->_td [pcdata (show (i * j))]) [1..n])+             ) [1..n])+    +    ]+    +temp = _img ++temp2 = _img 

@@ -0,0 +1,56 @@+++import Network.FastCGI+import Text.CHXHtml.XHtml1_strict+-- CHXHtml demoFastCGI.hs+-- +-- Paul Talaga -- June 5, 2010+-- +-- Construct a static Hello World XHTML1 Strict compliant page+-- render it to FastCGI via ByteString for speed+-- containing a from to specify how large the table should be.+--+-- If the 'n' parameter is set produce a multiplication table of that size.+++main = runFastCGI $ handleErrors test++test :: CGI CGIResult+test  = do n <- (Network.FastCGI.getInput "n");+           case n of+               Just m -> outputFPS $ render_bs (helloWorldTable (read m::Int))+               Nothing -> outputFPS $ render_bs helloWorld++helloWorld = helloWorldTemplate [] ++-- Simple Hello World template page+helloWorldTemplate content = +    _html [+        _head [+            _title [pcdata "Hello World Multi Table"]+        ],+        _body [_h1 [pcdata "Hello World Multiplication Table"],+            _hr,+            form_ [method_att Get] [div_ [] [+                    _label [pcdata "nxn:"],+                    input_ +                ]+            ],+            -- The <a> tag can not be under <body>, but inside a <div>.+            -- Try > htmlHelp ["html","body"]   to get a list of allowed tags and attributes+            -- Uncomment the following line to cause a type error.+            -- _a [pcdata "Will not work!"],+            _div  content+        ]+    ]+             +-- Hello World table page with dynamic table multiplication table+-- Because children are specified as a list, we can use Haskell's built-in functions for+-- list manipulation and creation.          +helloWorldTable n = helloWorldTemplate +    [table_ [border_att "1"] +        (map (\i->_tr +                (map (\j->_td [pcdata (show (i * j))]) [1..n])+             ) [1..n])+    +    ]

@@ -0,0 +1,73 @@+import Network.FastCGI+import Text.CHXHtml.XHtml1_strict+import List+-- CHXHtml htmlHelp.hs+-- +-- Paul Talaga -- June 11, 2010+-- +-- Expose the htmlHelp function as a web interface.+--+-- If the 'q' parameter is set, split on , and run through htmlHelp function.+++main = runFastCGI $ handleErrors test++test :: CGI CGIResult+test  = do q <- (Network.FastCGI.getInput "q");+           case q of+               Just m -> outputFPS $ render_bs (htmlHelpPage m) +               Nothing -> outputFPS $ render_bs (htmlHelpPage "html,body,div")+++-- htmlHelp page accepting the user's query+htmlHelpPage query = +    _html [+        _head [+            _title [pcdata "CHXHtml htmlHelp "],+            link_ [href_att "/fuzz.css", rel_att "stylesheet", type_att "text/css"]+        ],+        _body [_h1 [pcdata "htmlHelp Web Interface"],+            _p [pcdata "Web interface for the htmlHelp function in the Haskell Text.CHXHtml library."],+            div_ [class_att "block"] [_code [pcdata "htmlHelp :: [String] -> [[String]]]"]+                    ],+            _p [pcdata "Specify the nesting context below, such as ", _code [pcdata "'html,body,div'"],pcdata "Which returns a list of W3C allowable children and attributes for Xhtml1_strict."],+            _p [pcdata "We've 'webified' the function, allowing the omisison of \" in the list of Strings as well as pretty-printing the output.  Content created by CHXHtml and Haskell!"],+            form_ [method_att Get, action_att "htmlHelp.fcg"] [p_ [] [    +                    _label [pcdata "Input:"],+                    input_ [type_att "text", name_att "q", size_att "50", value_att query],+                    input_ [type_att "submit",value_att "Submit"]+                ]+            ],+            (result query)+        ]+    ]+             +-- Produce the html for the result, if any+result query+    | query == "" = _div []+    | otherwise = _div [+                        _hr,+                        _h2 [pcdata ("Results for: " ++ concat (intersperse " -> " (splitInput query ',' [])))],  -- make the query nicer with -> between tags+                        div_ [style_att "float:left;width:220px;"] [+                            _h3 [pcdata "Allowed Children:"],+                            div_ [class_att "block"] (intersperse _br (map pcdata children))+                            ],+                        div_ [style_att "float:left;width:50px;"] [pcdata_bs (s2b"&nbsp;")],    -- TODO: add character codes to library! _bs does not escape content+                        div_ [style_att "float:left;width:300px;"] [+                            _h3 [pcdata "Allowed Attributes:"],+                            div_ [class_att "block"] (intersperse _br (map pcdata attributes))+                            ]+                       ]+    where r = htmlHelp (splitInput query ',' [])+          children = r !! 0 -- TODO: eek, this is dangerous, change+          attributes = r !! 1+          +splitInput :: String -> Char -> [String] -> [String] +-- Given a string, delimter, and [], create a list of strings.+splitInput (x:xs) d (s:sx)+    | x == ' ' = splitInput xs d (s:sx)     -- ignore spaces+    | x == d = splitInput xs d ("":(s:sx))+    | otherwise = splitInput xs d ((s ++ [x]):sx)+splitInput [] _ result = reverse result  +splitInput s c [] = splitInput s c [""]+