module Web.Text where
import General.Code
import Data.TagStr
import Numeric
-- | Only append strings if neither one is empty
(+?) :: String -> String -> String
a +? b = if null a || null b then [] else a ++ b
-- | Escape the second argument as HTML before appending
(+&) :: String -> String -> String
a +& b = a ++ escapeHTML b
-- | Escape the second argument as a CGI query string before appending
(+%) :: String -> String -> String
a +% b = a ++ escapeCGI b
-- TODO: Should be somewhere else
escapeHTML = concatMap f
where
f '\"' = """
f '<' = "<"
f '>' = ">"
f '&' = "&"
f '\n' = "
"
f x = [x]
escapeCGI = concatMap f
where
f x | isAlphaNum x || x `elem` "-" = [x]
| x == ' ' = "+"
| otherwise = '%' : ['0'|length s == 1] ++ s
where s = showHex (ord x) ""
showTagHTML = showTagHTMLWith (const Nothing)
showTagHTMLWith :: (TagStr -> Maybe String) -> TagStr -> String
showTagHTMLWith f x = g x
where
g x | isJust (f x) = fromJust $ f x
g (Str x) = escapeHTML x
g (Tags xs) = concatMap g xs
g (TagBold x) = "" ++ showTagHTML x ++ ""
g (TagUnderline x) = "" ++ showTagHTML x ++ ""
g (TagHyperlink "" x) = g (TagHyperlink url x)
where str = showTagText x
url = if "http:" `isPrefixOf` str then str else "?hoogle=" +% str
g (TagHyperlink url x) = "" ++ showTagHTML x ++ ""
g (TagColor i x) = "" ++ showTagHTML x ++ ""
-- TODO: Should be in Data.TagStr?
-- TODO: Should only break on spaces
trimTags :: Int -> TagStr -> TagStr
trimTags n (Tags xs) = Tags $ f n xs
where
f n [] = []
f n (x:xs) | m < n = x : f (n-m) xs
| otherwise = [trimTags n x, Str "..."]
where m = length (showTagText x)
trimTags n x | length (showTagText x) > n = Tags []
| otherwise = x
onStr :: (String -> String) -> TagStr -> TagStr
onStr f (Str x) = Str $ f x
onStr f x = x