Alpha: simplify publication & module for header packs
This commit is contained in:
orbifx
parent
6c27c7c6fb
commit
071808367c
@ -12,30 +12,17 @@ let writer dir name acc (text,store_item) = (* todo: single_parser -> [files] *)
|
||||
match Text.(str "Content-Type" text) with
|
||||
| "" | "text/plain" ->
|
||||
let filename = dir ^ "/" ^ Text.alias text in
|
||||
let idfilename = dir ^ "/" ^ Id.to_string text.Text.uuid ^ ".txt" in
|
||||
file_when_changed store_item idfilename (fun _title -> Text.to_string) text.title text;
|
||||
(* let idfilename = dir ^ "/" ^ Id.to_string text.Text.uuid ^ ".txt" in*)
|
||||
(* file_when_changed store_item idfilename (fun _title -> Text.to_string) text.title text;*)
|
||||
file_when_changed store_item (filename ^ ".html") (Html.page "") name text;
|
||||
file_when_changed store_item (filename ^ ".gmi") Gemini.page name text;
|
||||
(acc + 1)
|
||||
| x -> prerr_endline ("No converter for Content-Type: " ^ x ^ ", for " ^ text.Text.title); acc
|
||||
|
||||
let index_pack archive indexed_texts =
|
||||
let persons ps = List.rev @@ Person.Set.fold (fun x a -> Msgpck.String (Person.to_string x) :: a) ps [] in
|
||||
let to_pack a t =
|
||||
let open Text in
|
||||
let of_set field t = List.rev @@ String_set.fold (fun x a -> Msgpck.String x :: a) (set field t) [] in
|
||||
Msgpck.(List [Bytes (Id.to_bytes t.uuid); String t.title; List (persons t.authors); List (of_set "topics" t); List (of_set "keywords" t)])
|
||||
:: a
|
||||
in
|
||||
let header_pack = Msgpck.List List.(fold_left to_pack [] indexed_texts) in
|
||||
let columns = Msgpck.(List [String "id"; String "title"; String "authors"; String "topics"; String "keywords"]) in
|
||||
let archive = Msgpck.(List [Int 0; String archive.A.name; List (persons archive.A.archivists)]) in
|
||||
Bytes.to_string @@ Msgpck.Bytes.to_string (List [archive; columns; header_pack])
|
||||
|
||||
let index_writer dir archive topic_roots topic_map indexed_texts =
|
||||
let name = archive.A.name in
|
||||
let file path = File_store.file (dir ^ path) in
|
||||
file "/index.pck" (index_pack archive indexed_texts);
|
||||
file "/index.pck" (Header_pack.pack archive indexed_texts);
|
||||
file "/index.html" (Html.topic_main_index name topic_roots indexed_texts);
|
||||
List.iter
|
||||
(fun topic -> file ("/index." ^ topic ^ ".htm") (Html.topic_sub_index name topic_map topic indexed_texts))
|
||||
@ -49,22 +36,24 @@ let index_writer dir archive topic_roots topic_map indexed_texts =
|
||||
|
||||
let convert_all dir archive =
|
||||
let name = archive.A.name in
|
||||
let published_count = A.(fold ~order:newest (writer dir name) 0 (published archive)) in
|
||||
let count = A.(fold ~order:newest (writer dir name) 0 archive) in (*TODO: merge*)
|
||||
let topic_map, indexed_metas =
|
||||
let topic_map = Logarion.Topic_set.Map.empty in
|
||||
let fn (ts,ls) (elt,_) = Logarion.(Topic_set.to_map ts (Text.set "topics" elt)), elt::ls in
|
||||
A.(fold ~order:newest fn (topic_map,[]) (indexed archive)) in
|
||||
let fn (ts,ls) (elt,_) =
|
||||
Logarion.(Topic_set.to_map ts (Text.set "topics" elt)), elt::ls in
|
||||
A.(fold ~order:newest fn (topic_map,[]) archive) in
|
||||
let topic_roots = Logarion.Topic_set.roots topic_map in
|
||||
index_writer dir archive topic_roots topic_map indexed_metas;
|
||||
print_endline @@ "Converted: " ^ string_of_int (published_count) ^ "\nIndexed: " ^ string_of_int (List.length indexed_metas);
|
||||
print_endline @@ "Converted: " ^ string_of_int (count) ^ "\nIndexed: " ^ string_of_int (List.length indexed_metas);
|
||||
Ok ()
|
||||
|
||||
let convert_dir cmd_dir =
|
||||
let (>>=) = Result.bind in
|
||||
let config_dir archive = try Ok (Store.KV.find "Export-Dir" archive.File_store.kv) with Not_found -> Error "unspecified export dir" in
|
||||
let init dir =
|
||||
Result.map_error (function `Msg m -> m) Logarion.File_store.Directory.(directory dir |> print ~descr:"export" dir) in
|
||||
(A.of_path "."
|
||||
Result.map_error (function `Msg m -> m)
|
||||
Logarion.File_store.Directory.(directory dir |> print ~descr:"export" dir) in
|
||||
(A.of_path "."
|
||||
>>= fun archive -> (match cmd_dir with "" -> config_dir archive | x -> Ok x)
|
||||
>>= fun dir -> init dir
|
||||
>>= fun _ -> convert_all dir archive)
|
||||
|
||||
@ -107,7 +107,7 @@ let listing_index topic_map topic_roots path metas =
|
||||
let topic_main_index title topic_roots metas =
|
||||
wrap title "Topics"
|
||||
(fold_topic_roots topic_roots
|
||||
^ "<nav><h2>Recent</h2>" ^ to_dated_links ~limit:5 metas
|
||||
^ "<nav><h2>Latest</h2>" ^ to_dated_links ~limit:5 metas
|
||||
^ {|<br/><a href="index.date.html">More by date</a></nav>|} )
|
||||
|
||||
let topic_sub_index title topic_map topic_root metas =
|
||||
|
||||
@ -37,27 +37,35 @@ let list_term =
|
||||
Term.(const text_list $ field $ authors $ keywords $ topics),
|
||||
Term.info "list" ~doc:"list texts" ~man:[ `S "DESCRIPTION"; `P "List texts in Logarion archive" ]
|
||||
|
||||
let publish and_index files = match A.of_path "." with
|
||||
let split_filetypes files =
|
||||
let acc (dirs, files) x = if Sys.is_directory x then (x::dirs, files) else (dirs, x::files) in
|
||||
List.fold_left acc ([],[]) files
|
||||
|
||||
let file files = match A.of_path "." with
|
||||
| Error msg -> prerr_endline msg
|
||||
| Ok archive -> File_store.(list_iter (if and_index then index else publish) archive files)
|
||||
| Ok _archive ->
|
||||
let dirs, files = split_filetypes files in
|
||||
let link dir file = Unix.link file (dir ^"/"^ file) in
|
||||
List.iter (fun d -> List.iter (link d) files) dirs
|
||||
|
||||
let publish_term =
|
||||
let file_term =
|
||||
let files = Arg.(value & pos_all string [] & info [] ~doc:"filenames") in
|
||||
let index = Arg.(value & flag & info ["i"; "index"] ~doc:"Also index") in
|
||||
let doc = "publish notes; it will become available in exports and for distribution" in
|
||||
let doc = "file texts in directories" in
|
||||
let man = [ `S "DESCRIPTION"; `P doc ] in
|
||||
Term.(const publish $ index $ files), Term.info "publish" ~doc ~man
|
||||
Term.(const file $ files), Term.info "file" ~doc ~man
|
||||
|
||||
let deindex and_unpub files = match A.of_path "." with
|
||||
let unfile files = match A.of_path "." with
|
||||
| Error msg -> prerr_endline msg
|
||||
| Ok archive -> File_store.(list_iter (if and_unpub then unpublish else deindex) archive files)
|
||||
| Ok _archive ->
|
||||
let dirs, files = split_filetypes files in
|
||||
let unlink dir file = try Unix.unlink (dir ^"/"^ file) with Unix.(Unix_error(ENOENT,_,_))-> () in
|
||||
List.iter (fun d -> List.iter (unlink d) files) dirs
|
||||
|
||||
let deindex_term =
|
||||
let unfile_term =
|
||||
let files = Arg.(value & pos_all string [] & info [] ~doc:"filenames") in
|
||||
let unpub = Arg.(value & flag & info ["u"; "unpublish"] ~doc:"Also unpublish") in
|
||||
let doc = "deindex; it will disappear from indices" in
|
||||
let doc = "unfile texts from directories" in
|
||||
let man = [ `S "DESCRIPTION"; `P doc ] in
|
||||
Term.(const deindex $ unpub $ files), Term.info "deindex" ~doc ~man
|
||||
Term.(const unfile $ files), Term.info "unfile" ~doc ~man
|
||||
|
||||
let init _force = File_store.init ()
|
||||
|
||||
@ -69,29 +77,22 @@ let init_term =
|
||||
|
||||
let create_term =
|
||||
let f title topics_opt interactive =
|
||||
match A.of_path "." with
|
||||
| Error m -> prerr_endline m
|
||||
| Ok archive ->
|
||||
let t = match title with "" -> "Draft" | _ -> title in
|
||||
let authors = archive.archivists in
|
||||
let date = Date.({ created = Some (Ptime_clock.now ()); edited = None }) in
|
||||
let text = { (Text.blank ()) with title = t; authors; date } in
|
||||
let text = try Text.with_str_set text "Topics" (Option.get topics_opt) with _ -> text in
|
||||
match File_store.with_text archive text with
|
||||
| Error s -> prerr_endline s
|
||||
| Ok (filepath, _note) ->
|
||||
match interactive with false -> print_endline filepath
|
||||
| true ->
|
||||
print_endline @@ "Created: " ^ filepath;
|
||||
let rec yn () = match read_line () with "y" -> true | "n" -> false
|
||||
| _ -> print_string "y or n? "; flush stdout; yn () in
|
||||
let _code = Sys.command ("$EDITOR " ^ filepath) in
|
||||
print_string "Publish? [yn]: ";
|
||||
match yn () with false -> ()
|
||||
| true ->
|
||||
print_string "Index? [yn]: ";
|
||||
let and_index = yn () in
|
||||
File_store.(list_iter (if and_index then index else publish) archive [filepath])
|
||||
match A.of_path "." with
|
||||
| Error m -> prerr_endline m
|
||||
| Ok archive ->
|
||||
let t = match title with "" -> "Draft" | _ -> title in
|
||||
let authors = archive.archivists in
|
||||
let date = Date.({ created = Some (Ptime_clock.now ()); edited = None }) in
|
||||
let text = { (Text.blank ()) with title = t; authors; date } in
|
||||
let text = try Text.with_str_set text "Topics" (Option.get topics_opt) with _ -> text in
|
||||
match File_store.with_text archive text with
|
||||
| Error s -> prerr_endline s
|
||||
| Ok (filepath, _note) ->
|
||||
match interactive with false -> print_endline filepath
|
||||
| true ->
|
||||
print_endline @@ "Created: " ^ filepath;
|
||||
let _code = Sys.command ("$EDITOR " ^ filepath) in
|
||||
()
|
||||
in
|
||||
let title = Arg.(value & pos 0 string "" & info [] ~docv:"TITLE" ~doc:"Title for new article") in
|
||||
let topics= Arg.(value & opt (some string) None & info ["t"; "topics"] ~docv:"TOPICS" ~doc:"Topics for new article") in
|
||||
@ -104,7 +105,7 @@ let default_cmd =
|
||||
let man = [ `S "BUGS"; `P "Submit bugs <mailto:logarion@lists.orbitalfox.eu?subject=[Issue] summary-here>" ] in
|
||||
Term.(ret (const (`Help (`Pager, None)))), Term.info "logarion" ~version ~doc ~man
|
||||
|
||||
let cmds = [ init_term; create_term; publish_term; deindex_term; list_term; Convert.term ]
|
||||
let cmds = [ init_term; create_term; file_term; unfile_term; list_term; Convert.term ]
|
||||
|
||||
let () =
|
||||
Random.self_init();
|
||||
|
||||
2
lib/dune
2
lib/dune
@ -1,4 +1,4 @@
|
||||
(library
|
||||
(name logarion)
|
||||
(public_name logarion)
|
||||
(libraries ptime uuidm uri re.str bos text_parse text_parse.parsers))
|
||||
(libraries ptime uuidm uri re.str bos text_parse text_parse.parsers msgpck))
|
||||
|
||||
@ -1,12 +1,11 @@
|
||||
type t = string
|
||||
type item_t = string
|
||||
type archive_t = { name: string; archivists: Person.Set.t; id: Id.t;
|
||||
type archive_t = {
|
||||
name: string; archivists: Person.Set.t; id: Id.t;
|
||||
kv: string Store.KV.t; store: t }
|
||||
type record_t = Text.t * item_t
|
||||
|
||||
let extensions = [ ".txt"; ".gmi"; ".md"; ".org" ]
|
||||
let pubdir = "/.logarion/published/"
|
||||
let idxdir = "/.logarion/indexed/"
|
||||
let extensions = [ ".txt" ]
|
||||
|
||||
let to_string f =
|
||||
let ic = open_in f in
|
||||
@ -16,45 +15,24 @@ let to_string f =
|
||||
close_in ic;
|
||||
Bytes.to_string s
|
||||
|
||||
let file path content = let out = open_out path in
|
||||
output_string out content; close_out out
|
||||
|
||||
let (//) a b = a ^ "/" ^ b
|
||||
|
||||
let to_text dir filename = let f = dir // filename in
|
||||
to_string f |> Text.of_string |> Result.map_error (fun m -> f^": "^m)
|
||||
let text_filetype dir name =
|
||||
try Fpath.(let v = v name in mem_ext extensions v || (not (exists_ext v) && not (Sys.is_directory @@ dir^"/"^name)))
|
||||
with Invalid_argument str -> prerr_endline ("file: " ^ name ^ " invalid (" ^ str ^ ")"); false
|
||||
|
||||
let clean_unlinked dir filepath =
|
||||
let file = dir ^ filepath in
|
||||
match (Unix.lstat file).st_nlink with 1 -> Unix.unlink file | _ -> ()
|
||||
| exception Unix.Unix_error(Unix.ENOENT,_,_) -> ()
|
||||
|
||||
let purged_substore archive subdir =
|
||||
let store = archive.store ^ subdir in
|
||||
Array.iter (clean_unlinked store) @@ Sys.readdir store;
|
||||
{ archive with store }
|
||||
|
||||
let published archive = purged_substore archive pubdir
|
||||
let indexed archive = purged_substore archive idxdir
|
||||
|
||||
let publish dir text file =
|
||||
try Unix.link file (dir ^ pubdir ^ Id.to_string text.Text.uuid)
|
||||
with Unix.Unix_error(Unix.EEXIST,_,_) -> ()
|
||||
let deindex dir text _file =
|
||||
try Unix.unlink (dir ^ idxdir ^ Id.to_string text.Text.uuid)
|
||||
with Unix.Unix_error(Unix.ENOENT,_,_) -> ()
|
||||
let unpublish dir text file =
|
||||
deindex dir text file;
|
||||
try Unix.unlink (dir ^ pubdir ^ Id.to_string text.Text.uuid)
|
||||
with Unix.Unix_error(Unix.ENOENT,_,_) -> ()
|
||||
let index dir text file =
|
||||
publish dir text file;
|
||||
try Unix.link file (dir ^ idxdir ^ Id.to_string text.Text.uuid)
|
||||
with Unix.Unix_error(Unix.EEXIST,_,_) -> ()
|
||||
let text_filetype dir name = try
|
||||
let open Fpath in
|
||||
let v = v name in
|
||||
mem_ext extensions v && not (Sys.is_directory @@ dir^"/"^name)
|
||||
with Invalid_argument str ->
|
||||
prerr_endline ("file: " ^ name ^ " invalid (" ^ str ^ ")"); false
|
||||
|
||||
let newest (a,_pa) (b,_pb) = Text.newest a b
|
||||
let oldest (a,_pa) (b,_pb) = Text.oldest a b
|
||||
|
||||
|
||||
let list_iter fn {store;_} paths =
|
||||
let link f = match to_text store f with Ok t -> fn store t f | Error s -> prerr_endline s in
|
||||
List.iter link paths
|
||||
@ -135,8 +113,6 @@ let uuid_filename repo extension text =
|
||||
let candidate = repo // String.sub (Id.to_string text.uuid) 0 6 ^ "." ^ basename ^ extension in
|
||||
if Sys.file_exists candidate then Error "Name clash, try again" else Ok candidate
|
||||
|
||||
let file path content = let out = open_out path in output_string out content; close_out out
|
||||
|
||||
let with_text {store;_} new_text =
|
||||
let extension = List.hd extensions in
|
||||
Result.bind (uuid_filename store extension new_text) @@
|
||||
|
||||
59
lib/header_pack.ml
Normal file
59
lib/header_pack.ml
Normal file
@ -0,0 +1,59 @@
|
||||
let persons ps =
|
||||
let add x a = Msgpck.String (Person.to_string x) :: a in
|
||||
List.rev @@ Person.Set.fold add ps []
|
||||
|
||||
let of_set field t =
|
||||
let add x a = Msgpck.String x :: a in
|
||||
List.rev @@ String_set.fold add (Text.set field t) []
|
||||
|
||||
let to_pack a t =
|
||||
let open Text in
|
||||
Msgpck.(List [Bytes (Id.to_bytes t.uuid); String t.title; List (persons t.authors);
|
||||
List (of_set "topics" t); List (of_set "keywords" t)]) :: a
|
||||
|
||||
let pack_filename ?(filename="index.pck") archive =
|
||||
let dir = Store.KV.find "Export-Dir" archive.File_store.kv in (*raises Not_found*)
|
||||
dir ^ "/" ^ filename
|
||||
|
||||
let with_info fn = let open Msgpck in function
|
||||
| Msgpck.List (v::n::a) -> fn (to_int v) (to_string n) a
|
||||
| _ -> invalid_arg "Pack header"
|
||||
|
||||
let list filename = try
|
||||
let texts_list = function
|
||||
| Msgpck.List (_info :: _fields :: [texts]) -> Msgpck.to_list texts
|
||||
| _ -> prerr_endline "malformed feed"; [] in
|
||||
let _pos, data = Msgpck.StringBuf.read @@ File_store.to_string filename in
|
||||
Ok (texts_list data)
|
||||
with Not_found -> Error "unspecified export dir"
|
||||
|
||||
let contains text = function
|
||||
| Msgpck.List (id::title::_authors::_topics::_keywords) ->
|
||||
(match Id.of_bytes (Msgpck.to_bytes id) with
|
||||
| None -> prerr_endline ("Invalid id for " ^ Msgpck.to_string title); false
|
||||
| Some id -> text.Text.uuid = id)
|
||||
| _ -> prerr_endline ("Invalid record pattern"); false
|
||||
|
||||
let columns = Msgpck.(List [String "id"; String "title"; String "authors";
|
||||
String "topics"; String "keywords"])
|
||||
|
||||
let pack archive records =
|
||||
let header_pack = List.fold_left to_pack [] records in
|
||||
let archive = Msgpck.(List [Int 0; String archive.File_store.name;
|
||||
List (persons archive.archivists)]) in
|
||||
Bytes.to_string @@ Msgpck.Bytes.to_string (List [archive; columns;
|
||||
Msgpck.List header_pack])
|
||||
|
||||
let add archive records =
|
||||
let fname = pack_filename archive in
|
||||
let append_fn published (t, _f) =
|
||||
if List.exists (contains t) published then published
|
||||
else to_pack published t in
|
||||
match list fname with Error e -> prerr_endline e | Ok published_list ->
|
||||
let header_pack = List.fold_left append_fn published_list records in
|
||||
let archive = Msgpck.(List [Int 0; String archive.File_store.name;
|
||||
List (persons archive.archivists)]) in
|
||||
File_store.file fname @@ Bytes.to_string @@ Msgpck.Bytes.to_string (List
|
||||
[archive; columns; Msgpck.List header_pack])
|
||||
|
||||
let unpublish _archive _records = ()
|
||||
@ -3,11 +3,9 @@ module KV = Map.Make (String)
|
||||
module type T = sig
|
||||
type t
|
||||
type item_t
|
||||
type archive_t = { name : string; archivists : Person.Set.t; id : Id.t; kv : string KV.t; store : t }
|
||||
type archive_t = { name: string; archivists: Person.Set.t; id: Id.t; kv: string KV.t; store: t }
|
||||
type record_t = Text.t * item_t
|
||||
val of_path: string -> (archive_t, string) result
|
||||
val published: archive_t -> archive_t
|
||||
val indexed: archive_t -> archive_t
|
||||
val newest: record_t -> record_t -> int
|
||||
val oldest: record_t -> record_t -> int
|
||||
val with_id: archive_t -> Id.t -> (Text.t option, Text.t list) result
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user