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 '<' = "&lt;"
        f '>' = "&gt;"
        f '&' = "&amp;"
        f '\n' = "<br/>"
        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) = "<b>" ++ showTagHTML x ++ "</b>"
        g (TagUnderline x) = "<i>" ++ showTagHTML x ++ "</i>"
        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) = "<a href=\"" +& url ++ "\">" ++ showTagHTML x ++ "</a>"
        g (TagColor i x) = "<span class='c" ++ show i ++ "'>" ++ showTagHTML x ++ "</span>"


-- 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