# HG changeset patch
# User Steve Losh <steve@stevelosh.com>
# Date 1458746388 0
# Node ID 251cea71ed58db6d6702fa758c39a16b2e0ff6e7

Initial commit.  It kind of works.

diff -r 000000000000 -r 251cea71ed58 .ffignore
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/.ffignore	Wed Mar 23 15:19:48 2016 +0000
@@ -0,0 +1,1 @@
+docs/build
diff -r 000000000000 -r 251cea71ed58 .hgignore
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/.hgignore	Wed Mar 23 15:19:48 2016 +0000
@@ -0,0 +1,4 @@
+syntax: glob
+
+docs/build
+scratch.lisp
diff -r 000000000000 -r 251cea71ed58 Makefile
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Makefile	Wed Mar 23 15:19:48 2016 +0000
@@ -0,0 +1,23 @@
+.PHONY: pubdocs
+
+sourcefiles = $(shell ffind --full-path --dir src --literal .lisp)
+docfiles = $(shell ls docs/*.markdown)
+apidoc = docs/03-reference.markdown
+
+# src/utils.lisp: src/make-utilities.lisp
+# 	cd src && sbcl --noinform --load make-utilities.lisp  --eval '(quit)'
+
+$(apidoc): $(sourcefiles) docs/api.lisp
+	sbcl --noinform --load docs/api.lisp  --eval '(quit)'
+
+docs: docs/build/index.html
+
+docs/build/index.html: $(docfiles) docs/title
+	cd docs && ~/.virtualenvs/d/bin/d
+
+pubdocs: docs
+	hg -R ~/src/sjl.bitbucket.org pull -u
+	rsync --delete -a ./docs/build/ ~/src/sjl.bitbucket.org/cl-ggp
+	hg -R ~/src/sjl.bitbucket.org commit -Am 'cl-ggp: Update site.'
+	hg -R ~/src/sjl.bitbucket.org push
+
diff -r 000000000000 -r 251cea71ed58 README.markdown
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/README.markdown	Wed Mar 23 15:19:48 2016 +0000
@@ -0,0 +1,15 @@
+The GGP Protocol looks approximately like this:
+
+    (START <MATCH ID> <ROLE> <GAME DESCRIPTION> <STARTCLOCK> <PLAYCLOCK>)
+    READY
+
+    (PLAY <MATCH ID> <PRIOR MOVES>)
+    MOVE (explanation “...”) (taunt “...”)
+
+    (STOP <MATCH ID> <PRIOR MOVES>)
+    DONE
+
+Undocumented, because lol:
+
+    (INFO)
+    ((NAME MYNAME) (STATUS ???) (SPECIES LOL))
diff -r 000000000000 -r 251cea71ed58 cl-ggp.asd
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/cl-ggp.asd	Wed Mar 23 15:19:48 2016 +0000
@@ -0,0 +1,21 @@
+(asdf:defsystem #:cl-ggp
+  :name "ggp"
+  :description "A framework for writing General Game Playing clients."
+
+  :author "Steve Losh <steve@stevelosh.com>"
+  :maintainer "Steve Losh <steve@stevelosh.com>"
+
+  :license "MIT/X11"
+  :version "0.0.1"
+
+  :depends-on (#:clack
+               #:flexi-streams
+               #:optima
+               #:fare-quasiquote-optima
+               #:fare-quasiquote-readtable)
+
+  :serial t
+  :components ((:file "package")
+               (:module "src"
+                :components ((:file "ggp")))))
+
diff -r 000000000000 -r 251cea71ed58 docs/01-installation.markdown
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/docs/01-installation.markdown	Wed Mar 23 15:19:48 2016 +0000
@@ -0,0 +1,2 @@
+Installation
+============
diff -r 000000000000 -r 251cea71ed58 docs/02-overview.markdown
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/docs/02-overview.markdown	Wed Mar 23 15:19:48 2016 +0000
@@ -0,0 +1,83 @@
+Overview
+========
+
+`cl-ggp` handles the GGP protocol for you.  Players are implemented as CLOS
+objects.
+
+[TOC]
+
+Basics
+------
+
+You can create your own player by extending the `ggp-player` class, creating an
+object, and calling `start-player` on it to fire it up:
+
+    (defclass simple-player (ggp:ggp-player)
+      ())
+
+    (defvar *player* (make-instance 'simple-player
+                                    :name "SimplePlayer"
+                                    :port 4000))
+
+    (ggp:start-player *player*)
+
+`ggp-player` takes `:name` and `:port` initargs.  It has a few other internal
+slots you shouldn't mess with.
+
+You can kill a player with `kill-player`.
+
+Functionality
+-------------
+
+`cl-ggp` defines four generic methods that are called on players at various
+points in each game.  You can provide method definitions for some or all of
+these to let your player do whatever it needs to do.
+
+At a minimum you **must** implement `player-select-move`.  The others are
+optional and will default to doing nothing.
+
+### player-start-game
+
+    (defmethod player-start-game ((player YOUR-PLAYER) rules role start-clock play-clock)
+      ...)
+
+This is called when a new game starts.
+
+`rules` is the GDL rules of the game, parsed into Lisp lists/symbols.  You'll
+probably want to feed this into a logic library.
+
+`role` is a symbol representing which role you've been assigned.
+
+`start-clock` is 
+
+`play-clock` is 
+
+### player-update-game
+
+    (defmethod player-update-game ((player YOUR-PLAYER) moves)
+      ...)
+
+This is called once per turn, to update the game state with the moves each
+player selected.
+
+`moves` is a list of the moves made by all players.
+
+### player-select-move
+
+    (defmethod player-select-move ((player YOUR-PLAYER))
+      ...)
+
+This is called once per turn.  It should return the move your player wants to
+do.  All players **must** implement this function.
+
+### player-stop-game
+
+    (defmethod player-stop-game ((player YOUR-PLAYER))
+      ...)
+
+This is called when the game is stopped.  You can use it for things like tearing
+down any extra data structures you've made, suggesting a GC to your Lisp, etc.
+
+Example Player
+--------------
+
diff -r 000000000000 -r 251cea71ed58 docs/03-reference.markdown
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/docs/03-reference.markdown	Wed Mar 23 15:19:48 2016 +0000
@@ -0,0 +1,14 @@
+# API Reference
+
+The following is a list of all user-facing parts of `cl-ggp`.
+
+If there are backwards-incompatible changes to anything listed here, they will
+be noted in the changelog and the author will feel bad.
+
+Anything not listed here is subject to change at any time with no warning, so
+don't touch it.
+
+[TOC]
+
+## Package GGP
+
diff -r 000000000000 -r 251cea71ed58 docs/04-changelog.markdown
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/docs/04-changelog.markdown	Wed Mar 23 15:19:48 2016 +0000
@@ -0,0 +1,2 @@
+Changelog
+=========
diff -r 000000000000 -r 251cea71ed58 docs/api.lisp
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/docs/api.lisp	Wed Mar 23 15:19:48 2016 +0000
@@ -0,0 +1,130 @@
+(let ((*standard-output* (make-broadcast-stream)))
+  (ql:quickload "docparser"))
+
+(defparameter *index*
+  (docparser:parse :cl-ggp))
+
+(defparameter *document-packages*
+  (list "GGP"))
+
+(defparameter *header*
+  "The following is a list of all user-facing parts of `cl-ggp`.
+
+If there are backwards-incompatible changes to anything listed here, they will
+be noted in the changelog and the author will feel bad.
+
+Anything not listed here is subject to change at any time with no warning, so
+don't touch it.
+
+")
+
+
+;;;; From the CL Cookbook
+(defun replace-all (string part replacement &key (test #'char=))
+  "Returns a new string in which all the occurences of the part
+is replaced with replacement."
+  (with-output-to-string (out)
+    (loop with part-length = (length part)
+          for old-pos = 0 then (+ pos part-length)
+          for pos = (search part string
+                            :start2 old-pos
+                            :test test)
+          do (write-string string out
+                           :start old-pos
+                           :end (or pos (length string)))
+          when pos do (write-string replacement out)
+          while pos)))
+
+
+;;;; Documentation Utils
+(defun get-doc (package-name symbol-name)
+  (elt (docparser:query *index*
+                        :package-name package-name
+                        :symbol-name symbol-name)
+       0))
+(defun get-package-doc (package-name)
+  ;; good god, lemon
+  (docparser::find-package-index *index* package-name))
+
+
+;;;; Markdown Rendering
+(defun render-package-header (package-name)
+  (format t "## Package ~A~%~%"
+          (replace-all package-name "*" "\\*")))
+
+(defun render-package-docstring (package-name)
+  (let ((package-docstring
+         (docparser::package-index-docstring (get-package-doc package-name))))
+    (when package-docstring
+      (format t "~A~%~%" package-docstring))))
+
+(defun render-symbol-header (symbol-name extra)
+  (format t "### ~A~A~%~%"
+          (replace-all symbol-name "*" "\\*")
+          extra))
+
+(defun render-docstring (node)
+  (let ((documentation (docparser:node-docstring node)))
+    (when documentation
+      (format t "~A~%~%" documentation))))
+
+(defun render-lambda-list (node)
+  (format t "    ~A~%~%"
+          (cons (docparser:node-name node)
+                (docparser:operator-lambda-list node))))
+
+(defgeneric render-documentation (node symbol-name))
+
+
+(defmethod render-documentation ((node docparser:documentation-node) symbol-name)
+  (render-symbol-header symbol-name "")
+  (format t "`~A`~%~%" (class-of node))
+  (render-docstring node))
+
+(defmethod render-documentation ((node docparser:variable-node) symbol-name)
+  (render-symbol-header symbol-name " (variable)")
+  (render-docstring node))
+
+(defmethod render-documentation ((node docparser:function-node) symbol-name)
+  (render-symbol-header symbol-name " (function)")
+  (render-lambda-list node)
+  (render-docstring node))
+
+(defmethod render-documentation ((node docparser:macro-node) symbol-name)
+  (render-symbol-header symbol-name " (macro)")
+  (render-lambda-list node)
+  (render-docstring node))
+
+
+;;;; Documentation Sections
+(defun document-symbol (package-name symbol)
+  (let* ((symbol-name (symbol-name symbol))
+         (doc-node (get-doc package-name symbol-name)))
+    (render-documentation doc-node symbol-name)))
+
+(defun document-package (package-name)
+  (render-package-header package-name)
+  (render-package-docstring package-name)
+  (let ((symbols (loop :for s :being :the external-symbol :of package-name
+                       :collect s)))
+    (mapc #'(lambda (symbol)
+             (document-symbol package-name symbol))
+          (sort symbols #'string-lessp :key #'symbol-name))))
+
+(defun document-header ()
+  (format t "# API Reference~%~%")
+  (format t *header*)
+  (format t "[TOC]~%~%"))
+
+
+;;;; Main
+(defun main ()
+  (with-open-file (*standard-output* #p"docs/03-reference.markdown"
+                                     :direction :output
+                                     :if-exists :supersede)
+    (document-header)
+    (mapc #'document-package *document-packages*)))
+
+
+(main)
+
diff -r 000000000000 -r 251cea71ed58 docs/footer.markdown
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/docs/footer.markdown	Wed Mar 23 15:19:48 2016 +0000
@@ -0,0 +1,14 @@
+<i>Made with Lisp and love by [Steve Losh][] in Reykjavík, Iceland.</i>
+
+[Steve Losh]: http://stevelosh.com/
+
+<script>
+  (function(i,s,o,g,r,a,m){i['GoogleAnalyticsObject']=r;i[r]=i[r]||function(){
+  (i[r].q=i[r].q||[]).push(arguments)},i[r].l=1*new Date();a=s.createElement(o),
+  m=s.getElementsByTagName(o)[0];a.async=1;a.src=g;m.parentNode.insertBefore(a,m)
+  })(window,document,'script','//www.google-analytics.com/analytics.js','ga');
+
+  ga('create', 'UA-15328874-3', 'auto');
+  ga('send', 'pageview');
+
+</script>
diff -r 000000000000 -r 251cea71ed58 docs/index.markdown
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/docs/index.markdown	Wed Mar 23 15:19:48 2016 +0000
@@ -0,0 +1,11 @@
+`cl-ggp` is a tiny framework for writing [GGP][] players in Common Lisp.
+
+It handles the GGP protocol for you but *nothing else*.  In particular you'll
+need to bring your own logic system to parse the games.
+
+[GGP]: http://www.ggp.org/
+
+* **License:** MIT/X11
+* **Documentation:** <http://sjl.bitbucket.org/cl-ggp/>
+* **Code:** <http://bitbucket.org/sjl/cl-ggp/>
+* **Issues:** <http://bitbucket.org/sjl/cl-ggp/issues/>
diff -r 000000000000 -r 251cea71ed58 docs/title
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/docs/title	Wed Mar 23 15:19:48 2016 +0000
@@ -0,0 +1,1 @@
+cl-ggp
diff -r 000000000000 -r 251cea71ed58 package.lisp
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/package.lisp	Wed Mar 23 15:19:48 2016 +0000
@@ -0,0 +1,18 @@
+(defpackage #:ggp
+  (:use #:cl #:optima)
+  (:import-from #:optima #:match)
+  (:export
+    :ggp-player
+
+    :player-start-game
+    :player-update-game
+    :player-select-move
+    :player-stop-game
+
+    :player-name
+    :player-port
+
+    :start-player
+    :kill-player
+    ))
+
diff -r 000000000000 -r 251cea71ed58 src/example.lisp
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/example.lisp	Wed Mar 23 15:19:48 2016 +0000
@@ -0,0 +1,19 @@
+(in-package #:cl-user)
+
+(defclass simple-player (ggp:ggp-player)
+  ())
+
+(defmethod ggp:player-select-move ((player simple-player))
+  'wait)
+
+(defvar *player* nil)
+
+(setf *player* (make-instance 'simple-player
+                              :name "SimplePlayer"
+                              :port 5000))
+
+
+(ggp:start-player *player*)
+(ggp:kill-player *player*)
+
+(setf (slot-value *player* 'ggp::current-match) nil)
diff -r 000000000000 -r 251cea71ed58 src/ggp.lisp
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/ggp.lisp	Wed Mar 23 15:19:48 2016 +0000
@@ -0,0 +1,144 @@
+(in-package #:ggp)
+(named-readtables:in-readtable :fare-quasiquote)
+
+(defparameter *debug*
+  t)
+
+(defparameter *ggp-package*
+  (find-package :ggp))
+
+
+;;;; GGP Player
+(defclass ggp-player ()
+  ((name :initarg :name :initform "CL-GGP" :reader player-name)
+   (port :initarg :port :initform 9999 :reader player-port)
+   (current-match :initform nil)
+   (server)))
+
+(defgeneric player-start-game (player rules role start-clock play-clock))
+(defgeneric player-update-game (player moves))
+(defgeneric player-select-move (player))
+(defgeneric player-stop-game (player))
+
+
+(defmethod player-start-game ((player ggp-player) rules role start-clock play-clock)
+  nil)
+
+(defmethod player-update-game ((player ggp-player) moves)
+  nil)
+
+(defmethod player-select-move ((player ggp-player))
+  (error "Required method player-select-move is not implemented for ~A" player))
+
+(defmethod player-stop-game ((player ggp-player))
+  nil)
+
+
+;;;; Utils
+(defun safe-read-from-string (s)
+  ;; what could go wrong
+  (let ((*read-eval* nil)
+        (*package* *ggp-package*))
+    (read-from-string s)))
+
+(defun render-to-string (e)
+  (let ((*package* *ggp-package*))
+    (format nil "~A" e)))
+
+
+;;;; Clack Horseshit
+(defun l (&rest args)
+  (when *debug*
+    (apply #'format *debug-io* args)))
+
+(defun resp (body &key (code 200) (content-type "text/acl"))
+  (list code
+        (list :content-type content-type
+              :content-length (length body))
+        (list body)))
+
+(defun get-body (env)
+  ;; jesus christ clack why do i have to write this shit
+  (let ((body (make-array (getf env :content-length)
+                          :element-type 'flex:octet)))
+    (read-sequence body (getf env :raw-body))
+    (flex:octets-to-string body)))
+
+
+;;;; GGP Protocol
+(defun handle-info (player)
+  `((name ,(slot-value player 'name))
+    (status ,(if (slot-value player 'current-match) 'busy 'available))
+    (species alien)))
+
+(defun handle-start (player match-id role rules start-clock play-clock)
+  (declare (ignore play-clock))
+  (setf (slot-value player 'current-match) match-id)
+  (l "Starting match ~S as ~S~%" match-id role)
+  (player-start-game player rules role start-clock play-clock)
+  'ready)
+
+(defun handle-play (player match-id moves)
+  (l "Handling play request with moves ~S~%" moves)
+  (player-update-game player moves)
+  (player-select-move player))
+
+(defun handle-stop (player match-id moves)
+  (l "Handling stop request for ~S~%" match-id)
+  (player-stop-game player)
+  (setf (slot-value player 'current-match) nil)
+  'done)
+
+
+(defun route (player request)
+  "Route the request to the appropriate player function."
+  (match request
+    (`(info)
+     (handle-info player))
+
+    (`(play ,match-id ,moves)
+     (handle-play player match-id moves))
+
+    (`(stop ,match-id ,moves)
+     (handle-stop player match-id moves))
+
+    (`(start ,match-id ,role ,rules ,start-clock ,play-clock)
+     (handle-start player match-id role rules start-clock play-clock))
+
+    (unknown-request
+      (l "UNKNOWN REQUEST: ~S~%~%" unknown-request)
+      'what)))
+
+(defun should-log-p (request)
+  (match request
+    (`(info) nil)
+    (_ t)))
+
+;;;; Boilerplate
+(defun app (player env)
+  (let* ((body (get-body env))
+         (request (safe-read-from-string body))
+         (should-log (should-log-p request)))
+    (when should-log
+      (l "~%~%Got a request ====================================~%")
+      (l "~S~%" request)
+      (l "==================================================~%"))
+    (let* ((response (route player request))
+           (rendered-response (render-to-string response)))
+      (when should-log
+        (l "==================================================~%")
+        (l "Responding with:~%~A~%" rendered-response)
+        (l "==================================================~%"))
+      (resp rendered-response))))
+
+
+;;;; Spinup/spindown
+(defun start-player (player)
+  (let* ((player-handler #'(lambda (env) (app player env)))
+         (server (clack:clackup player-handler
+                                :port (player-port player))))
+    (setf (slot-value player 'server) server)
+    player))
+
+(defun kill-player (player)
+  (clack.handler:stop (slot-value player 'server)))