1 | module Id = Meta.Id
|
---|
2 | type alias_t = string
|
---|
3 |
|
---|
4 | module Configuration = struct
|
---|
5 | type t = {
|
---|
6 | repository : Lpath.repo_t;
|
---|
7 | title : string;
|
---|
8 | owner : string;
|
---|
9 | email : string;
|
---|
10 | id : Id.t;
|
---|
11 | }
|
---|
12 |
|
---|
13 | let of_config config =
|
---|
14 | let open Confix in
|
---|
15 | let open Confix.Config in
|
---|
16 | let str k = ConfixToml.(string config ("archive" / k)) in
|
---|
17 | try
|
---|
18 | Ok {
|
---|
19 | repository =
|
---|
20 | (try Lpath.repo_of_string (str "repository" |> with_default ".")
|
---|
21 | with
|
---|
22 | | Invalid_argument s -> failwith ("Invalid repository: " ^ s)
|
---|
23 | | Failure s -> failwith ("Missing repository value: " ^ s));
|
---|
24 | title = str "title" |> with_default "";
|
---|
25 | owner = str "owner" |> with_default "";
|
---|
26 | email = str "email" |> with_default "";
|
---|
27 | id = match Id.of_string (str "uuid" |> mandatory) with Some id -> id | None -> failwith "Invalid UUID in config";
|
---|
28 | }
|
---|
29 | with Failure str -> Error str
|
---|
30 |
|
---|
31 | let validity config =
|
---|
32 | let repo = Lpath.fpath_of_repo config.repository in
|
---|
33 | let open Confix.Config.Validation in
|
---|
34 | empty
|
---|
35 | &> is_directory repo
|
---|
36 | end
|
---|
37 |
|
---|
38 | module AliasMap = Meta.AliasMap
|
---|
39 |
|
---|
40 | module Make (Store : Store.T) = struct
|
---|
41 | type t = {
|
---|
42 | config : Configuration.t;
|
---|
43 | store : Store.t;
|
---|
44 | }
|
---|
45 |
|
---|
46 | let note_lens note = note
|
---|
47 | let meta_lens note = note.Note.meta
|
---|
48 |
|
---|
49 | let recency_order a b = Meta.(Date.compare a.date b.date)
|
---|
50 |
|
---|
51 | let latest archive =
|
---|
52 | Store.to_list ~order:recency_order meta_lens archive.store
|
---|
53 |
|
---|
54 | let listed archive =
|
---|
55 | let notes = Store.to_list meta_lens archive.store in
|
---|
56 | List.filter Meta.(fun e -> CategorySet.listed e.categories) notes
|
---|
57 |
|
---|
58 | let published archive =
|
---|
59 | let notes = Store.to_list meta_lens archive.store in
|
---|
60 | List.filter Meta.(fun e -> CategorySet.published e.categories) notes
|
---|
61 |
|
---|
62 | let latest_listed archive =
|
---|
63 | let notes = Store.to_list ~order:recency_order meta_lens archive.store in
|
---|
64 | List.filter Meta.(fun e -> CategorySet.listed e.categories) notes
|
---|
65 |
|
---|
66 | let with_topic archive topic =
|
---|
67 | let notes = Store.to_list ~order:recency_order meta_lens archive.store in
|
---|
68 | List.filter Meta.(fun e -> StringSet.exists (fun t -> t = topic) e.topics) notes
|
---|
69 |
|
---|
70 | let topics archive =
|
---|
71 | let notes = Store.to_list meta_lens archive.store in
|
---|
72 | List.fold_left Meta.(fun a e -> unique_topics a e) Meta.StringSet.empty notes
|
---|
73 |
|
---|
74 | let latest_entry archive fragment =
|
---|
75 | let notes = Store.to_list ~order:recency_order meta_lens archive.store in
|
---|
76 | let containing_fragment e = Re.Str.(string_match (regexp fragment)) (e.Meta.title) 0 in
|
---|
77 | try Some (List.find containing_fragment notes)
|
---|
78 | with Not_found -> None
|
---|
79 |
|
---|
80 | let note_with_id archive id = Store.note_with_id archive.store id
|
---|
81 | let note_with_alias archive alias = Store.note_with_alias archive.store alias
|
---|
82 |
|
---|
83 | let with_note archive note = Store.with_note archive.store note
|
---|
84 |
|
---|
85 | let sublist ~from ~n list =
|
---|
86 | let aggregate_subrange (i, elms) e = succ i, if i >= from && i <= n then e::elms else elms in
|
---|
87 | List.fold_left aggregate_subrange (0, []) list |> snd
|
---|
88 |
|
---|
89 | end
|
---|