kkallio@6: style active
kkallio@6: style last
kkallio@6: 
kkallio@6: datatype navItem = NavItem of string * url
kkallio@6: 
rmbruijn@24: fun name (NavItem (text, url)) = text
rmbruijn@24: 
kkallio@6: datatype navBar m = NavBar of (list navItem) * (list navItem)
kkallio@6: (* First list is items before the active item, second list is items at and after the active one.
kkallio@6:  * If the second list is non-empty its head is the active item.  Parameter mode is to avoid
kkallio@6:  * double reverses coming from calling printingNavBar. *)
kkallio@6: 
kkallio@6: type build = unit
kkallio@6: type print = unit
kkallio@6: 
kkallio@6: class mode t = navBar t -> xbody
kkallio@6: 
kkallio@6: (* The case of special treatment for the last one seems common in themes. *)
kkallio@6: fun mapXLast [a ::: Type] [ctx ::: {Unit}] (f : a -> bool -> xml ctx [] []) (ls : list a) : (xml ctx [] []) =
kkallio@6:     let
kkallio@6:         fun mapXLast' ls =
kkallio@6:             case ls of
kkallio@6:                 [] => <xml/>
kkallio@6:               | x :: [] => <xml>{f x True}</xml>
kkallio@6:               | x :: ls => <xml>{f x False}{mapXLast' ls}</xml>
kkallio@6:     in
kkallio@6:         mapXLast' ls
kkallio@6:     end
kkallio@6: 
kkallio@6: fun navItemToXml css (NavItem (text, url)) =
kkallio@6:     case css of
kkallio@6:         None => <xml><a href={url} title={text}>{[text]}</a></xml>
kkallio@6:       | Some cl => <xml><a class={cl} href={url} title={text}>{[text]}</a></xml>
kkallio@6: 
kkallio@6: fun navBarToXml' (NavBar (before, after)) =
kkallio@6:     let
kkallio@6:         fun navListToXml checkForLast =
kkallio@6:             mapXLast (fn navItem lst =>
kkallio@6:                          let
kkallio@6:                              val linkXml = navItemToXml None navItem
kkallio@6:                          in
kkallio@6:                              if checkForLast && lst then
kkallio@6:                                  <xml><li class={last}>{linkXml}</li></xml>
kkallio@6:                              else
kkallio@6:                                  <xml><li>{linkXml}</li></xml>
kkallio@6:                          end)
kkallio@6:     in
kkallio@6:         case after of
kkallio@6:             [] => <xml>{navListToXml True before}</xml>
kkallio@6:           | act :: tl =>
kkallio@6:             <xml>
kkallio@6:               {navListToXml False before}
kkallio@6:               {case tl of
kkallio@6:                    [] => <xml><li class={last}>{navItemToXml (Some active) act}</li></xml>
kkallio@6:                  | _ =>
kkallio@6:                    <xml>
kkallio@6:                      <li>{navItemToXml (Some active) act}</li>
kkallio@6:                      {navListToXml True tl}
kkallio@6:                    </xml>}
kkallio@6:             </xml>
kkallio@6:     end
kkallio@6: 
kkallio@6: fun printingNavBar (NavBar (before, after)) =
kkallio@6:     NavBar (List.rev before, List.rev after)
kkallio@6: 
kkallio@6: fun navBarToXml [t ::: Type] (m : mode t) = m
kkallio@6: 
kkallio@6: fun navToXml_build (n : navBar build) : xbody =
kkallio@6:     navBarToXml' (printingNavBar n)
kkallio@6: 
kkallio@6: fun navToXml_print (n: navBar print) : xbody =
kkallio@6:     navBarToXml' n
kkallio@6: 
kkallio@6: val emptyNavBar = NavBar ([], [])
kkallio@6: 
kkallio@6: fun mkNavItem text url =
kkallio@6:     NavItem (text, url)
kkallio@6: 
kkallio@6: fun navAdd navItem navBar =
kkallio@6:     case navBar of
kkallio@6:         NavBar (before, []) => NavBar (navItem :: before, [])
kkallio@6:       | NavBar (before, after) => NavBar (before, navItem :: after)
kkallio@6: 
kkallio@6: fun navAddActive navItem navBar =
kkallio@6:     case navBar of
kkallio@6:         NavBar (before, []) => NavBar (before, navItem :: [])
kkallio@6:       | NavBar (before, after) => NavBar (List.append after before, navItem :: [])