# HG changeset patch
# User Steve Losh <steve@stevelosh.com>
# Date 1484589946 0
# Node ID 5cfeafea0350de0cdf938be7503ff1b7071dde54
# Parent  21d537ce910a8cab5d17441327832414175f6420
First robot

diff -r 21d537ce910a -r 5cfeafea0350 .gitignore
--- /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
diff -r 21d537ce910a -r 5cfeafea0350 .lispwords
--- 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)
diff -r 21d537ce910a -r 5cfeafea0350 creds-example.lisp
--- 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)
     ))
diff -r 21d537ce910a -r 5cfeafea0350 magitek.asd
--- 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")))))
diff -r 21d537ce910a -r 5cfeafea0350 package.lisp
--- 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))
diff -r 21d537ce910a -r 5cfeafea0350 src/auth.lisp
--- 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))))
diff -r 21d537ce910a -r 5cfeafea0350 src/database.lisp
--- /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))))
diff -r 21d537ce910a -r 5cfeafea0350 src/main.lisp
--- 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)
diff -r 21d537ce910a -r 5cfeafea0350 src/robots/git-commands.lisp
--- /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))
+
diff -r 21d537ce910a -r 5cfeafea0350 src/twitter.lisp
--- /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))
+