summaryrefslogtreecommitdiffabout
path: root/src/prelude.ml
blob: a5c336fdf22f11a4925a1b7a944f403e881fd430 (plain)
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
(******************************************************************************)
(*   Copyright (c) 2013-2014 Armaël Guéneau.                                  *)
(*   See the file LICENSE for copying permission.                             *)
(******************************************************************************)

open Batteries

open Papierslib

let iter_effect_tl (f: 'a -> unit) (effect: unit -> unit) (l: 'a list) =
  match l with
  | [] -> ()
  | [x] -> f x
  | x::xs -> f x; List.iter (fun x -> effect (); f x) xs

let iteri_effects (f: int -> 'a -> unit)
    ~(before: unit -> unit)
    ~(between: unit -> unit)
    (l: 'a list) =
  match l with
  | [] -> ()
  | [x] -> before (); f 0 x
  | x::xs -> before (); f 0 x; List.iteri (fun i x -> between (); f (i+1) x) xs

let spawn (cmd: string) =
  if Unix.fork () = 0 then (
    Unix.setsid () |> ignore;
    Unix.execv
      "/bin/sh"
      [| "/bin/sh"; "-c"; cmd |]
  )

let filteri (p: int -> 'a -> bool) (l: 'a list) =
  List.fold_left (fun (id, acc) x ->
    (id + 1,
     if p id x then x::acc else acc)
  ) (0, []) l
  |> snd |> List.rev

let (^/) = Filename.concat

(* Return the list of all the files in a given directory, with
   their relative path into the directory. *)
let explore_directory (dir: string) =
  let root = dir in

  let rec aux prefix =
    let files = ref [] in
    begin try
      let content = Sys.readdir (root ^/ prefix) in
      Array.iter (fun it ->
        let it = prefix ^/ it in
        if Sys.is_directory (root ^/ it) then
          files := (aux it) @ !files
        else
          files := it :: !files
      ) content;
      with Sys_error _ -> () end;
    !files in
  aux ""

let in_path (name: string): bool =
  Sys.getenv "PATH"
  |> String.nsplit ~by:":"
  |> List.Exceptionless.find (fun dir ->
    Sys.file_exists (Filename.concat dir name))
  |> Option.is_some

class read_line ~term ~prompt = object(self)
  inherit LTerm_read_line.read_line ()
  inherit [Zed_utf8.t] LTerm_read_line.term term

  method! show_box = false

  initializer
    self#set_prompt
      (React.S.const
         (LTerm_text.of_string_maybe_invalid prompt))
end

let read_line ?(prompt = "") ?(initial_text = "") () =
  let open Lwt in
  let main =
    Lazy.force LTerm.stdout >>= fun term ->
    let engine = new read_line ~term ~prompt in
    CamomileLibrary.UTF8.iter engine#insert initial_text;
    engine#run
  in
  Lwt_main.run main

(*****************************************************************************)
(* Path manipulations :                                                      *)
(*****************************************************************************)

(* Take [path], relative to the current working directory, and output
   the absolute path *)
let full_path_in_cwd (path: Path.t) =
  if Path.is_relative path then
    Path.(
      concat
        (of_string (Unix.getcwd ()))
        path
    )
  else
    path

(* Output [path] relatively to [db_base_path] *)
let relative_path (db_path: Path.t) (path: Path.t) =
  try
    Path.relative_to_parent db_path path
  with Path.Not_parent -> path

(* Relocate [path] to be relative to the database location [db_path] *)
let relocate (db_path: Path.t) (path: Path.t) =
  let relocated = path
    |> full_path_in_cwd
    |> relative_path db_path
    |> Path.normalize
  in
  if Path.is_absolute relocated then (
    (* [path] was not pointing to a file in the repository *)
    Printf.eprintf "Error: %s is outside repository\n"
      (Path.to_string path);
    exit 1
  );
  relocated

(* Take [path], relative to the db location, and output the absolute
   path *)
let full_path_in_db (db_path: Path.t) (path: Path.t) =
  if Path.is_relative path then
    Path.concat db_path path
  else
    path

(* Import a source string *)
let import_source
    ?(check_file_exists = true)
    (db_path: Path.t)
    (src: string) =
  Source.of_string src
  |> Source.map_path (fun path ->
    if check_file_exists then (
      let full_path = full_path_in_cwd path |> Path.to_string in
      if not (Sys.file_exists full_path) then
        failwith (Printf.sprintf "%s doesn't exist" full_path)
    );
    relocate db_path path
  )