Commit 355c53c4 authored by Michele Alberti's avatar Michele Alberti
Browse files

Move existence logic into Filepath module in order to leverage on it.

parent 4d7915e8
......@@ -451,13 +451,10 @@ struct
module Filepath
(X: sig
include Parameter_sig.Input_with_arg
val existence : Parameter_sig.existence
val existence : Filepath.existence
end) =
struct
exception No_file
exception File_exists
include Build
(struct
include Datatype.Filepath
......@@ -466,31 +463,20 @@ struct
let functor_name = "Filepath"
end)
let check_existence existence fp =
match existence with
| Parameter_sig.Indifferent -> ()
| Parameter_sig.Must_exist ->
if not (Sys.file_exists (Filepath.Normalized.to_pretty_string fp)) then
raise No_file
| Parameter_sig.Must_not_exist ->
if Sys.file_exists (Filepath.Normalized.to_pretty_string fp) then
raise File_exists
let existence = X.existence
let convert f oldstr newstr =
let oldfp = Filepath.Normalized.to_pretty_string oldstr in
let newfp = Filepath.Normalized.to_pretty_string newstr in
f oldfp newfp
let set fp =
try
check_existence existence fp ; set fp
with
| No_file -> P.L.abort "file not found: '%a'" Filepath.Normalized.pretty fp
| File_exists -> P.L.abort "file already exists: '%a'" Filepath.Normalized.pretty fp
let set_str s = set (Filepath.Normalized.of_string s)
let set_str s =
let fp =
try
Filepath.Normalized.of_string ~existence:X.existence s
with
| Filepath.No_file -> P.L.abort "file not found: '%s'" s
| Filepath.File_exists -> P.L.abort "file already exists: '%s'" s
in
set fp
let add_option name =
Cmdline.add_option
......
......@@ -321,26 +321,9 @@ module type Specific_dir = sig
end
type existence = Must_exist | Must_not_exist | Indifferent
(** signature for normalized pathnames. *)
module type Filepath = sig
exception No_file
(** raised by {!check_existence} if no file exists and [existence] is [Must_exist]. *)
exception File_exists
(** raised by {!check_existence} if some file exists and [existence] is
[Must_nos_exist]. *)
val existence: existence
module type Filepath = S with type t = Filepath.Normalized.t
val check_existence: existence -> Filepath.Normalized.t -> unit
(** Checks the existence/absence of a file. May raise [No_file] or [File_exists]. *)
include S with type t = Filepath.Normalized.t
end
(* ************************************************************************** *)
(** {3 Collections} *)
......@@ -540,7 +523,7 @@ module type Builder = sig
module Filepath(X: sig
include Input_with_arg
val existence: existence
val existence: Filepath.existence
end): Filepath
exception Cannot_build of string
......
......@@ -720,7 +720,7 @@ module LoadState =
(struct
let option_name = "-load"
let arg_name = "filename"
let existence = Parameter_sig.Must_exist
let existence = Filepath.Must_exist
let help = "load a previously-saved session from file <filename>"
end)
......
......@@ -1942,7 +1942,8 @@ module Filepath = struct
let varname _ = "p"
end)
let dummy = Filepath.Normalized.unknown
let of_string ?base_name s = Filepath.Normalized.of_string ?base_name s
let of_string ?existence ?base_name s =
Filepath.Normalized.of_string ?existence ?base_name s
let pp_abs = Filepath.Normalized.pp_abs
end
......
......@@ -348,7 +348,7 @@ val integer: Integer.t Type.t
@since 18.0-Argon *)
module Filepath: sig
include S_with_collections with type t = Filepath.Normalized.t
val of_string: ?base_name:string -> string -> t
val of_string: ?existence:Filepath.existence -> ?base_name:string -> string -> t
val pp_abs: Format.formatter -> t -> unit
val dummy: t
end
......
......@@ -127,15 +127,36 @@ let insert base path_name =
let cwd = insert dummy (Sys.getcwd())
let normalize ?base_name path_name =
if path_name = "" then ""
else
let base =
match base_name with
| None -> cwd
| Some b -> insert cwd b in
let norm_path_name = (insert base path_name).path_name in
if norm_path_name = "" then "/" else norm_path_name
type existence = Must_exist | Must_not_exist | Indifferent
exception No_file
exception File_exists
let normalize ?(existence=Indifferent) ?base_name path_name =
let path =
if path_name = ""
then ""
else
let base =
match base_name with
| None -> cwd
| Some b -> insert cwd b in
let norm_path_name = (insert base path_name).path_name in
if norm_path_name = "" then "/" else norm_path_name
in
match existence with
| Indifferent ->
path
| Must_exist ->
if Sys.file_exists path
then path
else raise No_file
| Must_not_exist ->
if Sys.file_exists path
then raise File_exists
else path
(* -------------------------------------------------------------------------- *)
(* --- Symboling Names --- *)
......@@ -210,7 +231,7 @@ let is_relative ?base_name file_name =
module Normalized = struct
type t = string
let of_string ?base_name s = normalize ?base_name s
let of_string ?existence ?base_name s = normalize ?existence ?base_name s
let to_pretty_string s = pretty s
let equal : t -> t -> bool = (=)
let compare = String.compare
......
......@@ -27,6 +27,14 @@
NOTE: Prefer using the [Normalized] module whenever possible.
*)
type existence = Must_exist | Must_not_exist | Indifferent
exception No_file
(** raised whenever no file exists and [existence] is [Must_exist]. *)
exception File_exists
(** raised whenever some file exists and [existence] is [Must_not_exist]. *)
(** Returns an absolute path leading to the given file.
The result is similar to [realpath --no-symlinks].
Some special behaviors include:
......@@ -38,7 +46,7 @@
but [normalize] may accept them.
@modify Aluminium-20160501 optional base_name. *)
val normalize: ?base_name:string -> string -> string
val normalize: ?existence:existence -> ?base_name:string -> string -> string
(** [relativize base_name file_name] returns a relative path name of
[file_name] w.r.t. [base_name], if [base_name] is a prefix of [file];
......@@ -85,7 +93,7 @@ module Normalized: sig
(** [of_string s] converts [s] into a normalized path.
@raise Invalid_argument if [s] is the empty string. *)
val of_string: ?base_name:string -> string -> t
val of_string: ?existence:existence -> ?base_name:string -> string -> t
(** [to_pretty_string p] returns [p] prettified,
that is, a relative path-like string.
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment