-- | Menu constructors.
module Text.HTML.Light.Composite.Menu where

import Data.List as L
import Prelude as P
import Text.HTML.Light.Attribute as H
import Text.HTML.Light.Element as H
import Text.XML.Light

-- | A menu entry is /(name,identifier,link)/.
type Menu_Entry = (String,String,Maybe String)

type Menu_P = ([Content] -> [Content])

-- | Menu constructor.
type Menu_C = Menu_P -> String -> [Menu_Entry] -> String -> Content

nav_menu :: Element_C -> Element_C -> Menu_C
nav_menu outer_f inner_f between_f ty m h =
    let cl = class' ty
        f (nm,nm_id,ln) =
            let a_cl = class' (if nm_id == h then "here" else "not-here")
                at = maybe [a_cl] ((: [a_cl]) . href) ln
            in inner_f [cl,H.id nm_id] [a at [cdata nm]]
    in nav [cl] [outer_f [cl] (between_f (L.map f m))]

-- | Make a 'nav' menu of class /ty/ with a 'ul' structure.  The entry
-- corresponding to identifier /h/ is marked with the class @here@.
nav_menu_list :: Menu_C
nav_menu_list = nav_menu ul li

-- | Variant of 'nav_menu_list' using 'H.span' elements.
nav_menu_span :: Menu_C
nav_menu_span f =
    let sp = H.span [class' "menu-separator"] [cdata " | "]
    in nav_menu H.div H.span (f . intersperse sp)