diff options
| -rw-r--r-- | lux-mode/lux-mode.el | 4 | ||||
| -rw-r--r-- | stdlib/source/lux/control/remember.lux | 67 | ||||
| -rw-r--r-- | stdlib/source/lux/time/date.lux | 75 |
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." |