hazel
/
aoc-2021
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity
Browse Source

AAAAAAAAA WHAT THE FUCK

master
Hazel Levine 1 year ago
parent
81b5d2deda
commit
af6e82863c
Signed by: hazel
GPG Key ID: 1884029A28789A62
8 changed files with 431 additions and 0 deletions
Whitespace
Show all changes Ignore whitespace when comparing lines Ignore changes in amount of whitespace Ignore changes in whitespace at EOL
Split View
Diff Options
Show Stats Download Patch File Download Diff File
  1. 70
      .gitignore
  2. 1
      bin/README.md
  3. 93
      bin/get-challenge
  4. 15
      bin/get-input
  5. 15
      day1.rkt
  6. 119
      lib/aoc.rkt
  7. 103
      lib/common.rkt
  8. 15
      tmpl.rkt

70
.gitignore vendored
Unescape View File

@ -0,0 +1,70 @@
# ---> Racket
# gitignore template for the Racket language
# website: http://www.racket-lang.org/
# DrRacket autosave files
*.rkt~
*.rkt.bak
\#*.rkt#
\#*.rkt#*#
# Compiled racket bytecode
compiled/
*.zo
# Dependency tracking files
*.dep
# ---> Emacs
# -*- mode: gitignore; -*-
*~
\#*\#
/.emacs.desktop
/.emacs.desktop.lock
*.elc
auto-save-list
tramp
.\#*
# Org-mode
.org-id-locations
*_archive
# flymake-mode
*_flymake.*
# eshell files
/eshell/history
/eshell/lastdir
# elpa packages
/elpa/
# reftex files
*.rel
# AUCTeX auto folder
/auto/
# cask packages
.cask/
dist/
# Flycheck
flycheck_*.el
# server auth directory
/server/
# projectiles files
.projectile
# directory configuration
.dir-locals.el
# network security
/network-security.data
.envrc
.status.rktd
viz/*

1
bin/README.md
Unescape View File

@ -0,0 +1 @@
these are stolen from [haskal's stuff](https://git.lain.faith/haskal/aoc2020/src/branch/aoc2020/scripts). go look there

93
bin/get-challenge
Unescape View File

@ -0,0 +1,93 @@
#!/usr/bin/env racket
#lang racket
(require "../lib/aoc.rkt"
ansi-color
html
xml)
(define erase-line "\033[K")
;; finds a given element of an xexpr
(define (find-element el doc)
(match doc
[(list (== el) _ ...) doc]
[(list tag attrs children ...)
(ormap (curry find-element el) children)]
[_ #f]))
(struct style-ast [fg bg fs children] #:transparent)
;; convert xexpr tree to an ast with lower-level styling
(define (xexpr->style-ast doc)
(match doc
[(? string?) (style-ast #f #f #f doc)]
[(list (or 'script 'form) _ ...) #f]
[(list-no-order 'p (list 'span (list-no-order '(class "share")) _ ...) _ ...) #f]
[(list 'li _ children ...)
(define out-children (filter identity (map xexpr->style-ast children)))
(style-ast #f #f #f (cons (style-ast #f #f #f "- ") out-children))]
[(list tag attrs children ...)
(define-values [fg bg fs]
(match* (tag attrs)
[('main _) (values #f #f #f)]
[('article _) (values #f #f #f)]
[('p (list-no-order '(class "day-success") _ ...)) (values 'yellow #f 'bold)]
[('p _) (values #f #f #f)]
[('pre _) (values #f #f #f)]
[('h2 _) (values #f #f 'bold)]
[('ul _) (values #f #f #f)]
[('a _) (values 'green #f #f)]
[('code _) (values 'white 234 #f)]
[('span _) (values #f #f #f)]
[('em (list-no-order '(class "star") _ ...)) (values 'yellow #f 'bold)]
[('em _) (values #f #f 'bold)]
[(_ _)
(printf "warning: unhandled ~a ~a\n" tag attrs)
(values #f #f #f)]))
(define inner-children (filter identity (map xexpr->style-ast children)))
(define new-children
(if ((or/c 'h2 'pre 'p) tag)
(let ([nls (list (style-ast #f #f #f "\n") (style-ast #f #f #f "\n"))])
(append nls inner-children nls))
inner-children))
(style-ast fg bg fs new-children)]))
(define (output-style-ast ast)
(define num-newlines (make-parameter #f))
(define (helper ast [prev-bg ""] [prev-fg ""])
(match-define (style-ast fg bg fs children) ast)
(when bg (background-color bg))
(when fg (foreground-color fg))
(match children
["\n"
(unless (or (false? (num-newlines)) (>= (num-newlines) 2))
(num-newlines (add1 (num-newlines)))
(display "\n"))]
[(? string? str)
(num-newlines 0)
(if (string-contains? str "\n")
(for ([i (in-naturals)] [line (in-list (string-split (string-trim str "\n") "\n"))])
(color-display (format (if (zero? i) "~a~a" "\n~a~a") erase-line line)))
(color-display str))]
[_ (map (lambda (item) (helper item (or bg prev-bg) (or fg prev-fg)))
children)])
(when prev-bg (background-color prev-bg))
(when prev-fg (foreground-color prev-fg)))
(num-newlines #f)
(helper ast))
(command-line
#:program "get-challenge"
#:args (day)
(define in (aoc-fetch-challenge (getenv "AOC_YEAR") day (getenv "AOC_SESSION")))
(use-html-spec #f)
(define doc-xmls (read-html-as-xml in))
(close-input-port in)
(define doc `(top-element ,@(map xml->xexpr doc-xmls)))
(define main (find-element 'main doc))
(define ast (xexpr->style-ast main))
; (pretty-write ast)
(output-style-ast ast))

15
bin/get-input
Unescape View File

@ -0,0 +1,15 @@
#!/usr/bin/env racket
#lang racket
(require "../lib/aoc.rkt")
(command-line
#:program "get-input"
#:args (day)
(define in (aoc-fetch-input (getenv "AOC_YEAR") day (getenv "AOC_SESSION")))
(define out (build-path (current-directory)
"data"
(string-append "day" day ".txt")))
(cond [(file-exists? out) (displayln "input data already exists")]
[else
(call-with-output-file out (lambda (prt) (copy-port in prt)))
(displayln "done!")]))

15
day1.rkt
Unescape View File

@ -0,0 +1,15 @@
#lang racket
(require "lib/common.rkt")
(define (day1a lst)
(void))
(define (day1b lst)
(void))
(module+ main
(call-with-input-file "data/day1.txt"
(lambda (prt)
(define lines (port->lines prt))
(answer 1 1 (day1a lines))
(answer 1 2 (day1b lines)))))

119
lib/aoc.rkt
Unescape View File

@ -0,0 +1,119 @@
#lang racket
(require net/uri-codec net/http-client)
(provide aoc-fetch-input
aoc-fetch-challenge
aoc-submit-answer
aoc-complete?
aoc-set-complete!)
; stolen from:
; https://git.lain.faith/haskal/aoc2020/src/branch/aoc2020/scripts/aoc-lib.rkt
(define *host* "adventofcode.com")
(define *status-file* ".status.rktd")
; generate API path
(define/contract (puzzle-path year day endpoint)
(-> string? string? (or/c "input" "answer" false/c) path?)
(define base (build-path "/" year "day" day))
(if endpoint (build-path base endpoint) base))
; sets necessary headers for API
(define (make-headers session)
(list (string-append "Cookie: session=" session)
"Content-Type: application/x-www-form-urlencoded"))
; http request helper
(define (aoc-request year day endpoint session
[method 'GET] [data #f])
(define (parse-headers hlist)
(for/list ([h (in-list hlist)])
(match h
[(pregexp #px"^([^:]+): (.*?)$" (list _ k v))
(cons (string->symbol (string-downcase (bytes->string/utf-8 k)))
(bytes->string/utf-8 v))]
[x (cons 'unknown x)])))
(define (do-request path headers method data)
(define-values (status headers-out content)
(http-sendrecv *host* path
#:ssl? #t
#:headers headers
#:method method
#:data data))
(define headers-out/parsed (parse-headers headers-out))
(match status
[(pregexp #px"^HTTP/1\\.[10] 200") content]
[(pregexp #px"^HTTP/1\\.[10] 302")
(define location (rest (or (assoc 'location headers-out/parsed)
(error "got 302 with no location"))))
(printf "got redirect to ~a\n" location)
(close-input-port content)
(do-request location headers 'GET #f)]
[(pregexp #px"^HTTP/1\\.[10] 404")
(error "endpoint returned 404.\n response: " (port->bytes content))]
[stat
(error "endpoint returned unexpected data.\n status: "
stat
"\n response: "
(port->bytes content))]))
(do-request (path->string (puzzle-path year day endpoint))
(make-headers session)
method data))
; gets the input file for a challenge
(define/contract (aoc-fetch-input year day session)
(-> string? string? string? input-port?)
(aoc-request year day "input" session))
; submits an answer to the server
(define/contract (aoc-submit-answer year day session part answer)
(-> string? string? string? (or/c 1 2 "1" "2") string? (or/c symbol? bytes?))
(define data `((level . ,(~a part))
(answer . ,answer)))
(define resp
(port->bytes (aoc-request year day "answer" session 'POST
(alist->form-urlencoded data))))
(match resp
[(pregexp #px"That's the right answer")
(aoc-set-complete! day part)
'answer-correct]
[(pregexp #px"That's not the right answer")
'answer-incorrect]
[(pregexp #px"You gave an answer too recently")
'rate-limited]
[(pregexp #px"Did you already complete it?")
(aoc-set-complete! day part)
'already-completed]
[x x]))
; fetches the HTML page for a challenge
(define/contract (aoc-fetch-challenge year day session)
(-> string? string? string? input-port?)
(aoc-request year day #f session))
; generates entries for the challenge status file
(define (day+part->key day part)
(when (string? day)
(set! day (string->number day)))
(when (string? part)
(set! part (string->number part)))
(cons day part))
; gets the status file
(define (aoc-get-status)
(cond [(file-exists? *status-file*)
(call-with-input-file *status-file* read)]
[else '()]))
; is a challenge complete already?
(define (aoc-complete? day part)
(set-member? (aoc-get-status) (day+part->key day part)))
; marks a challenge as completed
(define (aoc-set-complete! day part)
(define status (set-add (aoc-get-status) (day+part->key day part)))
(call-with-output-file *status-file*
(lambda (prt)
(write status prt))
#:mode 'binary
#:exists 'replace))

103
lib/common.rkt
Unescape View File

@ -0,0 +1,103 @@
#lang racket
(require "aoc.rkt"
parser-tools/lex
syntax/parse/define
threading
(for-syntax syntax/for-body))
(provide (all-from-out threading)
dbg vector-reverse
values->list list->values
blank? datum? format-datum
for/min for/max
lex-string
answer)
(define (dbg a)
(pretty-print a)
a)
(define (vector-reverse v)
(list->vector (reverse (vector->list v))))
(define-simple-macro (values->list body:expr ...+)
(call-with-values (lambda () body ...) list))
(define (list->values lst)
(apply values lst))
(define (blank? str)
(for/and ([c (in-string str)])
(char-blank? c)))
(define (datum? x)
(or (list? x) (symbol? x)))
(define (string->datum str)
(unless (blank? str)
(define result (read (open-input-string (format "(~a)" str))))
(if (= (length result) 1)
(car result)
result)))
(define (format-datum datum-template . args)
(unless (datum? datum-template)
(raise-argument-error 'format-datums "datum?" datum-template))
(string->datum (apply format (format "~a" datum-template)
(map (lambda (arg)
(if (syntax? arg)
(syntax->datum arg)
arg))
args))))
(define-syntax (for/max stx)
(syntax-case stx ()
[(_ clauses body ... tail-expr)
(with-syntax ([original stx]
[((pre-body ...) (post-body ...))
(split-for-body stx #'(body ... tail-expr))])
#'(for/fold/derived original
([current-max -inf.0])
clauses
pre-body ...
(define maybe-new-max (let () post-body ...))
(if (> maybe-new-max current-max)
maybe-new-max
current-max)))]))
(define-syntax (for/min stx)
(syntax-case stx ()
[(_ clauses body ... tail-expr)
(with-syntax ([original stx]
[((pre-body ...) (post-body ...))
(split-for-body stx #'(body ... tail-expr))])
#'(for/fold/derived original
([current-min +inf.0])
clauses
pre-body ...
(define maybe-new-min (let () post-body ...))
(if (< maybe-new-min current-min)
maybe-new-min
current-min)))]))
(define (lex-string lexer str)
(define in (open-input-string str))
(port-count-lines! in)
(let loop ([v (lexer in)])
(cond [(void? (position-token-token v)) (loop (lexer in))]
[(eof-object? (position-token-token v)) '()]
[else (cons v (loop (lexer in)))])))
(define (answer day part answer)
(printf "answer ~a.~a: ~s\n" day part answer)
(unless (aoc-complete? day part)
(printf "submit? [Y/n]: ")
(match (string-downcase (string-trim (read-line)))
[(or "" "y" "yes")
(printf "glhf\n")
(define resp
(aoc-submit-answer (getenv "AOC_YEAR")
(~a day)
(getenv "AOC_SESSION")
(~a part)
(~a answer)))
(printf "server responded: ~a\n" resp)]
[_ (printf "coward\n")])))

15
tmpl.rkt
Unescape View File

@ -0,0 +1,15 @@
#lang racket
(require "lib/common.rkt")
(define (dayNa lst)
(void))
(define (dayNb lst)
(void))
(module+ main
(call-with-input-file "data/dayN.txt"
(lambda (prt)
(define lines (port->lines prt))
(answer N 1 (dayNa lines))
(answer N 2 (dayNb lines)))))
Write Preview
Loading…
Cancel
Save