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
(** *)
open Types;;
module XR = Xtmpl.Rewrite
let docs ?set ?setname ?filter ?typ ?max ?(reverse=true) ?(sort=[]) stog env =
let docs =
match set with
Some set ->
let l = Types.Doc_set.elements set in
List.map (fun id -> (id, Types.doc stog id)) l
| None ->
Types.doc_list ?set: setname stog
in
let (stog, docs) =
match filter with
None -> (stog, docs)
| Some filter -> Filter.filter_docs stog env filter docs
in
let docs =
match typ with
| None | Some [] -> docs
| Some types ->
List.filter (fun (_,doc) -> List.mem doc.doc_type types) docs
in
let (stog, docs) =
match sort with
[] -> (stog, Types.sort_ids_docs_by_date docs)
| fields ->
let (stog, docs) = List.fold_left
(fun (stog, acc) (id, e) ->
let (stog, env) = Engine.doc_env stog env stog e in
(stog, ((id, e, env) :: acc))
)
(stog, [])
docs
in
Types.sort_ids_docs_by_rules stog fields docs
in
let docs = if reverse then List.rev docs else docs in
let docs =
match max with
None -> docs
| Some n -> Stog_base.Misc.list_chop n docs
in
(stog, docs)
;;
let docs_of_args ?set stog env args =
let setname = XR.get_att_cdata args ("", "set") in
let filter =
Stog_base.Misc.map_opt
Filter.filter_of_string
(XR.get_att_cdata args ("", "filter"))
in
let typ =
match XR.get_att_cdata args ("", "type") with
None | Some "" -> None
| Some s ->
Some (Stog_base.Misc.split_string s [',' ; ';'])
in
let max = Stog_base.Misc.map_opt int_of_string
(XR.get_att_cdata args ("", "max"))
in
let reverse =
match XR.get_att_cdata args ("", "reverse") with
None -> true
| Some s -> Io.bool_of_string s
in
let sort =
match XR.get_att_cdata args ("", "sort") with
None -> None
| Some s -> Some (Stog_base.Misc.split_string s [','])
in
docs ?set ?setname ?filter ?typ ?max ~reverse ?sort stog env
;;