blob: d4331ba8295924f50aabdee1d42ee29871202e33 (
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
144
|
(.module:
[library
[lux #*
[abstract
[monad (#+ do)]
[codec (#+ Codec)]
[equivalence (#+ Equivalence)]
[order (#+ Order)]]
[control
["." try (#+ Try)]
["." exception (#+ exception:)]
["<>" parser
["<t>" text (#+ Parser)]]]
[data
["." text ("#\." monoid)]]
[math
[number
["n" nat ("#\." decimal)]
["i" int ("#\." decimal)]]]
[type
abstract]]])
(def: (internal year)
(-> Int Int)
(if (i.< +0 year)
(inc year)
year))
(def: (external year)
(-> Int Int)
(if (i.> +0 year)
year
(dec year)))
(exception: .public there_is_no_year_0)
(abstract: .public Year
{}
Int
(def: .public (year value)
(-> Int (Try Year))
(case 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
365)
(type: .public Period
Nat)
(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)
(dec year)
(inc year))]
(`` (|> +0
(~~ (template [<polarity> <years>]
[(<polarity> (i./ (.int <years>) limit))]
[i.+ ..leap]
[i.- ..century]
[i.+ ..era]
))
(..with_year_0_leap year)))))
(def: (encode year)
(-> Year Text)
(let [year (..value year)]
(if (i.< +0 year)
(i\encode year)
(n\encode (.nat year)))))
(def: .public parser
(Parser Year)
(do {! <>.monad}
[sign (<>.or (<t>.this "-") (in []))
digits (<t>.many <t>.decimal)
raw_year (<>.codec i.decimal (in (text\compose "+" digits)))]
(<>.lift (..year (case sign
(#.Left _) (i.* -1 raw_year)
(#.Right _) raw_year)))))
(implementation: .public codec
{#.doc (doc "Based on ISO 8601."
"For example: 2017")}
(Codec Text Year)
(def: encode ..encode)
(def: decode (<t>.run ..parser)))
(implementation: .public equivalence
(Equivalence Year)
(def: (= reference subject)
(i.= (..value reference) (..value subject))))
(implementation: .public order
(Order Year)
(def: &equivalence ..equivalence)
(def: (< reference subject)
(i.< (..value reference) (..value subject))))
|
