package catala

  1. Overview
  2. Docs
Legend:
Page
Library
Module
Module type
Parameter
Class
Class type
Source

Source file latex.ml

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
(* This file is part of the Catala compiler, a specification language for tax and social benefits
   computation rules. Copyright (C) 2020 Inria, contributor: Denis Merigoux
   <denis.merigoux@inria.fr>

   Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except
   in compliance with the License. You may obtain a copy of the License at

   http://www.apache.org/licenses/LICENSE-2.0

   Unless required by applicable law or agreed to in writing, software distributed under the License
   is distributed on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express
   or implied. See the License for the specific language governing permissions and limitations under
   the License. *)

(** This modules weaves the source code and the legislative text together into a document that law
    professionals can understand. *)

open Utils
module A = Surface.Ast
module R = Re.Pcre
module C = Cli

(** {1 Helpers} *)

(** Espaces various LaTeX-sensitive characters *)
let pre_latexify (s : string) =
  let percent = R.regexp "%" in
  let s = R.substitute ~rex:percent ~subst:(fun _ -> "\\%") s in
  let dollar = R.regexp "\\$" in
  let s = R.substitute ~rex:dollar ~subst:(fun _ -> "\\$") s in
  let premier = R.regexp "1er" in
  let s = R.substitute ~rex:premier ~subst:(fun _ -> "1\\textsuperscript{er}") s in
  let underscore = R.regexp "\\_" in
  let s = R.substitute ~rex:underscore ~subst:(fun _ -> "\\_") s in
  s

(** Usage: [wrap_latex source_files custom_pygments language fmt wrapped]

    Prints an LaTeX complete documùent structure around the [wrapped] content. *)
let wrap_latex (source_files : string list) (language : C.backend_lang) (fmt : Format.formatter)
    (wrapped : Format.formatter -> unit) =
  Format.fprintf fmt
    "\\documentclass[11pt, a4paper]{article}\n\n\
     \\usepackage[T1]{fontenc}\n\
     \\usepackage[utf8]{inputenc}\n\
     \\usepackage[%s]{babel}\n\
     \\usepackage{lmodern}\n\
     \\usepackage{minted}\n\
     \\usepackage{amssymb}\n\
     \\usepackage{newunicodechar}\n\
     \\usepackage{textcomp}\n\
     \\usepackage[hidelinks]{hyperref}\n\
     \\usepackage[dvipsnames]{xcolor}\n\
     \\usepackage{fullpage}\n\
     \\usepackage[many]{tcolorbox}\n\n\
     \\newunicodechar{÷}{$\\div$}\n\
     \\newunicodechar{×}{$\\times$}\n\
     \\newunicodechar{≤}{$\\leqslant$}\n\
     \\newunicodechar{≥}{$\\geqslant$}\n\
     \\newunicodechar{→}{$\\rightarrow$}\n\
     \\newunicodechar{≠}{$\\neq$}\n\n\
     \\newcommand*\\FancyVerbStartString{```catala}\n\
     \\newcommand*\\FancyVerbStopString{```}\n\n\
     \\fvset{\n\
     numbers=left,\n\
     frame=lines,\n\
     framesep=3mm,\n\
     rulecolor=\\color{gray!70},\n\
     firstnumber=last,\n\
     codes={\\catcode`\\$=3\\catcode`\\^=7}\n\
     }\n\n\
     \\title{\n\
     %s\n\
     }\n\
     \\author{\n\
     %s Catala version %s\n\
     }\n\
     \\begin{document}\n\
     \\maketitle\n\n\
     %s : \n\
     \\begin{itemize}%s\\end{itemize}\n\n\
     \\[\\star\\star\\star\\]\\\\\n"
    (match language with `Fr -> "french" | `En -> "english")
    ( match language with
    | `Fr -> "Implémentation de texte législatif"
    | `En -> "Legislative text implementation" )
    (match language with `Fr -> "Document généré par" | `En -> "Document generated by")
    Utils.Cli.version
    ( match language with
    | `Fr -> "Fichiers sources tissés dans ce document"
    | `En -> "Source files weaved in this document" )
    (String.concat ","
       (List.map
          (fun filename ->
            let mtime = (Unix.stat filename).Unix.st_mtime in
            let ltime = Unix.localtime mtime in
            let ftime =
              Printf.sprintf "%d-%02d-%02d, %d:%02d" (1900 + ltime.Unix.tm_year)
                (ltime.Unix.tm_mon + 1) ltime.Unix.tm_mday ltime.Unix.tm_hour ltime.Unix.tm_min
            in
            Printf.sprintf "\\item\\texttt{%s}, %s %s"
              (pre_latexify (Filename.basename filename))
              (match language with `Fr -> "dernière modification le" | `En -> "last modification")
              ftime)
          source_files));
  wrapped fmt;
  Format.fprintf fmt "\n\n\\end{document}"

