CHXHtml-0.1.4: htmlHelp.hs

import Network.CGI
import Text.CHXHtml.XHtml1_strict
import qualified Text.CHXHtml.XHtml1_transitional as T
import qualified Text.CHXHtml.XHtml1_frameset as F
import List
-- CHXHtml htmlHelp.hs
-- 
-- Paul Talaga -- Nov 3, 2010
-- 
-- Expose the htmlHelp function as a web interface.
--
-- If the 'q' parameter is set, split on ',' and run through htmlHelp function.
-- The 's' parameter sets the standard, 'strict','transitional','frameset', if none then 'strict' is assumed.
--
-- Assumes the file is compiled to htmlHelp.cgi, as that is the form's action location.
-- To compile:  ghc --make htmlHelp.hs -o htmlHelp.cgi 


main = runCGI $ handleErrors test

test :: CGI CGIResult
test  = do q <- (Network.CGI.getInput "q");
           s <- (Network.CGI.getInput "s");
           case q of
               Just m -> case s of
                            Just n -> outputFPS $ render_bs (htmlHelpPage m n) 
                            Nothing -> outputFPS $ render_bs (htmlHelpPage m "strict") 
               Nothing -> outputFPS $ render_bs (htmlHelpPage "html,body,div" "strict")


-- htmlHelp page accepting the user's query
htmlHelpPage query spec = 
    _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 the specified specification."],
            _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.cgi"] [p_ [] [    
                    _label [pcdata "Input:"],
                    input_ [type_att "text", name_att "q", size_att "50", value_att query],
                    _br,
                    _label [pcdata "Spec:"],
                    select_ [name_att "s"] [option_ ([value_att "strict"] ++ selected spec "strict") [pcdata "XHtml 1.00 Strict"],
                             option_ ([value_att "transitional"] ++ selected spec "transitional") [pcdata "XHtml 1.00 Transitional"],
                             option_ ([value_att "frameset"] ++ selected spec "frameset") [pcdata "XHtml 1.00 Frameset"]],
                    input_ [type_att "submit",value_att "Submit"]
                ]
            ],
            (result query spec)
        ]
    ]
             
-- Produce the html for the result, if any
result query spec
    | query == "" = _div []
    | otherwise = _div [
                        _hr,
                        _h2 [pcdata ("Results for: " ++ concat (intersperse " -> " (splitInput query ',' []))),_br,pcdata  ("Spec: " ++ spec)],  -- make the query nicer with -> between tags
--                        _h2 [pcdata ("Specification: " ++ spec)],
                        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;"] [ce_nbsp],    -- Character codes are prefixed with ce_
                        div_ [style_att "float:left;width:300px;"] [
                            _h3 [pcdata "Allowed Attributes:"],
                            div_ [class_att "block"] (intersperse _br (map pcdata attributes))
                            ]
                       ]
    where r = if spec == "transitional"
              then T.htmlHelp (splitInput query ',' [])
              else if spec == "frameset"
                   then F.htmlHelp (splitInput query ',' [])
                   else 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 [""]

-- return a 'selected' attribute so the last query's state is maintained
selected spec pos 
    | spec == pos = [selected_att "true"]
    | otherwise = []