- (define n-workers 10)
- (define given (list
- (λ (x) (if (even? x) x #f))
- (range 11)))
- (check-equal?
- (sort (apply concurrent-filter-map (cons n-workers given)) <)
- (sort (apply filter-map given ) <)))
-
-(define (msg-print out-format odd msg)
- (printf
- (match out-format
- ['single-line "~a \033[1;37m<~a ~a>\033[0m \033[0;~am~a\033[0m~n"]
- ['multi-line "~a~n\033[1;37m<~a ~a>\033[0m~n\033[0;~am~a\033[0m~n~n"]
- [_ (raise (format "Invalid output format: ~a" out-format))])
- (date->string (seconds->date [msg-ts_epoch msg]) #t)
- (msg-nick msg)
- (msg-uri msg)
- (if odd 36 33)
- (msg-text msg)))
-
-(define re-msg-begin
- ; TODO Zulu offset. Maybe in several formats. Which ones?
- (pregexp "^[0-9]{4}-[0-9]{2}-[0-9]{2}T[0-9]{2}:[0-9]{2}:[0-9]{2}"))
-
-(define (str->msg nick uri str)
- (if (not (regexp-match? re-msg-begin str))
- (begin
- (log-debug "Non-msg line from nick:~a, line:~a" nick str)
- #f)
- (let ([toks (string-split str (regexp "\t+"))])
- (if (not (= 2 (length toks)))
- (begin
- (log-warning "Invalid msg line from nick:~a, msg:~a" nick str)
- #f)
- (let*
- ([ts_rfc3339 (first toks)]
- [text (second toks)]
- [t (string->rfc3339-record ts_rfc3339)]
- ; TODO handle tz offset
- [ts_epoch (find-seconds [rfc3339-record:second t]
- [rfc3339-record:minute t]
- [rfc3339-record:hour t]
- [rfc3339-record:mday t]
- [rfc3339-record:month t]
- [rfc3339-record:year t])])
- (msg ts_epoch ts_rfc3339 nick uri text))))))
+ (let* ([f (λ (x) (if (even? x) x #f))]
+ [xs (range 11)]
+ [actual (sort (concurrent-filter-map 10 f xs) <)]
+ [expected (sort ( filter-map f xs) <)])
+ (check-equal? actual expected "concurrent-filter-map")))
+
+(define msg-print
+ (let* ([colors (vector 36 33)]
+ [n (vector-length colors)])
+ (λ (out-format color-i msg)
+ (let ([color (vector-ref colors (modulo color-i n))]
+ [nick (msg-nick msg)]
+ [uri (msg-uri msg)]
+ [text (msg-text msg)])
+ (match out-format
+ ['single-line
+ (printf "~a \033[1;37m<~a>\033[0m \033[0;~am~a\033[0m~n"
+ (parameterize ([date-display-format 'iso-8601])
+ (date->string (seconds->date [msg-ts_epoch msg]) #t))
+ nick color text)]
+ ['multi-line
+ (printf "~a~n\033[1;37m<~a ~a>\033[0m~n\033[0;~am~a\033[0m~n~n"
+ (parameterize ([date-display-format 'rfc2822])
+ (date->string (seconds->date [msg-ts_epoch msg]) #t))
+ nick uri color text)])))))
+
+; TODO Implement rfc3339->epoch and remove dependency on rfc3339-old
+
+(define str->msg
+ (let ([re (pregexp "^([0-9]{4}-[0-9]{2}-[0-9]{2}T[0-9]{2}:[0-9]{2}(:[0-9]{2})?)(\\.[0-9]+)?([^\\s\t]*)[\\s\t]+(.*)$")])
+ (λ (nick uri str)
+ (with-handlers*
+ ([exn:fail?
+ (λ (e)
+ (log-error "Failed to parse msg: ~v, from: ~v, at: ~v, because: ~v" str nick uri e)
+ #f)])
+ (match (regexp-match re str)
+ [(list _wholething ts s _fractional tz text)
+ (let*
+ ([ts_rfc3339 (string-append ts (if s "" ":00") (if tz tz ""))]
+ [t (string->rfc3339-record ts_rfc3339)]
+ [s (rfc3339-record:second t)]
+ ; TODO handle tz offset
+ [ts_epoch (find-seconds [if s s 0]
+ [rfc3339-record:minute t]
+ [rfc3339-record:hour t]
+ [rfc3339-record:mday t]
+ [rfc3339-record:month t]
+ [rfc3339-record:year t])])
+ (msg ts_epoch ts_rfc3339 nick uri text))]
+ [_
+ (log-debug "Non-msg line from nick:~a, line:~a" nick str)
+ #f])))))
+
+(module+ test
+ (let* ([tzs (for*/list ([d '("-" "+")]
+ [h '("5" "05")]
+ [m '("00" ":00" "57" ":57")])
+ (string-append d h m))]
+ [tzs (list* "" "Z" tzs)])
+ (for* ([n '("fake-nick")]
+ [u '("fake-uri")]
+ [s '("" ":10")]
+ [f '("" ".1337")]
+ [z tzs]
+ [sep (list "\t" " ")]
+ [txt '("foo bar baz" "'jaz poop bear giraffe / tea" "@*\"``")])
+ (let* ([ts (string-append "2020-11-18T22:22"
+ (if (non-empty-string? s) s ":00")
+ z)]
+ [m (str->msg n u (string-append ts sep txt))])
+ (check-not-false m)
+ (check-equal? (msg-nick m) n)
+ (check-equal? (msg-uri m) u)
+ (check-equal? (msg-text m) txt)
+ (check-equal? (msg-ts_rfc3339 m) ts (format "Given: ~v" ts))
+ )))
+
+ (let* ([ts "2020-11-18T22:22:09-0500"]
+ [tab " "]
+ [text "Lorem ipsum"]
+ [nick "foo"]
+ [uri "bar"]
+ [actual (str->msg nick uri (string-append ts tab text))]
+ [expected (msg 1605756129 ts nick uri text)])
+ ; FIXME re-enable after handling tz offset
+ ;(check-equal?
+ ; (msg-ts_epoch actual)
+ ; (msg-ts_epoch expected)
+ ; "str->msg ts_epoch")
+ (check-equal?
+ (msg-ts_rfc3339 actual)
+ (msg-ts_rfc3339 expected)
+ "str->msg ts_rfc3339")
+ (check-equal?
+ (msg-nick actual)
+ (msg-nick expected)
+ "str->msg nick")
+ (check-equal?
+ (msg-uri actual)
+ (msg-uri expected)
+ "str->msg uri")
+ (check-equal?
+ (msg-text actual)
+ (msg-text expected)
+ "str->msg text")))