1 (** Guessing a file's language for syntax highlighting. 2 3 Detection is best-effort and purely advisory: the blob renders identically 4 whether or not a language is found, so a wrong guess degrades to plain text 5 rather than breaking the page. 6 7 Sources are tried in descending order of reliability: the filename 8 extension, then a shebang, then an Emacs file variable, then a Vim modeline. 9 *) 10 11 let of_filename name = 12 (* First check the bare filename for well-known extensionless files *) 13 let basename = Filename.basename name |> String.lowercase_ascii in 14 match basename with 15 | "makefile" | "gnumakefile" -> Some "makefile" 16 | "dockerfile" -> Some "dockerfile" 17 | "dune" | "dune-project" | "dune-workspace" -> Some "dune" 18 | "jenkinsfile" -> Some "groovy" 19 | _ -> ( 20 match Filename.extension name |> String.lowercase_ascii with 21 | ".ml" | ".mli" -> Some "ocaml" 22 | ".mld" -> Some "ocamldoc" 23 | ".c" | ".h" -> Some "c" 24 | ".clj" | ".cljs" | ".cljc" | ".edn" -> Some "clojure" 25 | ".cpp" | ".cc" | ".cxx" | ".hpp" -> Some "cpp" 26 | ".cs" -> Some "csharp" 27 | ".css" -> Some "css" 28 | ".dart" -> Some "dart" 29 | ".diff" | ".patch" -> Some "diff" 30 | ".dune" -> Some "dune" 31 | ".el" | ".lisp" | ".cl" | ".scm" | ".ss" -> Some "lisp" 32 | ".erl" | ".hrl" -> Some "erlang" 33 | ".ex" | ".exs" -> Some "elixir" 34 | ".f90" | ".f95" | ".f03" | ".f08" | ".f" | ".for" -> Some "fortran" 35 | ".go" -> Some "go" 36 | ".gradle" | ".groovy" -> Some "groovy" 37 | ".hs" -> Some "haskell" 38 | ".html" | ".htm" -> Some "html" 39 | ".java" -> Some "java" 40 | ".jl" -> Some "julia" 41 | ".js" | ".mjs" | ".cjs" -> Some "javascript" 42 | ".json" -> Some "json" 43 | ".kt" | ".kts" -> Some "kotlin" 44 | ".lua" -> Some "lua" 45 | ".m" -> Some "objective-c" 46 | ".md" -> Some "markdown" 47 | ".nix" -> Some "nix" 48 | ".opam" -> Some "opam" 49 | ".org" -> Some "org" 50 | ".php" -> Some "php" 51 | ".pl" | ".pm" | ".t" -> Some "perl" 52 | ".proto" -> Some "protobuf" 53 | ".ps1" | ".psm1" | ".psd1" -> Some "powershell" 54 | ".py" -> Some "python" 55 | ".r" -> Some "r" 56 | ".rb" -> Some "ruby" 57 | ".rs" -> Some "rust" 58 | ".scala" | ".sc" -> Some "scala" 59 | ".sh" | ".bash" | ".zsh" -> Some "bash" 60 | ".sql" -> Some "sql" 61 | ".swift" -> Some "swift" 62 | ".tf" | ".hcl" -> Some "terraform" 63 | ".toml" -> Some "toml" 64 | ".ts" | ".tsx" -> Some "typescript" 65 | ".vue" -> Some "vue" 66 | ".xml" | ".svg" | ".xsl" -> Some "xml" 67 | ".yaml" | ".yml" -> Some "yaml" 68 | ".zig" -> Some "zig" 69 | _ -> None) 70 71 let of_shebang line = 72 if not (String.starts_with ~prefix:"#!" line) then None 73 else 74 (* Extract the last path component, ignoring env and arguments *) 75 let rest = String.sub line 2 (String.length line - 2) in 76 let parts = String.split_on_char ' ' (String.trim rest) in 77 let interpreter = 78 match parts with 79 | [] -> "" 80 | cmd :: args -> 81 let base = Filename.basename cmd in 82 if base = "env" then 83 (* /usr/bin/env python3 — take next non-flag argument *) 84 List.find_opt (fun s -> s <> "" && s.[0] <> '-') args 85 |> Option.value ~default:"" |> Filename.basename 86 else base 87 in 88 (* Strip version suffixes: python3.11 -> python, ruby3.2 -> ruby *) 89 let strip_trailing_digits s = 90 let len = String.length s in 91 let rec find_end i = 92 if i < 0 then s 93 else if s.[i] >= '0' && s.[i] <= '9' then find_end (i - 1) 94 else String.sub s 0 (i + 1) 95 in 96 find_end (len - 1) 97 in 98 let interpreter = 99 match String.split_on_char '.' interpreter with 100 | [] -> "" 101 | base :: _ -> strip_trailing_digits base 102 in 103 match String.lowercase_ascii interpreter with 104 | "sh" | "bash" | "dash" | "ash" | "zsh" -> Some "bash" 105 | "python" -> Some "python" 106 | "ruby" -> Some "ruby" 107 | "perl" -> Some "perl" 108 | "node" | "deno" | "bun" -> Some "javascript" 109 | "lua" -> Some "lua" 110 | "php" -> Some "php" 111 | "elixir" -> Some "elixir" 112 | "awk" | "gawk" | "mawk" -> Some "awk" 113 | "ocaml" -> Some "ocaml" 114 | _ -> None 115 116 let of_emacs_variables line = 117 let find_between s prefix suffix = 118 let plen = String.length prefix in 119 let slen = String.length suffix in 120 let total = String.length s in 121 let rec find_start i = 122 if i > total - plen then None 123 else if String.sub s i plen = prefix then 124 let after = i + plen in 125 let rec find_end j = 126 if j > total - slen then None 127 else if String.sub s j slen = suffix then 128 Some (String.sub s after (j - after) |> String.trim) 129 else find_end (j + 1) 130 in 131 find_end after 132 else find_start (i + 1) 133 in 134 find_start 0 135 in 136 let extract_mode between = 137 let props = String.split_on_char ';' between in 138 let mode_prop = 139 List.find_map 140 (fun prop -> 141 match String.split_on_char ':' (String.trim prop) with 142 | [ key; value ] 143 when String.trim (String.lowercase_ascii key) = "mode" -> 144 Some (String.trim value) 145 | _ -> None) 146 props 147 in 148 match mode_prop with 149 | Some _ -> mode_prop 150 | None -> 151 if 152 (not (String.contains between ':')) 153 && not (String.contains between ';') 154 then Some (String.trim between) 155 else None 156 in 157 let normalize_mode mode = 158 match String.lowercase_ascii mode with 159 | "tuareg" | "caml" | "ocaml" -> Some "ocaml" 160 | "emacs-lisp" | "lisp" | "elisp" -> Some "lisp" 161 | "shell-script" | "sh" | "bash" -> Some "bash" 162 | "python" -> Some "python" 163 | "ruby" -> Some "ruby" 164 | "perl" | "cperl" -> Some "perl" 165 | "c" -> Some "c" 166 | "c++" -> Some "cpp" 167 | "javascript" | "js" -> Some "javascript" 168 | "typescript" -> Some "typescript" 169 | "rust" -> Some "rust" 170 | "go" -> Some "go" 171 | "haskell" -> Some "haskell" 172 | "lua" -> Some "lua" 173 | "sql" -> Some "sql" 174 | "yaml" -> Some "yaml" 175 | "nix" -> Some "nix" 176 | "makefile" -> Some "makefile" 177 | m -> Some m 178 in 179 let ( >>= ) = Option.bind in 180 find_between line "-*-" "-*-" >>= extract_mode >>= normalize_mode 181 182 let of_vim_modeline line = 183 let contains_substring s sub = 184 let slen = String.length s in 185 let sublen = String.length sub in 186 let rec check i = 187 if i > slen - sublen then false 188 else if String.sub s i sublen = sub then true 189 else check (i + 1) 190 in 191 sublen <= slen && check 0 192 in 193 let l = String.lowercase_ascii line in 194 let has_vim_prefix = 195 contains_substring l "vim:" 196 || contains_substring l "vi:" || contains_substring l "ex:" 197 in 198 if not has_vim_prefix then None 199 else 200 let find_value prefix s = 201 let plen = String.length prefix in 202 let slen = String.length s in 203 let rec find_at i = 204 if i > slen - plen then None 205 else if String.sub s i plen = prefix then 206 let vstart = i + plen in 207 let rec scan_end j = 208 if j >= slen || s.[j] = ' ' || s.[j] = ':' || s.[j] = '\t' then j 209 else scan_end (j + 1) 210 in 211 let vend = scan_end vstart in 212 Some (String.sub s vstart (vend - vstart)) 213 else find_at (i + 1) 214 in 215 find_at 0 216 in 217 let ft = 218 match find_value "ft=" l with 219 | Some _ as r -> r 220 | None -> find_value "filetype=" l 221 in 222 match ft with 223 | None -> None 224 | Some ft -> ( 225 match ft with 226 | "sh" | "bash" | "zsh" -> Some "bash" 227 | "python" -> Some "python" 228 | "ruby" -> Some "ruby" 229 | "perl" -> Some "perl" 230 | "javascript" | "js" -> Some "javascript" 231 | "typescript" -> Some "typescript" 232 | "ocaml" -> Some "ocaml" 233 | "c" -> Some "c" 234 | "cpp" -> Some "cpp" 235 | "rust" -> Some "rust" 236 | "go" -> Some "go" 237 | "haskell" -> Some "haskell" 238 | "lua" -> Some "lua" 239 | "make" | "makefile" -> Some "makefile" 240 | "yaml" -> Some "yaml" 241 | "sql" -> Some "sql" 242 | "nix" -> Some "nix" 243 | other -> Some other) 244 245 (** Inspect the first and last five lines, where editors conventionally place 246 mode declarations. *) 247 let of_content content = 248 let lines = String.split_on_char '\n' content in 249 let len = List.length lines in 250 let rec take n = function 251 | _ when n <= 0 -> [] 252 | [] -> [] 253 | x :: rest -> x :: take (n - 1) rest 254 in 255 let rec drop n = function 256 | l when n <= 0 -> l 257 | [] -> [] 258 | _ :: rest -> drop (n - 1) rest 259 in 260 let first_lines = take (min 5 len) lines in 261 let last_lines = drop (max 0 (len - 5)) lines in 262 let try_lines detector lines = List.find_map detector lines in 263 let ( <|> ) a b = match a with Some _ -> a | None -> b () in 264 match first_lines with 265 | [] -> None 266 | first :: _ -> 267 ( (of_shebang first <|> fun () -> try_lines of_emacs_variables first_lines) 268 <|> fun () -> try_lines of_vim_modeline first_lines ) 269 <|> fun () -> try_lines of_vim_modeline last_lines 270 271 (** Prefer the filename, falling back to markers inside the content. *) 272 let detect ~filename content = 273 match Option.bind filename of_filename with 274 | Some _ as found -> found 275 | None -> of_content content 276