diff --git a/Gruntfile.js b/Gruntfile.js
new file mode 100644
index 0000000..883d58d
--- /dev/null
+++ b/Gruntfile.js
@@ -0,0 +1,67 @@
+module.exports = function(grunt) {
+
+ "use strict";
+
+ grunt.initConfig({
+
+ libFiles: [
+ "src/**/*.purs",
+ "bower_components/purescript-*/src/**/*.purs"
+ ],
+
+ clean: ["tmp", "output"],
+
+ pscMake: {
+ lib: {
+ src: ["<%=libFiles%>"]
+ },
+ tests: {
+ src: ["tests/Tests.purs", "<%=libFiles%>"]
+ }
+ },
+
+ dotPsci: ["<%=libFiles%>"],
+
+ copy: [
+ {
+ expand: true,
+ cwd: "output",
+ src: ["**"],
+ dest: "tmp/node_modules/"
+ }, {
+ src: ["js/index.js"],
+ dest: "tmp/index.js"
+ }
+ ],
+
+ execute: {
+ tests: {
+ src: "tmp/index.js"
+ }
+ },
+
+ // produce a single js file
+ psc: {
+ examples: {
+ options: {
+ module: ["BrowserMain"],
+ main: false
+ },
+ src: ["<%=libFiles%>"],
+ dest: "tmp/BrowserMain.js"
+ }
+ }
+ });
+
+ grunt.loadNpmTasks("grunt-contrib-copy");
+ grunt.loadNpmTasks("grunt-contrib-clean");
+ grunt.loadNpmTasks("grunt-execute");
+ grunt.loadNpmTasks("grunt-purescript");
+
+ grunt.registerTask("test", ["pscMake:tests", "copy", "execute:tests"]);
+ grunt.registerTask("make", ["pscMake:lib", "dotPsci"]);
+ grunt.registerTask("default",
+ // ["clean", "make", "test"]
+ ["clean", "make", "psc:examples"]
+ );
+};
diff --git a/LICENSE b/LICENSE
new file mode 100644
index 0000000..c0600b7
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,20 @@
+The MIT License (MIT)
+
+Copyright (c) 2014 Erik Post
+
+Permission is hereby granted, free of charge, to any person obtaining a copy of
+this software and associated documentation files (the "Software"), to deal in
+the Software without restriction, including without limitation the rights to
+use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of
+the Software, and to permit persons to whom the Software is furnished to do so,
+subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in all
+copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS
+FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR
+COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER
+IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
+CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
\ No newline at end of file
diff --git a/README.org b/README.org
new file mode 100644
index 0000000..6bd9464
--- /dev/null
+++ b/README.org
@@ -0,0 +1,26 @@
+#+title: PureScript Free Turtle interpreter
+
+A demonstration of a Turtle interpreter based on the Free monad, with HTML Canvas graphics support.
+
+Example:
+
+#+BEGIN_SRC purescript
+main :: Context2DEff
+main =
+ get2DContext "turtleCanvas" >>=
+ beginStroke >>=
+ compileTurtleProg star >>=
+ endStroke
+
+star = do
+ right 144
+ forward 100
+ right 144
+ forward 100
+ right 144
+ forward 100
+ right 144
+ forward 100
+ right 144
+ forward 100
+#+END_SRC
diff --git a/bower.json b/bower.json
new file mode 100644
index 0000000..1c5b78b
--- /dev/null
+++ b/bower.json
@@ -0,0 +1,27 @@
+{
+ "name": "purescript-free-turtle",
+ "description": "A demonstration of a Turtle interpreter based on the Free monad, with HTML Canvas graphics support.",
+ "keywords": ["purescript"],
+ "ignore": [
+ "**/.*",
+ "bower_components",
+ "node_modules",
+ "output",
+ "tests",
+ "js",
+ "tmp",
+ "bower.json",
+ "Gruntfile.js",
+ "package.json"
+ ],
+ "dependencies": {
+ "purescript-free" : "*",
+ "purescript-math" : "*",
+ "purescript-arrays" : "*",
+ "purescript-maybe" : "*",
+ "purescript-foldable-traversable" : "*"
+ },
+ "devDependencies": {
+ "purescript-quickcheck" : "*"
+ }
+}
diff --git a/html/index.html b/html/index.html
new file mode 100644
index 0000000..93049de
--- /dev/null
+++ b/html/index.html
@@ -0,0 +1,34 @@
+
+
+
+
+
+ PureScript Free Turtle
+
+
+
+
+
+
+
+
diff --git a/package.json b/package.json
new file mode 100644
index 0000000..809a2ca
--- /dev/null
+++ b/package.json
@@ -0,0 +1,16 @@
+{
+ "name": "purescript-free-turtle",
+ "version": "0.1.0",
+ "description": "A demonstration of a Turtle interpreter based on the Free monad, with HTML Canvas graphics support.",
+ "main": "",
+ "private": true,
+ "author": "Erik Post",
+ "license": "MIT",
+ "dependencies": {
+ "grunt": "~0.4.4",
+ "grunt-contrib-copy": "~0.5.0",
+ "grunt-contrib-clean": "~0.5.0",
+ "grunt-execute": "~0.1.5",
+ "grunt-purescript": "~0.5.0"
+ }
+}
diff --git a/src/BrowserMain.purs b/src/BrowserMain.purs
new file mode 100644
index 0000000..0ada6de
--- /dev/null
+++ b/src/BrowserMain.purs
@@ -0,0 +1,31 @@
+module BrowserMain where
+
+import Language
+import CanvasCompiler
+import Canvas
+import Util
+import Control.Monad
+import Control.Monad.Eff
+import Debug.Trace
+
+
+main :: Context2DEff
+main =
+ get2DContext "turtleCanvas" >>=
+ beginStroke >>=
+ compileTurtleProg star >>=
+ endStroke
+
+star = do
+ right 144
+ forward 100
+ right 144
+ forward 100
+ right 144
+ forward 100
+ right 144
+ forward 100
+ right 144
+ forward 100
+
+star' = forward 100 >> star
diff --git a/src/Canvas.purs b/src/Canvas.purs
new file mode 100644
index 0000000..d3f2c0d
--- /dev/null
+++ b/src/Canvas.purs
@@ -0,0 +1,57 @@
+module Canvas where
+
+import Control.Monad.Eff
+
+foreign import data Context2D :: *
+foreign import data DOM :: !
+
+type Context2DEff = Eff (dom :: DOM) Context2D
+
+
+foreign import get2DContext
+ """
+ function get2DContext(canvasId) {
+ return function() {
+ return document.getElementById(canvasId).getContext('2d');
+ };
+ }
+ """ :: forall eff. String -> Context2DEff
+
+
+foreign import beginStroke
+ """
+ function beginStroke(context) {
+ return function() {
+ context.beginPath();
+ context.lineWidth = 2;
+ context.strokeStyle = 'purple';
+ context.moveTo(0, 0);
+ return context;
+ };
+ }
+ """ :: forall eff. Context2D -> Context2DEff
+
+foreign import endStroke
+ """
+ function endStroke(context) {
+ return function() {
+ context.stroke();
+ return context;
+ };
+ }
+ """ :: forall eff. Context2D -> Context2DEff
+
+foreign import lineTo
+ """
+ function lineTo(x) {
+ return function(y) {
+ return function (context) {
+ return function() {
+ //console.log('executing lineTo(', x, ',', y, ')');
+ context.lineTo(x,y);
+ return context;
+ };
+ };
+ };
+ }
+ """ :: Number -> Number -> Context2D -> Context2DEff
diff --git a/src/CanvasCompiler.purs b/src/CanvasCompiler.purs
new file mode 100644
index 0000000..7f629f1
--- /dev/null
+++ b/src/CanvasCompiler.purs
@@ -0,0 +1,68 @@
+module CanvasCompiler where
+
+import Canvas
+import Language
+import Control.Monad
+import Control.Monad.Free
+import Control.Monad.State
+import Control.Monad.Trans
+import Control.Monad.State.Class
+import Control.Monad.Eff
+import Data.Tuple
+import Data.Foldable
+import Math (sin, cos, pi)
+
+
+-- | x, y, rotation
+data Turtle = Turtle Number Number Angle
+
+instance turtleShow :: Show Turtle where
+ show (Turtle x y angle) = "(Turtle " ++ show x ++ " " ++ show y ++ " " ++ show angle ++ ")"
+
+
+compileTurtleProg :: forall a. TurtleProg a -> Context2D -> Context2DEff
+compileTurtleProg turtleProg ctx = foldl (>>=) (pure ctx) (compileTurtleProg' turtleProg)
+
+
+compileTurtleProg' :: forall a. TurtleProg a -> [Context2D -> Context2DEff]
+compileTurtleProg' turtleProg =
+
+ evalState turtleProgState (Turtle 0 0 0)
+
+ where turtleProg' = const [] <$> turtleProg
+ turtleProgState = compileTurtleProg'' turtleProg'
+
+
+compileTurtleProg'' :: TurtleProg [Context2D -> Context2DEff]
+ -> State Turtle [Context2D -> Context2DEff]
+compileTurtleProg'' = goM compileCmd
+
+ -- pick off the outermost TurtleCmd from the TurtleProg and process it
+ where compileCmd :: TurtleCmd (TurtleProg [Context2D -> Context2DEff])
+ -> State Turtle (TurtleProg [Context2D -> Context2DEff])
+
+ compileCmd (Forward r rest) = do
+
+ Turtle x y angle <- get
+
+ let x' = x + adjacent r angle
+ y' = y + opposite r angle
+ instr = lineTo x' y'
+
+ put (Turtle x' y' angle)
+
+ return ((\prog -> prog ++ [instr]) <$> rest)
+
+
+ compileCmd (Right angleDeg rest) = do
+
+ let angle = rad angleDeg
+
+ modify $ \(Turtle x y angle0) -> Turtle x y (angle0 + angle)
+
+ return rest
+
+
+adjacent r angle = r * cos angle
+opposite r angle = r * sin angle
+rad angleDegrees = (2 * pi * (angleDegrees % 360)) / 360
diff --git a/src/Language.purs b/src/Language.purs
new file mode 100644
index 0000000..4a28cce
--- /dev/null
+++ b/src/Language.purs
@@ -0,0 +1,30 @@
+module Language where
+
+import Control.Monad
+import Control.Monad.Free
+import Control.Monad.State
+import Control.Monad.Trans
+import Control.Monad.State.Class
+
+
+type Angle = Number
+
+data TurtleCmd a = Forward Number a
+ | Right Angle a
+
+instance turtleCmd :: Functor TurtleCmd where
+ (<$>) f (Forward dist r) = Forward dist (f r)
+ (<$>) f (Right angle r) = Right angle (f r)
+
+instance turtleCmdShow :: (Show a) => Show (TurtleCmd a) where
+ show x = "(TurtleCmd)"
+
+type TurtleProg = Free TurtleCmd
+
+forward :: Number -> forall a. (TurtleProg Unit)
+forward n = liftF (Forward n unit)
+
+right :: Angle -> forall a. (TurtleProg Unit)
+right angle = liftF (Right angle unit)
+
+left angle = right (360 - angle)
diff --git a/src/Util.purs b/src/Util.purs
new file mode 100644
index 0000000..4d492d7
--- /dev/null
+++ b/src/Util.purs
@@ -0,0 +1,7 @@
+module Util where
+
+infixl 1 >>
+
+(>>) :: forall m a b. (Monad m) => m a -> m b -> m b
+(>>) ma mb = ma >>= (\_ -> mb)
+