diff --git a/penrose.cabal b/penrose.cabal
--- a/penrose.cabal
+++ b/penrose.cabal
@@ -2,7 +2,7 @@
 -- documentation, see http://haskell.org/cabal/users-guide/
 
 name:                penrose
-version:             0.1.0.0
+version:             0.1.0.1
 synopsis:            A system that automatically visualize mathematics
 -- description:         
 homepage:            http://penrose.ink
@@ -18,7 +18,7 @@
 
 executable penrose
   main-is:             Main.hs
-  -- other-modules:       
+  other-modules:       Utils Server StyAst Compiler Functions
   other-extensions:    AllowAmbiguousTypes, RankNTypes, UnicodeSyntax, NoMonomorphismRestriction, OverloadedStrings, DeriveGeneric, DuplicateRecordFields
   build-depends:       base >=4.9 && <4.10, random >=1.1 && <1.2, containers >=0.5 && <0.6, gloss >=1.11 && <1.12, megaparsec >=5.3 && <5.4, ad >=4.3 && <4.4, aeson >=1.2 && <1.3, text >=1.2 && <1.3, websockets >=0.11 && <0.12, old-time >=1.1 && <1.2
   hs-source-dirs:      src
diff --git a/src/Compiler.hs b/src/Compiler.hs
new file mode 100644
--- /dev/null
+++ b/src/Compiler.hs
@@ -0,0 +1,491 @@
+ module Compiler where
+-- TODO split this up + do selective export
+
+import System.IO -- read/write to file
+import System.Environment
+import Control.Arrow ((>>>))
+import System.Random
+import Debug.Trace
+import Data.List
+
+-- Substance grammar
+
+data SetType = Open | Closed | Unspecified
+     deriving (Show, Eq)
+
+data Set = Set' String SetType
+     deriving (Show, Eq)
+
+data Pt = Pt' String
+     deriving (Show, Eq)
+
+-- Map <label> <from-set> <to-set>
+data Map = Map' String String String -- TODO needs validation vs Set Set
+     deriving (Show, Eq)
+
+data SubObj = OS Set | OP Pt | OM Map
+     deriving (Show, Eq)
+-- TODO open sets?? they should inherit style characteristics from sets
+
+data SubObjType = Set SetType | Pt | Map -- how to tie this to the types above
+     deriving (Show, Eq)
+
+data SubDecl = Decl SubObj
+     deriving (Show, Eq)
+
+-- TODO vs. Set Set. user only specifies names
+-- TODO we assume that non-subset sets must not overlap (implicit constraint)
+data SubConstr = Intersect String String
+               | NoIntersect String String
+               | Subset String String
+               | NoSubset String String
+               | PointIn String String
+               | PointNotIn String String
+     deriving (Show, Eq)
+
+data SubLine = LD SubDecl | LC SubConstr
+     deriving (Show, Eq)
+-- TODO do some program analysis to split the decls and constraints, which refer to things in the decls
+-- and validate that the things they refer to are the right type (inline at some point??)
+
+type SubSpec = [SubLine]
+type SubSpecDiv = ([SubDecl], [SubConstr])
+
+-- Sample Substance programs (more in file)
+sub0 = "Set A"
+sub1 = "OpenSet A"
+sub2 = "Set A\nOpenSet B"
+sub3 = "Set A\nOpenSet B\nSubset A B"
+
+-- test
+subSpecs = [sub0, sub1, sub2, sub3]
+subTest = subValidateAll subSpecs
+
+-- specs for 3 continuous map diagrams can be found in continuousmap1.sub, etc.
+
+-- Substance parser
+-- TODO divide into decls and constraints for typechecking and reference checking
+-- parsing human-written programs: extra spaces ok (words removes them).
+-- extra newlines ok (filter empty lines out). HOWEVER, this is not ok for validation, as
+-- the pretty-printer does not add additional whitespace.
+subParse :: String -> SubSpec
+subParse = map (subToLine . words) . filter nonempty . lines
+         where nonempty x = (x /= "")
+
+-- parses based on line length. should really tokenize and behave like DFA
+-- TODO fix this or use lexer / parser generator
+subToLine :: [String] -> SubLine
+subToLine s@[x, y] = LD $ Decl $
+                  if x == "Set" then OS (Set' y Unspecified)
+                  else if x == "OpenSet" then OS (Set' y Open)
+                  else if x == "ClosedSet" then OS (Set' y Closed)
+                  else if x == "Point" then OP (Pt' y)
+                  else error $ "Substance spec line: 2-token line '"
+                       ++ show s ++ "' does not begin with Set/OpenSet/ClosedSet"
+
+-- TODO validate names exist in decls, are of type set
+-- TODO auto-gen parser from grammar
+subToLine s@[x, y, z] = LC $
+                   if x == "Intersect" then Intersect y z
+                   else if x == "NoIntersect" then NoIntersect y z
+                   else if x == "Subset" then Subset y z
+                   else if x == "NoSubset" then NoSubset y z
+                   else if x == "In" then PointIn y z -- TODO ^
+                   else if x == "NotIn" then PointNotIn y z
+                   else error $ "Substance spec line: 3-token line '"
+                     ++ show s ++ "' does not begin with (No)Intersect/Subset/(Not)In"
+
+subToLine s@[w, x, y, z] = LD $ Decl $
+                   if w == "Map" then OM (Map' x y z)
+                   else error $ "Substance spec line: 4-token line '"
+                       ++ show s ++ "' does not begin with Map"
+
+subToLine s = error $ "Substance spec line '" ++ show s ++ "' is not 2, 3, or 4 tokens"
+
+-- Pretty-printer for Substance AST
+subPrettyPrintLine :: SubLine -> String
+subPrettyPrintLine (LD (Decl decl)) = case decl of
+                   OS (Set' name stype) -> case stype of
+                                          Open -> "OpenSet " ++ name
+                                          Closed -> "ClosedSet " ++ name
+                                          Unspecified -> "Set " ++ name
+                   OP (Pt' name) -> "Point " ++ name
+                   OM (Map' x y z) -> "Map " ++ x ++ " " ++ y ++ " " ++ z
+subPrettyPrintLine (LC constr) = case constr of
+                     Subset s1 s2   -> "Subset " ++ s1 ++ " " ++ s2
+                     PointIn p s    -> "In " ++ p ++ " " ++ s
+                     PointNotIn p s -> "NotIn " ++ p ++ " " ++ s
+
+subPrettyPrint :: SubSpec -> String
+subPrettyPrint s = concat $ intersperse nl $ map subPrettyPrintLine s
+
+-- Ugly pretty-printer for Substance
+subPrettyPrintLine' :: SubLine -> String
+subPrettyPrintLine' = show
+
+subPrettyPrint' :: SubSpec -> String
+subPrettyPrint' s = concat $ intersperse nl $ map subPrettyPrintLine' s
+
+-- if a well-formed program is parsed, its output should equal the original
+subValidate :: String -> Bool
+subValidate s = (s == (subPrettyPrint $ subParse s))
+
+subValidateAll :: [String] -> Bool
+subValidateAll = all subValidate
+
+-- Substance reference checker TODO
+-- returns lines in same order as in program
+subSeparate :: SubSpec -> SubSpecDiv
+subSeparate = foldr separate ([], [])
+            where separate line (decls, constrs) =
+                           case line of
+                           (LD x) -> (x : decls, constrs)
+                           (LC x) -> (decls, x : constrs)
+
+-- Substance typechecker TODO
+
+---------------------------------------
+
+-- Style grammar (relies on the Substance grammar, specifically SubObj)
+-- no styling for constraints
+
+data SetShape = SetCircle | Box
+     deriving (Show, Eq)
+
+data PtShape = SolidDot | HollowDot | Cross
+     deriving (Show, Eq)
+
+-- data MapShape = LeftArr | RightArr | DoubleArr
+data MapShape = SolidArrow
+     deriving (Show, Eq)
+
+data Direction = Horiz | Vert | Angle Float
+     deriving (Show, Eq)
+
+data SubShape = SS SetShape | SP PtShape | SM MapShape
+     deriving (Show, Eq)
+
+data LineType = Solid | Dotted
+     deriving (Show, Eq, Read)
+
+data Color = Red | Blue | Black | Yellow -- idk
+     deriving (Show, Eq, Read)
+
+data M a = Auto | Override a -- short for Maybe (option type)
+     deriving (Show, Eq)
+
+data StyLevel = SubVal String | LabelOfSubVal String | SubType SubObjType | Global
+     deriving (Show, Eq)
+-- LabelOfSubObj is meant to allow styling of whatever label object A (originally named A) now has
+-- e.g. it could be named "hello" with Label (SubValue "A") (Override "Hello"). (don't label labels)
+-- then do (Position (LabelOfSubObj "A") 100 200)
+
+type Opacity = Float -- 0 to 100%, TODO validate
+type Priority' = Float -- higher = higher priority
+
+-- There are three different layers of Style: global setting (over all types),
+-- type setting (over all values of that type), and value setting.
+-- The more specific ones implicitly override the more general ones.
+-- If there are two conflicting ones at the same level, the more recent one will be used for "everything"
+-- TODO more sophisticated system with scope
+-- TODO if some aspect of style unspecified, then supplement with default
+-- any setting is implicitly an override of the global default style
+-- can choose to leave out an aspect (= implicitly auto), or explicitly specify auto; same thing
+-- TODO need to validate that the shape specified matches that of the type
+-- e.g. Shape Map Diamond is invalid
+-- also, order does not matter between lines
+data StyLine = Shape StyLevel (M SubShape) -- implicitly solid unless line is specified
+               | Line StyLevel (M LineType) (M Float) -- hollow shape; non-negative thickness
+               | Color StyLevel (M Color) (M Opacity)
+               | Priority StyLevel (M Priority') -- for line breaking
+               | Dir StyLevel (M Direction)
+               | Label StyLevel (M String) -- TODO add ability to turn off labeling
+               | Scale StyLevel (M Float) -- scale factor
+               | AbsPos StyLevel (M (Float, Float)) -- in pixels; TODO relative positions
+     deriving (Show, Eq)
+
+type StySpec = [StyLine]
+
+-- Sample Style programs and tests
+-- TODO style is more complicated than substance; this doesn't test it fully
+
+nl = "\n"
+together = intercalate nl
+sty0 = "Shape Global Circle"
+sty1 = "Shape Set Box"
+sty2 = "Shape A Circle"
+sty3 = together [sty0, sty1, sty2] -- test overrides
+sty4 = "Shape Set Circle\nShape Map RightArr\nLine Map Solid"
+sty5 = "Line Map Dotted 5.01"
+sty6 = "Color All Red 66.7"
+sty7 = "Priority Label_AB 10.1"
+sty8 = "Label All hithere"
+sty9 = "Label Label_AB oh_no" -- TODO don't label labels. also allow spaces in labels (strings)
+sty10 = "Direction Map Horizontal"
+-- test all
+sty_all = "Shape Set Circle\nShape Map RightArrow\nLine Map Solid Auto\nColor Global Blue 100\nPriority Map 100\nPriority Set 50\nDirection Map Horizontal\nDirection A Vertical\nLabel A NewA\nScale A 100\nPosition A -100 501\nColor Label_A Blue 100"
+-- TODO deal with OpenSet, ClosedSet
+-- TODO write tests of substance working *with* style
+
+-- TODO add tests that should fail
+styf1 = "Shape"
+styf2 = "Shape Label_A"
+styf3 = "Line Dotted 5.01"
+
+-- TODO syntactically valid but semantically invalid programs
+styfs1 = "Shape Map Circle"
+
+-- Style parser
+styParse :: String -> StySpec -- same as subParse
+styParse = map (styToLine . words) . filter nonempty . lines
+         where nonempty x = (x /= "")
+
+getLevel :: String -> StyLevel
+getLevel s = if s == "All" then Global
+             -- TODO will need to update parsers whenever I add a new type...
+             else if s == "Set" then SubType (Set Unspecified)
+             else if s == "OpenSet" then SubType (Set Open)
+             else if s == "ClosedSet" then SubType (Set Closed)
+             else if s == "Point" then SubType Pt
+             else if s == "Map" then SubType Map
+             else if (take 6 s == "Label_")
+                  then let res = drop 6 s in
+                       if length res > 0 then LabelOfSubVal res
+                       else error "Empty object name ('Label_') in style level"
+             else SubVal s -- sets could be named anything; later we validate that this ref exists
+
+getShape :: [String] -> M SubShape
+getShape [] = error "No Style shape param"
+getShape [x] = if x == "Auto" then Auto
+               else if x == "Circle" then Override (SS SetCircle)
+               else if x == "Box" then Override (SS Box)
+               else if x == "SolidDot" then Override (SP SolidDot)
+               else if x == "HollowDot" then Override (SP HollowDot)
+               else if x == "Cross" then Override (SP Cross)
+               else if x == "SolidArrow" then Override (SM SolidArrow)
+            --    else if x == "LeftArrow" then Override (SM LeftArr)
+            --    else if x == "RightArrow" then Override (SM RightArr)
+            --    else if x == "DoubleArrow" then Override (SM DoubleArr)
+               else error $ "Invalid shape param '" ++ show x ++ "'"
+getShape s = error $ "Too many style shape params in '" ++ show s ++ "'"
+
+handleAuto :: String -> (String -> a) -> M a
+handleAuto v f = if v == "Auto" then Auto else Override (f v)
+
+readFloat :: String -> Float
+readFloat x = read x :: Float
+
+styToLine :: [String] -> StyLine
+styToLine [] = error "Style spec line is empty"
+styToLine s@[x] = error $ "Style spec line '" ++ show s ++ "' is only 1 token"
+styToLine s@(x : y : xs) =
+          let level = getLevel y in -- throws its own errors
+          if x == "Shape" then
+             let shp = getShape xs in -- TODO handle Auto
+             Shape level shp
+          else if x == "Line" then
+             case xs of
+             [a, b] -> let ltype = handleAuto a (\x -> read x :: LineType) in -- TODO read is hacky, bad errorsn
+                       let lthick = handleAuto b readFloat in
+                       Line level ltype lthick
+             _ -> error $ "Incorrect number of params (not 3) for Line: '" ++ show xs ++ "'"
+          else if x == "Color" then
+               case xs of
+               [a, b] -> let ctype = handleAuto a (\x -> read x :: Color) in
+                         let opacity = handleAuto b readFloat in
+                         Color level ctype opacity
+               _ -> error $ "Incorrect # of params (not 3) for Color: '" ++ show xs ++ "'"
+          else if x == "Priority" then
+               case xs of
+               [a] -> let priority = handleAuto a readFloat in
+                      Priority level priority
+               _  -> error $ "Incorrect number of params (not 2) for Priority: '" ++ show xs ++ "'"
+          else if x == "Direction" then
+               case xs of
+               [a] -> let dir = handleAuto a (\x -> if x == "Horizontal" then Horiz
+                                                    else if x == "Vertical" then Vert
+                                                    else Angle (read x :: Float)) in
+                      Dir level dir
+               _  -> error $ "Incorrect number of params (not 2) for Direction: '" ++ show xs ++ "'"
+          else if x == "Label" then
+               case xs of
+               [a] -> Label level (handleAuto a id) -- label name is a string
+               _  -> error $ "Incorrect number of params (not 2) for Label: '" ++ show xs ++ "'"
+          else if x == "Scale" then
+               case xs of
+               [a] -> let scale = handleAuto a readFloat in
+                      Scale level scale
+               _  -> error $ "Incorrect number of params (not 2) for Scale: '" ++ show xs ++ "'"
+          else if x == "Position" then
+               case xs of
+               [a] -> if a == "Auto" then AbsPos level Auto
+                      else error $ "Only 1 param, but it is not Auto: '" ++ show a ++ "'"
+               [a, b] -> let x' = readFloat a in -- no Auto allowed if two params
+                         let y' = readFloat b in
+                         AbsPos level (Override (x', y'))
+               _  -> error $ "Incorrect number of params (not 2) for Position: '" ++ show xs ++ "'"
+          else error $ "Style spec line: '" ++ show s
+               ++ "' does not begin with Shape/Line/Color/Priority/Direction/Label/Scale/Position"
+
+-- Pretty-printer for Style AST
+-- TODO write the full pretty-printer
+styPrettyPrintLine :: StyLine -> String
+styPrettyPrintLine = show
+
+styPrettyPrint :: StySpec -> String
+styPrettyPrint s = concat $ intersperse nl $ map styPrettyPrintLine s
+
+-- Style validater
+
+-- Style typechecker TODO
+
+-- Style reference checker
+
+---------------------------------------
+
+-- Take a Substance and Style program, and produce the abstract layout representation
+
+-- TODO try doing this w/o Style first? everything is compiled to a default style with default labels
+-- write out applying Style on top: applying global overrides, then by type, then by name
+-- going to need some kind of abstract intermediate type
+-- figure out the intermediate subsets of the language I can support
+  -- e.g. map requires me to draw arrows, don't support direction and priority for now
+-- how many objects I can support, e.g. A -> B -> C -> D requires scaling the size of each obj to fit on canvas
+-- how the optimization code needs to scale up to meet the needs of multiple objects (labels only?)
+-- also, optimization on multiple layouts
+-- how to lay things out w/ constraints only (maybe)
+-- how to apply optimization to the labels & what their obj functions should be
+
+-- TODO finish parser for both, put into Slack tonight w/ description of override, continuousmap1.sub/sty
+
+-- Substance only, circular sets only -> world state
+-- then scale up optimization code to handle any number of sets
+-- then support the Subset constraint only
+-- then add labels and set styles
+subt1 = "Set A"
+subt2 = "Set A\nSet B"
+subt2a = "Set A\nSet B\nSubset A B"
+subt3 = "Set A\nSet B\nSet C"
+subt4 = "Set A\nSet B\nSet C"
+subt4a = "Set A\nSet B\nOpenSet C"
+subt5 = "Set A\nSet B\nOpenSet C\nSubset B C"
+styt1 = "Color Set Blue 50"
+styt2 = "Color Set Blue 50\nLine OpenSet Dotted 1"
+
+-- New type: inner join (?) of Decl with relevant constraint lines and relevant style lines
+-- (only the ones that apply; not the ones that are overridden)
+-- Type: Map Var (Decl, [SubConstr], [StyLine]) <-- the Var is the object's name (string) in Substance
+-- does this include labels?? it includes overridden labels in StyLine but not labels like Set A -> "A"
+-- for now, assume what about labels? -- are they separate? should they be linked? they all get default style
+  -- make a separate Map Label ObjName ? no, assuming no renaming for now
+-- then we need to write a renderer type: Decl -> (Position, Size) -> [StyLine] -> Picture)
+  -- also (Label -> (Position, Size) -> [StyLine] -> Picture)
+
+-- if we do a demo entirely w/o optimization... is that easier? and how would I do it?
+  -- layout algo (for initial state, at least): randomly place objs (sets, points) w/ no constraints
+  -- or place aligned horizontally so they don't intersect, choose radius as fn of # unconstrained objs?
+  -- for constraints: for any set that's a subset of another, pick a smaller radius & place it inside that set.
+  -- constraints: same for points (in fact, easier for points)--place it (at r/2, 45 degrees) inside that set
+  -- there's no validation... a point/set could be in multiple sets?? assume not
+  -- at this point we're almost hardcoding the diagram? not necessarily
+  -- TODO actually hardcode the diagram in gloss; seeing the final representation will help
+  -- add'l constraint: all other objects should not intersect. use optimization to maintain exclusion?
+-- it seems likely that i'll get rid of the opt part for diagrams--might rewrite code instead of using opt code
+
+-- BUT can I use opt for labels, given a fixed diagram state?
+  -- put all labels in center. set label is attracted to center or just-outside-or-inside border of set,
+  -- point label is attracted to just-outside-point, map label attracted to center
+  -- all labels repulsed from other objects and labels.
+  -- would hardcoding label locations be a bad thing to do?
+  -- creating unconstrained objective fn: f :: DiagramInfo -> LabelInfo -> Label Positions -> Label Positions
+  -- where f info pos = f_attract info pos + f_repel info pos, and each includes the pairwise interactions
+  -- can autodiff deal with this? does this preserve the (forall a. Floating a => [a] -> a) type?
+  -- is the function too complicated for autodiff?
+
+-- TODO simple optimizer type, using state (Position and Size): ??
+  -- optimization fn: put all sets at the center, then use centerAndRepel. how to maintain subset?
+-- the things the optimizer needs to know are Name, Position, Size, SubObjType (which includes names of other objects that this one is linked to, e.g. Map)... (later: needs to know Direction Label Scale AbsPos)
+-- and it updates the Position and possibly the Size
+
+-- TODO how to synthesize the objective functions and constraint functions and implicit constraints?
+-- pairwise interactions? see above
+
+-- Since the compiler and the runtime share the layout representation,
+-- I'm going to re-type it here since the rep may change.
+-- Runtime imports Compiler as qualified anyway, so I can just convert the types again there.
+-- Here: removing selc / sell (selected). Don't forget they should satisfy Located typeclass
+data Circ = Circ { namec :: String
+                 , xc :: Float
+                 , yc :: Float
+                 , r :: Float }
+     deriving (Eq, Show)
+
+data Label' = Label' { xl :: Float
+                   , yl :: Float
+                   , textl :: String
+                   , scalel :: Float }  -- calculate h,w from it
+     deriving (Eq, Show)
+
+data Obj = C Circ | L Label' deriving (Eq, Show)
+
+defaultRad = 100
+
+-- TODO these functions are now unused
+-- declToShape :: SubDecl -> [Obj]
+-- declToShape (Decl (OS (Set' name setType))) =
+--             case setType of
+--             Open -> [C $ Circ { namec = name, xc = 0, yc = 0, r = defaultRad }, L $ Label' { xl = 0, yl = 0, textl = name, scalel = 1 }]
+--             Closed -> [C $ Circ { namec = name, xc = 0, yc = 0, r = defaultRad }, L $ Label' { xl = 0, yl = 0, textl = name, scalel = 1 }]
+--             Unspecified -> [C $ Circ { namec = name, xc = 0, yc = 0, r = defaultRad }, L $ Label' { xl = 0, yl = 0, textl = name, scalel = 1 }]
+-- declToShape (Decl (OP (Pt' name))) = error "Substance -> Layout doesn't support points yet"
+-- declToShape (Decl (OM (Map' mapName fromSet toSet))) = error "Substance -> Layout doesn't support maps yet"
+
+-- toStateWithDefaultStyle :: [SubDecl] -> [Obj]
+-- toStateWithDefaultStyle decls = concatMap declToShape decls -- should use style
+
+-- subToLayoutRep :: SubSpec -> [Obj] -- this needs to know about the Obj type??
+-- subToLayoutRep spec = let (decls, constrs) = subSeparate spec in
+--                    toStateWithDefaultStyle decls
+
+-- Substance + Style typechecker
+
+-- Substance + Style reference checker
+
+-- Produce the constraints and objective function
+
+-- Add rendering and interaction info to produce a world state for gloss
+
+---------------------------------------
+
+-- Runtime: layout algorithm picks a smart initial state
+-- then tries to satisfy constraints and minimize objective function, live and interactively
+-- TODO make module for this and optimization code
+
+---------------------------------------
+
+-- ghc compiler.hs; ./compiler <filename>.sub
+parseSub = do
+       args <- getArgs
+       let fileIn = head args
+       program <- readFile fileIn
+       putStrLn $ show $ subParse program
+       putStrLn $ show $ subValidate program
+
+-- ghc compiler.hs; ./compiler <filename>.sty
+parseSty = do
+       args <- getArgs
+       let fileIn = head args
+       program <- readFile fileIn
+       putStrLn $ styPrettyPrint $ styParse program
+
+-- ghc compiler.hs; ./compiler <filename>.sub <filename>.sty
+subAndSty = do
+       args <- getArgs
+       let (subFile, styFile) = (head args, args !! 1) -- TODO usage
+       subIn <- readFile subFile
+       styIn <- readFile styFile
+       putStrLn $ subPrettyPrint $ subParse subIn
+       putStrLn "--------"
+       putStrLn $ styPrettyPrint $ styParse styIn
+
+main = subAndSty
diff --git a/src/Functions.hs b/src/Functions.hs
new file mode 100644
--- /dev/null
+++ b/src/Functions.hs
@@ -0,0 +1,335 @@
+{-# LANGUAGE AllowAmbiguousTypes, RankNTypes, UnicodeSyntax, NoMonomorphismRestriction #-}
+module Functions where
+import Shapes
+import Utils
+import qualified Data.Map.Strict as M
+
+----------------------- Sample objective functions that operate on objects (given names)
+-- TODO write about expectations for the objective function writer
+
+-- type ObjFnOn a = forall a. (Floating a, Real a, Show a, Ord a) => [Name] -> M.Map Name (Obj' a) -> a
+type ObjFnOn a = forall a. (Floating a, Real a, Show a, Ord a) => [Obj' a] -> a
+-- illegal polymorphic or qualified type--can't return a forall?
+type ObjFnNamed a = forall a. (Floating a, Real a, Show a, Ord a) => M.Map Name (Obj' a) -> a
+type Weight a = a
+
+-- TODO deal with lists in a more principled way
+-- maybe the typechecking should be done elsewhere...
+-- shouldn't these two be parametric over objects?
+centerCirc :: ObjFnOn a
+centerCirc [C' c] = (xc' c)^2 + (yc' c)^2
+centerCirc [L' _] = error "misnamed label"
+
+-- distanceOf :: ObjFnOn a
+-- toLeft [fromname, toname] dict =
+--     case (M.lookup fromname dict, M.lookup toname dict) of
+--         -- (Just (A' a), Just (S' s), Just (S' e)) ->
+--         -- (Just (A' a), Just (S' s), Just (C' e)) ->
+--         -- (Just (A' a), Just (C' s), Just (S' e)) ->
+--         (Just (C' s), Just (C' e)) ->
+--             -- (fromx - sx)^2 + (fromy - sy)^2 + (tox - ex)^2 + (toy - ey)^2
+--             (xc' s - xc' e + 400)^2
+
+onTop :: ObjFnOn a
+onTop [L' s, L' e] = (yl' s - yl' e - 100)^2
+
+sameHeight :: ObjFnOn a
+sameHeight [C' s, S' e] = (yc' s - ys' e)^2
+sameHeight [S' s, C' e] = (ys' s - yc' e)^2
+sameHeight [C' s, C' e] = (yc' s - yc' e)^2
+sameHeight [S' s, S' e] = (ys' s - ys' e)^2
+sameHeight [L' s, L' e] = (yl' s - yl' e)^2
+
+sameX :: ObjFnOn a
+sameX [C' s, S' e] = (xc' s - xs' e)^2
+sameX [S' s, C' e] = (xs' s - xc' e)^2
+sameX [C' s, C' e] = (xc' s - xc' e)^2
+sameX [S' s, S' e] = (xs' s - xs' e)^2
+sameX [L' s, L' e] = (xl' s - xl' e)^2
+
+sameCenter :: ObjFnOn a
+sameCenter [C' s, S' e] = (yc' s - ys' e)^2 + (xc' s - xs' e)^2
+sameCenter [S' s, C' e] = (ys' s - yc' e)^2 + (xs' s - xc' e)^2
+sameCenter [C' s, C' e] = (yc' s - yc' e)^2 + (xc' s - xc' e)^2
+sameCenter [S' s, S' e] = (ys' s - ys' e)^2 + (xs' s - xs' e)^2
+sameCenter [L' s, L' e] = (yl' s - yl' e)^2 + (xl' s - xl' e)^2
+
+toLeft :: ObjFnOn a
+toLeft [C' s, S' e] = (xc' s - xs' e + 400)^2
+toLeft [S' s, C' e] = (xs' s - xc' e + 400)^2
+-- toLeft [C' s, C' e] = (xc' s - xc' e + r' s + r' e + 200)^2
+toLeft [C' s, C' e] = (xc' s - xc' e + 400)^2
+toLeft [S' s, S' e] = (xs' s - xs' e + 400)^2
+toLeft [L' s, L' e] = (xl' s - xl' e + 100)^2
+
+
+centerMap :: ObjFnOn a
+centerMap [A' a, S' s, S' e] = _centerMap a [xs' s, ys' s] [xs' e, ys' e]
+                [spacing + (halfDiagonal . side') s, negate $ spacing + (halfDiagonal . side') e]
+centerMap [A' a, S' s, C' e] = _centerMap a [xs' s, ys' s] [xc' e, yc' e]
+                [spacing + (halfDiagonal . side') s, negate $ spacing + r' e]
+centerMap [A' a, C' s, S' e] = _centerMap a [xc' s, yc' s] [xs' e, ys' e]
+                [spacing + r' s, negate $ spacing + (halfDiagonal . side') e]
+centerMap [A' a, C' s, C' e] = _centerMap a [xc' s, yc' s] [xc' e, yc' e]
+                [ spacing * r' s, negate $ spacing * r' e]
+centerMap [A' a, L' s, L' e] = _centerMap a [xl' s, yl' s] [xl' e, yl' e]
+                [spacing * hl' s, negate $ spacing * hl' e]
+centerMap [A' a, L' s, C' e] = _centerMap a [xl' s, yl' s] [xc' e, yc' e]
+                [spacing, negate $ spacing + r' e]
+centerMap o = error ("CenterMap: unsupported arguments: " ++ show o)
+spacing = 1.1 -- TODO: arbitrary
+
+_centerMap :: forall a. (Floating a, Real a, Show a, Ord a) =>
+                SolidArrow' a -> [a] -> [a] -> [a] -> a
+_centerMap a s1@[x1, y1] s2@[x2, y2] [o1, o2] =
+    let vec  = [x2 - x1, y2 - y1] -- direction the arrow should point to
+        dir = normalize vec -- direction the arrow should point to
+        [sx, sy, ex, ey] = if norm vec > o1 + abs o2
+                then (s1 +. o1 *. dir) ++ (s2 +. o2 *. dir) else s1 ++ s2
+        [fromx, fromy, tox, toy] = [startx' a, starty' a, endx' a, endy' a] in
+    (fromx - sx)^2 + (fromy - sy)^2 + (tox - ex)^2 + (toy - ey)^2
+
+repel :: ObjFnOn a
+repel [C' c, S' d] = 1 / distsq (xc' c, yc' c) (xs' d, ys' d) - r' c - side' d + epsd
+repel [S' c, C' d] = 1 / distsq (xc' d, yc' d) (xs' c, ys' c) - r' d - side' c + epsd
+repel [C' c, C' d] = 1 / distsq (xc' c, yc' c) (xc' d, yc' d) - r' c - r' d + epsd
+repel [L' c, L' d] =
+    if c == d then 0 else 1 / distsq (xl' c, yl' c) (xl' d, yl' d)
+repel [L' c, C' d] = if labelName (namec' d) == namel' c then 0 else 1 / distsq (xl' c, yl' c) (xc' d, yc' d)
+repel [C' c, L' d] = 1 / distsq (xc' c, yc' c) (xl' d, yl' d)
+repel [L' c, S' d] = if labelName (names' d) == namel' c then 0 else 1 / distsq (xl' c, yl' c) (xs' d, ys' d)
+repel [S' c, L' d] = 1 / distsq (xs' c, ys' c) (xl' d, yl' d)
+repel [A' c, L' d] = repel' (startx' c, starty' c) (xl' d, yl' d) +
+        repel' (endx' c, endy' c) (xl' d, yl' d)
+repel [A' c, C' d] = repel' (startx' c, starty' c) (xc' d, yc' d) +
+        repel' (endx' c, endy' c) (xc' d, yc' d)
+repel _  = error "invalid selectors in repel"
+
+repel' x y = 1 / distsq x y + epsd
+
+centerLabel :: ObjFnOn a
+centerLabel [C' c, L' l] =
+                let [cx, cy, lx, ly] = [xc' c, yc' c, xl' l, yl' l] in
+                -- if dist (cx, cy) (lx, ly) > r' c then (cx - lx)^2 + (cy - ly)^2 else 0.3 *
+                     (cx - lx)^2 + (cy - ly)^2
+centerLabel [S' s, L' l] =
+                let [cx, cy, lx, ly] = [xs' s, ys' s, xl' l, yl' l] in
+                (cx - lx)^2 + (cy - ly)^2
+centerLabel [P' p, L' l] =
+                let [px, py, lx, ly] = [xp' p, yp' p, xl' l, yl' l] in
+                (px + 10 - lx)^2 + (py + 20 - ly)^2 -- Top right from the point
+centerLabel [A' a, L' l] =
+                let (sx, sy, ex, ey) = (startx' a, starty' a, endx' a, endy' a)
+                    (mx, my) = midpoint (sx, sy) (ex, ey)
+                    (lx, ly) = (xl' l, yl' l) in
+                (mx - lx)^2 + (my + 1.1 * hl' l - ly)^2 -- Top right from the point
+centerLabel o  = error ("centerLabel not called with 1 arg" ++ show o)
+
+outside :: ObjFnOn a
+outside [L' o, C' i] =
+            -- let d = dist (xl' o, yl' o) (xc' i, yc' i) in
+            -- if d > r' i  then 0 else
+            -- (dist (xl' o, yl' o) (xc' i, yc' i) - (1.2 * r' i))^2
+            (dist (xl' o, yl' o) (xc' i, yc' i) - (1.2 * r' i))^2
+            -- (dist (xl' o, yl' o) (xc' i, yc' i) - (2 * r' i))^2
+outside [L' o, S' i] =
+            (dist (xl' o, yl' o) (xs' i, ys' i) - 2 * (halfDiagonal . side') i)^2
+
+------- Ambient objective functions
+
+-- -- no names specified; can apply to any combination of objects in M.Map
+-- type AmbientObjFn a = forall a. (Floating a, Real a, Show a, Ord a) => M.Map Name (Obj' a) -> a
+--
+-- -- if there are no circles, doesn't do anything
+-- -- TODO fix in case there's only 1 circle?
+-- circParams :: (Floating a, Real a, Show a, Ord a) => M.Map Name (Obj' a) -> ([a], [a])
+-- circParams m = unpackSplit $ filter isCirc $ M.elems m
+--            where isCirc (C' _) = True
+--                  isCirc _ = False
+--
+-- -- reuse existing objective function
+-- circlesCenterAndRepel :: AmbientObjFn a
+-- circlesCenterAndRepel objMap = let (fix, vary) = circParams objMap in
+--                                centerAndRepel_dist fix vary
+--
+-- circlesCenter :: AmbientObjFn a
+-- circlesCenter objMap = let (fix, vary) = circParams objMap in
+--                        centerObjs fix vary
+
+-- pairwiseRepel :: [Obj] -> Float
+-- pairwiseRepel objs = sumMap pairRepel $ allPairs objs
+
+-- pairRepel :: Obj -> Obj -> Float
+-- pairRepel c d = 1 / (distsq c d)
+--           where distsq c d = (getX c - getX d)^2 + (getY c - getY c)^2
+
+-- -- returns a list of ambient constraint fns--4 for each object
+-- -- i guess i don’t NEED to weight each individually. just sum them and weight the whole thing
+-- allInBbox :: [Obj] -> Float
+-- allInBbox objs = sum $ concatMap inBbox objs
+--           where inBbox o = [boxleft o, boxright o, boxup o, boxdown o]
+--                 boxleft o = getX o - leftline -- magnitude of violation
+
+------- Constraints
+-- Constraints are written WRT magnitude of violation
+-- TODO metaprogramming for boolean constraints
+-- TODO use these types?
+-- type ConstraintFn a = forall a. (Floating a, Real a, Show a, Ord a) => [Name] -> M.Map Name (Obj' a) -> a
+
+defaultCWeight :: Floating a => a
+defaultCWeight = 1
+
+-- TODO: should points also have a weight of 1?
+defaultPWeight :: Floating a => a
+defaultPWeight = 1
+
+
+--------------------------------------------------------------------------------
+-- Constraint functions
+-- List: smallerThan, contains, outsideOf, overlapping, nonOverlapping, samesize, maxsize, minsize
+type ConstraintFn = forall a. (Floating a, Real a, Show a, Ord a) => [Obj' a] -> a
+
+sameSize :: ConstraintFn
+sameSize [S' s1, S' s2] = (side' s1 - side' s2)**2
+sameSize [C' s1, C' s2] = (r' s1 - r' s2)**2
+
+maxSize :: ConstraintFn
+limit = max (fromIntegral 700) (fromIntegral 900)
+maxSize [C' c] = r' c -  limit / 3
+maxSize [S' s] = side' s - limit  / 3
+
+minSize :: ConstraintFn
+minSize [C' c] = 20 - r' c
+minSize [S' s] = 20 - side' s
+
+smallerThan  :: ConstraintFn
+-- smallerThan [C' inc, C' outc] =  (r' outc) - (r' inc) - 0.4 * r' outc -- TODO: taking this as a parameter?
+smallerThan [C' inc, C' outc] = (r' inc) - (r' outc)
+smallerThan [S' inc, S' outc] = (side' outc) - (side' inc) - subsetSizeDiff
+smallerThan [C' c, S' s] = 0.5 * side' s - r' c
+smallerThan [S' s, C' c] = r' c - (halfDiagonal . side') s
+
+contains :: ConstraintFn
+contains [C' outc, C' inc] =
+    -- tr (namec' outc ++  " contains " ++ namec' inc ++ " val: ") $
+    -- strictSubset [[xc' inc, yc' inc, r' inc], [xc' outc, yc' outc, r' outc]]
+    let res =  dist (xc' inc, yc' inc) (xc' outc, yc' outc) - (r' outc - r' inc) in
+    if res > 0 then res else 0
+contains [S' outc, S' inc] = strictSubset
+    [[xs' inc, ys' inc, 0.5 * side' inc], [xs' outc, ys' outc, 0.5 * side' outc]]
+contains [S' outc, C' inc] = strictSubset
+    [[xc' inc, yc' inc, r' inc], [xs' outc, ys' outc, 0.5 * side' outc]]
+contains [C' outc, S' inc] = strictSubset
+    [[xs' inc, ys' inc, (halfDiagonal . side') inc], [xc' outc, yc' outc, r' outc]]
+contains [C' set, P' pt] =
+        dist (xp' pt, yp' pt) (xc' set, yc' set) - 0.5 * r' set
+contains [S' set, P' pt] =
+    dist (xp' pt, yp' pt) (xs' set, ys' set) - 0.4 * side' set
+contains [C' set, L' label] =
+    let res = dist (xl' label, yl' label) (xc' set, yc' set) - 0.5 * r' set in
+    if res < 0 then 0 else res
+contains [S' set, L' label] =
+    dist (xl' label, yl' label) (xs' set, ys' set) - (side' set) / 2 + wl' label
+contains _  = error "subset not called with 2 args"
+
+outsideOf :: ConstraintFn
+outsideOf [C' inc, C' outc] =
+    noSubset [[xc' inc, yc' inc, r' inc], [xc' outc, yc' outc, r' outc]]
+outsideOf [S' inc, S' outc] =
+    noSubset [[xs' inc, ys' inc, (halfDiagonal . side') inc],
+        [xs' outc, ys' outc, (halfDiagonal . side') outc]]
+outsideOf [C' inc, S' outs] =
+    noSubset [[xc' inc, yc' inc, r' inc], [xs' outs, ys' outs, (halfDiagonal . side') outs]]
+outsideOf [S' inc, C' outc] =
+    noSubset [[xs' inc, ys' inc, (halfDiagonal . side') inc], [xc' outc, yc' outc, r' outc]]
+outsideOf [P' pt, C' set] =
+    -dist (xp' pt, yp' pt) (xc' set, yc' set) + r' set
+outsideOf [P' pt, S' set] =
+    -dist (xp' pt, yp' pt) (xs' set, ys' set) + (halfDiagonal . side') set
+outsideOf [L' lout, C' inset] =
+    let labelR = max (wl' lout) (hl' lout)
+        res = - dist (xl' lout, yl' lout) (xc' inset, yc' inset) + r' inset + labelR in
+    if namel' lout == (labelName $ namec' inset) then 0 else res
+    -- if res <= 0 then 1 / res else res
+    -- - dist (xl' lout, yl' lout) (xc' inset, yc' inset) + r' inset
+outsideOf [L' lout, S' inset] =
+    - dist (xl' lout, yl' lout) (xs' inset, ys' inset) + (halfDiagonal . side') inset
+outsideOf _ = error "noSubset not called with 2 args"
+
+overlapping :: ConstraintFn
+overlapping [C' xset, C' yset] =
+    looseIntersect [[xc' xset, yc' xset, r' xset], [xc' yset, yc' yset, r' yset]]
+overlapping [S' xset, C' yset] =
+    looseIntersect [[xs' xset, ys' xset, 0.5 * side' xset], [xc' yset, yc' yset, r' yset]]
+overlapping [C' xset, S' yset] =
+    looseIntersect [[xc' xset, yc' xset, r' xset], [xs' yset, ys' yset, 0.5 * side' yset]]
+overlapping [S' xset, S' yset] =
+    looseIntersect [[xs' xset, ys' xset, 0.5 * side' xset], [xs' yset, ys' yset, 0.5 * side' yset]]
+overlapping _ = error "intersect not called with 2 args"
+
+nonOverlapping :: ConstraintFn
+nonOverlapping [C' xset, C' yset] =
+    noIntersectExt [[xc' xset, yc' xset, r' xset], [xc' yset, yc' yset, r' yset]]
+nonOverlapping [S' xset, C' yset] =
+    noIntersectExt [[xs' xset, ys' xset, (halfDiagonal . side') xset], [xc' yset, yc' yset, r' yset]]
+nonOverlapping [C' xset, S' yset] =
+    noIntersectExt [[xc' xset, yc' xset, r' xset], [xs' yset, ys' yset, (halfDiagonal . side') yset]]
+nonOverlapping [S' xset, S' yset] =
+    noIntersectExt [[xs' xset, ys' xset, (halfDiagonal . side') xset],
+        [xs' yset, ys' yset, (halfDiagonal . side') yset]]
+nonOverlapping [A' arr, L' label] =
+    let (sx, sy, ex, ey, t) = (startx' arr, starty' arr, endx' arr, endy' arr, thickness' arr)
+        (x1, y1, x2, y2) = (sx, sy - t, ex, ey + t)
+        dx = maximum [x1 - xl' label, 0, xl' label - x2]
+        dy = maximum [y1 - yl' label, 0, yl' label - y2] in
+        tr "labelvsArr: " $ -sqrt(dx**2 + dy**2) - wl' label
+nonOverlapping  _ = error "no intersect not called with 2 args"
+
+type PairConstrV a = forall a . (Floating a, Ord a, Show a) => [[a]] -> a -- takes pairs of "packed" objs
+
+
+noConstraint :: PairConstrV a
+noConstraint _ = 0
+
+-- To convert your inequality constraint into a violation to be penalized:
+-- it needs to be in the form "c < 0" and c is the violation penalized if > 0
+-- so e.g. if you want "x < -100" then you would convert it to "x + 100 < 0" with c = x + 100
+-- if you want "f x > -100" then you would convert it to "-(f x + 100) < 0" with c = -(f x + 100)"
+
+-- all sets must pairwise-strict-intersect
+-- plus an offset so they overlap by a visible amount (perhaps this should be an optimization parameter?)
+looseIntersect :: PairConstrV a
+looseIntersect [[x1, y1, s1], [x2, y2, s2]] = let offset = 10 in
+        -- if s1 + s2 < offset then error "radii too small"  --TODO: make it const
+        -- else
+            dist (x1, y1) (x2, y2) - (s1 + s2 - offset)
+
+-- the energy actually increases so it always settles around the offset
+-- that's because i am centering all of them--test w/objective off
+-- TODO flatten energy afterward, or get it to be *far* from the other set
+-- offset so the sets differ by a visible amount
+noSubset :: PairConstrV a
+noSubset [[x1, y1, s1], [x2, y2, s2]] = let offset = 10 in -- max/min dealing with s1 > s2 or s2 < s1
+         -(dist (x1, y1) (x2, y2)) + max s2 s1 - min s2 s1 + offset
+
+-- the first set is the subset of the second, and thus smaller than the second in size.
+-- TODO: test for equal sets
+-- TODO: for two primitives we have 4 functions, which is not sustainable. NOT NEEDED, remove them.
+strictSubset :: PairConstrV a
+strictSubset [[x1, y1, s1], [x2, y2, s2]] = dist (x1, y1) (x2, y2) - (s2 - s1)
+
+-- exterior point method constraint: no intersection (meaning also no subset)
+noIntersectExt :: PairConstrV a
+noIntersectExt [[x1, y1, s1], [x2, y2, s2]] = -(dist (x1, y1) (x2, y2)) + s1 + s2 + offset where offset = 10
+
+pointInExt :: PairConstrV a
+pointInExt [[x1, y1], [x2, y2, r]] = dist (x1, y1) (x2, y2) - 0.5 * r
+
+pointNotInExt :: PairConstrV a
+pointNotInExt [[x1, y1], [x2, y2, r]] = - dist (x1, y1) (x2, y2) + r
+
+-- exterior point method: penalty function
+penalty :: (Ord a, Floating a, Show a) => a -> a
+penalty x = (max x 0) ^ q -- weights should get progressively larger in cr_dist
+            where  q = 2 -- also, may need to sample OUTSIDE feasible set
+            -- where q = 3 -- also, may need to sample OUTSIDE feasible set
diff --git a/src/Server.hs b/src/Server.hs
new file mode 100644
--- /dev/null
+++ b/src/Server.hs
@@ -0,0 +1,110 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE DeriveGeneric #-}
+
+module Server where
+import Shapes
+import GHC.Generics
+import Data.Monoid (mappend)
+import Data.Text (Text)
+import Control.Monad (forM_, forever)
+import Control.Monad.IO.Class (liftIO)
+import Control.Concurrent (MVar, newMVar, modifyMVar_, modifyMVar, readMVar)
+import qualified Data.Text as T
+import qualified Data.Text.IO as T
+import qualified Runtime as R
+import qualified Network.WebSockets as WS
+import GHC.Float (float2Double)
+import Control.Exception
+import System.Time
+-- import System.Posix.Unistd(usleep)
+import Data.Char (isPunctuation, isSpace)
+import Data.Aeson
+import Data.Maybe (fromMaybe)
+
+
+type ServerState = R.State
+data FeedBack = Cmd Command | Drag DragEvent | Update UpdateShapes deriving (Show, Generic)
+data Command = Command { command :: String } deriving (Show, Generic)
+data DragEvent = DragEvent { name :: String, xm :: Float, ym :: Float } deriving (Show, Generic)
+data UpdateShapes = UpdateShapes { objs :: [Obj] } deriving (Show, Generic)
+instance FromJSON FeedBack
+instance FromJSON Command
+instance FromJSON DragEvent
+instance FromJSON UpdateShapes
+
+
+wsSendJSON :: ToJSON j => WS.Connection -> j -> IO ()
+wsSendJSON conn obj = WS.sendTextData conn $ encode obj
+
+-- wsReceiveJSON :: (WS.TextProtocol p, FromJSON j) => WS.WebSockets p (Maybe j)
+-- wsReceiveJSON = fmap decode WS.receiveData
+
+servePenrose :: String -> Int -> R.State -> IO ()
+servePenrose domain port initState = do
+    putStrLn "Starting Server..."
+    WS.runServer domain port $ application initState
+
+application :: ServerState -> WS.ServerApp
+application s pending = do
+    conn <- WS.acceptRequest pending
+    WS.forkPingThread conn 30 -- To keep the connection alive
+    wsSendJSON conn (R.objs s)
+    loop conn (step s)
+
+loop :: WS.Connection -> R.State -> IO ()
+loop conn s
+    | R.optStatus ( R.params s) == R.EPConverged = do
+        putStrLn "Optimization completed."
+        -- wsSendJSON conn (R.objs s) -- TODO: is this necessary?
+        processCommand conn s
+    | R.autostep s = stepAndSend conn s
+    | otherwise = processCommand conn s
+
+processCommand :: WS.Connection -> R.State -> IO ()
+processCommand conn s = do
+    -- putStrLn "Receiving Commands"
+    msg_json <- WS.receiveData conn
+    case decode msg_json of
+        Just e -> case e of
+            Cmd (Command cmd)  -> executeCommand cmd conn s
+            Drag (DragEvent name xm ym)  -> dragUpdate name xm ym conn s
+            Update (UpdateShapes objs)  -> updateShapes objs conn s
+        Nothing -> error "Error reading JSON"
+
+updateShapes :: [Obj] -> WS.Connection -> R.State -> IO ()
+updateShapes newObjs conn s = if R.autostep s then stepAndSend conn news else loop conn news
+    where
+        news = s { R.objs = newObjs, R.params = (R.params s) { R.weight = R.initWeight, R.optStatus = R.NewIter }}
+
+dragUpdate :: String -> Float -> Float -> WS.Connection -> R.State -> IO ()
+dragUpdate name xm ym conn s = if R.autostep s then stepAndSend conn news else loop conn news
+    where
+        newObjs = map (\x ->
+                if getName x == name
+                    then setX (xm + getX x) $ setY (-ym + getY x) x
+                    else x)
+            (R.objs s)
+        news = s { R.objs = newObjs, R.params = (R.params s) { R.weight = R.initWeight, R.optStatus = R.NewIter }}
+
+executeCommand :: String -> WS.Connection -> R.State -> IO ()
+executeCommand cmd conn s
+    | cmd == "resample" = resampleAndSend conn s
+    | cmd == "step"     = stepAndSend conn s
+    | cmd == "autostep" = loop conn (s { R.autostep = not $ R.autostep s })
+    | otherwise         = putStrLn ("Can't recognize command " ++ cmd)
+
+
+resampleAndSend, stepAndSend :: WS.Connection -> R.State -> IO ()
+resampleAndSend conn s = do
+    let (objs', rng') = R.sampleConstrainedState (R.rng s) (R.objs s) (R.constrs s)
+    let nexts = s { R.objs = objs', R.down = False, R.rng = rng', R.params = (R.params s) { R.weight = R.initWeight, R.optStatus = R.NewIter } }
+    wsSendJSON conn (R.objs nexts)
+    loop conn nexts
+stepAndSend conn s = do
+    let nexts = step s
+    wsSendJSON conn (R.objs nexts)
+    loop conn nexts
+
+step :: R.State -> R.State
+step s = s { R.objs = objs', R.params = params' }
+        where (objs', params') = R.stepObjs (float2Double R.calcTimestep) (R.params s) (R.objs s)
diff --git a/src/StyAst.hs b/src/StyAst.hs
new file mode 100644
--- /dev/null
+++ b/src/StyAst.hs
@@ -0,0 +1,421 @@
+module StyAst where
+-- module Main (main) where
+
+import Control.Monad (void)
+import Text.Megaparsec
+import Text.Megaparsec.Expr
+import Text.Megaparsec.String -- input stream is of the type ‘String’
+import System.Environment
+import qualified Data.Map.Strict as M
+import qualified Text.Megaparsec.Lexer as L
+
+
+-- Style grammar (relies on the Substance grammar, specifically SubObj)
+
+data SubType = Set | Pt | Map | Intersect | NoIntersect | NoSubset | Subset | PointIn | PointNotIn | AllTypes deriving (Show, Eq)
+
+data StyObj = Circle | Box | Dot | Arrow | NoShape | Color | Text | Auto
+    deriving (Show)
+
+type StyObjInfo
+    = (StyObj, M.Map String Expr)
+
+data StySpec = StySpec {
+    spType :: SubType,
+    spId :: String,
+    spArgs :: [String],
+    spShape :: StyObjInfo,
+    spShpMap :: M.Map String StyObjInfo
+} deriving (Show)
+
+type StyProg = [Block]
+
+type Block = ([Selector], [Stmt])
+
+data Selector = Selector
+              { selTyp :: SubType
+              , selPatterns :: [Pattern]
+            --   , selIds :: [String]
+          }
+              deriving (Show)
+data Pattern
+    = RawID String
+    | WildCard String
+    deriving (Show)
+
+data Stmt
+    = Assign String Expr
+    | ObjFn String [Expr]
+    | ConstrFn String [Expr]
+    | Avoid String [Expr]
+    deriving (Show)
+
+data Expr
+    = IntLit Integer
+    | FloatLit Float
+    | Id String
+    | BinOp BinaryOp Expr Expr
+    | Cons StyObj [Stmt] -- Constructors for objects
+    deriving (Show)
+
+data BinaryOp = Access deriving (Show)
+
+data Color = RndColor | Colo
+          { r :: Float
+          , g :: Float
+          , b :: Float
+          , a :: Float }
+          deriving (Show)
+--
+-- data Shape
+--     = Circle [(String, Expr)]
+--     | Box [(String, Expr)]
+--     | Dot [(String, Expr)]
+--     | Arrow [(String, Expr)]
+--     | NoShape
+--     deriving (Show)
+
+---- Style program
+styleParser :: Parser [Block]
+styleParser = between sc eof styProg
+
+-- TODO: required global and/or style block or not?
+-- TODO: How can I write something like noop???
+-- NOTE: sequence matters here
+styProg :: Parser [Block]
+styProg = some block
+-- globalBlock <|> typeBlock <|> objBlock
+-- <|> emptyProg
+
+---- Style blocks
+block :: Parser Block
+block = do
+    sel <- selector `sepBy1` comma
+    void (symbol "{")
+    try newline'
+    sc
+    stmts <- try stmtSeq
+    -- res <- try stmtSeq
+    -- let stmts = case res of
+    --                 Just a -> a
+    --                 Nothing -> []
+    void (symbol "}")
+    newline'
+    return (sel, stmts)
+    -- return (sel, [])
+
+globalSelect :: Parser Selector
+globalSelect = do
+    i <- WildCard <$> identifier
+    -- return $ Selector AllTypes [] []
+    return $ Selector AllTypes [i]
+
+constructorSelect :: Parser Selector
+constructorSelect = do
+    typ <- subtype
+    -- sc
+    pat <- patterns
+    -- void sc <|> void (symbol ":")
+    -- ids <- many identifier
+    -- res <- optional $ rword "as" *> some identifier
+    -- let ids = case res of
+    --             Just a -> a
+    --             Nothing -> []
+    -- return $ Selector typ pat ids
+    return $ Selector typ pat
+
+selector :: Parser Selector
+selector = constructorSelect <|> globalSelect
+
+subtype :: Parser SubType
+subtype = do
+    str <- symbol "Set"
+       <|> symbol "Point"
+       <|> symbol "Map"
+       <|> symbol "Subset"
+       <|> symbol "NoSubset"
+       <|> symbol "Intersect"
+       <|> symbol "NoIntersect"
+       <|> symbol "PointIn"
+       <|> symbol "PointNotIn"
+
+    return (convert str)
+    where convert s
+            | s == "Set" = Set
+            | s == "Point" = Pt
+            | s == "Map" = Map
+            | s == "Subset" = Subset
+            | s == "NoSubset" = NoSubset
+            | s == "Intersect" = Intersect
+            | s == "NoIntersect" = NoIntersect
+            | s == "PointIn" = PointIn
+            | s == "PointNotIn" = PointNotIn
+
+styObj :: Parser StyObj
+styObj = do
+    str <- symbol "Color"
+       <|> symbol "None"
+       <|> symbol "Arrow"
+       <|> symbol "Text"
+       <|> symbol "Circle"
+       <|> symbol "Box"
+       <|> symbol "Dot"
+    return (convert str)
+    where convert s
+            | s == "Color" = Color
+            | s == "Arrow" = Arrow
+            | s == "None"  = NoShape
+            | s == "Text"  = Text
+            | s == "Circle"  = Circle
+            | s == "Box"  = Box
+            | s == "Dot"  = Dot
+
+patterns :: Parser [Pattern]
+patterns = many pattern
+    where pattern = (WildCard <$> identifier <|> RawID <$> backticks identifier)
+
+    -- manyTill anyChar (symbol "{")
+---- Statements
+stmtSeq :: Parser [Stmt]
+stmtSeq = endBy stmt newline'
+
+stmt :: Parser Stmt
+stmt =
+    try objFn
+    <|> try assignStmt
+    <|> try avoidObjFn
+    <|> try constrFn
+--
+assignStmt :: Parser Stmt
+assignStmt = do
+    var  <- attribute
+    sc
+    void (symbol "=")
+    e    <- expr
+    return (Assign var e)
+--
+objFn :: Parser Stmt
+objFn = do
+    rword "objective"
+    fname  <- identifier
+    void (symbol "(")
+    params <- expr `sepBy` comma
+    void (symbol ")")
+    -- params <- sepBy expr comma
+    return (ObjFn fname params)
+
+avoidObjFn :: Parser Stmt
+avoidObjFn = do
+    rword "avoid"
+    fname  <- identifier
+    lbrac
+    params <- expr `sepBy` comma
+    rbrac
+    return (Avoid fname params)
+
+constrFn :: Parser Stmt
+constrFn = do
+    rword "constraint"
+    fname  <- identifier
+    void (symbol "(")
+    params <- expr `sepBy` comma
+    void (symbol ")")
+    -- params <- sepBy expr comma
+    return (ConstrFn fname params)
+
+expr :: Parser Expr
+expr =  try objConstructor
+    <|> makeExprParser term operators
+    <|> none
+    <|> auto
+    <|> number
+
+term :: Parser Expr
+term = Id <$> identifier
+
+operators :: [[Operator Parser Expr]]
+operators = [ [ InfixL (BinOp Access <$ symbol ".")] ]
+
+none :: Parser Expr
+none = do
+    rword "None"
+    return $ Cons NoShape []
+
+auto :: Parser Expr
+auto = do
+    rword "Auto"
+    return $ Cons Auto []
+
+objConstructor :: Parser Expr
+objConstructor = do
+    typ <- styObj
+    lbrac >> newline'
+    stmts <- stmtSeq
+    rbrac  -- NOTE: not consuming the space because stmt already does
+    return $ Cons typ stmts
+
+number :: Parser Expr
+number =  FloatLit <$> try float <|> IntLit <$> integer
+
+attribute :: Parser String
+attribute = many alphaNumChar
+
+--
+--
+--
+-- typeBlock :: Parser Block
+-- typeBlock = do
+--     t     <- typ
+--     stmts <- braces stmtSeq
+--     return $ TypeBlock t stmts
+--
+-- objBlock :: Parser Block
+-- objBlock = do
+--     i     <- identifier
+--     stmts <- braces stmtSeq
+--     return $ ObjBlock i stmts
+
+
+---- Lexer functions
+sc :: Parser ()
+sc = L.space (void separatorChar) lineCmnt blockCmnt
+  where lineCmnt  = L.skipLineComment "--" >> newline'
+        blockCmnt = L.skipBlockComment "/*" "*/" >> newline'
+
+newline' :: Parser ()
+newline' = void sc >> void (many newline) >> void sc
+
+backticks :: Parser a -> Parser a
+backticks = between (symbol "`") (symbol "`")
+
+braces :: Parser a -> Parser a
+braces = between (symbol "{") (symbol "}")
+
+lparen, rparen, lbrac, rbrac :: Parser ()
+lbrac = void (symbol "{")
+rbrac = void (symbol "}")
+lparen = void (symbol "(")
+rparen = void (symbol ")")
+
+parens :: Parser a -> Parser a
+parens = between (symbol "(") (symbol ")")
+
+lexeme :: Parser a -> Parser a
+lexeme = L.lexeme sc
+
+comma :: Parser String
+comma = symbol ","
+
+symbol :: String -> Parser String
+symbol = L.symbol sc
+
+integer :: Parser Integer
+integer = lexeme L.integer
+
+float :: Parser Float
+float = realToFrac <$> lexeme L.float -- TODO: parsing without sign?
+
+identifier :: Parser String
+identifier = (lexeme . try) (p >>= check)
+  where
+    p       = (:) <$> letterChar <*> many alphaNumChar
+    check x = if x `elem` rws
+                then fail $ "keyword " ++ show x ++ " cannot be an identifier"
+                else return x
+
+-- Reserved words
+rword :: String -> Parser ()
+rword w = string w *> notFollowedBy alphaNumChar *> sc
+
+rws, attribs, attribVs, shapes, types :: [String] -- list of reserved words
+rws =     ["avoid", "global", "as"] ++ types ++ shapes
+-- ++ types ++ attribs ++ shapes ++ colors
+
+types =   ["Set", "Map", "Point"]
+attribs = ["shape", "color", "label", "scale", "position"]
+attribVs = shapes ++ colors
+shapes =  ["Auto", "None", "Circle", "Box", "SolidArrow", "SolidDot", "HollowDot", "Cross"]
+colors =  ["Random", "Black", "Red", "Blue", "Yellow"]
+--
+-- getType :: String -> SubType
+-- getType str = case str of
+--     "Set"   -> Set
+--     "Map"   -> Map
+--     "Point" -> Pt
+--     "Subset" -> Subset
+--
+--
+-- getAttribute :: String -> Attribute
+-- getAttribute str = case str of
+--     "shape" -> Shape
+--     "color" -> Color
+--     "bordor" -> LineType
+--
+--
+-- getAttributeV :: String -> AttributeV
+-- getAttributeV str = case str of
+--     "None"       -> ShapeV   NoShape
+--     "Circle"     -> ShapeV $ SS SetCircle
+--     "Box"        -> ShapeV $ SS Box
+--     "SolidArrow" -> ShapeV $ SM SolidArrow
+--     "SolidDot"   -> ShapeV $ SP SolidDot
+--     "HollowDot"  -> ShapeV $ SP HollowDot
+--     "Cross"      -> ShapeV $ SP Cross
+--     "Red"        -> ColorV Red
+--     "Yellow"     -> ColorV Yellow
+--     "Blue"       -> ColorV Blue
+--     "Black"      -> ColorV Black
+--     "Random"     -> ColorV Random
+--
+-- attribute :: Parser Attribute
+-- attribute = (lexeme . try) (p >>= check)
+--   where
+--     p       = many letterChar
+--     check x = if x `elem` attribs
+--                 then return (getAttribute x)
+--                 else fail $ "keyword " ++ show x ++ " cannot be an attribute"
+--
+-- attributeValue :: Parser AttributeV
+-- attributeValue = (lexeme . try) (p >>= check)
+--   where
+--     p       = many letterChar
+--     check x = if x `elem` attribVs
+--                 then return (getAttributeV x)
+--                 else fail $ "keyword " ++ show x ++ " cannot be an attribute value"
+--
+-- typ :: Parser SubType
+-- typ = (lexeme . try) (p >>= check)
+--   where
+--     p       = some letterChar
+--     check x = if x `elem` types
+--                 then return (getType x)
+--                 else fail $ "Type " ++ show x ++ " is not a valid type"
+--
+-- -- access :: Parser Expr
+-- -- access = do
+-- --     i <- identifier
+-- --     void (symbol ".")
+-- --     a <- attributeName
+-- --     return (Access i a)
+--
+--
+--
+--
+
+-- -- TODO
+-- styPrettyPrint :: Block -> String
+-- styPrettyPrint b = "HAHAHAHA"
+
+parseFromFile p file = runParser p file <$> readFile file
+
+main :: IO ()
+main = do
+    args <- getArgs
+    let styFile = head args
+    styIn <- readFile styFile
+    -- putStrLn styIn
+    -- parseTest styleParser styIn
+    case runParser styleParser styFile styIn of
+         Left err -> putStr (parseErrorPretty err)
+         Right xs -> mapM_ print xs
+    return ()
diff --git a/src/Utils.hs b/src/Utils.hs
new file mode 100644
--- /dev/null
+++ b/src/Utils.hs
@@ -0,0 +1,91 @@
+module Utils where
+import Debug.Trace
+
+debug = False
+debugLineSearch = False
+debugObj = False -- turn on/off output in obj fn or constraint
+
+-- used when sampling the inital state, make sure sizes satisfy subset constraints
+subsetSizeDiff :: Floating a => a
+subsetSizeDiff = 10.0
+
+epsd :: Floating a => a -- to prevent 1/0 (infinity). put it in the denominator
+epsd = 10 ** (-10)
+
+halfDiagonal :: (Floating a) => a -> a
+halfDiagonal side = 0.5 * dist (0, 0) (side, side)
+
+labelName :: String -> String
+labelName name = "Label_" ++ name
+
+
+-- Some debugging functions. @@@
+debugF :: (Show a) => a -> a
+debugF x = if debug then traceShowId x else x
+debugXY x1 x2 y1 y2 = if debug then trace (show x1 ++ " " ++ show x2 ++ " " ++ show y1 ++ " " ++ show y2 ++ "\n") else id
+
+-- To send output to a file, do ./EXECUTABLE 2> FILE.txt
+tr :: Show a => String -> a -> a
+tr s x = if debug then trace "---" $ trace s $ traceShowId x else x -- prints in left to right order
+
+trRaw :: Show a => String -> a -> a
+trRaw s x = if debug then  trace "---" $ trace s $ trace (show x ++ "\n") x else x-- prints in left to right order
+
+trStr :: String -> a -> a
+trStr s x = if debug then trace "---" $ trace s x else x -- prints in left to right order
+
+tr' :: Show a => String -> a -> a
+tr' s x = if debugLineSearch then trace "---" $ trace s $ traceShowId x else x -- prints in left to right order
+
+tro :: Show a => String -> a -> a
+tro s x = if debugObj then trace "---" $ trace s $ traceShowId x else x -- prints in left to right order
+
+---- Lists-as-vectors utility functions, TODO split out of file
+
+-- define operator precedence: higher precedence = evaluated earlier
+infixl 6 +., -.
+infixl 7 *. -- .*, /.
+
+-- assumes lists are of the same length
+dotL :: Floating a => [a] -> [a] -> a
+dotL u v = if not $ length u == length v
+           then error $ "can't dot-prod different-len lists: " ++ (show $ length u) ++ " " ++ (show $ length v)
+           else sum $ zipWith (*) u v
+
+(+.) :: Floating a => [a] -> [a] -> [a] -- add two vectors
+(+.) u v = if not $ length u == length v
+           then error $ "can't add different-len lists: " ++ (show $ length u) ++ " " ++ (show $ length v)
+           else zipWith (+) u v
+
+(-.) :: Floating a => [a] -> [a] -> [a] -- subtract two vectors
+(-.) u v = if not $ length u == length v
+           then error $ "can't subtract different-len lists: " ++ (show $ length u) ++ " " ++ (show $ length v)
+           else zipWith (-) u v
+
+negL :: Floating a => [a] -> [a]
+negL = map negate
+
+(*.) :: Floating a => a -> [a] -> [a] -- multiply by a constant
+(*.) c v = map ((*) c) v
+
+norm :: Floating a => [a] -> a
+norm = sqrt . sum . map (^ 2)
+
+normsq :: Floating a => [a] -> a
+normsq = sum . map (^ 2)
+
+normalize :: Floating a => [a] -> [a]
+normalize v = (1 / norm v) *. v
+
+-- Find the angle between x-axis and a line passing points, reporting in radians
+findAngle :: Floating a => (a, a) -> (a, a) -> a
+findAngle (x1, y1) (x2, y2) = atan $ (y2 - y1) / (x2 - x1)
+
+midpoint :: Floating a => (a, a) -> (a, a) -> (a, a) -- mid point
+midpoint (x1, y1) (x2, y2) = ((x1 + x2) / 2, (y1 + y2) / 2)
+
+dist :: Floating a => (a, a) -> (a, a) -> a -- distance
+dist (x1, y1) (x2, y2) = sqrt ((x1 - x2)^2 + (y1 - y2)^2)
+
+distsq :: Floating a => (a, a) -> (a, a) -> a -- distance
+distsq (x1, y1) (x2, y2) = (x1 - x2)^2 + (y1 - y2)^2