jb/src/template.ml

open Drame
open Tyxml.Html
open Lang

(* wrap all elements of l wi a <li> to make a <ul> *)
let simple_ul l = ul (List.map (fun o -> li [ o ]) l)

let mk_nav_a request page ~en ~fr =
  let is_current_page =
    let current_route = request.Request.route |> Fmt.str "%a" Route.pp in
    (* TODO improve this/make "breadcrumb navigation" *)
    (* this is to mark the link in the nav as .current even if we are in a sub-page *)
    String.equal current_route page
    || Array.length request.route > 0
       && String.equal (Fmt.str "/%s" request.route.(0)) page
  in
  let a_class = a_class (if is_current_page then [ "current" ] else []) in
  a ~a:(a_class :: [ a_href page ]) [ txt request ~fr ~en ]

let render request ?title:title_txt ?(scripts = []) ?(styles = []) ~h1 content =
  let title_txt =
    Option.fold
      ~none:
        { en = "Joanna Barreiro - Architect"
        ; fr = "Joanna Barreiro - Architecte"
        }
      ~some:(fun { en; fr } ->
        { en = Fmt.str "%s - Joanna Barreiro - Architect" en
        ; fr = Fmt.str "%s - Joanna Barreiro - Architecte" fr
        } )
      title_txt
  in
  let favicon = [ link ~rel:[ `Icon ] ~href:Sitemap.favicon () ] in
  let scripts =
    List.map
      (fun s ->
        script
          ~a:
            [ a_script_type (`Mime "text/javascript")
            ; a_src @@ Sitemap.script s
            ; a_defer ()
            ]
          (txt_anylang "") )
      scripts
  in
  let styles =
    List.map
      (fun s -> link ~rel:[ `Stylesheet ] ~href:(Sitemap.style s) ())
      ("style.css" :: styles)
  in
  let meta =
    [ meta
        ~a:
          [ a_name "description"
          ; a_content request
              ~fr:
                "Joanna Barreiro - Architecte libérale - Maître d'œuvre dans \
                 le secteur Île-de-France, Seine-et-Marne et Angers, \
                 Maine-et-Loire."
              ~en:
                "Joanna Barreiro - Liberal architect - Project manager in the \
                 Île-de-France, Seine-et-Marne and Angers, Maine-et-Loire \
                 areas."
          ]
        ()
    ; meta
        ~a:
          [ a_name "keywords"
          ; a_content request
              ~fr:
                "architecture,urbanisme,design,construction,réhabilitation,joanna,barreiro,architecte,jb,construction \
                 neuve,rénovation,rénovation énergétique,architecture \
                 d'intérieur,expertise et conseil,urbanisme"
              ~en:
                "architecture,urbanism,design,construction,refurbishment,joanna,barreiro,architect,jb,renovation,energy \
                 renovation,interior architecture,design,expertise and \
                 advice,town planning"
          ]
        ()
    ]
  in
  let head =
    head
      (title (txt_choice request title_txt))
      (favicon @ meta @ styles @ scripts)
  in
  let current_page = Some (request.route |> Fmt.str "%a" Route.pp) in
  let lang_choice =
    let href =
      ( match Lang.of_request request with
      | English -> Sitemap.set_french
      | French -> Sitemap.set_english )
        current_page
    in
    let en =
      ( match Lang.of_request request with
      | English -> span ~a:[ a_class [ "current-lang" ] ]
      | French -> span ~a:[] )
        [ txt_anylang "en" ]
    in
    let sep = span ~a:[ a_class [ "lang-sep" ] ] [ txt_anylang " | " ] in
    let fr =
      ( match Lang.of_request request with
      | English -> span ~a:[]
      | French -> span ~a:[ a_class [ "current-lang" ] ] )
        [ txt_anylang "fr" ]
    in
    a ~a:[ a_class [ "lang-choice" ]; a_href href ] [ en; sep; fr ]
    (*
    div
      [ (
        match Lang.of_request request with
        | English -> txt_anylang "en"
        | French ->
          a
            ~a:[ a_href @@ Sitemap.set_english current_page ]
            [ txt_anylang "en" ] )
      ; ( match Lang.of_request request with
        | English ->
          a
            ~a:[ a_href @@ Sitemap.set_french current_page ]
            [ txt_anylang "fr" ]
        | French -> txt_anylang "fr" )
      ]
      *)
  in
  let mk_nav_a = mk_nav_a request in
  let topbar =
    nav
      [ a
          ~a:[ a_href Sitemap.home; a_class [ "aimg" ] ]
          [ (let alt = { en = "JB logo"; fr = "Logo JB" } in
             img request ~a:[ a_class [ "logo" ] ] ~src:Sitemap.favicon ~alt )
          ]
      ; simple_ul
          [ mk_nav_a Sitemap.home ~fr:"Accueil" ~en:"Home"
          ; mk_nav_a Sitemap.about ~fr:"À propos" ~en:"About"
          ; mk_nav_a Sitemap.projects ~fr:"Projets" ~en:"Projects"
          ; mk_nav_a Sitemap.services ~fr:"Services" ~en:"Services"
          ; mk_nav_a Sitemap.contact ~fr:"Contact" ~en:"Contact"
            (* TODO move "en/fr" elsewhere? *)
          ]
      ]
  in

  let lang = Fmt.str "%a" Lang.pp (Lang.of_request request) in

  let doc =
    html
      ~a:[ a_lang lang ]
      head
      (body
         [ topbar
         ; main
             [ Tyxml.Html.h1
                 ~a:[ a_class [ "hidden" ] ]
                 [ txt_choice request h1 ]
             ; div [ content ]
             ]
         ; footer [ lang_choice ]
         ] )
  in
  Html_doc.of_tyxml doc