aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--lux-mode/lux-mode.el4
-rw-r--r--stdlib/source/lux/control/remember.lux67
-rw-r--r--stdlib/source/lux/time/date.lux75
3 files changed, 111 insertions, 35 deletions
diff --git a/lux-mode/lux-mode.el b/lux-mode/lux-mode.el
index 45fbb75ec..970bd89bb 100644
--- a/lux-mode/lux-mode.el
+++ b/lux-mode/lux-mode.el
@@ -263,7 +263,8 @@ Called by `imenu--generic-function'."
(jvm-host (altRE "class:" "interface:" "import:" "object" "do-to" "synchronized" "class-for"))
(alternative-format (altRE "char" "bin" "oct" "hex"))
(documentation (altRE "doc" "comment"))
- (function-application (altRE "|>" "|>>" "<|" "<<|" "_\\$" "\\$_")))
+ (function-application (altRE "|>" "|>>" "<|" "<<|" "_\\$" "\\$_"))
+ (remember (altRE "remember" "to-do" "fix-me")))
(let ((control (altRE control//flow
control//pattern-matching
control//logic
@@ -293,6 +294,7 @@ Called by `imenu--generic-function'."
alternative-format
documentation
function-application
+ remember
;;;;;;;;;;;;;;;;;;;;;;;;
"\\.module:"
"def:" "type:" "program:" "context:"
diff --git a/stdlib/source/lux/control/remember.lux b/stdlib/source/lux/control/remember.lux
new file mode 100644
index 000000000..a355a705b
--- /dev/null
+++ b/stdlib/source/lux/control/remember.lux
@@ -0,0 +1,67 @@
+(.module:
+ [lux #*
+ [control
+ [monad (#+ do)]
+ ["p" parser ("p/." Functor<Parser>)]
+ ["ex" exception (#+ exception:)]]
+ [data
+ ["." error]
+ ["." text
+ format]]
+ [time
+ ["." instant]
+ ["." date (#+ Date) ("date/." Order<Date> Codec<Text,Date>)]]
+ ["." macro
+ ["." code]
+ ["s" syntax (#+ Syntax syntax:)]]
+ ["." io]])
+
+(exception: #export (must-remember {message Text} {focus (Maybe Code)})
+ (format message text.new-line
+ (case focus
+ (#.Some focus)
+ (%code focus)
+
+ #.None
+ "")))
+
+(def: deadline
+ (Syntax Date)
+ ($_ p.either
+ (p/map (|>> instant.from-millis instant.date)
+ s.int)
+ (do p.Monad<Parser>
+ [raw s.text]
+ (case (:: date.Codec<Text,Date> decode raw)
+ (#error.Success date)
+ (wrap date)
+
+ (#error.Failure message)
+ (p.fail message)))))
+
+(syntax: #export (remember {deadline ..deadline} {message s.text} {focus (p.maybe s.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 (ex.construct must-remember [message focus])))))
+
+(do-template [<name> <message>]
+ [(syntax: #export (<name> {deadline ..deadline} {message s.text} {focus (p.maybe s.any)})
+ (wrap (list (` (..remember (~ (code.text (date/encode deadline)))
+ (~ (code.text (format <message> " " message)))
+ (~+ (case focus
+ (#.Some focus)
+ (list focus)
+
+ #.None
+ (list))))))))]
+
+ [to-do "TODO"]
+ [fix-me "FIXME"]
+ )
diff --git a/stdlib/source/lux/time/date.lux b/stdlib/source/lux/time/date.lux
index 59bfc5c0e..27113d336 100644
--- a/stdlib/source/lux/time/date.lux
+++ b/stdlib/source/lux/time/date.lux
@@ -5,12 +5,12 @@
order
enum
codec
- ["p" parser]
+ ["p" parser ("p/." Functor<Parser>)]
[monad (#+ do)]]
[data
["." error (#+ Error)]
["." maybe]
- ["." number ("int/." Codec<Text,Int>)]
+ ["." number ("nat/." Codec<Text,Nat>) ("int/." Codec<Text,Int>)]
[text ("text/." Monoid<Text>)
["l" lexer]]
[collection
@@ -57,18 +57,18 @@
(def: (month-to-nat month)
(-> Month Nat)
(case month
- #January 0
- #February 1
- #March 2
- #April 3
- #May 4
- #June 5
- #July 6
- #August 7
- #September 8
- #October 9
- #November 10
- #December 11))
+ #January 00
+ #February 01
+ #March 02
+ #April 03
+ #May 04
+ #June 05
+ #July 06
+ #August 07
+ #September 08
+ #October 09
+ #November 10
+ #December 11))
(`` (structure: #export _ (Order Month)
(def: eq Equivalence<Month>)
@@ -223,30 +223,37 @@
## Based on this: https://stackoverflow.com/a/42936293/6823464
(def: (pad value)
(-> Int Text)
- (if (i/< +10 value)
- (text/compose "0" (int/encode value))
- (int/encode value)))
+ (let [digits (nat/encode (.nat value))]
+ (if (i/< +10 value)
+ (text/compose "0" digits)
+ digits)))
(def: (encode [year month day])
(-> Date Text)
($_ text/compose
- (int/encode year) "-"
+ (if (i/< +0 year)
+ (int/encode year)
+ (nat/encode (.nat year)))
+ "-"
(pad (|> month month-to-nat inc .int)) "-"
(pad (|> day .int))))
(def: lex-year
(l.Lexer Int)
(do p.Monad<Parser>
- [sign (p.or (l.this "-") (l.this "+"))
- raw-year (p.codec number.Codec<Text,Int> (l.many l.decimal))
+ [sign (p.maybe (l.this "-"))
+ raw-year (p.codec number.Codec<Text,Nat> (l.many l.decimal))
#let [signum (case sign
- (#.Left _) -1
- (#.Right _) +1)]]
- (wrap (i/* signum raw-year))))
+ (#.Some _)
+ -1
+
+ #.None
+ +1)]]
+ (wrap (i/* signum (.int raw-year)))))
(def: lex-section
(l.Lexer Int)
- (p.codec number.Codec<Text,Int> (l.exactly 2 l.decimal)))
+ (p/map .int (p.codec number.Codec<Text,Nat> (l.exactly 2 l.decimal))))
(def: (leap-years year)
(-> Int Int)
@@ -298,15 +305,15 @@
(i/<= (.int month-days) utc-day)))]
(wrap {#year utc-year
#month (case utc-month
- +1 #January
- +2 #February
- +3 #March
- +4 #April
- +5 #May
- +6 #June
- +7 #July
- +8 #August
- +9 #September
+ +01 #January
+ +02 #February
+ +03 #March
+ +04 #April
+ +05 #May
+ +06 #June
+ +07 #July
+ +08 #August
+ +09 #September
+10 #October
+11 #November
+12 #December
@@ -315,7 +322,7 @@
(def: (decode input)
(-> Text (Error Date))
- (l.run input lex-date))
+ (l.run input ..lex-date))
(structure: #export _
{#.doc (doc "Based on ISO 8601."