diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,26 @@
+Copyright (c) 2015, Jason Priestley
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are
+met:
+
+1. Redistributions of source code must retain the above copyright
+   notice, this list of conditions and the following disclaimer.
+
+2. Redistributions in binary form must reproduce the above copyright
+   notice, this list of conditions and the following disclaimer in the
+   documentation and/or other materials provided with the
+   distribution.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/Treersec.hs b/Treersec.hs
new file mode 100644
--- /dev/null
+++ b/Treersec.hs
@@ -0,0 +1,422 @@
+{-# LANGUAGE KindSignatures, RankNTypes, GADTs, OverloadedStrings #-}
+
+module Treersec where
+
+import Data.Maybe
+import Control.Applicative
+import Control.Monad
+import Control.Arrow (first, (***))
+import Data.List
+
+import SneathLane.Graphics
+import SneathLane.Widget hiding (Branch, Leaf)
+import SneathLane.BasicWidgets
+
+import Haste
+
+data PP a = PP Int [(Int, Widget GraphicTree a)]
+
+pp_fromWidget (Finish z) = error "fromWidget: Continue widget required"
+
+pp_fromWidget wi@(Continue out _ _ _) = let (Rect x y w h) = graphicTreeBounds out in PP (ceiling $ x + w) (repeat (ceiling (y + h), wi))
+
+pp_above (PP w lgs) (PP w' rgs) =
+  let w'' = max w w'
+      lgs' = drop (w'' - w) lgs
+      rgs' = drop (w'' - w') rgs
+  in PP w'' (zipWith (\(lh,lg) (rh,rg) -> (lh + rh, above lg rg)) lgs' rgs')
+
+
+pp_beside (PP w lgs) (PP w' rgs) = PP (w + w') (go lgs rgs)
+  where
+    go lgs@((lh,lg):lgs') rgs@((rh,rg):rgs') =
+      (max lh rh, beside lg rg) : if lh <= rh then go lgs rgs' else go lgs' rgs
+
+pp_alts (PP w lgs) (PP w' rgs) = PP (min w w') (go w lgs w' rgs)
+  where
+    go w lgs w' rgs | w < w' = head lgs : go (w + 1) (tail lgs) w' rgs
+                    | w' < w = head rgs : go w lgs (w' + 1) (tail rgs)
+                    | otherwise = zipWith (\ll rr -> if fst ll <= fst rr then ll else rr) lgs rgs
+
+pp_out w (PP w' gs) = snd $ head $ drop (max 0 (w - w')) gs
+
+straightList pps = pp_alts (foldl1 pp_above pps) (foldl1 pp_beside pps)
+
+
+instance Functor PP where
+  fmap fn (PP w gs) = PP w (map (\(h,g) -> (h,fmap fn g)) gs)
+
+type Printer a = [PP a] -> [PP a]
+
+data Grammar a = Alts [([Grammar a], Printer a)]
+               | Term (String -> [String])
+               | At Int
+
+llength :: [a] -> Int
+llength = length
+
+gfix :: ((Int -> Grammar a) -> Int -> Grammar a) -> (Int -> Grammar a)
+gfix gg i = gg (const $ At i) i
+
+term :: (String -> [String]) -> Int -> Grammar a
+term s _i = Term s
+
+alts :: [([Int -> Grammar a], Printer a)] -> Int -> Grammar a
+alts gs i = Alts ((map.first.map) ($ (i+1)) gs)
+
+data Node = Placeholder
+          | Branch Int [Node]
+          | Leaf String deriving (Show)
+
+data LinearNode = LPlaceholder
+                | LBranch Int
+                | LLeaf String deriving (Show)
+
+data GrammarZ a = GrammarZ (Grammar a) [(Grammar a, (Int, Int))] [(Int, Int)]
+
+gzChildren :: GrammarZ a -> [[GrammarZ a]]
+gzChildren (GrammarZ (Alts alts) up coords) =
+  zipWith (\n gs ->
+             let up' m = up ++ [(Alts alts, (n, m))]
+             in zipWith (\g m -> case g of
+                    At k -> GrammarZ (fst $ (up' m) !! k) (take k (up' m)) (coords ++ [(n,m)])
+                    _ -> GrammarZ g (up' m) (coords ++ [(n,m)])) gs [0..]) [0..] (map fst alts)
+
+gzChildren _ = error "gzChildren called on non-Alt gz"
+
+instance Eq (GrammarZ a) where
+  (==) (GrammarZ g gs _) (GrammarZ g' gs' _) =
+    map snd gs == map snd gs'
+
+gzInject g = GrammarZ g [] []
+
+gzCoords (GrammarZ g gs coords) = coords
+
+lastCoords (Branch _ ns) ((i,j):is) = (i,j) : lastCoords (ns !! j) is
+lastCoords node [] = go node
+  where
+    go (Branch i ns) | not (null ns) = (i, llength ns - 1) : go (last ns)
+    go _ = []
+
+commonCoords c1 c2 = case (c1, c2) of
+  (x:xs, y:ys) | x == y -> x: commonCoords xs ys
+  _ -> []
+
+getSelection g node c1 c2 =
+  let top = commonCoords c1 c2
+  in case subCoords g g node top c1 c2 of
+  Nothing -> [top]
+  Just bottom -> [top, bottom]
+
+subCoords gtop g node top c1 c2 = case (top, node) of
+  ((i,j):is, Branch _ ns) ->
+    let g' = (gzChildren g !! i) !! j
+    in (subCoords g' g' (ns !! j) is (tail c1) (tail c2))
+  ([], Branch i []) -> Nothing
+  ([], Branch i ns) ->
+    let ln = llength ns - 1
+        (skip,c1',c2') = case (c1, c2) of
+          ((_,j):c1',(_,j'):c2') -> (max j j' == ln, c1', c2')
+          ([], (_,j'):c2') -> (j' == ln, [], c2')
+          ((_,j):c1',[]) -> (j == ln, c1', [])
+          ([],[]) -> (False, [], [])
+    in if skip || ((gzChildren g !! i) !! ln) /= gtop
+       then fmap ((i,ln) :) (subCoords gtop ((gzChildren g !! i) !! ln) (last ns) [] c1' c2')
+       else Just [(i,ln)]
+
+  _ -> Nothing
+
+
+type PreOrder a = [(LinearNode, GrammarZ a)]
+
+getNode :: Node -> [(Int, Int)] -> Node
+getNode n [] = n
+getNode (Branch _ ns) ((i,j):is) = getNode (ns !! j) is
+getNode n _ = n
+
+replaceNode :: GrammarZ a -> Node -> Maybe Node -> [(Int, Int)] -> Node
+replaceNode g n splice [] = fromMaybe (parsePreOrder [emptyOrPlaceholder g]) splice
+
+replaceNode g (Branch _ ns) splice ((i,j):is) =
+  let n' = replaceNode ((gzChildren g !! i) !! j) (ns !! j) splice is
+  in Branch i (take j ns ++ [n'] ++ drop (j+1) ns)
+
+flattenNode :: GrammarZ a -> Node -> PreOrder a
+flattenNode g node = case node of
+  Placeholder -> [(LPlaceholder, g)]
+  Leaf s -> [(LLeaf s, g)]
+  Branch i nodes -> (LBranch i, g) : concat (zipWith flattenNode (gzChildren g !! i) nodes)
+
+splitNodeAfter g node cursor = let (xs,y:ys) = splitNodeAt g node cursor in (y:xs, ys)
+
+splitNodeAt g node cursor = (reverse *** id) (go g node cursor)
+  where
+    go g node cursor =
+      case (cursor, node) of
+      ([],_) -> ([], flattenNode g node)
+
+      ((i,j):is, Branch _ ns) ->
+        let gs = zip (gzChildren g !! i) ns
+            pre = take j gs
+            ((g',n'):post) = drop j gs
+            (pre',post') = go g' n' is
+        in ([(LBranch i, g)] ++ (concatMap (uncurry flattenNode) pre) ++ pre',
+            post' ++ concatMap (uncurry flattenNode) post)
+
+      _ -> error "Incorrect cursor in splitNodeAt"
+
+parsePreOrder :: PreOrder a -> Node
+parsePreOrder xs = let (res,leftover) = go xs in if null leftover then res else error "parsePreorder"
+  where
+    go (x:xs) = case x of
+      (LPlaceholder,_) -> (Placeholder, xs)
+      (LLeaf s,_) -> (Leaf s, xs)
+      (LBranch i, GrammarZ (Alts alts) _ _) ->
+        let (children,xs') = foldl (\(nodes,xs) _g -> let (node,xs') = go xs
+                                                      in (node:nodes, xs')) ([], xs) (fst $ alts !! i)
+        in (Branch i (reverse children), xs')
+
+preOrderZipUp (xs,ys) = parsePreOrder (reverse xs ++ ys)
+
+cursorBack' g node cursor = preOrderCursor $ preOrderBack $ splitNodeAt g node cursor
+cursorBack g node cursor = preOrderCursor $ preOrderBack $ splitNodeAfter g node cursor
+
+preOrderBack :: (PreOrder a, PreOrder a) -> (PreOrder a, PreOrder a)
+preOrderBack ([],ys) = ([], ys)
+preOrderBack (x:xs, ys) =  case x of
+  (LPlaceholder,_) -> (x:xs, ys)
+  (LLeaf _,_) -> (x:xs, ys)
+  _ -> preOrderBack (xs, x:ys)
+
+preOrderCursor ([],_) = []
+preOrderCursor ((_,g):xs, _) = gzCoords g
+
+nextTokens :: (PreOrder a, PreOrder a) -> [(PreOrder a, PreOrder a)]
+nextTokens (prev, []) = []
+nextTokens (prev, x:next) = logging (map fst prev, map fst (x:next)) $ case x of
+  (LLeaf _, _) -> []
+  (LPlaceholder, GrammarZ (Term _) _ _) -> [(prev, x:next)]
+  (LPlaceholder, g) -> concat $ zipWith (\alt j -> nextTokens ((LBranch j, g):prev, map emptyOrPlaceholder alt ++ next)) (gzChildren g) [0..]
+  (LBranch i, g@(GrammarZ (Alts alts) _ _)) ->
+    if null $ fst $ alts !! i
+    then concat $ zipWith (\alt j -> nextTokens ((LBranch j, g):prev, map emptyOrPlaceholder alt ++ next)) (gzChildren g) [0..]
+    else nextTokens (x:prev, next) ++ concatMap (\(a:alt) -> nextTokens (a:prev, alt ++ (x:next))) (recursiveOptions g)
+
+
+recursiveOptions :: GrammarZ a -> [[(LinearNode, GrammarZ a)]]
+recursiveOptions g = go [] g g
+  where
+    go seen g h =
+      if elem h seen
+      then []
+      else case h of
+      GrammarZ (Term _) _ _ -> []
+      _ -> concatMap (\(gs,i) ->
+                        if null gs
+                        then []
+                        else map ((LBranch i, h) :) (if last gs == g
+                                                     then [map (emptyOrPlaceholder) (init gs)]
+                                                     else map (map (emptyOrPlaceholder) (init gs) ++) (go (h:seen) g (last gs)))
+                        ) (zip (gzChildren h) [0..])
+
+emptyOrPlaceholder :: GrammarZ a -> (LinearNode, GrammarZ a)
+emptyOrPlaceholder g = case g of
+  GrammarZ (Alts alts) up _ -> case findIndex null (map fst alts) of
+    Just i -> (LBranch i, g)
+    Nothing -> (LPlaceholder, g)
+  _ -> (LPlaceholder, g)
+
+
+pp_besides :: [PP a] -> [PP a]
+pp_besides = (:[]) . foldr pp_beside (pp_fromWidget $ graphicWidget Nothing (graphicList [noGraphic]))
+
+pp_straightList = (:[]) . straightList
+
+data PPList a = PPList [PP a]
+
+instance Functor PPList where
+  fmap f (PPList pps) = PPList $ map (fmap f) pps
+
+concatPPList (PPList xs) (PPList ys) = PPList (xs ++ ys)
+
+renderNode inSel sels w_leaf w_ph mauto g node = (\(PPList [pp]) -> pp_out 500 pp) auto_node
+  where
+    auto_node = case mauto of
+      Just ([],PPList pp) -> let PPList pp' = go [] inSel sels Nothing g node in PPList $ pp_besides (pp ++ pp')
+      _ -> go [] inSel sels mauto g node
+
+    go coords inSel sels mauto g node =
+      let appendAuto (PPList pp) = case mauto of
+            Just ([], PPList pp') -> PPList (pp_besides (pp ++ pp'))
+            _ -> PPList pp
+          (inSel',sels') = case sels of
+            []:xs -> (not inSel, xs)
+            _ -> (inSel, sels)
+      in case (g, node) of
+      (_, Placeholder) -> appendAuto (w_ph (reverse coords) inSel')
+      (_, Leaf s) -> appendAuto (w_leaf (reverse coords) s inSel')
+      (GrammarZ (Alts alts) _ _, Branch i ch) ->
+        let gs' = gzChildren g !! i
+            pr = snd $ alts !! i
+            ws' = zipWith3 (\j' g' node' ->
+                              let sels'' = case sels' of
+                                    ((_,j):is):xs | j == j' -> is:xs
+                                    _ -> []
+                                  mauto' = case mauto of
+                                    Just ((_,j):is, auto) | j == j' -> Just (is,auto)
+                                    _ -> Nothing
+                              in go ((i,j'):coords) inSel' sels'' mauto' g' node') [0..] gs' ch
+            (PPList pps) = (if null ws'
+                            then PPList []
+                            else balancedFold concatPPList ws')
+        in PPList (pr pps)
+
+edit :: (forall a. GrammarZ a) -> Node -> Widget GraphicTree z
+edit g node = waiting node
+  where
+    mouseDown node selStart selEnd = do
+      let sel = getSelection g node selStart selEnd
+      (coords', mouseUp) <- renderNode False sel
+                            (\coords s isSel -> hoverable s coords isSel)
+                            (\coords isSel -> hoverable "#" coords isSel)
+                            Nothing g node
+      if mouseUp
+        then selected node selStart coords'
+        else mouseDown node selStart coords'
+
+    selected node selStart selEnd = do
+      let sel = getSelection g node selStart selEnd
+      let reselect = renderNode False sel
+                 (\coords s inSel -> clickable s coords inSel)
+                 (\coords inSel -> clickable "#" coords inSel)
+                 Nothing g node
+      result <- (fmap Left keyable) `beside` (fmap Right reselect)
+      case result of
+            Left "x" ->
+              let splice = case sel of
+                    [top,end] -> Just (getNode node (top ++ end))
+                    [top] -> Nothing
+              in waiting (replaceNode g node splice (head sel))
+            Left "i" -> editing node (cursorBack' g node (head sel))
+            Left "a" ->
+              let endSel = case sel of
+                    [top,end] -> top ++ end
+                    [top] -> lastCoords node top
+              in editing node (cursorBack g node endSel)
+            Right coords' -> mouseDown node coords' coords'
+
+
+    waiting node = do
+      coords <- renderNode False [] (\coords s inSel -> clickable s coords inSel) (\coords inSel -> clickable "#" coords inSel) Nothing g node
+      mouseDown node coords coords
+
+    clickable :: String -> z -> Bool -> PPList z
+    clickable str ret sel =
+      let self = Continue ((\mev -> case mev of
+                              EvMouseDown _ _ -> (Nothing, Finish ret)
+                              _ -> (Nothing, self)) <$ showText str sel) Nothing Nothing NotFocusable
+      in PPList [pp_fromWidget self]
+
+    hoverable :: String -> z -> Bool -> PPList (z, Bool)
+    hoverable str ret sel =
+      let self = Continue ((\mev -> case mev of
+                              EvMouseUp _ _ -> (Nothing, Finish (ret, True))
+                              EvMouseMove _ -> (Nothing, Finish (ret, False))
+                              _ -> (Nothing, self)) <$ showText str sel) Nothing Nothing NotFocusable
+      in PPList [pp_fromWidget self]
+
+    keyable :: Widget GraphicTree String
+    keyable = simpleFocus
+              (Continue (const (Nothing, keyable) <$ graphicList [noGraphic]) Nothing Nothing)
+              (\key -> case key of
+                 EvKeyInput "x" -> Finish "x"
+                 EvKeyInput "i" -> Finish "i"
+                 EvKeyInput "a" -> Finish "a"
+                 _ -> keyable)
+
+    showText :: String -> Bool -> GraphicTree ()
+    showText str sel =
+      let textWidth = measureText codeTS (toJSString str)
+          ps = PathStyle Nothing (Just (if sel then RGBA 0 0 0 1 else RGBA 1 1 1 1))
+          ts = if sel then codeTS {ts_color = RGBA 1 1 1 1} else codeTS
+          components = [
+            rectPath ps (textWidth + 4) (fromIntegral (ts_lineHeight codeTS) + 4) 0,
+            Text ts (2,2) (toJSString str)
+            ]
+      in graphicList components
+
+    editing node cursor = do
+      res <- renderNode False []
+           (\coords s inSel -> clickable s (Left coords) inSel)
+           (\coords inSel -> clickable "#" (Left coords) inSel)
+           (Just (cursor, PPList [pp_fromWidget $ fmap Right (autoC node cursor)])) g node
+
+      case res of
+        Left coords -> mouseDown node coords coords
+        Right (Just (node', cursor')) -> editing node' cursor'
+        Right Nothing -> waiting node
+
+
+    autoC node coords =
+      let nts = nextTokens (splitNodeAfter g node coords)
+      in if null nts
+         then Finish Nothing
+         else autoComplete codeTS (\str -> concatMap (\(back,(_,g@(GrammarZ (Term f) _ _)):next) ->
+                                                        let result s = logging ("result", map fst $ reverse back ++ [(LLeaf s, g)] ++ next) (parsePreOrder $ reverse back ++ [(LLeaf s, g)] ++ next, gzCoords g)
+                                                        in map (\s -> (toJSString s, Just $ result s)) (f $ fromJust $ fromJSString str)) nts) "" True
+
+codeTS = TextStyle (RGBA 0 0 0 1.0) 40 46 False False "\"Sans-Serif\""
+
+str a = term (\s -> if s `isPrefixOf` a then [a] else [])
+
+tok_str = term (\s -> if "\"" `isPrefixOf` s
+                      then if "\"" `isSuffixOf` s then [s] else [s ++ "\""]
+                      else [])
+
+tok_num = term (\s -> if not (null s) && all (`elem` ("0123456789" :: String)) s then [s] else [])
+
+aList :: Grammar a
+aList = gfix (\top -> alts [
+                ([], pp_besides),
+                ([term (const ["a"]), top], pp_besides)
+                ]) 0
+
+json :: Grammar a
+json = gfix (\any -> alts [
+                 ([obj any], id),
+                 ([arr any], id),
+                 ([simple], id)
+                 ]) 0
+  where
+    obj any = alts [([str "{", sepListNE (kvPair any) (str ","), str "}"], pp_straightList . list_pp)]
+
+    kvPair any = alts [([tok_str, str ":", any], pp_besides)]
+
+    arr any = alts [([str "[", sepListNE any (str ","), str "]"], pp_straightList . list_pp)]
+
+
+    simple = alts [([tok_str], id),
+                   ([tok_num], id)]
+
+    list_pp pps = head pps : (commas $ init $ tail pps) ++ [last pps]
+
+    commas [] = []
+    commas [x] = [x]
+    commas (x:y:xs) = pp_beside x y : commas xs
+
+
+
+
+sepListNE x y = gfix (\top -> alts [
+                          ([x, alts [
+                                ([], id),
+                                ([y, top], id)
+                                ]
+                           ], id)
+                          ])
+
+
+
+widgetMain = runOnCanvas $ \w -> edit (gzInject json) jsonNode
+  where
+    jsonNode = Branch 1 [Branch 0 [Leaf "[", Placeholder, Leaf "]"]] --(parsePreOrder [emptyOrPlaceholder (gzInject json)])
diff --git a/treersec.cabal b/treersec.cabal
new file mode 100644
--- /dev/null
+++ b/treersec.cabal
@@ -0,0 +1,27 @@
+name:                treersec
+version:             1
+synopsis:            Structure Editing Combinators
+description:         Build a structure editor for a programming language from combinators following the grammar.
+homepage:            http://sneathlane.com/treersec
+license:             BSD2
+license-file:        LICENSE
+author:              Jason Priestley
+maintainer:          jason@sneathlane.com
+category:            GUI
+build-type:          Simple
+cabal-version:       >=1.10
+
+Flag Haste-inst
+  Description: either if it is being compiled with haste-inst or with cabal
+  Default: False
+
+library
+  exposed-modules:     Treersec
+  if flag(haste-inst)
+    build-depends: base >=4.0 && <5, haste-lib >=0.5 && <0.6, sneathlane-haste >=2 && <3
+    ghc-options: --link-jslib --ddisable-js-opts
+  else
+    build-depends: base >=4.0 && <5, haste-compiler >=0.5 && <0.6, sneathlane-haste >=2 && <3
+    ghc-options:
+  other-extensions:    KindSignatures, GADTs, OverloadedStrings
+  default-language:    Haskell2010
