diff --git a/Language/Javascript/JMacro/Base.hs b/Language/Javascript/JMacro/Base.hs
--- a/Language/Javascript/JMacro/Base.hs
+++ b/Language/Javascript/JMacro/Base.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE FlexibleInstances, UndecidableInstances, OverlappingInstances, TypeFamilies, RankNTypes, DeriveDataTypeable, StandaloneDeriving, FlexibleContexts, TypeSynonymInstances, ScopedTypeVariables #-}
+{-# LANGUAGE FlexibleInstances, UndecidableInstances, OverlappingInstances, OverloadedStrings, TypeFamilies, RankNTypes, DeriveDataTypeable, StandaloneDeriving, FlexibleContexts, TypeSynonymInstances, ScopedTypeVariables, GADTs #-}
 
 -----------------------------------------------------------------------------
 {- |
@@ -16,7 +16,7 @@
   -- * ADT
   JStat(..), JExpr(..), JVal(..), Ident(..), IdentSupply(..),
   -- * Generic traversal (via compos)
-  JMacro(..), MultiComp(..), Compos(..),
+  JMacro(..), JMGadt(..), Compos(..),
   composOp, composOpM, composOpM_, composOpFold,
   -- * Hygienic transformation
   withHygiene, scopify,
@@ -36,31 +36,43 @@
   ) where
 import Prelude hiding (tail, init, head, last, minimum, maximum, foldr1, foldl1, (!!), read)
 import Control.Applicative hiding (empty)
-import Control.Arrow (second)
+import Control.Arrow ((***))
 import Control.Monad.State.Strict
 import Control.Monad.Identity
 
 import Data.Function
 import Data.Char (toLower,isControl)
-import Data.Maybe (fromMaybe)
-import qualified Data.Set as S
 import qualified Data.Map as M
+import qualified Data.Text.Lazy as T
+import qualified Data.Text as TS
 import Data.Generics
 import Data.Monoid(Monoid, mappend, mempty)
 
 import Numeric(showHex)
 import Safe
-import Text.JSON
-import Text.PrettyPrint.HughesPJ as PP
+import Data.Aeson
+import qualified Data.Vector as V
+import qualified Data.HashMap.Strict as HM
+import Text.PrettyPrint.Leijen.Text hiding ((<$>))
 
+import qualified Text.PrettyPrint.Leijen.Text as PP
+
 import Language.Javascript.JMacro.Types
 
+-- wl-pprint-text compatibility with pretty
+infixl 5 $$, $+$
+($+$), ($$), ($$$) :: Doc -> Doc -> Doc
+x $+$ y = x PP.<$> y
+x $$ y  = align (x $+$ y)
+x $$$ y = align (nest 2 $ x $+$ y)
+
 {--------------------------------------------------------------------
   ADTs
 --------------------------------------------------------------------}
 
 newtype IdentSupply a = IS {runIdentSupply :: State [Ident] a} deriving Typeable
 
+inIdentSupply :: (State [Ident] a -> State [Ident] b) -> IdentSupply a -> IdentSupply b
 inIdentSupply f x = IS $ f (runIdentSupply x)
 
 instance Data a => Data (IdentSupply a) where
@@ -103,8 +115,8 @@
 data JStat = DeclStat   Ident (Maybe JLocalType)
            | ReturnStat JExpr
            | IfStat     JExpr JStat JStat
-           | WhileStat  JExpr JStat
-           | ForInStat  Bool Ident JExpr JStat
+           | WhileStat  Bool JExpr JStat -- bool is "do"
+           | ForInStat  Bool Ident JExpr JStat -- bool is "each"
            | SwitchStat JExpr [(JExpr, JStat)] JStat
            | TryStat    JStat Ident JStat JStat
            | BlockStat  [JStat]
@@ -114,10 +126,14 @@
            | UnsatBlock (IdentSupply JStat)
            | AntiStat   String
            | ForeignStat Ident JLocalType
-           | BreakStat
+           | LabelStat JsLabel JStat
+           | BreakStat (Maybe JsLabel)
+           | ContinueStat (Maybe JsLabel)
              deriving (Eq, Ord, Show, Data, Typeable)
 
+type JsLabel = String
 
+
 instance Monoid JStat where
     mempty = BlockStat []
     mappend (BlockStat xs) (BlockStat ys) = BlockStat $ xs ++ ys
@@ -175,70 +191,68 @@
 {--------------------------------------------------------------------
   Compos
 --------------------------------------------------------------------}
+-- | Compos and ops for generic traversal as defined over
+-- the JMacro ADT.
 
 -- | Utility class to coerce the ADT into a regular structure.
 class JMacro a where
-    toMC :: a -> MultiComp
-    fromMC :: MultiComp -> a
+    jtoGADT :: a -> JMGadt a
+    jfromGADT :: JMGadt a -> a
 
--- | Union type to allow regular traversal by compos.
-data MultiComp = MStat JStat | MExpr JExpr | MVal JVal | MIdent Ident deriving Show
+instance JMacro Ident where
+    jtoGADT = JMGId
+    jfromGADT (JMGId x) = x
+    jfromGADT _ = error "impossible"
 
+instance JMacro JStat where
+    jtoGADT = JMGStat
+    jfromGADT (JMGStat x) = x
+    jfromGADT _ = error "impossible"
+    
+instance JMacro JExpr where
+    jtoGADT = JMGExpr
+    jfromGADT (JMGExpr x) = x
+    jfromGADT _ = error "impossible"
 
--- | Compos and ops for generic traversal as defined over
--- the JMacro ADT.
-class Compos t where
-    compos :: (forall a. a -> m a) -> (forall a b. m (a -> b) -> m a -> m b)
-           -> (t -> m t) -> t -> m t
+instance JMacro JVal where
+    jtoGADT = JMGVal 
+    jfromGADT (JMGVal x) = x
+    jfromGADT _ = error "impossible"
 
+-- | Union type to allow regular traversal by compos.
+data JMGadt a where
+    JMGId   :: Ident -> JMGadt Ident
+    JMGStat :: JStat -> JMGadt JStat
+    JMGExpr :: JExpr -> JMGadt JExpr
+    JMGVal  :: JVal  -> JMGadt JVal
 
-composOp :: Compos t => (t -> t) -> t -> t
+
+composOp :: Compos t => (forall a. t a -> t a) -> t b -> t b
 composOp f = runIdentity . composOpM (Identity . f)
-composOpM :: (Compos t, Monad m) => (t -> m t) -> t -> m t
+composOpM :: (Compos t, Monad m) => (forall a. t a -> m (t a)) -> t b -> m (t b)
 composOpM = compos return ap
-composOpM_ :: (Compos t, Monad m) => (t -> m ()) -> t -> m ()
+composOpM_ :: (Compos t, Monad m) => (forall a. t a -> m ()) -> t b -> m ()
 composOpM_ = composOpFold (return ()) (>>)
-composOpFold :: Compos t => b -> (b -> b -> b) -> (t -> b) -> t -> b
+composOpFold :: Compos t => b -> (b -> b -> b) -> (forall a. t a -> b) -> t c -> b
 composOpFold z c f = unC . compos (\_ -> C z) (\(C x) (C y) -> C (c x y)) (C . f)
 newtype C b a = C { unC :: b }
 
-instance JMacro Ident where
-    toMC = MIdent
-    fromMC (MIdent x) = x
-    fromMC _ = error "fromMC"
-
-instance JMacro JVal where
-    toMC = MVal
-    fromMC (MVal x) = x
-    fromMC _ = error "fromMC"
-
-instance JMacro JExpr where
-    toMC = MExpr
-    fromMC (MExpr x) = x
-    fromMC _ = error "fromMC"
-
-instance JMacro JStat where
-    toMC = MStat
-    fromMC (MStat x) = x
-    fromMC _ = error "fromMC"
-
-instance JMacro [JStat] where
-    toMC = MStat . BlockStat
-    fromMC (MStat (BlockStat x)) = x
-    fromMC _ = error "fromMC"
+class Compos t where
+    compos :: (forall a. a -> m a) -> (forall a b. m (a -> b) -> m a -> m b)
+           -> (forall a. t a -> m (t a)) -> t c -> m (t c)
 
+instance Compos JMGadt where
+    compos = jmcompos
 
-instance Compos MultiComp where
-  compos = mcCompos
-    where
-     mcCompos :: forall m. (forall a. a -> m a) -> (forall a b. m (a -> b) -> m a -> m b) -> (MultiComp -> m MultiComp) -> MultiComp -> m MultiComp
-     mcCompos ret app f' v = case v of
-        MIdent _ -> ret v
-        MStat v' -> ret MStat `app` case v' of
+jmcompos :: forall m c. (forall a. a -> m a) -> (forall a b. m (a -> b) -> m a -> m b) -> (forall a. JMGadt a -> m (JMGadt a)) -> JMGadt c -> m (JMGadt c)
+jmcompos ret app f' v = 
+    case v of
+     JMGId _ -> ret v
+     JMGStat v' -> ret JMGStat `app` case v' of
            DeclStat i t -> ret DeclStat `app` f i `app` ret t
            ReturnStat i -> ret ReturnStat `app` f i
            IfStat e s s' -> ret IfStat `app` f e `app` f s `app` f s'
-           WhileStat e s -> ret WhileStat `app` f e `app` f s
+           WhileStat b e s -> ret (WhileStat b) `app` f e `app` f s
            ForInStat b i e s -> ret (ForInStat b) `app` f i `app` f e `app` f s
            SwitchStat e l d -> ret SwitchStat `app` f e `app` l' `app` f d
                where l' = mapM' (\(c,s) -> ret (,) `app` f c `app` f s) l
@@ -250,8 +264,10 @@
            UnsatBlock _ -> ret v'
            AntiStat _ -> ret v'
            ForeignStat i t -> ret ForeignStat `app` f i `app` ret t
-           BreakStat -> ret BreakStat
-        MExpr v' -> ret MExpr `app` case v' of
+           ContinueStat l -> ret (ContinueStat l)
+           BreakStat l -> ret (BreakStat l)
+           LabelStat l s -> ret (LabelStat l) `app` f s
+     JMGExpr v' -> ret JMGExpr `app` case v' of
            ValExpr e -> ret ValExpr `app` f e
            SelExpr e e' -> ret SelExpr `app` f e `app` f e'
            IdxExpr e e' -> ret IdxExpr `app` f e `app` f e'
@@ -263,7 +279,7 @@
            AntiExpr _ -> ret v'
            TypeExpr b e t -> ret (TypeExpr b) `app` f e `app` ret t
            UnsatExpr _ -> ret v'
-        MVal v' -> ret MVal `app` case v' of
+     JMGVal v' -> ret JMGVal `app` case v' of
            JVar i -> ret JVar `app` f i
            JList xs -> ret JList `app` mapM' f xs
            JDouble _ -> ret v'
@@ -275,25 +291,12 @@
                      m' = ret (M.fromAscList . zip ls) `app` mapM' f vs
            JFunc xs s -> ret JFunc `app` mapM' f xs `app` f s
            UnsatVal _ -> ret v'
-      where
-        mapM' :: (a -> m a) -> [a] -> m [a]
-        mapM' g = foldr (app . app (ret (:)) . g) (ret [])
-        f :: JMacro a => a -> m a
-        f x = ret fromMC `app` f' (toMC x)
 
-instance Compos JType where
-    compos ret app f v =
-        case v of
-          JTFunc args body -> ret JTFunc `app` mapM' f args `app` f body
-          JTForall vars t -> ret JTForall `app` ret vars `app` f t
-          JTList t -> ret JTList `app` f t
-          JTMap t -> ret JTMap `app` f t
-          JTRecord t m -> ret JTRecord `app` f t `app` m'
-              where (ls,ts) = unzip $ M.toList m
-                    m' = ret (M.fromAscList . zip ls) `app` mapM' f ts
-          x -> ret x
-      where
-        mapM' g = foldr (app . app (ret (:)) . g) (ret [])
+  where
+    mapM' :: forall a. (a -> m a) -> [a] -> m [a]
+    mapM' g = foldr (app . app (ret (:)) . g) (ret [])
+    f :: forall b. JMacro b => b -> m b
+    f x = ret jfromGADT `app` f' (jtoGADT x)
 
 {--------------------------------------------------------------------
   New Identifiers
@@ -336,12 +339,14 @@
 jsSaturate str x = evalState (runIdentSupply $ jsSaturate_ x) (newIdentSupply str)
 
 jsSaturate_ :: (JMacro a) => a -> IdentSupply a
-jsSaturate_ e = IS $ fromMC <$> go (toMC e)
-    where go v = case v of
-                   MStat (UnsatBlock us) -> go =<< (MStat <$> runIdentSupply us)
-                   MExpr (UnsatExpr  us) -> go =<< (MExpr <$> runIdentSupply us)
-                   MVal  (UnsatVal   us) -> go =<< (MVal  <$> runIdentSupply us)
-                   _ -> composOpM go v
+jsSaturate_ e = IS $ jfromGADT <$> go (jtoGADT e)
+    where 
+      go :: forall a. JMGadt a -> State [Ident] (JMGadt a)
+      go v = case v of
+               JMGStat (UnsatBlock us) -> go =<< (JMGStat <$> runIdentSupply us)
+               JMGExpr (UnsatExpr  us) -> go =<< (JMGExpr <$> runIdentSupply us)
+               JMGVal  (UnsatVal   us) -> go =<< (JMGVal  <$> runIdentSupply us)
+               _ -> composOpM go v
 
 {--------------------------------------------------------------------
   Transformation
@@ -349,11 +354,13 @@
 
 --doesn't apply to unsaturated bits
 jsReplace_ :: JMacro a => [(Ident, Ident)] -> a -> a
-jsReplace_ xs e = fromMC $ go (toMC e)
-    where go v = case v of
-                   MIdent i -> maybe v MIdent (M.lookup i mp)
+jsReplace_ xs e = jfromGADT $ go (jtoGADT e)
+    where 
+      go :: forall a. JMGadt a -> JMGadt a    
+      go v = case v of
+                   JMGId i -> maybe v JMGId (M.lookup i mp)
                    _ -> composOp go v
-          mp = M.fromList xs
+      mp = M.fromList xs
 
 --only works on fully saturated things
 jsUnsat_ :: JMacro a => [Ident] -> a -> IdentSupply a
@@ -367,28 +374,24 @@
 -- following the transformation. As the transformation preserves
 -- free variables, it is hygienic. Cannot be used nested.
 withHygiene:: JMacro a => (a -> a) -> a -> a
-withHygiene f x = fromMC $ case mx of
-              MStat _  -> toMC $ UnsatBlock (coerceMC <$> jsUnsat_ is' x'')
-              MExpr _  -> toMC $ UnsatExpr  (coerceMC <$> jsUnsat_ is' x'')
-              MVal  _  -> toMC $ UnsatVal   (coerceMC <$> jsUnsat_ is' x'')
-              MIdent _ -> toMC $ f x
+withHygiene f x = jfromGADT $ case mx of
+              JMGStat _  -> jtoGADT $ UnsatBlock (jsUnsat_ is' x'')
+              JMGExpr _  -> jtoGADT $ UnsatExpr  (jsUnsat_ is' x'')
+              JMGVal  _  -> jtoGADT $ UnsatVal   (jsUnsat_ is' x'')
+              JMGId _ -> jtoGADT $ f x
     where (x', (StrI l:_)) = runState (runIdentSupply $ jsSaturate_ x) is
           x'' = f x'
           is = newIdentSupply (Just "inSat")
           lastVal = readNote "inSat" (drop 6 l) :: Int
           is' = take lastVal is
-          mx = toMC x
-          coerceMC :: (JMacro a, JMacro b) => a -> b
-          coerceMC = fromMC . toMC
-
-
-
+          mx = jtoGADT x
 
 -- | Takes a fully saturated expression and transforms it to use unique variables that respect scope.
 scopify :: JStat -> JStat
-scopify x = evalState (fromMC <$> go (toMC x)) (newIdentSupply Nothing)
-    where go v = case v of
-                   (MStat (BlockStat ss)) -> MStat . BlockStat <$>
+scopify x = evalState (jfromGADT <$> go (jtoGADT x)) (newIdentSupply Nothing)
+    where go :: forall a. JMGadt a -> State [Ident] (JMGadt a)
+          go v = case v of
+                   (JMGStat (BlockStat ss)) -> JMGStat . BlockStat <$>
                                              blocks ss
                        where blocks [] = return []
                              blocks (DeclStat (StrI i) t : xs) =  case i of
@@ -399,26 +402,26 @@
                                   put st
                                   rest <- blocks xs
                                   return $ [DeclStat newI t `mappend` jsReplace_ [(StrI i, newI)] (BlockStat rest)]
-                             blocks (x':xs) = (fromMC <$> go (toMC x')) <:> blocks xs
+                             blocks (x':xs) = (jfromGADT <$> go (jtoGADT x')) <:> blocks xs
                              (<:>) = liftM2 (:)
-                   (MStat (ForInStat b (StrI i) e s)) -> do
+                   (JMGStat (ForInStat b (StrI i) e s)) -> do
                           (newI:st) <- get
                           put st
-                          rest <- fromMC <$> go (toMC s)
-                          return $ MStat . ForInStat b newI e $ jsReplace_ [(StrI i, newI)] rest
-                   (MStat (TryStat s (StrI i) s1 s2)) -> do
+                          rest <- jfromGADT <$> go (jtoGADT s)
+                          return $ JMGStat . ForInStat b newI e $ jsReplace_ [(StrI i, newI)] rest
+                   (JMGStat (TryStat s (StrI i) s1 s2)) -> do
                           (newI:st) <- get
                           put st
-                          t <- fromMC <$> go (toMC s)
-                          c <- fromMC <$> go (toMC s1)
-                          f <- fromMC <$> go (toMC s2)
-                          return . MStat . TryStat t newI (jsReplace_ [(StrI i, newI)] c) $ f
-                   (MExpr (ValExpr (JFunc is s))) -> do
+                          t <- jfromGADT <$> go (jtoGADT s)
+                          c <- jfromGADT <$> go (jtoGADT s1)
+                          f <- jfromGADT <$> go (jtoGADT s2)
+                          return . JMGStat . TryStat t newI (jsReplace_ [(StrI i, newI)] c) $ f
+                   (JMGExpr (ValExpr (JFunc is s))) -> do
                             st <- get
                             let (newIs,newSt) = splitAt (length is) st
                             put (newSt)
-                            rest <- fromMC <$> go (toMC s)
-                            return . MExpr . ValExpr $ JFunc newIs $ (jsReplace_ $ zip is newIs) rest
+                            rest <- jfromGADT <$> go (jtoGADT s)
+                            return . JMGExpr . ValExpr $ JFunc newIs $ (jsReplace_ $ zip is newIs) rest
                    _ -> composOpM go v
 
 {--------------------------------------------------------------------
@@ -436,10 +439,10 @@
 renderPrefixJs pfx = jsToDoc . jsSaturate (Just $ "jmId_"++pfx)
 
 braceNest :: Doc -> Doc
-braceNest x = char '{' $$ nest 2 x $$ char '}'
+braceNest x = char '{' <+> nest 2 x $$ char '}'
 
 braceNest' :: Doc -> Doc
-braceNest' x = char '{' $+$ nest 2 x $$ char '}'
+braceNest' x = nest 2 (char '{' $+$ x) $$ char '}'
 
 class JsToDoc a
     where jsToDoc :: a -> Doc
@@ -452,17 +455,28 @@
         where rest = case t of
                        Nothing -> text ""
                        Just tp -> text " /* ::" <+> jsToDoc tp <+> text "*/"
-    jsToDoc (WhileStat p b)  = text "while" <> parens (jsToDoc p) $$ braceNest' (jsToDoc b)
+    jsToDoc (WhileStat False p b)  = text "while" <> parens (jsToDoc p) $$ braceNest' (jsToDoc b)
+    jsToDoc (WhileStat True  p b)  = (text "do" $$ braceNest' (jsToDoc b)) $+$ text "while" <+> parens (jsToDoc p)
     jsToDoc (UnsatBlock e) = jsToDoc $ sat_ e
-    jsToDoc BreakStat = text "break"
+
+    jsToDoc (BreakStat l) = maybe (text "break") (((<+>) `on` text) "break" . T.pack) l
+    jsToDoc (ContinueStat l) = maybe (text "continue") (((<+>) `on` text) "continue" . T.pack) l
+    jsToDoc (LabelStat l s) = text (T.pack l) <> char ':' $$ printBS s
+        where
+          printBS (BlockStat ss) = vcat $ interSemi $ flattenBlocks ss
+          printBS x = jsToDoc x
+          interSemi [x] = [jsToDoc x]
+          interSemi [] = []
+          interSemi (x:xs) = (jsToDoc x <> semi) : interSemi xs
+
     jsToDoc (ForInStat each i e b) = text txt <> parens (text "var" <+> jsToDoc i <+> text "in" <+> jsToDoc e) $$ braceNest' (jsToDoc b)
         where txt | each = "for each"
                   | otherwise = "for"
     jsToDoc (SwitchStat e l d) = text "switch" <+> parens (jsToDoc e) $$ braceNest' cases
-        where l' = map (\(c,s) -> text "case" <+> parens (jsToDoc c) <> char ':' $$ nest 2 (jsToDoc [s])) l ++ [text "default:" $$ nest 2 (jsToDoc [d])]
+        where l' = map (\(c,s) -> (text "case" <+> parens (jsToDoc c) <> char ':') $$$ (jsToDoc s)) l ++ [text "default:" $$$ (jsToDoc d)]
               cases = vcat l'
     jsToDoc (ReturnStat e) = text "return" <+> jsToDoc e
-    jsToDoc (ApplStat e es) = jsToDoc e <> (parens . fsep . punctuate comma $ map jsToDoc es)
+    jsToDoc (ApplStat e es) = jsToDoc e <> (parens . fillSep . punctuate comma $ map jsToDoc es)
     jsToDoc (TryStat s i s1 s2) = text "try" $$ braceNest' (jsToDoc s) $$ mbCatch $$ mbFinally
         where mbCatch | s1 == BlockStat [] = PP.empty
                       | otherwise = text "catch" <> parens (jsToDoc i) $$ braceNest' (jsToDoc s1)
@@ -470,49 +484,56 @@
                         | otherwise = text "finally" $$ braceNest' (jsToDoc s2)
     jsToDoc (AssignStat i x) = jsToDoc i <+> char '=' <+> jsToDoc x
     jsToDoc (PPostStat isPre op x)
-        | isPre = text op <> jsToDoc x
-        | otherwise = jsToDoc x <> text op
-    jsToDoc (AntiStat s) = text $ "`(" ++ s ++ ")`"
+        | isPre = text (T.pack op) <> optParens x
+        | otherwise = optParens x <> text (T.pack op)
+    jsToDoc (AntiStat s) = text . T.pack $ "`(" ++ s ++ ")`"
     jsToDoc (ForeignStat i t) = text "//foriegn" <+> jsToDoc i <+> text "::" <+> jsToDoc t
     jsToDoc (BlockStat xs) = jsToDoc (flattenBlocks xs)
-        where flattenBlocks (BlockStat y:ys) = flattenBlocks y ++ flattenBlocks ys
-              flattenBlocks (y:ys) = y : flattenBlocks ys
-              flattenBlocks [] = []
 
+flattenBlocks :: [JStat] -> [JStat]
+flattenBlocks (BlockStat y:ys) = flattenBlocks y ++ flattenBlocks ys
+flattenBlocks (y:ys) = y : flattenBlocks ys
+flattenBlocks [] = []
+
+optParens :: JExpr -> Doc
+optParens x = case x of
+                (PPostExpr _ _ _) -> parens (jsToDoc x)
+                _ -> jsToDoc x
+
 instance JsToDoc JExpr where
     jsToDoc (ValExpr x) = jsToDoc x
     jsToDoc (SelExpr x y) = cat [jsToDoc x <> char '.', jsToDoc y]
     jsToDoc (IdxExpr x y) = jsToDoc x <> brackets (jsToDoc y)
     jsToDoc (IfExpr x y z) = parens (jsToDoc x <+> char '?' <+> jsToDoc y <+> char ':' <+> jsToDoc z)
-    jsToDoc (InfixExpr op x y) = parens $ sep [jsToDoc x, text op', jsToDoc y]
+    jsToDoc (InfixExpr op x y) = parens $ sep [jsToDoc x, text (T.pack op'), jsToDoc y]
         where op' | op == "++" = "+"
                   | otherwise = op
 
     jsToDoc (PPostExpr isPre op x)
-        | isPre = text op <> jsToDoc x
-        | otherwise = jsToDoc x <> text op
+        | isPre = text (T.pack op) <> optParens x
+        | otherwise = optParens x <> text (T.pack op)
 
-    jsToDoc (ApplExpr je xs) = jsToDoc je <> (parens . fsep . punctuate comma $ map jsToDoc xs)
+    jsToDoc (ApplExpr je xs) = jsToDoc je <> (parens . fillSep . punctuate comma $ map jsToDoc xs)
     jsToDoc (NewExpr e) = text "new" <+> jsToDoc e
-    jsToDoc (AntiExpr s) = text $ "`(" ++ s ++ ")`"
+    jsToDoc (AntiExpr s) = text . T.pack $ "`(" ++ s ++ ")`"
     jsToDoc (TypeExpr b e t)  = parens $ jsToDoc e <+> text (if b then "/* ::!" else "/* ::") <+> jsToDoc t <+> text "*/"
     jsToDoc (UnsatExpr e) = jsToDoc $ sat_ e
 
 instance JsToDoc JVal where
     jsToDoc (JVar i) = jsToDoc i
-    jsToDoc (JList xs) = brackets . fsep . punctuate comma $ map jsToDoc xs
+    jsToDoc (JList xs) = brackets . fillSep . punctuate comma $ map jsToDoc xs
     jsToDoc (JDouble d) = double d
     jsToDoc (JInt i) = integer i
-    jsToDoc (JStr s) = text ("\""++encodeJson s++"\"")
-    jsToDoc (JRegEx s) = text ("/"++s++"/")
+    jsToDoc (JStr s) = text . T.pack $ "\""++encodeJson s++"\""
+    jsToDoc (JRegEx s) = text . T.pack $ "/"++s++"/"
     jsToDoc (JHash m)
             | M.null m = text "{}"
-            | otherwise = braceNest . fsep . punctuate comma . map (\(x,y) -> quotes (text x) <> colon <+> jsToDoc y) $ M.toList m
-    jsToDoc (JFunc is b) = parens $ text "function" <> parens (fsep . punctuate comma . map jsToDoc $ is) $$ braceNest' (jsToDoc b)
+            | otherwise = braceNest . fillSep . punctuate comma . map (\(x,y) -> squotes (text (T.pack x)) <> colon <+> jsToDoc y) $ M.toList m
+    jsToDoc (JFunc is b) = parens $ text "function" <> parens (fillSep . punctuate comma . map jsToDoc $ is) $$ braceNest' (jsToDoc b)
     jsToDoc (UnsatVal f) = jsToDoc $ sat_ f
 
 instance JsToDoc Ident where
-    jsToDoc (StrI s) = text s
+    jsToDoc (StrI s) = text (T.pack s)
 
 instance JsToDoc [JExpr] where
     jsToDoc = vcat . map ((<> semi) . jsToDoc)
@@ -526,14 +547,14 @@
     jsToDoc JTBool = text "Bool"
     jsToDoc JTStat = text "()"
     jsToDoc JTImpossible = text "_|_" -- "⊥"
-    jsToDoc (JTForall vars t) = text "forall" <+> fsep  (punctuate comma (map ppRef vars)) <> text "." <+> jsToDoc t
-    jsToDoc (JTFunc args ret) = fsep . punctuate (text " ->") . map ppType $ args' ++ [ret]
+    jsToDoc (JTForall vars t) = text "forall" <+> fillSep  (punctuate comma (map ppRef vars)) <> text "." <+> jsToDoc t
+    jsToDoc (JTFunc args ret) = fillSep . punctuate (text " ->") . map ppType $ args' ++ [ret]
         where args'
                | null args = [JTStat]
                | otherwise = args
     jsToDoc (JTList t) = brackets $ jsToDoc t
     jsToDoc (JTMap t) = text "Map" <+> ppType t
-    jsToDoc (JTRecord t mp) = braces (fsep . punctuate comma . map (\(x,y) -> text x <+> text "::" <+> jsToDoc y) $ M.toList mp) <+> text "[" <> jsToDoc t <> text "]"
+    jsToDoc (JTRecord t mp) = braces (fillSep . punctuate comma . map (\(x,y) -> text (T.pack x) <+> text "::" <+> jsToDoc y) $ M.toList mp) <+> text "[" <> jsToDoc t <> text "]"
     jsToDoc (JTFree ref) = ppRef ref
     jsToDoc (JTRigid ref cs) = text "[" <> ppRef ref <> text "]"
 {-
@@ -545,16 +566,19 @@
 instance JsToDoc JLocalType where
     jsToDoc (cs,t) = maybe (text "") (<+> text "=> ") (ppConstraintList cs) <> jsToDoc t
 
+ppConstraintList :: Show a => [((Maybe String, a), Constraint)] -> Maybe Doc
 ppConstraintList cs
     | null cs = Nothing
-    | otherwise = Just . parens . fsep . punctuate comma $ map go cs
+    | otherwise = Just . parens . fillSep . punctuate comma $ map go cs
     where
       go (vr,Sub   t') = ppRef vr   <+> text "<:" <+> jsToDoc t'
       go (vr,Super t') = jsToDoc t' <+> text "<:" <+> ppRef vr
 
+ppRef :: Show a => (Maybe String, a) -> Doc
+ppRef (Just n,_) = text . T.pack $ n
+ppRef (_,i) = text . T.pack $ "t_"++show i
 
-ppRef (Just n,_) = text n
-ppRef (_,i) = text $ "t_"++show i
+ppType :: JType -> Doc
 ppType x@(JTFunc _ _) = parens $ jsToDoc x
 ppType x@(JTMap _) = parens $ jsToDoc x
 ppType x = jsToDoc x
@@ -705,7 +729,7 @@
 jsv = ValExpr . JVar . StrI
 
 jFor :: (ToJExpr a, ToStat b) => JStat -> a -> JStat -> b -> JStat
-jFor before p after b = BlockStat [before, WhileStat (toJExpr p) b']
+jFor before p after b = BlockStat [before, WhileStat False (toJExpr p) b']
     where b' = case toStat b of
                  BlockStat xs -> BlockStat $ xs ++ [after]
                  x -> BlockStat [x,after]
@@ -728,19 +752,20 @@
 nullStat :: JStat
 nullStat = BlockStat []
 
-
--- JSON instance
-instance ToJExpr JSValue where
-    toJExpr JSNull             = ValExpr $ JVar $ StrI "null"
-    toJExpr (JSBool b)         = ValExpr $ JVar $ StrI $ map toLower (show b)
-    toJExpr (JSRational b rat) = ValExpr $ JDouble $ realToFrac rat
-    toJExpr (JSString s)       = ValExpr $ JStr $ fromJSString s
-    toJExpr (JSArray vs)       = ValExpr $ JList $ map toJExpr vs
-    toJExpr (JSObject obj)     = ValExpr $ JHash $ M.fromList $ map (second toJExpr) $ fromJSObject obj
+-- Aeson instance
+instance ToJExpr Value where
+    toJExpr Null             = ValExpr $ JVar $ StrI "null"
+    toJExpr (Bool b)         = ValExpr $ JVar $ StrI $ map toLower (show b)
+    toJExpr (Number n)       = ValExpr $ JDouble $ realToFrac n
+    toJExpr (String s)       = ValExpr $ JStr $ TS.unpack s
+    toJExpr (Array vs)       = ValExpr $ JList $ map toJExpr $ V.toList vs
+    toJExpr (Object obj)     = ValExpr $ JHash $ M.fromList $ map (TS.unpack *** toJExpr) $ HM.toList obj
 
 -------------------------
 
 -- Taken from json package by Sigbjorn Finne.
+
+encodeJson :: String -> String
 encodeJson = concatMap encodeJsonChar
 
 encodeJsonChar :: Char -> String
diff --git a/Language/Javascript/JMacro/Benchmark.hs b/Language/Javascript/JMacro/Benchmark.hs
new file mode 100644
--- /dev/null
+++ b/Language/Javascript/JMacro/Benchmark.hs
@@ -0,0 +1,11 @@
+{-# LANGUAGE QuasiQuotes #-}
+
+import Criterion.Main
+import Language.Javascript.JMacro
+import Text.PrettyPrint.Leijen.Text (renderPretty, renderCompact, displayT)
+
+main = defaultMain [pretty, compact]
+
+pretty = bench "pretty" $ nf (displayT . renderPretty 0.4 100 . renderJs) jmPrelude
+
+compact = bench "compact" $ nf (displayT . renderCompact . renderJs) jmPrelude
diff --git a/Language/Javascript/JMacro/Executable.hs b/Language/Javascript/JMacro/Executable.hs
--- a/Language/Javascript/JMacro/Executable.hs
+++ b/Language/Javascript/JMacro/Executable.hs
@@ -1,5 +1,8 @@
+{-# LANGUAGE GADTs, RankNTypes #-}
+
 module Main where
 
+import Text.PrettyPrint.Leijen.Text (hPutDoc)
 import Control.Applicative
 import Control.Monad
 import Language.Javascript.JMacro
@@ -17,7 +20,7 @@
    let s = gotArg args "Scope"
    infile <- getArgStdio args "Infile" ReadMode
    outfile <- getArgStdio args "Outfile" WriteMode
-   either (hPrint stderr) (hPrint outfile) . parseIt s =<< hGetContents infile
+   either (hPrint stderr) (hPutDoc outfile) . parseIt s =<< hGetContents infile
   where
     parseIt True  = onRight (renderJs . scopify)  . parseJM
     parseIt False = onRight (renderJs . fixIdent) . parseJM
@@ -25,8 +28,10 @@
     onRight f (Right x) = Right (f x)
     onRight _ (Left x) = (Left x)
 
-    fixIdent x = fromMC $ composOp go (toMC x) :: JStat
-        where go v = case v of
-                       (MStat (DeclStat (StrI ('!':'!':i')) t)) -> MStat (DeclStat (StrI i') t)
-                       (MStat (DeclStat (StrI ('!':i')) t)) -> MStat (DeclStat (StrI i') t)
+    fixIdent x = jfromGADT $ composOp go (jtoGADT x) :: JStat
+        where
+          go :: forall a. JMGadt a -> JMGadt a
+          go v = case v of
+                       (JMGStat (DeclStat (StrI ('!':'!':i')) t)) -> JMGStat (DeclStat (StrI i') t)
+                       (JMGStat (DeclStat (StrI ('!':i')) t)) -> JMGStat (DeclStat (StrI i') t)
                        _ -> composOp go v
diff --git a/Language/Javascript/JMacro/QQ.hs b/Language/Javascript/JMacro/QQ.hs
--- a/Language/Javascript/JMacro/QQ.hs
+++ b/Language/Javascript/JMacro/QQ.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE FlexibleInstances, UndecidableInstances, OverlappingInstances, TypeFamilies, TemplateHaskell, QuasiQuotes #-}
+{-# LANGUAGE FlexibleInstances, UndecidableInstances, OverlappingInstances, TypeFamilies, TemplateHaskell, QuasiQuotes, RankNTypes, GADTs #-}
 
 -----------------------------------------------------------------------------
 {- |
@@ -17,7 +17,6 @@
 import Control.Applicative hiding ((<|>),many,optional,(<*))
 import Control.Arrow(first)
 import Control.Monad.State.Strict
-import qualified Data.ByteString.Char8 as BS
 import Data.Char(digitToInt, toLower, isUpper)
 import Data.List(isPrefixOf, sort)
 import Data.Generics(extQ,Data)
@@ -46,9 +45,7 @@
 import System.IO.Unsafe
 import Numeric(readHex)
 
--- import Web.Encodings
-
---import Debug.Trace
+-- import Debug.Trace
 
 {--------------------------------------------------------------------
   QuasiQuotation
@@ -96,11 +93,12 @@
 -- Don't replace identifiers on the right hand side of selector
 -- expressions.
 antiIdent :: JMacro a => String -> a -> a
-antiIdent s e = fromMC $ go (toMC e)
-    where go (MExpr (ValExpr (JVar (StrI s'))))
-             | s == s' = MExpr (AntiExpr $ fixIdent s)
-          go (MExpr (SelExpr x i)) =
-              MExpr (SelExpr (antiIdent s x) i)
+antiIdent s e = jfromGADT $ go (jtoGADT e)
+    where go :: forall a. JMGadt a -> JMGadt a
+          go (JMGExpr (ValExpr (JVar (StrI s'))))
+             | s == s' = JMGExpr (AntiExpr $ fixIdent s)
+          go (JMGExpr (SelExpr x i)) =
+              JMGExpr (SelExpr (antiIdent s x) i)
           go x = composOp go x
 
 antiIdents :: JMacro a => [String] -> a -> a
@@ -233,8 +231,8 @@
 
 jsLang :: P.LanguageDef ()
 jsLang = javaStyle {
-           P.reservedNames = ["var","return","if","else","while","for","in","break","new","function","switch","case","default","fun","try","catch","finally","foreign"],
-           P.reservedOpNames = ["|>","<|","+=","-=","*=","/=","%=","--","*","/","+","-",".","%","?","=","==","!=","<",">","&&","||","++","===",">=","<=","->","::","::!",":|","@"],
+           P.reservedNames = ["var","return","if","else","while","for","in","break","continue","new","function","switch","case","default","fun","try","catch","finally","foreign","do"],
+           P.reservedOpNames = ["|>","<|","+=","-=","*=","/=","%=","<<=", ">>=", ">>>=", "&=", "^=", "|=", "--","*","/","+","-",".","%","?","=","==","!=","<",">","&&","||","&", "^", "|", "++","===","!==", ">=","<=","!", "~", "<<", ">>", ">>>", "->","::","::!",":|","@"],
            P.identLetter = alphaNum <|> oneOf "_$",
            P.identStart  = letter <|> oneOf "_$",
            P.commentLine = "//",
@@ -357,6 +355,7 @@
 patternBlocks :: JMParser ([Ident],[JStat])
 patternBlocks = fmap concat . unzip . zipWith (\i efr -> either (\f -> (i, f i)) id efr) (map (StrI . ("jmId_match_" ++) . show) [(1::Int)..]) <$> many patternBinding
 
+destructuringDecl :: JMParser [JStat]
 destructuringDecl = do
     (i,patDecls) <- either (\f -> (matchVar, f matchVar)) id <$> patternBinding
     optAssignStat <- optionMaybe $ do
@@ -386,15 +385,18 @@
             <|> functionDecl
             <|> foreignStat
             <|> returnStat
+            <|> labelStat
             <|> ifStat
             <|> whileStat
             <|> switchStat
             <|> forStat
+            <|> doWhileStat
             <|> braces statblock
             <|> assignOpStat
             <|> tryStat
             <|> applStat
             <|> breakStat
+            <|> continueStat
             <|> antiStat
           <?> "statement"
     where
@@ -447,9 +449,12 @@
           else return $ [IfStat p b nullStat]
 
       whileStat =
-          reserved "while" >> liftM2 (\e b -> [WhileStat e (l2s b)])
+          reserved "while" >> liftM2 (\e b -> [WhileStat False e (l2s b)])
                               (parens expr) statementOrEmpty
 
+      doWhileStat = reserved "do" >> liftM2 (\b e -> [WhileStat True e (l2s b)])
+                    statementOrEmpty (reserved "while" *> parens expr)
+
       switchStat = do
         reserved "switch"
         e <- parens $ expr
@@ -457,7 +462,7 @@
         return $ [SwitchStat e l (l2s d)]
 
       caseStat =
-        reserved "case" >> liftM2 (,) expr (char ':' >> l2s <$> statblock0)
+        reserved "case" >> liftM2 (,) expr (char ':' >> l2s <$> statblock)
 
       tryStat = do
         reserved "try"
@@ -499,11 +504,11 @@
         b <- statement
         return $ jFor' before after p b
           where threeStat =
-                    liftM3 (,,) (statement)
-                                (expr)
-                                (semi >> statement)
-                jFor' :: (ToJExpr a) => [JStat] -> a -> [JStat] -> [JStat] -> [JStat]
-                jFor' before p after bs = before ++ [WhileStat (toJExpr p) b']
+                    liftM3 (,,) (option [] statement <* optional semi)
+                                (optionMaybe expr <* semi)
+                                (option [] statement)
+                jFor' :: [JStat] -> Maybe JExpr -> [JStat]-> [JStat] -> [JStat]
+                jFor' before p after bs = before ++ [WhileStat False (fromMaybe (jsv "true") p) b']
                     where b' = BlockStat $ bs ++ after
 
       assignOpStat = do
@@ -514,6 +519,12 @@
                                                <|> rop "*="
                                                <|> rop "/="
                                                <|> rop "%="
+                                               <|> rop "<<="
+                                               <|> rop ">>="
+                                               <|> rop ">>>="
+                                               <|> rop "&="
+                                               <|> rop "^="
+                                               <|> rop "|="
                                               )
           let gofail = fail ("Invalid assignment.")
           case e1 of
@@ -541,8 +552,24 @@
       expr2stat' _ = fail "Value expression used as statement"
 -}
 
-      breakStat = reserved "break" >> return [BreakStat]
+      breakStat = do
+        reserved "break"
+        l <- optionMaybe myIdent
+        return [BreakStat l]
 
+      continueStat = do
+        reserved "continue"
+        l <- optionMaybe myIdent
+        return [ContinueStat l]
+
+      labelStat = do
+        lbl <- try $ do
+                    l <- myIdent <* char ':'
+                    guard (l /= "default")
+                    return l
+        s <- l2s <$> statblock0
+        return [LabelStat lbl s]
+
       antiStat  = return . AntiStat <$> do
         x <- (try (symbol "`(") >> anyChar `manyTill` try (symbol ")`"))
         either (fail . ("Bad AntiQuotation: \n" ++))
@@ -552,6 +579,7 @@
 --args :: JMParser [JExpr]
 --args = parens $ commaSep expr
 
+compileRegex :: String -> Either WrapError Regex
 compileRegex s = unsafePerformIO $ compile co eo s
     where co = compExtended
           eo = execBlank
@@ -577,20 +605,26 @@
           let ans = (IfExpr e t el)
           addIf ans <|> return ans
     rawExpr = buildExpressionParser table dotExpr <?> "expression"
-    table = [[iop "*", iop "/", iop "%"],
+    table = [[pop "~", pop "!"],
+             [iop "*", iop "/", iop "%"],
              [pop "++", pop "--"],
              [iop "++", iop "+", iop "-", iop "--"],
+             [iop "<<", iop ">>", iop ">>>"],
              [consOp],
              [iope "==", iope "!=", iope "<", iope ">",
-              iope ">=", iope "<=", iope "==="],
-             [iop "&&", iop "||"],
+              iope ">=", iope "<=", iope "===", iope "!=="],
+             [iop "&"],
+             [iop "^"],
+             [iop "|"],
+             [iop "&&"],
+             [iop "||"],
              [applOp, applOpRev]
             ]
     pop  s  = Prefix (reservedOp s >> return (PPostExpr True s))
     iop  s  = Infix (reservedOp s >> return (InfixExpr s)) AssocLeft
     iope s  = Infix (reservedOp s >> return (InfixExpr s)) AssocNone
     applOp  = Infix (reservedOp "<|" >> return (\x y -> ApplExpr x [y])) AssocRight
-    applOpRev  = Infix (reservedOp "|>" >> return (\x y -> ApplExpr y [x])) AssocLeft
+    applOpRev = Infix (reservedOp "|>" >> return (\x y -> ApplExpr y [x])) AssocLeft
     consOp  = Infix (reservedOp ":|" >> return consAct) AssocRight
     consAct x y = ApplExpr (ValExpr (JFunc [StrI "x",StrI "y"] (BlockStat [BlockStat [DeclStat (StrI "tmp") Nothing, AssignStat tmpVar (ApplExpr (SelExpr (ValExpr (JVar (StrI "x"))) (StrI "slice")) [ValExpr (JInt 0)]),ApplStat (SelExpr tmpVar (StrI "unshift")) [ValExpr (JVar (StrI "y"))],ReturnStat tmpVar]]))) [x,y]
         where tmpVar = ValExpr (JVar (StrI "tmp"))
@@ -664,7 +698,7 @@
 around' a b x = lexeme (char a) >> (lexeme x <* char b)
 
 myIdent :: JMParser String
-myIdent = lexeme $ many1 (alphaNum <|> oneOf "_-!@#$%^&*();") <|> myStringLiteral '\''
+myIdent = lexeme $ many1 (alphaNum <|> oneOf "_-!@#$%^&*()") <|> myStringLiteral '\''
 
 ident' :: JMParser Ident
 ident' = do
@@ -758,35 +792,35 @@
 
 -- Taken from json package by Sigbjorn Finne.
 decodeJson :: String -> JMParser String
-decodeJson x = parse [] x
+decodeJson x = parseIt [] x
  where
-  parse rs cs =
+  parseIt rs cs =
     case cs of
       '\\' : c : ds -> esc rs c ds
       c    : ds
-       | c >= '\x20' && c <= '\xff'    -> parse (c:rs) ds
+       | c >= '\x20' && c <= '\xff'    -> parseIt (c:rs) ds
        | c < '\x20'     -> fail $ "Illegal unescaped character in string: " ++ x
-       | i <= 0x10ffff  -> parse (c:rs) ds
+       | i <= 0x10ffff  -> parseIt (c:rs) ds
        | otherwise -> fail $ "Illegal unescaped character in string: " ++ x
        where
         i = (fromIntegral (fromEnum c) :: Integer)
       [] -> return $ reverse rs
 
   esc rs c cs = case c of
-   '\\' -> parse ('\\' : rs) cs
-   '"'  -> parse ('"'  : rs) cs
-   'n'  -> parse ('\n' : rs) cs
-   'r'  -> parse ('\r' : rs) cs
-   't'  -> parse ('\t' : rs) cs
-   'f'  -> parse ('\f' : rs) cs
-   'b'  -> parse ('\b' : rs) cs
-   '/'  -> parse ('/'  : rs) cs
+   '\\' -> parseIt ('\\' : rs) cs
+   '"'  -> parseIt ('"'  : rs) cs
+   'n'  -> parseIt ('\n' : rs) cs
+   'r'  -> parseIt ('\r' : rs) cs
+   't'  -> parseIt ('\t' : rs) cs
+   'f'  -> parseIt ('\f' : rs) cs
+   'b'  -> parseIt ('\b' : rs) cs
+   '/'  -> parseIt ('/'  : rs) cs
    'u'  -> case cs of
              d1 : d2 : d3 : d4 : cs' ->
                case readHex [d1,d2,d3,d4] of
-                 [(n,"")] -> parse (toEnum n : rs) cs'
+                 [(n,"")] -> parseIt (toEnum n : rs) cs'
 
-                 x -> fail $ "Unable to parse JSON String: invalid hex: " ++ (show x)
+                 badHex -> fail $ "Unable to parse JSON String: invalid hex: " ++ show badHex
              _ -> fail $ "Unable to parse JSON String: invalid hex: " ++ cs
    _ ->  fail $ "Unable to parse JSON String: invalid escape char: " ++ [c]
 
diff --git a/Language/Javascript/JMacro/Rpc.hs b/Language/Javascript/JMacro/Rpc.hs
deleted file mode 100644
--- a/Language/Javascript/JMacro/Rpc.hs
+++ /dev/null
@@ -1,122 +0,0 @@
-{-# LANGUAGE QuasiQuotes, MultiParamTypeClasses, FunctionalDependencies, UndecidableInstances #-}
-
-{- |
-Module      :  Language.Javascript.JMacro.Rpc
-Copyright   :  (c) Gershom Bazerman, 2010
-License     :  BSD 3 Clause
-Maintainer  :  gershomb@gmail.com
-Stability   :  experimental
-
-Allows for the creation of rpc server/client pairs from monomorphic functions.
-The server portion
-is a function from a json-encoded list of parameters to a json
-response. A list of server functions are expected to be wrapped by a
-dispatch function in the server framework of your choice.
-
-The client
-portion generated from a function of arity n is a function from a
-string identifying a server or a subdirectory on a server to an arity
-n function from javascript expressions (of type
-'Language.Javascript.JMacro.Base.JExpr') to a single javascript
-expression. This expression, when evaluated on the client side, will
-call back to the provided server with json-serialized arguments and yield
-the result (deserialized from json). This client function is expected to be embedded
-via antiquotation into a larger block of jmacro code.
-
-Client portions must unfortunately be given explicit type signatures.
-
-The following example is a server/client pair providing an ajax call to add integers.
-
-> testRPCCall :: String -> JExpr -> JExpr -> JExpr
-> (testRPC, testRPCCall) = mkWebRPC "test" $ \x y -> asIO $ return (x + (y::Int))
-
-This code uses a simple request/response type based on strings to be as agnostic as possible about choice of web service stack. It can be used as is, or used as a model for code which targets a particular web stack (Happstack, Snap, FastCGI, etc.).
-
-The jQuery Javascript library is used to handle ajax requests, and hence pages which embed RPC calls must have the jQuery javascript library loaded.
-
--}
-
-module Language.Javascript.JMacro.Rpc (
-  -- * API
-  mkWebRPC, asIO, Request, Response(..), WebRPCDesc,
-  -- * Helper Classes
-  CallWebRPC(..),ToWebRPC(..)
-) where
-
-import Prelude hiding (tail, init, head, last, minimum, maximum, foldr1, foldl1, (!!), read)
-
-
-import Language.Javascript.JMacro.Base
-import Language.Javascript.JMacro.QQ
-
-import Text.JSON
-import Text.JSON.String
-
-type WebRPCDesc = (String, Request -> IO Response)
-
--- | A String containing a json representation of function arguments encoded as a list of parameters. Generally would be passed as part of an HTTP request.
-type Request = String
-
--- | Either a success or failure (with code). Generally would be turned back into a proper HTTP response.
-data Response = GoodResponse String
-              | BadResponse Int String
-
-returnResp :: JSON a => a -> IO Response
-returnResp r = return $ GoodResponse (encode r)
-respCode c e = BadResponse c e
-badData e = return $ respCode 400 ("Bad Data format: " ++ e)
-
-class ToWebRPC a where
-    toWebRPC_ :: a -> ([JSValue] -> IO Response)
-
-instance (JSON b) => ToWebRPC (IO b) where
-    toWebRPC_ f _ =  returnResp =<< f
-
-instance (JSON a, ToWebRPC b) => ToWebRPC (a -> b) where
-    toWebRPC_ f (x:xs) = case readJSON x of
-                           Ok v -> toWebRPC_ (f v) xs
-                           Error s -> badData s
-    toWebRPC_ _ _ = badData "missing parameter"
-
-toWebRPC :: ToWebRPC a => a -> Request -> IO Response
-toWebRPC f = \req -> case runGetJSON readJSArray req of
-                       (Right (JSArray xs)) ->f' xs
-                       (Left e) -> badData e
-                       _ -> badData "toWebRPC error"
-    where f' = toWebRPC_ f
-
-class CallWebRPC a b | a -> b where
-    callWebRPC_ :: [JExpr] -> String -> a -> b
-
-instance CallWebRPC (IO b) JExpr where
-    callWebRPC_ xs serverLoc _ =
-        [$jmacroE|
-         (\() { var res;
-//                $.post(`(serverLoc)`, { args : JSON.stringify `(reverse xs)` }, \(d) {res = d}, "json");
-                $.ajax({type    : "POST",
-                        url     : `(serverLoc)`,
-                        data    : { args : JSON.stringify `(reverse xs)` },
-                        success : \d {res = d},
-                        dataType: "json",
-                        async   : false
-                      });
-                return res;
-               }())|]
-
-instance (CallWebRPC b c, ToJExpr d) => CallWebRPC (a -> b) (d -> c) where
-    callWebRPC_ xs serverLoc f = \x -> callWebRPC_ (toJExpr x : xs) serverLoc (f undefined)
-
-callWebRPC :: (CallWebRPC a b) => String -> a -> b
-callWebRPC s f = callWebRPC_ [] s f
-
--- | Produce a pair of (ServerFunction, ClientFunction) from a function in IO
-mkWebRPC :: (ToWebRPC a, CallWebRPC a b) => String -> a -> (WebRPCDesc, String -> b)
-mkWebRPC name rpcFun = ((name,toWebRPC rpcFun), \server -> callWebRPC (server ++ "/" ++ name) rpcFun)
-
-
-testRPCCall :: String -> JExpr -> JExpr -> JExpr
-(testRPC, testRPCCall) = mkWebRPC "test" $ \x y -> asIO $ return (x + (y::Int))
-
--- | id with a helpful type.
-asIO :: IO a -> IO a
-asIO = id
diff --git a/Language/Javascript/JMacro/TypeCheck.hs b/Language/Javascript/JMacro/TypeCheck.hs
--- a/Language/Javascript/JMacro/TypeCheck.hs
+++ b/Language/Javascript/JMacro/TypeCheck.hs
@@ -1,34 +1,34 @@
-{-# LANGUAGE GeneralizedNewtypeDeriving, FlexibleInstances, PatternGuards #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving, FlexibleInstances, PatternGuards, RankNTypes #-}
 
 module Language.Javascript.JMacro.TypeCheck where
 
 import Language.Javascript.JMacro.Base
 import Language.Javascript.JMacro.Types
-import Language.Javascript.JMacro.QQ
 
 import Control.Applicative
-import Control.Arrow((&&&))
 import Control.Monad
+import Control.Monad.Identity
 import Control.Monad.State
 import Control.Monad.Reader
 import Control.Monad.Writer
 import Control.Monad.Error
 import Data.Either
 import Data.Map (Map)
-import Data.Maybe(catMaybes, fromMaybe)
+import Data.Maybe(catMaybes)
 import Data.List(intercalate, nub, transpose)
 import qualified Data.Traversable as T
 import qualified Data.Foldable as F
 import qualified Data.Map as M
+import qualified Data.Text.Lazy as T
 import Data.Set(Set)
 import qualified Data.Set as S
 
-import Text.PrettyPrint.HughesPJ
+import Text.PrettyPrint.Leijen.Text hiding ((<$>))
 
-import Debug.Trace
 
 -- Utility
 
+isLeft :: Either a b -> Bool
 isLeft (Left _) = True
 isLeft _ = False
 
@@ -53,6 +53,34 @@
 intersectionWithM :: (Monad m, Ord key) => (val -> val -> m b) -> Map key val -> Map key val -> m (Map key b)
 intersectionWithM f m1 m2 = T.sequence $ M.intersectionWith f m1 m2
 
+class Compos1 t where
+    compos1 :: (forall a. a -> m a) -> (forall a b. m (a -> b) -> m a -> m b)
+           -> (t -> m t) -> t -> m t
+
+instance Compos1 JType where
+    compos1 ret app f v =
+        case v of
+          JTFunc args body -> ret JTFunc `app` mapM' f args `app` f body
+          JTForall vars t -> ret JTForall `app` ret vars `app` f t
+          JTList t -> ret JTList `app` f t
+          JTMap t -> ret JTMap `app` f t
+          JTRecord t m -> ret JTRecord `app` f t `app` m'
+              where (ls,ts) = unzip $ M.toList m
+                    m' = ret (M.fromAscList . zip ls) `app` mapM' f ts
+          x -> ret x
+      where
+        mapM' g = foldr (app . app (ret (:)) . g) (ret [])
+
+composOp1 :: Compos1 t => (t -> t) -> t -> t
+composOp1 f = runIdentity . composOpM1 (Identity . f)
+composOpM1 :: (Compos1 t, Monad m) => (t -> m t) -> t -> m t
+composOpM1 = compos1 return ap
+composOpM1_ :: (Compos1 t, Monad m) => (t -> m ()) -> t -> m ()
+composOpM1_ = composOpFold1 (return ()) (>>)
+composOpFold1 :: Compos1 t => b -> (b -> b -> b) -> (t -> b) -> t -> b
+composOpFold1 z c f = unC . compos1 (\_ -> C z) (\(C x) (C y) -> C (c x y)) (C . f)
+newtype C b a = C { unC :: b }
+
 -- Basic Types and TMonad
 data StoreVal = SVType JType
               | SVConstrained (Set Constraint)
@@ -74,6 +102,7 @@
         "frozen: " ++ show frozen ++ "\n" ++
         "varCt: " ++ show varCt
 
+tcStateEmpty :: TCState
 tcStateEmpty = TCS [M.empty] M.empty [S.empty] S.empty 0 []
 
 newtype TMonad a = TMonad (ErrorT String (State TCState) a) deriving (Functor, Monad, MonadState TCState, MonadError String)
@@ -85,8 +114,10 @@
 class JTypeCheck a where
     typecheck :: a -> TMonad JType
 
+evalTMonad :: TMonad a -> Either String a
 evalTMonad (TMonad x) = evalState (runErrorT x) tcStateEmpty
 
+runTMonad :: TMonad a -> (Either String a, TCState)
 runTMonad (TMonad x) = runState (runErrorT x) tcStateEmpty
 
 withContext :: TMonad a -> TMonad String -> TMonad a
@@ -109,7 +140,7 @@
       go :: JType -> StateT (Map Int (Either String Int), Set String, Int) TMonad ()
       go (JTFree vr) = handleVR vr
       go (JTRigid vr cs) = handleVR vr >> traversem_ (go . fromC) cs
-      go v = composOpM_ go v
+      go v = composOpM1_ go v
 
       handleVR (mbName, ref) = do
         (m,ns,ct) <- get
@@ -129,6 +160,7 @@
         let n' = mkUnique ns n 0
         put (M.insert ref (Left n') m, S.insert n' ns, ct)
 
+      mkUnique :: Set String -> String -> Int -> String
       mkUnique ns n i
           | n' `S.member` ns = mkUnique ns n (i + 1)
           | otherwise = n'
@@ -145,12 +177,14 @@
                     where (q,r) = divMod i 26
                           letter = toEnum (fromEnum 'a' + r)
 
+
+prettyType :: JType -> TMonad String
 prettyType x = do
   xt <- resolveType x
   names <- freeVarsWithNames xt
   let replaceNames (JTFree ref) = JTFree $ fixRef ref
       replaceNames (JTForall refs t) = JTForall (map fixRef refs) $ replaceNames t
-      replaceNames v = composOp replaceNames v
+      replaceNames v = composOp1 replaceNames v
 
       fixRef (_,ref) = (M.lookup ref names, ref)
 
@@ -190,20 +224,25 @@
 prettyEnv :: TMonad [Map Ident String]
 prettyEnv = mapM (T.mapM prettyType) . tc_env =<< get
 
+runTypecheckRaw :: JTypeCheck a => a -> (Either String JType, TCState)
 runTypecheckRaw x = runTMonad (typecheckMain x)
 
+runTypecheckFull :: JTypeCheck a => a -> (Either String (String, [Map Ident String]), TCState)
 runTypecheckFull x = runTMonad $ do
                        r <- prettyType =<< typecheckMain x
                        e <- prettyEnv
                        return (r,e)
 
+runTypecheck :: JTypeCheck a => a -> Either String String
 runTypecheck x = evalTMonad $ prettyType =<< typecheckMain x
 
+evalTypecheck :: JTypeCheck a => a -> Either String [Map Ident String]
 evalTypecheck x = evalTMonad $ do
                     _ <- typecheckMain x
                     e <- prettyEnv
                     return e
 
+typecheckMain :: JTypeCheck a => a -> TMonad JType
 typecheckMain x = go `catchError` handler
     where go = do
             r <- typecheck x
@@ -216,6 +255,7 @@
 
 -- Manipulating VarRefs and Constraints
 
+addToStack :: Ord a => a -> [Set a] -> [Set a]
 addToStack v (s:ss) = S.insert v s : ss
 addToStack _ _ = error "addToStack: no sets" --[S.singleton v]
 
@@ -233,6 +273,7 @@
 mapConstraint f (Sub t) = Sub <$> f t
 mapConstraint f (Super t) = Super <$> f t
 
+partitionCs :: [Constraint] -> ([JType],[JType])
 partitionCs [] = ([],[])
 partitionCs (Sub t:cs) = (t:subs,sups)
     where (subs,sups) = partitionCs cs
@@ -273,7 +314,7 @@
 occursCheck :: Int -> JType -> TMonad ()
 occursCheck ref (JTFree (_,i))
   | i == ref = tyErr1 "Occurs check: cannot construct infinite type" (JTFree (Nothing,i))
-occursCheck ref x = composOpM_ (occursCheck ref) x
+occursCheck ref x = composOpM1_ (occursCheck ref) x
 
 checkConstraints :: JType -> [Constraint] -> TMonad ()
 checkConstraints t cs = mapM_ go cs
@@ -408,6 +449,7 @@
       normalizeConstraints cl = putCs =<< cannonicalizeConstraints cl
 
 
+cannonicalizeConstraints :: [Constraint] -> TMonad [Constraint]
 cannonicalizeConstraints constraintList = do
         -- trace ("ccl: " ++ show constraintList) $ return ()
         let (subs,restCs)  = findForallSubs constraintList
@@ -535,6 +577,7 @@
 
       unifyGroup :: [Int] -> ReaderT [Either Int Int] TMonad ()
       unifyGroup (vr:vrs) = lift $ mapM_ (\x -> instantiateVarRef (Nothing, x) (JTFree (Nothing,vr))) vrs
+      unifyGroup [] = return ()
 
       findLoop i cs@(c:_) = go [] cs
           where
@@ -574,6 +617,7 @@
 
 -- addRefsToStack x = modify (\s -> s {tc_stack = F.foldr addToStack (tc_stack s) x })
 
+frame2VarRefs :: Set t -> [(Maybe a, t)]
 frame2VarRefs frame = (\x -> (Nothing,x)) <$> S.toList frame
 
 addEnv :: Ident -> JType -> TMonad ()
@@ -616,7 +660,7 @@
           Just (SVType t) -> return Nothing
           _ -> return $ Just x
 
-resolveType = resolveTypeGen composOpM
+resolveType = resolveTypeGen composOpM1
 resolveTypeShallow = resolveTypeGen (const return)
 
 --TODO create proper bounds for records
@@ -643,7 +687,7 @@
           (Super t) -> lift . (<: newTy) =<< cloneType t
 
       cloneType (JTFree vr) = getRef vr
-      cloneType x = composOpM cloneType x
+      cloneType x = composOpM1 cloneType x
 
 lookupEnv :: Ident -> TMonad JType
 lookupEnv ident = resolveType =<< go . tc_env =<< get
@@ -656,7 +700,7 @@
 freeVars :: JType -> TMonad (Set Int)
 freeVars t = execWriterT . go =<< resolveType t
     where go (JTFree (_, ref)) = tell (S.singleton ref)
-          go x = composOpM_ go x
+          go x = composOpM1_ go x
 
 --only works on resolved types
 instantiateScheme :: [VarRef] -> JType -> TMonad JType
@@ -674,7 +718,7 @@
                            put $ M.insert ref (JTFree newRef) m
                            mapM_ (lift . addConstraint newRef <=< mapConstraint go) =<< lift (lookupConstraintsList vr)
                            return (JTFree newRef)
-      go x = composOpM go x
+      go x = composOpM1 go x
 
 --only works on resolved types
 instantiateRigidScheme :: [VarRef] -> JType -> TMonad JType
@@ -691,7 +735,7 @@
                            newRef <- JTRigid vr . S.fromList <$> lift (lookupConstraintsList vr)
                            put $ M.insert ref newRef m
                            return newRef
-      go x = composOpM go x
+      go x = composOpM1 go x
 
 --only works on resolved types
 checkEscapedVars :: [VarRef] -> JType -> TMonad ()
@@ -701,7 +745,7 @@
       go t@(JTRigid (_,ref) _)
           | ref `S.member` vs = tyErr1 "Qualified var escapes into environment" t
           | otherwise = return ()
-      go x = composOpM_ go x
+      go x = composOpM1_ go x
 
 -- Subtyping
 (<:) :: JType -> JType -> TMonad ()
@@ -751,6 +795,7 @@
         | M.isSubmapOfBy (\_ _ -> True) ym xm = xt <: yt >> intersectionWithM (<:) xm ym >> return () --TODO not right?
     go xt yt = tyErr2Sub xt yt
 
+(<<:>) :: TMonad JType -> TMonad JType -> TMonad ()
 x <<:> y = join $ liftA2 (<:) x y
 
 someUpperBound :: [JType] -> TMonad JType
@@ -769,6 +814,7 @@
 --  b <- (mapM_ (res <:) xs >> return True) `catchError` \e -> return False
 --  if b then return res else return JTImpossible
 
+(=.=) :: JType -> JType -> TMonad JType
 x =.= y = do
       x <: y
       y <: x
@@ -798,7 +844,7 @@
         | s `elem` ["==","/="] = do
                             et <- typecheck e
                             e1t <- typecheck e1
-                            et =.= e1t
+                            _ <- et =.= e1t
                             return JTBool
         | s `elem` ["||","&&"] = setFixed JTBool >> return JTBool
         | otherwise = throwError $ "Unhandled operator: " ++ s
@@ -859,7 +905,7 @@
     typecheck (JInt _) = return JTNum
     typecheck (JDouble _) = return JTNum
     typecheck (JStr _) = return JTString
-    typecheck (JList xs) = typecheck (JHash $ M.fromList $ zip (map show [0..]) xs)
+    typecheck (JList xs) = typecheck (JHash $ M.fromList $ zip (map show [(0::Int)..]) xs)
                            -- fmap JTList . someUpperBound =<< mapM typecheck xs
     typecheck (JRegEx _) = undefined --regex object
     typecheck (JHash mp) = do
@@ -889,7 +935,7 @@
     typecheck (IfStat e s s1) = do
                             typecheck e <<:> return JTBool
                             join $ liftA2 (\x y -> someUpperBound [x,y]) (typecheck s) (typecheck s1)
-    typecheck (WhileStat e s) = do
+    typecheck (WhileStat _ e s) = do
                             typecheck e <<:> return JTBool
                             typecheck s
     typecheck (ForInStat _ _ _ _) = undefined -- yipe!
@@ -909,7 +955,8 @@
       return JTStat
     typecheck (UnsatBlock _) = undefined --oyvey
     typecheck (AntiStat _) = undefined --oyvey
-    typecheck BreakStat = return JTStat
+    typecheck (BreakStat _) = return JTStat
     typecheck (ForeignStat i t) = integrateLocalType t >>= addEnv i >> return JTStat
 
-typecheckWithBlock stat = typecheck stat `withContext` (return $ "In statement: " ++ renderStyle (style {mode = OneLineMode}) (renderJs stat))
+typecheckWithBlock :: (JsToDoc a, JMacro a, JTypeCheck a) => a -> TMonad JType
+typecheckWithBlock stat = typecheck stat `withContext` (return $ "In statement: " ++ (T.unpack . displayT . renderCompact $ renderJs stat))
diff --git a/Language/Javascript/JMacro/Types.hs b/Language/Javascript/JMacro/Types.hs
--- a/Language/Javascript/JMacro/Types.hs
+++ b/Language/Javascript/JMacro/Types.hs
@@ -48,6 +48,8 @@
 
 type TypeParserState = (Int, Map String Int)
 
+type TypeParser a = CharParser TypeParserState a
+
 typLang :: P.LanguageDef TypeParserState
 typLang = emptyDef {
            P.reservedNames = ["()","->"],
@@ -56,18 +58,17 @@
            P.identStart  = letter <|> oneOf "_$"
           }
 
+lexer :: P.TokenParser TypeParserState
 lexer = P.makeTokenParser typLang
 
-whiteSpace= P.whiteSpace lexer
-symbol    = P.symbol lexer
+reservedOp :: String -> TypeParser ()
+parens, braces, brackets, lexeme :: TypeParser a -> TypeParser a
+identifier :: TypeParser String
+commaSep, commaSep1 :: TypeParser a -> TypeParser [a]
 parens    = P.parens lexer
 braces    = P.braces lexer
 brackets  = P.brackets lexer
-dot       = P.dot lexer
-colon     = P.colon lexer
-semi      = P.semi lexer
 identifier= P.identifier lexer
-reserved  = P.reserved lexer
 reservedOp= P.reservedOp lexer
 commaSep1 = P.commaSep1 lexer
 commaSep  = P.commaSep  lexer
@@ -77,8 +78,10 @@
 parseType :: String -> Either ParseError JType
 parseType s = runParser anyType (0,M.empty) "" s
 
+parseConstrainedType :: String -> Either ParseError JLocalType
 parseConstrainedType s = runParser constrainedType (0,M.empty) "" s
 
+runTypeParser :: CharParser a JLocalType
 runTypeParser = withLocalState (0,M.empty) (try (parens constrainedType) <|> constrainedType) -- anyType
 
 withLocalState :: (Functor m, Monad m) => st -> ParsecT s st m a -> ParsecT s st' m a
@@ -90,7 +93,6 @@
                   go (Error e) = (Error e)
 
 
-type TypeParser a = CharParser TypeParserState a
 
 constrainedType :: TypeParser JLocalType
 constrainedType = do
@@ -115,9 +117,9 @@
 funOrAtomType :: TypeParser JType
 funOrAtomType = do
   r <- anyNestedType `sepBy1` (lexeme (string "->"))
-  return $ case r of
+  return $ case reverse r of
     [x] -> x
-    (x:xs) -> JTFunc (init r) (last r)
+    (x:xs) -> JTFunc (reverse xs) x
     _ -> error "funOrAtomType"
 
 listType :: TypeParser JType
@@ -126,6 +128,7 @@
 anyNestedType :: TypeParser JType
 anyNestedType = nullType <|> parens anyType <|> atomicType <|> listType <|> recordType
 
+nullType :: TypeParser JType
 nullType = reservedOp "()" >> return JTStat
 
 atomicType :: TypeParser JType
@@ -135,8 +138,8 @@
     "Num" -> return JTNum
     "String" -> return JTString
     "Bool" -> return JTBool
-    (x:xs) | isUpper x -> fail $ "Unknown type: " ++ a
-           | otherwise -> JTFree <$> freeVarRef a
+    (x:_) | isUpper x -> fail $ "Unknown type: " ++ a
+          | otherwise -> JTFree <$> freeVarRef a
     _ -> error "typeAtom"
 
 recordType :: TypeParser JType
diff --git a/Language/Javascript/JMacro/Util.hs b/Language/Javascript/JMacro/Util.hs
--- a/Language/Javascript/JMacro/Util.hs
+++ b/Language/Javascript/JMacro/Util.hs
@@ -43,7 +43,7 @@
 ifElse x y z = IfStat (toJExpr x) (toStat y) (toStat z)
 
 while :: ToJExpr a => a -> JStat -> JStat
-while x y = WhileStat (toJExpr x) y
+while x y = WhileStat False (toJExpr x) y
 
 return :: ToJExpr a => a -> JStat
 return x = ReturnStat (toJExpr x)
diff --git a/jmacro.cabal b/jmacro.cabal
--- a/jmacro.cabal
+++ b/jmacro.cabal
@@ -1,5 +1,5 @@
 name:                jmacro
-version:             0.5.8
+version:             0.6.2
 synopsis:            QuasiQuotation library for programmatic generation of Javascript code.
 description:         Javascript syntax, functional syntax, hygienic names, compile-time guarantees of syntactic correctness, limited typechecking. Additional documentation available at <http://www.haskell.org/haskellwiki/Jmacro>
 category:            Language
@@ -11,24 +11,35 @@
 Build-Type:          Simple
 Cabal-Version:       >= 1.6
 
-
 library
-  build-depends:     base >= 4, base < 5, containers, pretty, safe >= 0.2, parsec > 3.0, template-haskell >= 2.3, mtl > 1.1 , haskell-src-exts, haskell-src-meta, bytestring >= 0.9, syb, json, regex-posix > 0.9
+  build-depends:     base >= 4, base < 5, containers, wl-pprint-text, text, safe >= 0.2, parsec > 3.0, template-haskell >= 2.3, mtl > 1.1 , haskell-src-exts, haskell-src-meta, bytestring >= 0.9, syb, aeson >= 0.5 , regex-posix > 0.9, vector >= 0.8, unordered-containers >= 0.2
 
   exposed-modules:   Language.Javascript.JMacro
                      Language.Javascript.JMacro.Util
                      Language.Javascript.JMacro.TypeCheck
                      Language.Javascript.JMacro.Types
                      Language.Javascript.JMacro.Prelude
-                     Language.Javascript.JMacro.Rpc
+                     -- Language.Javascript.JMacro.Rpc
   other-modules:     Language.Javascript.JMacro.Base
                      Language.Javascript.JMacro.QQ
                      Language.Javascript.JMacro.ParseTH
   ghc-options:       -Wall
 
+flag benchmarks
+  description: Build the benchmarks
+  default: False
+
 executable jmacro
   build-depends: parseargs
   main-is: Language/Javascript/JMacro/Executable.hs
+
+executable jmacro-bench
+  main-is: Language/Javascript/JMacro/Benchmark.hs
+  if flag(benchmarks)
+    buildable: True
+    build-depends: criterion
+  else
+    buildable: False
 
 source-repository head
   type:      darcs