blob: ae01271f5653eefc4d9c6c7db4d18d5c427c378d (
plain)
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
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
|
(.require
[library
[lux (.except)
[abstract
[monad (.only do)]
[codec (.only Codec)]
[equivalence (.only Equivalence)]
[order (.only Order)]]
[control
["<>" parser (.only)]
["[0]" try (.only Try)]
["[0]" exception (.only exception)]]
[data
["[0]" text (.use "[1]#[0]" monoid)
["<[1]>" \\parser (.only Parser)]]]
[math
[number
["n" nat (.use "[1]#[0]" decimal)]
["i" int (.use "[1]#[0]" decimal)]]]
[meta
[type
[primitive (.except)]]]]])
(def (internal year)
(-> Int Int)
(if (i.< +0 year)
(++ year)
year))
(def (external year)
(-> Int Int)
(if (i.> +0 year)
year
(-- year)))
(exception .public there_is_no_year_0)
... https://en.wikipedia.org/wiki/Gregorian_calendar
(primitive .public Year
Int
(def .public (year value)
(-> Int (Try Year))
(when value
+0 (exception.except ..there_is_no_year_0 [])
_ {try.#Success (abstraction (..internal value))}))
(def .public value
(-> Year Int)
(|>> representation ..external))
(def .public epoch
Year
(abstraction +1970))
)
(def .public days
Nat
365)
(type .public Period
Nat)
(with_template [<period> <name>]
[(def .public <name>
Period
<period>)]
[004 leap]
[100 century]
[400 era]
)
(def (divisible? factor input)
(-> Int Int Bit)
(|> input (i.% factor) (i.= +0)))
... https://en.wikipedia.org/wiki/Leap_year#Algorithm
(def .public (leap? year)
(-> Year Bit)
(let [year (|> year ..value ..internal)]
(and (..divisible? (.int ..leap) year)
(or (not (..divisible? (.int ..century) year))
(..divisible? (.int ..era) year)))))
(def (with_year_0_leap year days)
(let [after_year_0? (i.> +0 year)]
(if after_year_0?
(i.+ +1 days)
days)))
(def .public (leaps year)
(-> Year Int)
(let [year (|> year ..value ..internal)
limit (if (i.> +0 year)
(-- year)
(++ year))]
(`` (|> +0
(,, (with_template [<polarity> <years>]
[(<polarity> (i./ (.int <years>) limit))]
[i.+ ..leap]
[i.- ..century]
[i.+ ..era]
))
(..with_year_0_leap year)))))
(def (encoded year)
(-> Year Text)
(let [year (..value year)]
(if (i.< +0 year)
(i#encoded year)
(n#encoded (.nat year)))))
(def .public parser
(Parser Year)
(do [! <>.monad]
[sign (<>.or (<text>.this "-") (in []))
digits (<text>.many <text>.decimal)
raw_year (<>.codec i.decimal (in (text#composite "+" digits)))]
(<>.lifted (..year (when sign
{.#Left _} (i.* -1 raw_year)
{.#Right _} raw_year)))))
(def .public codec
(Codec Text Year)
(implementation
(def encoded ..encoded)
(def decoded (<text>.result ..parser))))
(def .public equivalence
(Equivalence Year)
(implementation
(def (= reference subject)
(i.= (..value reference) (..value subject)))))
(def .public order
(Order Year)
(implementation
(def equivalence ..equivalence)
(def (< reference subject)
(i.< (..value reference) (..value subject)))))
|