(** Replaces math operators by their nice unicode counterparts *)
let math_syms_replace (c : string) : string =
  let date = "\\d\\d/\\d\\d/\\d\\d\\d\\d" in
  let syms = R.regexp (date ^ "|!=|<=|>=|--|->|\\*|/") in
  let syms2cmd = function
    | "!=" -> "≠"
    | "<=" -> "≤"
    | ">=" -> "≥"
    | "--" -> "—"
    | "->" -> "→"
    | "*" -> "×"
    | "/" -> "÷"
    | s -> s
  in
  R.substitute ~rex:syms ~subst:syms2cmd c

(** {1 Weaving} *)

let law_article_item_to_latex (language : C.backend_lang) (fmt : Format.formatter)
    (i : A.law_article_item) : unit =
  match i with
  | A.LawText t -> Format.fprintf fmt "%s" (pre_latexify t)
  | A.CodeBlock (_, c) ->
      Format.fprintf fmt
        "\\begin{minted}[label={\\hspace*{\\fill}\\texttt{%s}},firstnumber=%d]{%s}\n\
         ```catala%s```\n\
         \\end{minted}"
        (pre_latexify (Filename.basename (Pos.get_file (Pos.get_position c))))
        (Pos.get_start_line (Pos.get_position c) - 1)
        (match language with `Fr -> "catala_fr" | `En -> "catala_en")
        (math_syms_replace (Pos.unmark c))

let rec law_structure_to_latex (language : C.backend_lang) (fmt : Format.formatter)
    (i : A.law_structure) : unit =
  match i with
  | A.LawHeading (heading, children) ->
      Format.fprintf fmt "\\%ssection*{%s}\n\n"
        ( match heading.law_heading_precedence with
        | 0 -> ""
        | 1 -> ""
        | 2 -> "sub"
        | 3 -> "sub"
        | _ -> "subsub" )
        (pre_latexify heading.law_heading_name);
      Format.pp_print_list
        ~pp_sep:(fun fmt () -> Format.fprintf fmt "\n\n")
        (law_structure_to_latex language) fmt children
  | A.LawInclude (A.PdfFile ((file, _), page)) ->
      let label = file ^ match page with None -> "" | Some p -> Format.sprintf "_page_%d," p in
      Format.fprintf fmt
        "\\begin{center}\\textit{Annexe incluse, retranscrite page \\pageref{%s}}\\end{center} \
         \\begin{figure}[p]\\begin{center}\\includegraphics[%swidth=\\textwidth]{%s}\\label{%s}\\end{center}\\end{figure}"
        label
        (match page with None -> "" | Some p -> Format.sprintf "page=%d," p)
        file label
  | A.LawInclude (A.CatalaFile _ | A.LegislativeText _) -> ()
  | A.LawArticle (article, children) ->
      Format.fprintf fmt "\\paragraph{%s}\n\n" (pre_latexify (Pos.unmark article.law_article_name));
      Format.pp_print_list
        ~pp_sep:(fun fmt () -> Format.fprintf fmt "\n")
        (law_article_item_to_latex language)
        fmt children
  | A.MetadataBlock (_, c) ->
      let metadata_title = match language with `Fr -> "Métadonnées" | `En -> "Metadata" in
      Format.fprintf fmt
        "\\begin{tcolorbox}[colframe=OliveGreen, breakable, \
         title=\\textcolor{black}{\\texttt{%s}},title after \
         break=\\textcolor{black}{\\texttt{%s}},before skip=1em, after skip=1em]\n\
         \\begin{minted}[numbersep=9mm, firstnumber=%d, label={\\hspace*{\\fill}\\texttt{%s}}]{%s}\n\
         ```catala%s```\n\
         \\end{minted}\n\
         \\end{tcolorbox}"
        metadata_title metadata_title
        (Pos.get_start_line (Pos.get_position c) - 1)
        (pre_latexify (Filename.basename (Pos.get_file (Pos.get_position c))))
        (match language with `Fr -> "catala_fr" | `En -> "catala_en")
        (math_syms_replace (Pos.unmark c))
  | A.IntermediateText t -> Format.fprintf fmt "%s" (pre_latexify t)

let program_item_to_latex (language : C.backend_lang) (fmt : Format.formatter) (i : A.program_item)
    : unit =
  match i with A.LawStructure law_s -> law_structure_to_latex language fmt law_s

(** {1 API} *)

let ast_to_latex (language : C.backend_lang) (fmt : Format.formatter) (program : A.program) : unit =
  Format.pp_print_list
    ~pp_sep:(fun fmt () -> Format.fprintf fmt "\n\n")
    (program_item_to_latex language) fmt program.program_items
OCaml

Innovation. Community. Security.