src/folio/query.sgl

1;;; (folio query) - Cross-file queries and status overview.

2;;;

3;;; Aggregation and filtering across all projects, inbox, and notes.

5(define-library (folio query)

6 (import (sigil struct)

7 (sigil string)

8 (sigil list)

9 (sigil dict)

10 (sigil fs)

11 (sigil time)

12 (folio store)

13 (folio task)

14 (folio id)

15 (folio inbox)

16 (folio project)

17 (folio note)

18 (folio index)

19 (folio links))

20 (export all-tasks

21 filter-tasks

22 folio-status)

23 (begin

25 ;;; Collect all tasks from inbox and all projects.

26 ;;;

27 ;;; Each task has source-file set so you can trace its origin.

28 (define (all-tasks store)

29 (: folio-store? -> list?)

30 (let* ((inbox-tasks (read-inbox store))

31 (project-files (store-project-files store))

32 (project-tasks

33 (apply append

34 (map (lambda (f)

35 (folio-project-tasks (read-project-cached f)))

36 project-files))))

37 (append inbox-tasks project-tasks)))

39 ;;; Filter tasks by status, priority, project, due-before, and tag.

40 ;;;

41 ;;; All parameters are optional; #f means no filter.

42 (define (filter-tasks tasks status priority project-name due-before tag)

43 (: list? (maybe string?) (maybe string?) (maybe string?) (maybe string?) (maybe string?) -> list?)

44 (filter

45 (lambda (task)

46 (and

47 ;; Status filter

48 (or (not status)

49 (cond

50 ((equal? status "open") (not (folio-task-done? task)))

51 ((equal? status "done") (folio-task-done? task))

52 (else #t)))

53 ;; Priority filter

54 (or (not priority)

55 (equal? priority (task-priority task)))

56 ;; Project filter (by source file basename)

57 (or (not project-name)

58 (let ((src (folio-task-source-file task)))

59 (and src

60 (string-contains? src

61 (string-append project-name ".md")))))

62 ;; Due-before filter

63 (or (not due-before)

64 (let ((due (task-due task)))

65 (and due (string<=? due due-before))))

66 ;; Tag filter (matches literal tags OR the task's source project name —

67 ;; so `--tag sigil-0130` finds project membership, not just tag matches)

68 (or (not tag)

69 (member tag (task-tags task))

70 (let ((src (folio-task-source-file task)))

71 (and src

72 (string-contains? src

73 (string-append tag ".md")))))))

74 tasks))

76 ;;; Compute a folio status overview.

77 ;;;

78 ;;; Returns a dict with inbox count, overdue tasks, active/stale projects,

79 ;;; recent notes, and orphaned notes.

80 (define (folio-status store . opts)

81 (: folio-store? -> dict?)

82 (let* ((idx (and (pair? opts) (car opts)))

83 (inbox-tasks (read-inbox store))

84 (projects (all-projects store))

85 (active-projects (filter (lambda (p)

86 (equal? (project-status p) "active"))

87 projects))

88 (today (format-date (current-second)))

89 (tasks (all-tasks store))

90 (overdue (filter (lambda (t)

91 (and (not (folio-task-done? t))

92 (let ((due (task-due t)))

93 (and due (string<? due today)))))

94 tasks))

95 (notes (if idx (index-note-summaries idx) (all-notes store)))

96 (derived (if idx

97 (recent-and-orphaned notes (index-orphan-names idx))

98 (list (take-up-to (sort-by-last-updated notes) 5)

99 (find-orphaned-notes store notes))))

100 (recent-notes (car derived))

101 ;; Stale projects: active but last-updated > 14 days ago

102 (stale-projects

103 (filter (lambda (p)

104 (let ((lu (dict-ref (folio-project-frontmatter p)

105 last-updated: #f)))

106 (and lu (days-ago? lu 14 today))))

107 active-projects))

108 ;; Orphaned notes: no incoming or outgoing links

109 (orphaned (cadr derived)))

110 (dict inbox-count: (length inbox-tasks)

111 overdue-count: (length overdue)

112 overdue-tasks: overdue

113 active-project-count: (length active-projects)

114 active-projects: active-projects

115 stale-project-count: (length stale-projects)

116 stale-projects: stale-projects

117 recent-notes: recent-notes

118 orphaned-note-count: (length orphaned)

119 orphaned-notes: orphaned

120 total-tasks: (length tasks)

121 total-notes: (length notes))))

122

123 ;; Sorting every summary and filtering the orphans is most of what status

124 ;; costs once the index answers are cached. The index hands back the same

125 ;; list objects while nothing changed, so the derived lists are kept for

126 ;; exactly those objects (eq?), and any change yields new ones.

127 (define status-derived (vector #f))

128

129 (define (recent-and-orphaned notes orphan-names)

130 (let ((memo (vector-ref status-derived 0)))

131 (if (and memo (eq? (car memo) notes) (eq? (cadr memo) orphan-names))

132 (cddr memo)

133 (let* ((names (dict))

134 (_ (for-each (lambda (name) (set! names (dict-set names name #t)))

135 orphan-names))

136 (derived (list (take-up-to (sort-by-last-updated notes) 5)

137 (filter (lambda (note)

138 (dict-contains? names (folio-note-name note)))

139 notes))))

140 (vector-set! status-derived 0 (cons notes (cons orphan-names derived)))

141 derived))))

142

143 ;; Check if a date string is more than N days before today.

144 (define (days-ago? date-str n today-str)

145 (let ((cutoff (n-days-before-today n)))

146 (string<? date-str cutoff)))

147

148 ;; Get the date N days before today as YYYY-MM-DD.

149 ;; Uses real timestamp arithmetic via (sigil time).

150 (define (n-days-before-today n)

151 (format-date (- (current-second) (* n 86400))))

152

153 ;; Sort notes by last-updated (most recent first).

154 (define (sort-by-last-updated notes)

155 (list-sort (lambda (a b)

156 (let ((a-date (or (dict-ref (folio-note-frontmatter a) last-updated: #f) ""))

157 (b-date (or (dict-ref (folio-note-frontmatter b) last-updated: #f) "")))

158 (string>? a-date b-date)))

159 notes))

160

161 ;; Take up to n items from a list.

162 (define (take-up-to lst n)

163 (if (or (null? lst) (<= n 0))

164 '()

165 (cons (car lst) (take-up-to (cdr lst) (- n 1)))))))