awoobot/awoobot.rkt

#!/usr/bin/env racket

#lang racket

(require astro/calendar astro/lunar
         racket/date
         "fedibot.rkt")

(define (current-date/utc)
  (seconds->date (* 0.001 (current-inexact-milliseconds)) #f))

(define (date->jd dt)
  (match-define (date ss mm hh d m y _ _ _ _) dt)
  (define d+ (+ d (/ hh 24) (/ mm 1440) (/ ss 86400)))
  (date-values->jd y m d+))

(define (jd->date-values* jd)
  (define-values [y m d] (jd->date-values jd))
  (define dq (floor d))
  (define df (- d dq))
  (define h (* df 24))
  (define hq (floor h))
  (define hf (- h hq))
  (define mm (* hf 60))
  (define mmq (floor mm))
  (define mmf (- mm mmq))
  (define ssq (floor (* mmf 60)))
  (values y m (inexact->exact dq) (inexact->exact hq) (inexact->exact mmq) (inexact->exact ssq)))

(define (do-awoo)
  (define (str-rpt-random str)
    (apply string-append (vector->list (make-vector (random 1 10) str))))

  (define toot (make-toot (string-append "AWOO" (str-rpt-random "O") (str-rpt-random "!"))))
  (send-toot/retry-on-err toot)
  (void))

(define (run-bot)
  (define now (current-date/utc))
  (define now-jd (date->jd now))
  (define DT (dynamical-delta-t (date-year now)))
  (define fullmoon-jd (- (lunar-next-phase now-jd 'full)
                         (/ DT 86400)))
  (displayln now-jd)
  (displayln fullmoon-jd)
  (define-values [y m d hh mm ss] (jd->date-values* fullmoon-jd))

  (if (< (- fullmoon-jd now-jd) (/ 60 86400))
    (begin
      (displayln "preparing to awoo")
      (sleep (inexact->exact (floor (* 86400 (- fullmoon-jd now-jd)))))
      (do-awoo)
      (sleep 5))
    (displayln "not time to awoo yet")))

(define (schedule-next)
  (define now (current-date/utc))
  (define now-jd (+ 0.5 (date->jd now)))
  (define DT (dynamical-delta-t (date-year now)))
  (define fullmoon-jd (- (lunar-next-phase now-jd 'full)
                         (/ DT 86400)))
  (define-values [y m d hh mm ss] (jd->date-values* (- fullmoon-jd (/ 30 86400))))
  (printf "schedule wakeup for: ~a ~a ~a ~a ~a ~a\n" y m d hh mm ss)

  (displayln "invoking systemd")
  (system* "/usr/bin/env" "systemd-run" "--user" "--same-dir"
           (format "--on-calendar=~a-~a-~a ~a:~a:~a UTC" y m d hh mm ss)
           (path->string (path->complete-path (find-system-path 'run-file)))))


(define selftest (make-parameter #f))

(command-line
  #:program "awoobot"
  #:once-each
  [("-t" "--test") "Send a test post" (selftest #t)]
  #:args ()
  (parameterize ([current-config (config-from-file "config.rktd")])
    (if (selftest)
      (begin
        (displayln "testing config")
        (send-toot/retry-on-err (make-toot "test post pls ignore,")))
      (begin
        (run-bot)
        (schedule-next)))
    (void)))