jb/src/projects.ml

open Drame
open Tyxml.Html
open Lang

(* projects data is in data/projects.scfg
   we could change it to be in a project_data.ml file like for services_data.ml
   or inversely move *_data.ml to .scfg *)

type project =
  { url_id : string
  ; year : int
  ; home_logo : Lang.img option
  ; main_img : Lang.img
  ; more_img : Lang.img list
  ; title : Lang.choice
  ; localisation : Lang.choice
  ; kind : Lang.choice
  ; description : Lang.choice
  }

let keep_draft = false

open Scfg.Types
open Scfg.Query

let of_dir dir =
  let get_alt dir =
    { fr = get_dir_exn "fr" dir.children |> get_param_exn 0
    ; en = get_dir_exn "en" dir.children |> get_param_exn 0
    }
  in
  let get_img dir =
    { alt = get_alt dir
    ; name = get_dir_exn "file" dir.children |> get_param_exn 0
    }
  in
  let url_id = get_param_exn 0 dir in
  let dirs = dir.children in
  let year = get_dir_exn "year" dirs |> get_param_pos_int_exn 0 in
  let home_logo = get_dir "logo" dirs |> Option.map get_img in
  let main_img = get_dir_exn "main_image" dirs |> get_img in
  let more_img = get_dirs "image" dirs |> List.map get_img in
  let title = get_dir_exn "title" dirs |> get_alt in
  let localisation = get_dir_exn "localisation" dirs |> get_alt in
  let kind = get_dir_exn "kind" dirs |> get_alt in
  let description = get_dir_exn "description" dirs |> get_alt in
  { url_id
  ; year
  ; home_logo
  ; main_img
  ; more_img
  ; title
  ; localisation
  ; kind
  ; description
  }

let projects =
  let cfg =
    match Data.read "projects.scfg" with
    | None -> Fmt.failwith "can't load projects"
    | Some projects -> Scfg.Parse.from_string projects
  in
  let dirs =
    match cfg with
    | Error (`Msg msg) -> Fmt.failwith "%s" msg
    | Ok dirs -> get_dirs "project" dirs
  in
  let dirs =
    List.filter
      (fun dir ->
        let is_draft =
          get_dir "draft" dir.children
          |> Option.map (get_param_bool_exn 0)
          |> Option.value ~default:false
        in
        keep_draft || not is_draft )
      dirs
  in
  List.map of_dir dirs

let get request =
  let projects =
    List.map
      (fun { url_id
           ; home_logo = _
           ; main_img
           ; more_img = _
           ; title
           ; localisation
           ; kind = _
           ; description = _
           ; year
           } ->
        let href = Sitemap.projects_one url_id in
        div
          [ a
              ~a:[ a_href href ]
              [ figure
                  ~a:[ a_class [ "imghover" ] ]
                  ~figcaption:
                    (`Bottom
                       (figcaption
                          [ txt_choice request title
                          ; br ()
                          ; txt_choice request localisation
                          ; txt_anylang ""
                          ; br ()
                          ; Fmt.kstr txt_anylang "%d" year
                          ] ) )
                  [ Lang.img request ~a:[]
                      ~src:(Sitemap.img main_img.name)
                      ~alt:main_img.alt
                  ]
              ]
          ] )
      projects
  in
  let content =
    div ~a:[ a_class [ "projects-grid"; "inline-padded" ] ] projects
  in
  let h1 = { fr = "Projets"; en = "Projects" } in
  let doc = Template.render request ~h1 content in
  Ok (Content.Html doc)

let get_one ~id request =
  let project =
    List.find (fun { url_id; _ } -> String.equal url_id id) projects
  in
  match project with
  | None ->
    let content =
      div
        [ p
            [ txt request ~en:"Project does not exist"
                ~fr:"Le projet n'existe pas"
            ]
        ]
    in
    let h1 = { fr = "Erreur"; en = "Error" } in
    let doc = Template.render request ~h1 content in
    Error (Status.Not_found, doc)
  | Some
      { url_id = _
      ; home_logo = _
      ; main_img
      ; more_img
      ; title
      ; localisation
      ; kind
      ; description
      ; year
      } ->
    let slider =
      Slider.make ~is_home:false request
        (List.map
           (fun img -> Slider.{ img; link = None })
           (main_img :: more_img) )
    in

    let content =
      div
        ~a:[ a_class [ "inline-padded" ] ]
        [ slider
        ; h2 ~a:[ a_class [ "project-one-title" ] ] [ txt_choice request title ]
        ; br ()
        ; h3
            ~a:[ a_class [ "project-one-subtitle" ] ]
            [ txt_choice request localisation ]
        ; h3
            ~a:[ a_class [ "project-one-subtitle" ] ]
            [ txt_choice request kind ]
        ; h3
            ~a:[ a_class [ "project-one-subtitle" ] ]
            [ Fmt.kstr txt_anylang "%d" year ]
        ; p
            ~a:
              [ a_class
                  [ "project-one-description"
                  ; "inline-padded" (*more padding*)
                  ]
              ]
            [ txt_choice request description ]
        ]
    in
    let doc =
      Template.render request ~styles:[ "csslider.css" ] ~h1:title content
    in
    Ok (Content.Html doc)