module Happstack.Helpers.HtmlOutput.Menu where

import Happstack.Server.HTTP.Types 
import Text.StringTemplate.Helpers
import Data.List (intercalate)
import Happstack.Helpers.HtmlOutput.Common

{- | 
Render a link which changes color when the current page is active, modulo css.

menuLink rq (url,anchortext)

similar to simpleLink, outputs an html link. However, menuLink looks at the request to determine if the page being linked to is the current page. If it is, it's in class menuitemSelected, otherwise class menuitem. if the url is blank, 
the link is unclickable, just displayed gray (e.g., features that haven't been enabled but are coming soon). You need to define the classes described here via css for these features to be useful. I usually do something like in a global css file:

a.menuitem:link {color: blue}

a.menuitem:active {color: blue}

a.menuitem:visited {color: blue}

a.menuitem:hover {color: blue}

a.menuitemSelected:link {color: purple}

a.menuitemSelected:active {color: purple}

a.menuitemSelected:visited {color: purple}

a.menuitemSelected:hover {color: purple}

-}
menuLink :: Request -> (String, String) -> String
menuLink = menuLink' "menuitemSelected" "menuitem"

{- |  menuLink' classSelected classUnselected rq (url,anchortext) = ... 
-}
menuLink' :: String -> String -> Request -> (String, String) -> String
menuLink' classSelected classUnselected rq (url,anchortext) = 
  render1 [("url",url),("anchortext",anchortext),("classSelected",classSelected),("classUnselected",classUnselected)] $
    if currUrl == url
        then "<a class=$classSelected$ href=\"$url$\">$anchortext$</a>"
        else if null url
                then "<font color=gray>$anchortext$</font>"
                else "<a class=\"$classUnselected$\" href=\"$url$\">$anchortext$</a>"
  where currUrl = rqURL rq



vMenuOL :: Request -> [(String, String)] -> String
vMenuOL rq = paintVOL . map (menuLink  rq )

vMenuUL :: Request -> [(String, String)] -> String
vMenuUL rq = paintVUL . map (menuLink  rq )

-- | hMenuBars rq = paintHBars . map (menuLink rq) 
hMenuBars :: Request -> [(String, String)] -> String
hMenuBars rq = paintHBars . map (menuLink rq)