aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/program/aedifex/artifact/time/date.lux
blob: 31a2f0f2af23723391f19fc9a90f94c0ff89e7d6 (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
(.using
 [library
  [lux (.except)
   [abstract
    [monad (.only do)]
    [equivalence (.only Equivalence)]]
   [control
    ["[0]" try (.only Try)]
    ["[0]" exception (.only exception:)]
    ["<>" parser
     ["<[0]>" text (.only Parser)]]]
   [data
    [text
     ["%" format]]]
   [math
    [number
     ["n" nat]
     ["i" int]]]
   [time
    ["[0]" date (.open: "[1]#[0]" equivalence)]
    ["[0]" year]
    ["[0]" month]]
   [type
    [primitive (.except)]]]])

(def: .public (pad value)
  (-> Nat Text)
  (if (n.< 10 value)
    (%.format "0" (%.nat value))
    (%.nat value)))

(def: min_year +1,000)
(def: max_year +9,999)

(exception: .public (year_is_out_of_range [year year.Year])
  (exception.report
   "Minimum" (%.int ..min_year)
   "Maximum" (%.int ..max_year)
   "Year" (%.int (year.value year))))

(primitive: .public Date
  date.Date

  (def: .public epoch
    Date
    (abstraction date.epoch))

  (def: .public (date raw)
    (-> date.Date (Try Date))
    (let [year (|> raw date.year year.value)]
      (if (or (i.< ..min_year year)
              (i.> ..max_year year))
        (exception.except ..year_is_out_of_range [(date.year raw)])
        {try.#Success (abstraction raw)})))

  (def: .public value
    (-> Date date.Date)
    (|>> representation))

  (implementation: .public equivalence
    (Equivalence Date)

    (def: (= reference subject)
      (date#= (representation reference)
              (representation subject))))

  (def: .public (format value)
    (%.Format Date)
    (%.format (|> value representation date.year year.value .nat %.nat)
              (|> value representation date.month month.number ..pad)
              (|> value representation date.day_of_month ..pad)))

  (def: .public parser
    (Parser Date)
    (do <>.monad
      [year (<>.codec n.decimal (<text>.exactly 4 <text>.decimal))
       year (<>.lifted (year.year (.int year)))
       month (<>.codec n.decimal (<text>.exactly 2 <text>.decimal))
       month (<>.lifted (month.by_number month))
       day_of_month (<>.codec n.decimal (<text>.exactly 2 <text>.decimal))
       date (<>.lifted (date.date year month day_of_month))]
      (in (abstraction date)))))