--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/.gitignore Mon Jan 16 18:05:46 2017 +0000
@@ -0,0 +1,1 @@
+creds.lisp
--- a/.lispwords Mon Jan 16 18:04:10 2017 +0000
+++ b/.lispwords Mon Jan 16 18:05:46 2017 +0000
@@ -0,0 +1,1 @@
+(1 execute-non-query execute-single)
--- a/creds-example.lisp Mon Jan 16 18:04:10 2017 +0000
+++ b/creds-example.lisp Mon Jan 16 18:05:46 2017 +0000
@@ -1,10 +1,9 @@
-(in-package :magitek)
+(in-package :magitek.twitter)
-(defparameter *api-key* "...")
-(defparameter *api-secret* "...")
+(setf *api-key* "...")
+(setf *api-secret* "...")
-(defparameter *credentials*
+(setf *credentials*
'(
- (auth-plist-goes-here use dump-auth-plist to get it)
- ; ...
+ (auth-plist-goes-here use (authorize) to get it)
))
--- a/magitek.asd Mon Jan 16 18:04:10 2017 +0000
+++ b/magitek.asd Mon Jan 16 18:05:46 2017 +0000
@@ -10,6 +10,8 @@
:chirp
:sqlite
:iterate
+ :chancery
+ :named-readtables
:cl-arrows)
:serial t
@@ -18,6 +20,8 @@
(:file "quickutils")))
(:file "package")
(:module "src" :serial t
- :components ((:file "creds")
- (:file "auth")
+ :components ((:file "auth")
+ (:file "database")
+ (:module "robots"
+ :components ((:file "git-commands")))
(:file "main")))))
--- a/package.lisp Mon Jan 16 18:04:10 2017 +0000
+++ b/package.lisp Mon Jan 16 18:05:46 2017 +0000
@@ -1,4 +1,4 @@
-(defpackage :magitek
+(defpackage :magitek.twitter
(:use
:cl
:iterate
@@ -6,4 +6,42 @@
:losh
:magitek.quickutils)
(:export
- ))
+ :tt-load-credentials
+ :tt-authorize
+ :tt-tweetable-p
+ :tt-tweet))
+
+(defpackage :magitek.database
+ (:use
+ :cl
+ :losh
+ :sqlite
+ :magitek.quickutils)
+ (:export
+ :db-connect
+ :db-insert-tweet
+ :db-tweeted-since-p))
+
+
+(defpackage :magitek.robots.git-commands
+ (:use
+ :cl
+ :iterate
+ :cl-arrows
+ :losh
+ :chancery
+ :magitek.quickutils)
+ (:export :random-string))
+
+
+(defpackage :magitek
+ (:use
+ :cl
+ :iterate
+ :cl-arrows
+ :losh
+ :magitek.twitter
+ :magitek.database
+ :magitek.quickutils)
+ (:export
+ :main))
--- a/src/auth.lisp Mon Jan 16 18:04:10 2017 +0000
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,38 +0,0 @@
-(in-package :magitek)
-
-(defparameter *accounts* (make-hash-table))
-
-(defun dump-auth-plist (account-name)
- (list :account-name account-name
- :api-key chirp:*oauth-api-key*
- :api-secret chirp:*oauth-api-secret*
- :access-token chirp:*oauth-access-token*
- :access-secret chirp:*oauth-access-secret*))
-
-(defun add-account (account)
- (setf (gethash (getf account :account-name) *accounts*)
- account))
-
-(defun load-accounts ()
- (map nil #'add-account *credentials*))
-
-(defun authorize (account-name)
- (format t "Visit ~A to get a PIN~%"
- (chirp:initiate-authentication :api-key *api-key*
- :api-secret *api-secret*))
- (princ "Enter PIN: ")
- (finish-output)
- (chirp:complete-authentication (read-line))
- (chirp:account/verify-credentials)
- (dump-auth-plist account-name))
-
-(defmacro with-account (account-name &body body)
- (once-only (account-name)
- `(if-found account (gethash ,account-name *accounts*)
- (let ((chirp:*oauth-api-key* (getf account :api-key))
- (chirp:*oauth-api-secret* (getf account :api-secret))
- (chirp:*oauth-access-token* (getf account :access-token))
- (chirp:*oauth-access-secret* (getf account :access-secret)))
- ,@body)
- (error "Account ~S not found, use (authorize ~S) to get creds"
- ,account-name ,account-name))))
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/database.lisp Mon Jan 16 18:05:46 2017 +0000
@@ -0,0 +1,39 @@
+(in-package :magitek.database)
+
+(defvar *database* nil)
+
+(defun db-connect (&key (path "database.sqlite"))
+ (setf *database* (connect path))
+ (values))
+
+(defun initialize-database ()
+ (execute-non-query *database*
+ "CREATE TABLE IF NOT EXISTS tweets(
+ id INTEGER PRIMARY KEY,
+ account TEXT NOT NULL,
+ content TEXT NOT NULL,
+ timestamp DATETIME DEFAULT CURRENT_TIMESTAMP NOT NULL
+ )")
+ (execute-non-query *database*
+ "CREATE INDEX IF NOT EXISTS idx_tweets_account_timestamp
+ ON tweets (account, timestamp)")
+ (values))
+
+(defun db-insert-tweet (account tweet)
+ (execute-non-query *database*
+ "INSERT INTO tweets (account, content) VALUES (?, ?)"
+ (aesthetic-string account)
+ (aesthetic-string tweet))
+ (values))
+
+(defun db-tweeted-since-p (account minutes-ago)
+ (check-type minutes-ago (integer 1))
+ (ensure-boolean
+ (execute-single *database*
+ "SELECT content FROM tweets
+ WHERE account = ?
+ AND timestamp > datetime('now', ?)
+ LIMIT 1
+ "
+ (aesthetic-string account)
+ (format nil "-~D minutes" minutes-ago))))
--- a/src/main.lisp Mon Jan 16 18:04:10 2017 +0000
+++ b/src/main.lisp Mon Jan 16 18:05:46 2017 +0000
@@ -1,1 +1,29 @@
(in-package :magitek)
+
+(defun hours-to-minutes (h)
+ (* h 60))
+
+
+(defun generate-tweet (generator)
+ (iterate
+ (repeat 100)
+ (finding (funcall generator) :such-that #'tt-tweetable-p)))
+
+
+(defun run-bot (name generator &key (hours 12))
+ (when (not (db-tweeted-since-p name (hours-to-minutes hours)))
+ (let ((tweet (generate-tweet generator)))
+ (if (null tweet)
+ (format t "Could not generate a suitable tweet for ~S~%" name)
+ (progn
+ (format t "Tweeting as ~S: ~S~%" name tweet)
+ (db-insert-tweet name tweet)
+ (tt-tweet name tweet)
+ (sleep 5.0))))))
+
+(defun main ()
+ (db-connect)
+ (tt-load-credentials)
+ (run-bot :git-commands #'magitek.robots.git-commands:random-string
+ :hours 12)
+ t)
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/robots/git-commands.lisp Mon Jan 16 18:05:46 2017 +0000
@@ -0,0 +1,226 @@
+(in-package :magitek.robots.git-commands)
+(named-readtables:in-readtable :chancery)
+
+(define-string noun
+ "binary blob"
+ "packfile"
+ "refspec"
+ "blob"
+ "branch"
+ "changeset"
+ "commit"
+ "conflicted merge"
+ "current HEAD"
+ "file"
+ "head"
+ "merge"
+ "remote"
+ "object"
+ "patch"
+ "ref"
+ "repository"
+ "symlink"
+ "tag"
+ "tip")
+
+
+(define-string git-location%
+ "repository"
+ "index"
+ "working tree"
+ "content-addressable filesystem"
+ "object store"
+ "reflog"
+ "current directory"
+ "current repository"
+ "current branch"
+ "checked-out branch"
+ "upstream repository"
+ "DAG")
+
+(define-string git-folder%
+ ""
+ "refs"
+ "logs"
+ "objects"
+ "hooks"
+ "HEAD"
+ "COMMIT_EDITMSG")
+
+(define-string git-folder
+ (".git/" :. git-folder%))
+
+(define-string git-location
+ ("the" git-location%)
+ git-folder)
+
+(define-string external-location
+ "Hacker News"
+ "Stack Overflow"
+ "Twitter"
+ "Reddit"
+ "Github"
+ "Gitlab"
+ "Github's status page"
+ "/dev/random"
+ "/dev/urandom"
+ "your .gitconfig"
+ "the git man pages"
+ "the git source code"
+ "the blockchain"
+ "your home directory")
+
+(define-string location
+ git-location
+ external-location)
+
+
+(define-string action
+ (list "bisect" "bisecting")
+ (list "clone" "cloning")
+ (list "commit" "committing")
+ (list "delete" "deleting")
+ (list "display" "displaying")
+ (list "fast-forward" "fast-forwarding")
+ (list "fetch" "fetching")
+ (list "merge" "merging")
+ (list "move" "moving")
+ (list "print" "printing")
+ (list "prune" "pruning")
+ (list "pull" "pulling")
+ (list "push" "pushing")
+ (list "record" "recording")
+ (list "revert" "reverting")
+ (list "remove" "removing")
+ (list "rename" "renaming")
+ (list "reset" "resetting")
+ (list "resolve" "resolving")
+ (list "show" "showing")
+ (list "sign" "signing")
+ (list "simplify" "simplifying")
+ (list "update" "updating")
+ (list "verify" "verifying"))
+
+(defun action-verb ()
+ (first (action)))
+
+
+(define-string refresh
+ "update"
+ "reset")
+
+(define-string refreshing
+ "updating"
+ "resetting")
+
+
+(define-string extremum
+ "newest"
+ "oldest"
+ "largest"
+ "smallest"
+ "sparsest"
+ "first"
+ "last"
+ "worst"
+ "simplest"
+ "best")
+
+(define-string adjective
+ "merged"
+ "unmerged"
+ "symbolic"
+ "uncommitted"
+ "signed"
+ "unsigned"
+ "big-endian"
+ "little-endian"
+ "childless"
+ "binary")
+
+
+(define-string age
+ "newest"
+ "oldest"
+ "first"
+ "last")
+
+(define-string look-for
+ "search"
+ "grep"
+ "bisect"
+ "filter")
+
+(define-string temporal-adverb
+ "before"
+ "after"
+ "without")
+
+
+(defun letter ()
+ (random-elt "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"))
+
+(defun shellify (str)
+ (string-downcase (substitute #\- #\space str)))
+
+(define-string short-option%
+ ("-" :. letter)
+ ("-" :. letter [noun shellify string-upcase]))
+
+(defparameter *noun* nil)
+
+(define-string long-option%
+ (eval (let ((*noun* (gen-string [noun shellify])))
+ (gen-string ("--" :. *noun* :. "=<" :. *noun* :. ">"))))
+ ("--" :. action-verb)
+ ("--" :. extremum)
+ ("--only-" :. adjective)
+ ("--only-" :. [noun shellify s])
+ ("--" :. action-verb :. "=<" :. [noun shellify] :. ">"))
+
+(define-string short-option
+ short-option%
+ ("[" :. short-option% :. "]"))
+
+(define-string long-option
+ long-option%
+ ("[" :. long-option% :. "]"))
+
+(define-string short-options
+ short-option
+ (short-option short-option))
+
+(define-string options
+ long-option
+ short-options
+ (short-options long-option)
+ (long-option short-options))
+
+
+(defparameter *command* nil)
+(defparameter *commanding* nil)
+
+(define-string description
+ (look-for location "for the" age noun "and" *command* "it")
+ ("read" (eval (+ 2 (random 2000))) "bytes from" location "and" *command* "them")
+ (*command* "the" extremum noun "in" git-location)
+ (*command* [noun a] temporal-adverb refreshing git-location)
+ (*command* "and push all" adjective [noun s] "to" location)
+ (*command* "all" adjective [noun s] "in" git-location)
+ (*command* "the" extremum "and merge it into" git-location)
+ (*command* "some" [noun s] "from a remote")
+ (*command* "two or more" [noun s] "and save them to" location)
+ ("move or" *command* [noun a] "in" git-location)
+ ("rebase" [noun a] "onto" location "after" *commanding* "it")
+ (*command* "and" refresh git-location)
+ ("list," *command* :. ", or delete" [noun s]))
+
+(defun entry ()
+ (destructuring-bind (*command* *commanding*) (action)
+ (gen-string
+ ("git" *command* options #\newline :. [description cap]))))
+
+;;;; API ----------------------------------------------------------------------
+(defun random-string ()
+ (entry))
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/twitter.lisp Mon Jan 16 18:05:46 2017 +0000
@@ -0,0 +1,56 @@
+(in-package :magitek.twitter)
+
+(defparameter *api-key* nil)
+(defparameter *api-secret* nil)
+(defparameter *credentials* nil)
+(defparameter *accounts* (make-hash-table))
+
+
+(defun dump-auth-plist (account-name)
+ (list :account-name account-name
+ :api-key chirp:*oauth-api-key*
+ :api-secret chirp:*oauth-api-secret*
+ :access-token chirp:*oauth-access-token*
+ :access-secret chirp:*oauth-access-secret*))
+
+(defun add-account (account)
+ (setf (gethash (getf account :account-name) *accounts*)
+ account))
+
+(defun load-accounts ()
+ (map nil #'add-account *credentials*))
+
+
+(defmacro with-account (account-name &body body)
+ (once-only (account-name)
+ `(if-found account (gethash ,account-name *accounts*)
+ (let ((chirp:*oauth-api-key* (getf account :api-key))
+ (chirp:*oauth-api-secret* (getf account :api-secret))
+ (chirp:*oauth-access-token* (getf account :access-token))
+ (chirp:*oauth-access-secret* (getf account :access-secret)))
+ ,@body)
+ (error "Account ~S not found, use (tt-authorize ~S) to get creds"
+ ,account-name ,account-name))))
+
+
+(defun tt-authorize (account-name)
+ (format t "Visit ~A to get a PIN~%"
+ (chirp:initiate-authentication :api-key *api-key*
+ :api-secret *api-secret*))
+ (princ "Enter PIN: ")
+ (finish-output)
+ (chirp:complete-authentication (read-line))
+ (chirp:account/verify-credentials)
+ (dump-auth-plist account-name))
+
+(defun tt-load-credentials ()
+ (load "creds.lisp")
+ (load-accounts))
+
+(defun tt-tweet (account text)
+ (with-account account
+ (chirp:tweet text)))
+
+(defun tt-tweetable-p (text)
+ (< (length text) 130))
+