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 = []