diff --git a/_oasis b/_oasis index 0f37c43..5d7cc1f 100644 --- a/_oasis +++ b/_oasis @@ -14,12 +14,12 @@ Library "logarion" Path: src Modules: Logarion BuildDepends: - toml,uuidm,omd,str,batteries,lens,lwt,lwt.unix,ptime,ptime.clock.os,re.str,lens.ppx_deriving + toml,uuidm,omd,str,batteries,lens,lwt,lwt.unix,ptime,ptime.clock.os,re.str,lens.ppx_deriving,fpath Executable logarion Path: src BuildDepends: - toml,uuidm,omd,str,batteries,lens,lwt,lwt.unix,ptime,ptime.clock.os,re.str,lens.ppx_deriving, + toml,uuidm,omd,str,batteries,lens,lwt,lwt.unix,ptime,ptime.clock.os,re.str,lens.ppx_deriving,fpath, cmdliner MainIs: command.ml CompiledObject: best @@ -27,7 +27,7 @@ Executable logarion Executable logarion-web Path: src BuildDepends: - toml,uuidm,omd,str,batteries,lens,lwt,lwt.unix,ptime,ptime.clock.os,re.str,lens.ppx_deriving, + toml,uuidm,omd,str,batteries,lens,lwt,lwt.unix,ptime,ptime.clock.os,re.str,lens.ppx_deriving,fpath, opium.unix,tyxml,mustache MainIs: web.ml CompiledObject: best diff --git a/src/command.ml b/src/command.ml index 35ccdd0..c2e7c57 100644 --- a/src/command.ml +++ b/src/command.ml @@ -5,7 +5,7 @@ let init = let f force = let repo = C.((try of_filename "logarion.toml" with Sys_error _ -> default ()).repository) - |> Logarion.repodir_string + |> Logarion.repodir_path |> Fpath.to_string in let make_dir d = let open Unix in diff --git a/src/logarion.ml b/src/logarion.ml index 839918e..ce2e8a7 100644 --- a/src/logarion.ml +++ b/src/logarion.ml @@ -2,15 +2,15 @@ module Id = struct include Ymd.Id end -type repodir_t = Repodir of string -type uuiddir_t = UUIDdir of string -type titledir_t = Titledir of string -type articlefilename_t = Articlefilename of string +type repodir_t = Repodir of Fpath.t +type uuiddir_t = UUIDdir of Fpath.t +type titledir_t = Titledir of Fpath.t +type articlefilename_t = Articlefilename of Fpath.t -let repodir_string = function Repodir path -> path -let uuiddir_string = function UUIDdir path -> path -let titledir_string = function Titledir path -> path -let articlefilename_string = function Articlefilename path -> path +let repodir_path = function Repodir path -> path +let uuiddir_path = function UUIDdir path -> path +let titledir_path = function Titledir path -> path +let articlefilename_path = function Articlefilename path -> path module Configuration = struct type t = { @@ -22,7 +22,7 @@ module Configuration = struct } let default ?(id=(Id.generate ())) () = { - repository = Repodir (Sys.getcwd ()); + repository = Repodir Fpath.(v (Sys.getcwd ())); title = "Logarion journal"; owner = ""; email = ""; @@ -36,8 +36,9 @@ module Configuration = struct | `Ok toml -> let str = Logarion_toml.str toml "general" in let default = default () in + let default_repo = default.repository |> repodir_path |> Fpath.to_string in { - repository = Repodir (str "repository" (repodir_string default.repository)); + repository = Repodir (str "repository" default_repo |> Fpath.v); title = str "title" default.title; owner = str "owner" default.owner; email = str "email" default.email; @@ -47,7 +48,7 @@ end module File = struct let load f = - let ic = open_in f in + let ic = open_in (Fpath.to_string f) in let n = in_channel_length ic in let s = Bytes.create n in really_input ic s 0 n; @@ -57,22 +58,17 @@ module File = struct let ymd f = Ymd.of_string (load f) end -let titledir (dir : repodir_t) = Titledir (repodir_string dir ^ "/title/") -let uuiddir (dir : repodir_t) = UUIDdir (repodir_string dir ^ "/uuid/") +let titledir (dir : repodir_t) = Titledir Fpath.(repodir_path dir / "title") +let uuiddir (dir : repodir_t) = UUIDdir Fpath.(repodir_path dir / "uuid") let extension = ".ymd" let article_path (repo : repodir_t) articlepath = - let titledir = titledir_string (titledir repo) in - Articlefilename (titledir ^ articlefilename_string articlepath) - + Articlefilename Fpath.(repodir_path repo / "title" // articlefilename_path articlepath) let title_path (repo : repodir_t) title = - let titledir = titledir_string (titledir repo) in - Articlefilename (titledir ^ Ymd.filename_of_title title ^ extension) - + Articlefilename Fpath.(repodir_path repo / "title" / (Ymd.filename_of_title title ^ extension)) let uuid_path (repo : repodir_t) ymd = - let uuiddir = uuiddir_string (uuiddir repo) in - Articlefilename (uuiddir ^ Ymd.(Id.to_string ymd.meta.Meta.uuid) ^ extension) + Articlefilename Fpath.(repodir_path repo / "uuid" / Ymd.(Id.to_string ymd.meta.Meta.uuid ^ extension)) let slug string = Filename.(string |> basename |> chop_extension) @@ -90,25 +86,27 @@ module Entry = struct let author_email e = e.attributes.author.Ymd.Author.email let of_filename repo (s : articlefilename_t) = - let ymd = File.ymd (articlefilename_string (article_path repo s)) in + let ymd = File.ymd (articlefilename_path (article_path repo s)) in { filename = s; attributes = ymd.Ymd.meta } let to_filename repo ymd = - let uuid_path = articlefilename_string @@ uuid_path repo ymd in + let uuid_path = Fpath.to_string @@ articlefilename_path @@ uuid_path repo ymd in let write_ymd out = Lwt_io.write out (Ymd.to_string ymd) in Lwt_io.with_file ~mode:Lwt_io.output uuid_path write_ymd - let to_ymd repo entry = File.ymd (articlefilename_string (article_path repo entry.filename)) + let to_ymd repo entry = File.ymd (articlefilename_path (article_path repo entry.filename)) let slug entry = - Filename.(entry.filename |> articlefilename_string |> basename |> chop_extension) + Fpath.(entry.filename |> articlefilename_path |> base |> rem_ext |> to_string) let compare_recency a b = Ymd.Date.compare (date b) (date a) end let rec next_semantic_filepath ?(version=0) titles ymd = - let candidate = titledir_string titles ^ (Ymd.filename ymd) ^ "." ^ (string_of_int version) ^ extension in - if Sys.file_exists candidate then next_semantic_filepath ~version:(version+1) titles ymd + let candidate = + let open Fpath in + titledir_path titles / (Ymd.filename ymd) |> add_ext (string_of_int version) |> add_ext extension in + if Sys.file_exists Fpath.(to_string candidate) then next_semantic_filepath ~version:(version+1) titles ymd else candidate module Archive = struct @@ -119,8 +117,8 @@ module Archive = struct let published = List.filter Entry.published let of_repo repo = - let files = Array.to_list @@ Sys.readdir (titledir_string (titledir repo)) in - let to_entry y = Entry.of_filename repo (Articlefilename y) in + let files = Array.to_list @@ Sys.readdir Fpath.(to_string @@ titledir_path (titledir repo)) in + let to_entry y = Entry.of_filename repo (Articlefilename (Fpath.v y)) in let fold_file a file = if BatString.ends_with file extension then try List.cons (to_entry file) a with Ymd.Syntax_error str -> prerr_endline str; a @@ -140,12 +138,12 @@ module Archive = struct let uuid x = x.Meta.uuid in let entry = List.find (fun entry -> uuid entry.attributes = uuid ymd.meta) entries in if slug entry <> filename ymd then - let found_filepath = articlefilename_string (article_path repo entry.filename) in - Lwt_unix.rename found_filepath (next_semantic_filepath titledir ymd) + let found_filepath = Fpath.to_string @@ articlefilename_path (article_path repo entry.filename) in + Lwt_unix.rename found_filepath (Fpath.to_string @@ next_semantic_filepath titledir ymd) else Lwt.return_unit with Not_found -> - Lwt_unix.link (articlefilename_string (uuid_path repo ymd)) (next_semantic_filepath titledir ymd); + Lwt_unix.link (Fpath.to_string @@ articlefilename_path (uuid_path repo ymd)) (Fpath.to_string @@ next_semantic_filepath titledir ymd); end else Lwt.return_unit) @@ -177,7 +175,7 @@ let latest_entry repo fragment = let entry_with_slug repo (slug as s) = let open Entry in - try Some (of_filename repo (Articlefilename (s ^ extension))) + try Some (of_filename repo (Articlefilename (Fpath.v @@ s ^ extension))) with _ -> let slugged last_match entry = if s <> Ymd.filename_of_title (title entry) then last_match