aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/lux/control/remember.lux
blob: 24bdacb037540bfcba9e2b9126acf6403fe81e65 (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
(.module:
  [lux #*
   [abstract
    [monad (#+ do)]]
   [control
    ["." io]
    ["." try]
    ["." exception (#+ exception:)]
    ["<>" parser ("#@." functor)
     ["<c>" code (#+ Parser)]]]
   [data
    ["." text
     ["%" format (#+ format)]]]
   [time
    ["." instant]
    ["." date (#+ Date) ("#@." order)]]
   ["." macro
    ["." code]
    [syntax (#+ syntax:)]]])

(exception: #export (must-remember {deadline Date} {today Date} {message Text} {focus (Maybe Code)})
  (exception.report
   ["Deadline" (%.date deadline)]
   ["Today" (%.date today)]
   ["Message" message]
   ["Code" (case focus
             (#.Some focus)
             (%.code focus)

             #.None
             "")]))

(def: deadline
  (Parser Date)
  ($_ <>.either
      (<>@map (|>> instant.from-millis instant.date)
              <c>.int)
      (do <>.monad
        [raw <c>.text]
        (case (:: date.codec decode raw)
          (#try.Success date)
          (wrap date)
          
          (#try.Failure message)
          (<>.fail message)))))

(syntax: #export (remember {deadline ..deadline} {message <c>.text} {focus (<>.maybe <c>.any)})
  (let [now (io.run instant.now)
        today (instant.date now)]
    (if (date@< deadline today)
      (wrap (case focus
              (#.Some focus)
              (list focus)

              #.None
              (list)))
      (macro.fail (exception.construct ..must-remember [deadline today message focus])))))

(template [<name> <message>]
  [(syntax: #export (<name> {deadline ..deadline} {message <c>.text} {focus (<>.maybe <c>.any)})
     (wrap (list (` (..remember (~ (code.text (%.date deadline)))
                      (~ (code.text (format <message> " " message)))
                      (~+ (case focus
                            (#.Some focus)
                            (list focus)

                            #.None
                            (list))))))))]

  [to-do  "TODO"]
  [fix-me "FIXME"]
  )