implementation module iTasks.Framework.HtmlUtil
import Text.HTML, Text.JSON, Text, Internet.HTTP, Data.Map, System.OS
import StdList, StdBool
embeddedStyle :: HtmlTag
embeddedStyle = StyleTag [TypeAttr "text/css"] [Html css]
where
css = "body { background: #fff; font-family: Verdana, Arial, sans-serif; font-size: 12px;} th { text-align: left; } "
+++ ".field-error em {color: #f00; font-weight: bold} .field-error input {border-color: #f00;} "
+++ "#main {margin: 20px; background: #d1dded; border: solid 2px #3a81ad; -moz-border-radius: 5px; background: -moz-linear-gradient(bottom, #d1dded, #fff);} "
+++ "#content { padding: 10px; } "
+++ ".buttons { padding: 5px; background-color: #3a81ad; } "
+++ ".section { margin: 10px; padding: 5px; overflow: auto;} "
+++ ".description { margin: 0px 15px 0px 15px; } "
+++ ".parameters th, { width: 150px; } "
+++ ".json { font-family: Courier, monotype; font-size: 12px;} "
+++ ".json ul { padding-left: 15px;} "
+++ "h1 { margin: 10px 15px 10px 15px; font-weight: normal; font-size: 24px;} "
+++ "h2 { margin: 5px 5px 5px 0px; font-weight: bold; font-size: 14px; border: solid #999; border-width: 0px 0px 1px 0px;} "
+++ "p { margin: 0px 0px 10px 0px; } "
+++ "button {-moz-border-radius: 3px; }"
pageLayout :: !String !String ![HtmlTag] -> HtmlTag
pageLayout title description content = HtmlTag [] [head,body]
where
head = HeadTag [] [TitleTag [] [Text title], embeddedStyle]
body = BodyTag [] [DivTag [IdAttr "main"] (header ++ content)]
header = [H1Tag [] [Text title],PTag [] [DivTag [ClassAttr "description"] [Html description]]]
notFoundPage :: !HTTPRequest -> HtmlTag
notFoundPage req = pageLayout "404 - Not Found" "" message
where
message = [DivTag [IdAttr "content"] [Text "The resource you tried to access ",StrongTag [] [Text req.req_path], Text " could not be found."]]
notFoundResponse :: !HTTPRequest -> HTTPResponse
notFoundResponse req
= {HTTPResponse | rsp_headers = fromList [("Status","404 - Not Found")], rsp_data = toString (notFoundPage req)}
paramValue :: !String !HTTPRequest -> String
paramValue name req
= case get name req.arg_post of
Just val = val
Nothing = case get name req.arg_get of
Just val = val
Nothing = ""
hasParam :: !String !HTTPRequest -> Bool
hasParam name req = isJust (get name req.arg_post) || isJust (get name req.arg_get)
nl2br :: !String -> HtmlTag
nl2br str = html [[Text line,BrTag []] \\ line <- split OS_NEWLINE str]
html2text :: !String -> String
html2text s
# s = replaceSubString "
" OS_NEWLINE s
# s = replaceSubString "
" OS_NEWLINE s
# s = replaceSubString "
" OS_NEWLINE s
# s = replaceSubString "
" OS_NEWLINE s
# s = replaceSubString "" OS_NEWLINE s
# s = stripHtmlTags s
# s = replaceSubString " " " " s
# s = replaceSubString "<" "<" s
# s = replaceSubString ">" ">" s
# s = replaceSubString "&" "&" s
= s
where
stripHtmlTags s
# fstOpen = indexOf "<" s
# fstClose = indexOf ">" s
| fstOpen <> -1 && fstClose <> -1 && fstOpen < fstClose
= stripHtmlTags (subString 0 fstOpen s +++ subString (fstClose + 1) (textSize s - fstClose) s)
| otherwise
= s