-
Notifications
You must be signed in to change notification settings - Fork 1
/
path.ss
95 lines (80 loc) · 3.21 KB
/
path.ss
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
#lang scheme/base
(require "base.ss")
(require "struct.ss")
; Filenames --------------------------------------
; [#:relative-to (U path #f)]
; [#:absolute? boolean]
; ->
; path
(define (content-types-path #:relative-to [relative-to-path #f] #:absolute? [absolute? #f])
(format-path (build-path "[Content_Types].xml")
#:relative-to relative-to-path
#:absolute? absolute?))
; [#:relative-to (U path #f)]
; [#:absolute? boolean]
; ->
; path
(define (package-relationships-path #:relative-to [relative-to-path #f] #:absolute? [absolute? #f])
(format-path (build-path "_rels/.rels")
#:relative-to relative-to-path
#:absolute? absolute?))
; workbook
; [#:relative-to (U path #f)]
; [#:absolute? boolean]
; ->
; path
(define (workbook-relationships-path book #:relative-to [relative-to-path #f] #:absolute? [absolute? #f])
(format-path (build-path "xl/_rels/workbook.xml.rels")
#:relative-to relative-to-path
#:absolute? absolute?))
; workbook
; [#:relative-to (U path #f)]
; [#:absolute? boolean]
; ->
; path
(define (stylesheet-path book #:relative-to [relative-to-path #f] #:absolute? [absolute? #f])
(format-path (build-path "xl/styles.xml")
#:relative-to relative-to-path
#:absolute? absolute?))
; package-part
; [#:relative-to (U path #f)]
; [#:absolute? boolean]
; ->
; path
(define (package-part-path part #:relative-to [relative-to-path #f] #:absolute? [absolute? #f])
(format-path (match part
[(? workbook? part) (workbook-path part)]
[(? worksheet? part) (worksheet-path part)])
#:relative-to relative-to-path
#:absolute? absolute?))
; Helpers ----------------------------------------
; path
; [#:relative-to (U path #f)]
; [#:absolute? boolean]
; ->
; path
(define (format-path complete-path #:relative-to [relative-to-path #f] #:absolute? [absolute? #f])
(let ([relative-path (if relative-to-path
(find-relative-path
(build-path "/" relative-to-path)
(build-path "/" complete-path))
complete-path)])
(if absolute?
(build-path "/" relative-path)
relative-path)))
; workbook -> relative-path
(define (workbook-path book)
(build-path "xl" "workbook.xml"))
; worksheet -> relative-path
(define (worksheet-path sheet)
(build-path "xl/worksheets" (format "~a.xml" (package-part-id sheet))))
; Provide statements -----------------------------
; contract
(define relative-path/c
(and/c path? relative-path?))
(provide/contract
[content-types-path (->* () (#:relative-to (or/c relative-path/c #f) #:absolute? boolean?) path?)]
[package-relationships-path (->* () (#:relative-to (or/c relative-path/c #f) #:absolute? boolean?) path?)]
[workbook-relationships-path (->* (workbook?) (#:relative-to (or/c relative-path/c #f) #:absolute? boolean?) path?)]
[stylesheet-path (->* (workbook?) (#:relative-to (or/c relative-path/c #f) #:absolute? boolean?) path?)]
[package-part-path (->* (package-part?) (#:relative-to (or/c relative-path/c #f) #:absolute? boolean?) path?)])