diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,8 @@
+Copyright (c) 2007-2008 Arjun Guha and Spiridon Eliopoulos.
+
+Contains source code derived from HtmlPrag 0.16 Copyright (c) 2003 - 2005 
+Neil W. Van Dyke, licensed under the terms of the GNU Lesser General Public
+License 2.1.
+
+WebBits is licensed under the terms of the GNU Lesser General Public License
+2.1.
diff --git a/Setup.lhs b/Setup.lhs
new file mode 100644
--- /dev/null
+++ b/Setup.lhs
@@ -0,0 +1,31 @@
+#!/usr/bin/env runhaskell
+> import Distribution.Simple
+> import qualified Data.List as L
+> import System.Directory
+> import System.Process (runCommand,waitForProcess)
+
+> isHaskellFile file = ".lhs" `L.isSuffixOf` file || ".hs" `L.isSuffixOf` file
+
+> moduleName file = "Test." ++ m where
+>   m = L.takeWhile (\ch -> ch /= '.') file
+
+> testMain _ _ _ _ = do
+>   files <- getDirectoryContents "src/Test"
+>   let tests = filter isHaskellFile files
+>   let testModules = map moduleName tests
+>   let testFuncs = map (++ ".main") testModules
+>   let testExpr = "sequence [ " ++ concat (L.intersperse "," testFuncs) ++ 
+>                  " ] >>= \\cases -> runTestTT (TestList cases)"
+>   let moduleLine = concat (L.intersperse " " testModules)
+>   let cmd = "cd src && ghc  -fno-monomorphism-restriction -fglasgow-exts " ++
+>             "-package HUnit -e \"" ++ testExpr ++ " >> return ()\" " ++ 
+>             moduleLine
+>   putStrLn "Testing command is:"
+>   putStrLn cmd
+>   putStrLn "\nLoading tests..."
+>   handle <- runCommand cmd
+>   waitForProcess handle
+>   putStrLn "Testing complete.  Errors reported above (if any)."
+ 
+
+> main = defaultMainWithHooks (simpleUserHooks { runTests = testMain })
diff --git a/WebBits.cabal b/WebBits.cabal
new file mode 100644
--- /dev/null
+++ b/WebBits.cabal
@@ -0,0 +1,50 @@
+Name:           WebBits
+Version:        0.9
+Cabal-Version:	>= 1.2
+Copyright:      Copyright (c) 2007-2008 Arjun Guha and Spiridon Eliopoulos
+License:        LGPL
+License-file:   LICENSE
+Author:         Arjun Guha, Spiridon Eliopoulos
+Maintainer:     Arjun Guha <arjun@cs.brown.edu>
+Homepage:       http://www.cs.brown.edu/research/plt/
+Stability:      provisional
+Category:       Tools
+Build-Type:     Custom
+Synopsis:       JavaScript analysis tools
+Description:
+
+	WebBits is a collection of libraries for working with JavaScript embeded in
+  HTML files.  Highlights include:
+
+	"WebBits.JavaScript.Crawl" returns all JavaScript in an HTML page, including
+  JavaScript from imported script files ("<script src=...>").
+
+  "WebBits.JavaScript.Environment" annotates JavaScript syntax with its static
+  environment and returns a list of free identifiers.
+
+  "WebBits.JavaScript.Parser" is a JavaScript parser that is largely based on
+  JavaScript 1.5.
+
+  "WebBits.Html.Parser" is a permissive HTML parser.
+ 
+Library
+  Hs-Source-Dirs:
+    src
+  Build-Depends:
+    base, mtl, parsec, pretty, containers
+  ghc-options:
+    -fwarn-incomplete-patterns -fglasgow-exts
+  Extensions:     
+    Generics Rank2Types MultiParamTypeClasses FunctionalDependencies
+    TypeSynonymInstances FlexibleInstances FlexibleContexts
+    DeriveDataTypeable NoMonomorphismRestriction
+  Exposed-Modules:
+    WebBits.Data.Zipper
+    WebBits.Html.Html WebBits.Html.Syntax WebBits.Html.PermissiveParser
+    WebBits.Html.PrettyPrint WebBits.Html.Instances WebBits.Common
+    WebBits.Html.RawScript WebBits.JavaScript.Combinators
+    WebBits.JavaScript.HtmlEmbedding WebBits.JavaScript.Instances
+    WebBits.JavaScript.JavaScript WebBits.JavaScript.Lexer 
+    WebBits.JavaScript.Parser WebBits.JavaScript.PrettyPrint
+    WebBits.JavaScript.Syntax WebBits.JavaScript.Environment
+    WebBits.JavaScript.Crawl
diff --git a/src/WebBits/Common.hs b/src/WebBits/Common.hs
new file mode 100644
--- /dev/null
+++ b/src/WebBits/Common.hs
@@ -0,0 +1,63 @@
+-- | Defines commonly used datatypes and functions.
+module WebBits.Common
+  ( PrettyPrintable(..)
+  , L.isPrefixOf
+  , SourcePos
+  , sourceName
+  ) where
+
+import Data.Map (Map)
+import Data.Maybe (catMaybes)
+import Data.Char (toLower)
+import Control.Applicative
+import qualified System.IO as IO
+import Control.Monad.State.Strict
+import Control.Monad.Identity
+import qualified Data.List as L
+import Data.Generics hiding (GT)
+import qualified Data.Foldable as Foldable
+import Data.Foldable (Foldable)
+import qualified Data.Traversable as Traversable
+import Data.Traversable (Traversable, traverse)
+import qualified Text.PrettyPrint.HughesPJ as Pp
+import Text.ParserCombinators.Parsec.Pos (SourcePos, initialPos, sourceName)
+
+lowercase = map toLower
+
+-- | 'PrettyPrintable' makes writing pretty-printing code for large, recursive
+-- data structures shorter.
+class PrettyPrintable a where
+  pp:: a -> Pp.Doc
+  
+instance PrettyPrintable a => PrettyPrintable (Maybe a) where
+  pp (Just a) = pp a
+  pp Nothing  = Pp.empty
+
+--------------------------------------------------------------------------------
+-- Generics for SourcePos
+
+-- | These definitions allow us to use data structures containing 'SourcePos'
+-- values with generics.
+
+-- |We make 'SourcePos' an instance of 'Typeable' so that we can use it with
+-- generics.
+instance Typeable SourcePos where
+  typeOf _  = 
+    mkTyConApp (mkTyCon "Text.ParserCombinators.Parsec.Pos.SourcePos") []
+    
+-- Complete guesswork.  It seems to work.
+sourcePosDatatype = mkDataType "SourcePos" [sourcePosConstr1]
+sourcePosConstr1 = mkConstr sourcePosDatatype "SourcePos" [] Prefix
+
+-- |We make 'SourcePos' an instance of 'Typeable' so that we can use it with
+-- generics.
+--
+-- This definition is incomplete.
+instance Data SourcePos where
+  -- We treat source locations as opaque.  After all, we don't have access to
+  -- the constructor.
+  gfoldl k z pos = z pos
+  toConstr _ = sourcePosConstr1
+  gunfold   = error "gunfold is not defined for SourcePos"
+  dataTypeOf = error "dataTypeOf is not defined for SourcePos"
+
diff --git a/src/WebBits/Data/Zipper.hs b/src/WebBits/Data/Zipper.hs
new file mode 100644
--- /dev/null
+++ b/src/WebBits/Data/Zipper.hs
@@ -0,0 +1,274 @@
+-- |A zipper for "Data.Tree".
+module WebBits.Data.Zipper
+  ( 
+  -- * Functional zipper
+  
+  -- $functionalZipper
+  
+    Tree(..)
+  , Location
+  , toLocation, fromLocation  
+  , dfsFold 
+  , dfsFoldM
+  , showTree
+
+  , empty
+  , up, down, left, right -- Location a -> Location a
+  , replace
+  , change
+  , insertDown, insertLeft, insertRight
+  , isTop, isChild
+  , getValue
+  , subTree
+  , top
+  , canGoLeft, canGoRight, canGoUp, canGoDown -- Location a -> Bool
+  
+  -- * Imperative tree construction
+  
+  -- $treeBuilder
+  
+  , ZipperT
+
+  , nest                  -- Monad m => v -> ZipperT v m a -> ZipperT v m a
+  , getNode               -- Monad m => ZipperT v m v
+  , setNode               -- Monad m => v -> ZipperT v m ()
+  , runZipperT
+  , evalZipperT
+  , execZipperT
+  , shiftLeft, shiftRight   -- Monad m => ZipperT v m ()
+  , shiftLeft', shiftRight' -- Monad m => ZipperT v m ()
+  , withCurrentChild        -- Monad m => Zipper T v m a -> ZipperT v m a
+  
+  ) where
+
+import Control.Monad
+import Control.Monad.State
+import Data.Tree (Tree (..), drawTree)
+
+-------------------------------------------------------------------------------
+-- Data types!
+--
+
+data Path a
+  = Top
+  | Split a [Tree a] (Path a) [Tree a]
+
+data Location a = Location (Tree a) (Path a)
+
+
+dfsFold :: (w -> v -> w) -- ^transforms a node 'v' using the accumulated
+                         -- value 'w' from the root of the tree to 'v'
+        -> w             -- ^the initial value of the accumulator at the root
+        -> Tree v 
+        -> Tree w
+dfsFold f w (Node v ts) = Node w' (map (dfsFold f w') ts)
+  where w' = f w v
+
+-- |Similar to 'dfsFold', but the transformation is done in the monad 'm'.  The
+-- sequence of operations is depth-first, left-to-right.
+dfsFoldM :: Monad m => (w -> v -> m w) -> w -> Tree v -> m (Tree w)
+dfsFoldM f w (Node v ts) = do
+  w'  <- f w v
+  ts' <- mapM (dfsFoldM f w') ts
+  return $ Node w' ts'
+
+-- Uses 'Data.Tree.drawShow'.
+showTree :: Show a => Tree a -> String
+showTree tree =  drawTree (fmap show tree)
+  
+
+-------------------------------------------------------------------------------
+-- Combinators!
+--
+
+-- $functionalZipper
+-- These are the core zipper functions.
+
+empty :: a -> Tree a
+empty a = Node a []
+
+up :: Location a -> Location a
+up (Location _ Top)               = error " up of Top"
+up (Location t (Split v ls p rs)) = Location (Node v (reverse ls ++ (t:rs))) p
+
+down :: Location a -> Location a
+down (Location (Node v []) _)     = error "down of empty"
+down (Location (Node v (t:ts)) p) = Location t (Split v [] p ts)
+
+left :: Location a -> Location a
+left (Location t Top)                   = error "left of top"
+left (Location t (Split v [] p rs))     = error "left on leftmost"
+left (Location t (Split v (l:ls) p rs)) = Location l (Split v ls p (t:rs))
+
+right :: Location a -> Location a
+right (Location t Top) = 
+  error "Data.Zipper.right : at the top"
+right (Location t (Split v ls p []))     = error "right on rightmost"
+right (Location t (Split v ls p (r:rs))) = Location r (Split v (t:ls) p rs)
+
+replace :: Location a -> Tree a ->  Location a
+replace (Location _ p) t = Location t p
+
+change :: Location a -> a -> Location a
+change (Location (Node _ cs) p) t = Location (Node t cs) p
+
+insertDown :: Location a -> Tree a -> Location a
+insertDown (Location (Node v ts) p) t = Location (Node v (t:ts)) p
+
+insertDownRight :: Location a -> Tree a -> Location a
+insertDownRight (Location (Node v ts) p) t = 
+  Location t (Split v (reverse ts) p [])
+
+insertLeft :: Location a -> Tree a -> Location a
+insertLeft (Location _ Top) _                = error "insert on top"
+insertLeft (Location t (Split v ls p rs)) t' =
+  Location t (Split v (t':ls) p rs)
+
+insertRight :: Location a -> Tree a -> Location a
+insertRight (Location _ Top) _                = error "insert on top"
+insertRight (Location t (Split v ls p rs)) t' = 
+  Location t (Split v ls p (t':rs))
+
+isTop :: Location a -> Bool
+isTop (Location _ Top) = True
+isTop _                = False
+
+isChild :: Location a -> Bool
+isChild = not . isTop
+
+canGoRight :: Location a -> Bool
+canGoRight (Location _ (Split _ _ _ [])) = False
+canGoRight (Location _ Top) = False
+canGoRight _ = True
+
+canGoDown :: Location a -> Bool
+canGoDown (Location (Node _ []) _) = False
+canGoDown _                        = True
+
+canGoLeft :: Location a -> Bool
+canGoLeft (Location _ Top)              = False
+canGoLeft (Location _ (Split _ [] _ _)) = False
+canGoLeft _                             = True
+
+canGoUp :: Location a -> Bool
+canGoUp (Location _ Top) = False
+canGoUp _                = True
+
+getValue :: Location a -> a
+getValue (Location (Node v _) _) = v
+
+subTree :: Location a -> Tree a
+subTree (Location node _) = node
+
+-- |Traverses to the top of the tree.
+--
+-- @
+-- up.top = undefined
+-- top.top = top
+-- @
+top :: Location a -> Location a
+top loc@(Location _ Top) = loc
+top loc@(Location _ _) = top (up loc)
+
+toLocation :: Tree a -> Location a
+toLocation t = Location t Top
+
+fromLocation :: Location a -> Tree a
+fromLocation (Location t _) = t
+
+
+-- $treeBuilder
+-- A state monad that carries a zipper.  It provides convenient methods to
+-- imperatively create and update a tree.
+--
+-- The state monad's set method may be used to arbitrarily update the current
+-- location.  However, such updates can break the behavior of nest and
+-- withCurrentChild.  We recommend avoiding StateT.set.
+
+type ZipperT v m a = StateT (Location v) m a
+
+
+runZipperT :: Monad m => ZipperT v m a -> Location v -> m (a, Tree v)
+runZipperT m l = do
+  (a, Location t Top) <- runStateT m l
+  return (a,t)
+
+evalZipperT :: Monad m => ZipperT v m a -> Location v -> m a
+evalZipperT m l = do
+  ~(a, _) <- runStateT m l
+  return a
+
+execZipperT :: Monad m => ZipperT v m a -> Location v -> m (Tree v)
+execZipperT m l = do
+  ~(_, Location t Top) <- runStateT m l
+  return t
+
+-- |Creates a new node as the right-most child of the current node.
+nest :: Monad m 
+     => v -- ^value of the new right-most child 
+     -> ZipperT v m a -- ^computation applied to the new child 
+     -> ZipperT v m a -- ^returns the result of the nested computation
+nest v m = do
+  z <- get 
+  put $ insertDownRight z (empty v)
+  a <- m
+  z' <- get -- z' is the child of z 
+  put (up z')
+  return a
+  
+getNode :: Monad m => ZipperT v m v
+getNode = do
+  (Location (Node v _) _)  <- get
+  return v
+  
+setNode :: Monad m => v -> ZipperT v m ()
+setNode v = do
+  (Location (Node _ cs) path) <- get
+  put $ Location (Node v cs) path
+
+withCurrentChild :: Monad m 
+                 => ZipperT v m a -- ^computation to apply to the current child 
+                 -> ZipperT v m a -- ^returns the result of the nested 
+                                  -- computation
+withCurrentChild m = do
+  z <- get
+  put (down z)
+  a <- m
+  z' <- get
+  put (up z')
+  return a
+
+shiftRight :: Monad m => ZipperT v m ()
+shiftRight = do
+  z <- get
+  put (right z)
+
+  
+shiftLeft :: Monad m => ZipperT v m ()
+shiftLeft = do
+  z <- get
+  put (left z)
+
+-- |Silently fails to shift right if there is no right-child.
+shiftRight' :: Monad m => ZipperT v m ()
+shiftRight' = do
+  z <- get
+  when (hasRight z)
+       (put (right z))
+
+-- |Silently fails to shift left if there is no left-child.
+shiftLeft' :: Monad m => ZipperT v m ()
+shiftLeft' = do
+  z <- get
+  when (hasLeft z)
+       (put (left z))
+
+hasLeft :: Location a -> Bool
+hasLeft (Location _ (Split _ (_:_) _ _)) = True
+hasLeft _                                = False
+
+hasRight :: Location a -> Bool
+hasRight (Location _ (Split _ _ _ (_:_))) = True
+hasRight _                                = False
+
+
diff --git a/src/WebBits/Html/Html.hs b/src/WebBits/Html/Html.hs
new file mode 100644
--- /dev/null
+++ b/src/WebBits/Html/Html.hs
@@ -0,0 +1,14 @@
+-- |Rexports various modules of the HTML library.  It's best to use this in lieu
+-- of selectively importing the following libraries.
+module WebBits.Html.Html
+  ( module WebBits.Html.Syntax
+  -- PermissiveParser
+  , html
+  , parseHtmlFromFile
+  , parseHtmlFromString
+  ) where
+  
+import WebBits.Html.Syntax
+import WebBits.Html.PermissiveParser
+import WebBits.Html.PrettyPrint -- no names, only instances
+import WebBits.Html.Instances -- no names, only instances
diff --git a/src/WebBits/Html/Instances.hs b/src/WebBits/Html/Instances.hs
new file mode 100644
--- /dev/null
+++ b/src/WebBits/Html/Instances.hs
@@ -0,0 +1,66 @@
+module WebBits.Html.Instances() where
+
+import qualified Prelude as Prelude
+import Prelude (Functor,map,fmap)
+import qualified Data.List as List
+import qualified Data.Char as Char
+import Data.Foldable
+import Data.Traversable
+import Control.Applicative
+
+import WebBits.Html.Syntax
+
+ltraverse:: (Traversable t, Applicative f) => (a -> f b) -> [t a] -> f [t b]
+ltraverse f [] = pure []
+ltraverse f (x:xs) = pure (:) <*> (traverse f x) <*> ltraverse f xs
+
+instance Functor (Attribute a) where
+  fmap f (Attribute id val a)            = Attribute id val a
+  fmap f (AttributeExpr a id script def) = AttributeExpr a id (f script) def
+
+instance Functor (Html a) where
+  fmap f (Element id attrs children a) = 
+    Element id (map (fmap f) attrs) (map (fmap f) children) a
+  fmap f (Text str a)                  = Text str a
+  fmap f (Comment str a)               = Comment str a
+  fmap f (HtmlSeq xs)                  = HtmlSeq (map (fmap f) xs)
+  fmap f (ProcessingInstruction str a) = ProcessingInstruction str a
+  fmap f (InlineScript script a def)   = InlineScript (f script) a def
+  fmap f (Script script a)             = Script (f script) a
+
+instance Foldable (Attribute a) where
+  foldr f x (Attribute id val a)          = x
+  foldr f x (AttributeExpr a id script def) = f script x
+
+instance Foldable (Html a) where
+  foldr f x (Element id attrs children a) =
+    Prelude.foldr  (\child x' -> foldr f x' child) x children  
+  foldr f x (Text str a)                  = x
+  foldr f x (Comment str a)               = x
+  foldr f x (HtmlSeq ys)                  = 
+    Prelude.foldr (\child x' -> foldr f x' child) x ys
+  foldr f x (ProcessingInstruction str a) = x
+  foldr f x (InlineScript script a def)   = f script x
+  foldr f x (Script script a)             = f script x
+
+instance Traversable (Attribute a) where
+  traverse f (Attribute id val a)            =
+    pure (Attribute id val a)
+  traverse f (AttributeExpr a id script def) =
+    (AttributeExpr a id) <$> (f script) <*> pure def
+
+instance Traversable (Html a) where
+  traverse f (Element id attrs children a) = 
+    (Element id) <$> ltraverse f attrs  <*> ltraverse f children <*> pure a
+  traverse f (Text str a)                  = 
+    pure (Text str a)
+  traverse f (Comment str a)               = 
+    pure (Comment str a)
+  traverse f (HtmlSeq xs)                  = 
+    HtmlSeq <$> ltraverse f xs
+  traverse f (ProcessingInstruction str a) = 
+    pure (ProcessingInstruction str a)
+  traverse f (InlineScript script a def)   =
+    InlineScript <$> (f script) <*> pure a <*> pure def
+  traverse f (Script script a)             = 
+    Script <$> (f script) <*> pure a
diff --git a/src/WebBits/Html/PermissiveParser.hs b/src/WebBits/Html/PermissiveParser.hs
new file mode 100644
--- /dev/null
+++ b/src/WebBits/Html/PermissiveParser.hs
@@ -0,0 +1,492 @@
+-- |A structure-recovering parser for malformed documents.
+--
+-- Copyright 2007-2008 Arjun Guha.
+-- Based on HtmlPrag 0.16 Copyright (C) 2003 - 2005 Neil W. Van Dyke.  
+--
+-- This program is Free Software; you can redistribute it and/or modify it under
+-- the terms of the GNU Lesser General Public License as published by the Free
+-- Software Foundation; either version 2.1 of the License, or (at your option)
+-- any later version.  This program is distributed in the hope that it will be
+-- useful, but without any warranty; without even the implied warranty of
+-- merchantability or fitness for a particular purpose.  See 
+-- <http://www.gnu.org/copyleft/lesser.html> for details.  For other license
+-- options and consulting, contact the author.
+module WebBits.Html.PermissiveParser
+  ( html
+  , parseHtmlFromFile
+  , parseHtmlFromString
+  -- tokenizer is exported primarily for testing
+  , tokens
+  , Token
+  ) where
+
+import Control.Monad
+import Text.ParserCombinators.Parsec hiding (token,tokens)
+import qualified Text.ParserCombinators.Parsec as Parsec
+import Data.Char (toLower)
+import Data.List (intersperse)
+
+import qualified WebBits.Html.Syntax as Html
+import WebBits.Html.Syntax (HtmlId,Attribute,Script(..))
+
+type ParsedHtml s = Html.Html SourcePos s
+type ParsedAttribute s = Html.Attribute SourcePos s
+
+--------------------------------------------------------------------------------
+-- Parsers generate warnings
+
+data Warning = StringWarning SourcePos String
+
+instance Show Warning where
+  show (StringWarning p s) = "Warning parsing HTML: " ++ s
+  showList [] s = s
+  showList (x:xs) s = show x ++ ('\n':showList xs s)
+
+warn:: String -> GenParser tok [Warning] ()
+warn s = do
+  p <- getPosition
+  updateState ((StringWarning p s):)
+
+noWarnings:: [Warning]
+noWarnings = []
+  
+
+-- A structure-recovering parser for malformed documents, derived from
+-- Neil W. Van Dyke's htmlprag library for PLT Scheme
+
+-- The elements in the list can legally enclose the 1st element of the pair.
+parentConstraints:: [(HtmlId,[HtmlId])]
+parentConstraints =
+  [("area",["map"]),
+   ("body",["html"]),
+   ("caption", ["table"]),
+   ("colgroup", ["table"]),
+   ("dd", ["dl"]),
+   ("dt", ["dl"]),
+   ("frame", ["frameset"]),
+   ("head", ["html"]),
+   ("isindex", ["head"]),
+   ("li", ["dir", "menu", "ol", "ul"]),
+   ("meta", ["head"]),
+   ("noframes", ["frameset"]),
+   ("option", ["select"]),
+   ("p", ["body", "td", "th"]),
+   ("param", ["applet"]),
+   ("tbody", ["table"]),
+   ("td", ["tr"]),
+   ("th", ["tr"]),
+   ("thead", ["table"]),
+   ("title", ["head"]),
+   ("tr", ["table", "tbody", "thead"])]
+
+-- |List of HTML elements that are empty.
+emptyElements:: [HtmlId]
+emptyElements = 
+  ["area", "base", "br", "frame", "hr", "img", "input", "isindex", "keygen", 
+   "link", "meta", "object", "param", "spacer", "wbr"]
+
+isLegalChildOf:: HtmlId -> HtmlId -> Bool
+isLegalChildOf child parent =
+  case lookup child parentConstraints of
+    Nothing             -> True
+    (Just legalParents) -> parent `elem` legalParents
+    
+isEmptyElement:: HtmlId -> Bool
+isEmptyElement element = element `elem` emptyElements
+
+--}}}
+
+--------------------------------------------------------------------------------
+-- Parses an HTML file into a stream of tokens.
+
+-- The auxillary parsing functions return values of this type.
+data Script s  => Token s
+  = Text SourcePos String
+  | EntityToken SourcePos String
+  | EntityInt SourcePos Int
+  | Tag SourcePos HtmlId [Attribute SourcePos s] Bool {-closed?-}
+  | Script SourcePos s
+  | Inline SourcePos s String
+  | EndTag SourcePos HtmlId
+  | Comment SourcePos String
+  | DoctypeToken SourcePos String String String (Maybe String)
+
+
+token:: Script s => Bool -> [Attribute SourcePos s] 
+     -> CharParser [Warning] (Token s)
+token expectedScript prevAttrs = case expectedScript of
+  True  -> (liftM2 Script getPosition (parseScriptBlock prevAttrs)) 
+             <?> "expected a script after a <script> tag"
+  False -> doctype <|> comment <|> tag <|> endTag <|> inlineScript <|> entity 
+             <|> text
+
+tokens:: Script s => CharParser [Warning] [Token s]
+tokens = (eof >> return []) <|> tokens' where
+  tokens' = do 
+    t <- token False []
+    case t of
+      (Tag _ "script" attrs False) -> do s <- token True attrs
+                                         ts <- tokens
+                                         return (t:s:ts)
+      _ -> tokens >>= return.(t:)
+
+--------------------------------------------------------------------------------
+-- Parsers for various components of HTML
+
+qname:: CharParser st String
+qname = do
+  x <- letter
+  xs <- many (noneOf "/*=<>\"\'  \v\f\t\r\n")
+  return (x:xs)
+
+-- |We do not permit spaces between the hyphens and the right-angle in the
+-- terminating '-->'.
+comment:: Script s => CharParser st (Token s) 
+comment =
+  let notDoubleHyphen = try (char '-' >> notFollowedBy (char '-') >> return '-')
+      notHyphen = noneOf "-"
+    in do try (string "<!--")
+          pos <- getPosition
+          msg <- many (notHyphen <|> notDoubleHyphen)
+          string "-->"
+          return (Comment pos msg)
+
+endTag:: Script s => CharParser [Warning] (Token s)
+endTag  = do
+  pos <- getPosition
+  string "</"
+  name <- qname <?> "closing tag\'s name"
+  junk <- manyTill anyChar (char '>') -- permits junk between tag name and '>'
+  unless (null junk) (warn $ "extra characters: " ++ junk ++ 
+                             "; assuming tag name is " ++ name)
+  return (EndTag pos name)
+  
+doctype:: Script s => CharParser [Warning] (Token s)
+doctype = do
+  p <- getPosition
+  try (string "<!DOCTYPE")
+  spaces
+  top <- qname <?> "top-element name"
+  spaces
+  avail <- qname <?> "availability"
+  spaces
+  regEtc <- quotedString <?> "registration, etc."
+  spaces
+  uri <- optionMaybe quotedString
+  spaces
+  string ">"
+  return (DoctypeToken p top avail regEtc uri)
+  
+entity:: Script s => CharParser [Warning] (Token s)
+entity = do
+  char '&'
+  pos <- getPosition
+  name <- many alphaNum <|> (char '#' >> many1 digit)
+  when (null name) (warn "no identifer or number after &")
+  (char ';' >> return ()) <|> (warn "expected semi-colon after entity") 
+  return (EntityToken pos name)
+  
+notScript:: CharParser a Char
+notScript = try (char '{' >> notFollowedBy (char '!') >> return '{')
+
+-- Parses raw text, upto an opening angle-bracket ('<').
+text:: Script s => CharParser st (Token s)
+text = do
+  pos  <- getPosition
+  cs <- many1 (noneOf "<{" <|> notScript) -- Doesn't consume the terminating angle bracket.
+  return (Text pos cs)
+
+-- Strings that are either double-quoted or single-quoted.  Note that HTML
+-- strings contain no escape sequences.
+quotedString:: CharParser a String
+quotedString =
+  (char '"' >> manyTill anyChar (char '"')) <|>
+  (char '\'' >> manyTill anyChar (char '\'')) <?>
+  "quoted string (double-quotes or single quotes)"
+
+-- Parses text to the right of a triple-stick in an inline expression.  We have
+-- to ensure that if we read a `!,' it isn't immediately followed by `}.'
+initText =
+  let notEnd = try (char '!' >> notFollowedBy (char '}') >> return '!')
+    in many1 (notEnd <|> noneOf "!")
+
+scriptValue:: Script s => CharParser a (s,String)
+scriptValue =
+  case parseAttributeScript of
+    Nothing -> fail "attribute-script parser not defined"
+    (Just parser) -> do string "{!"
+                        script <- parser
+                        init <- (string "!}" >> return "")  <|> 
+                                (string "|||" >> initText >>= 
+                                 (\s -> string "!}" >> return s))
+                        return (script,init)
+
+number:: CharParser a String
+number = many1 digit
+
+-- 
+nonquotedAttribute:: CharParser [Warning]  String
+nonquotedAttribute = do
+  x <- alphaNum <|> oneOf "_"
+  xs <- many (noneOf "/*=<>\"\'  \v\f\t\r\n")
+  warn $ "non-quoted attribute value: " ++ (x:xs)
+  return (x:xs)
+
+
+attribute:: Script s => CharParser [Warning] (Html.Attribute SourcePos s)
+attribute = do
+  pos  <- getPosition
+  name <- qname <?> "attribute name"
+  spaces
+  value <- (do char '='
+               spaces
+               (liftM Right scriptValue)
+                 <|> (liftM Left (quotedString <|> nonquotedAttribute)) 
+                 <?> "attribute value")
+           <|> (return $ Left "") -- Unspecified values are empty values.
+  case value of
+    (Left v)      -> return $ Html.Attribute name v pos
+    (Right (s,d)) -> return $ Html.AttributeExpr pos name s d
+
+-- Takes the name of the immediately-enclosing parent tag as an argument.
+tag:: Script s => CharParser [Warning] (Token s)
+tag = do
+  try (char '<' >> notFollowedBy (char '/'))
+  pos <- getPosition
+  name <- qname <?>  "opening tag\'s name"
+  spaces
+  attributes <- (attribute `sepEndBy` spaces)
+  (char '>' >> return (Tag pos name attributes False))
+    <|> (string "/>" >> return (Tag pos name attributes True))
+    <?> "end of tag (i.e. \">\")"
+
+
+-- Parses an inline (curly-banged) script, if an inline-script parser has been
+-- specified (i.e. not Nothing).  Two-character lookahead for the ``{!,'' after
+-- which control is passed to the inline script parser.  Once control returns,
+-- the parser expects to see the closing ``!}.''
+inlineScript:: Script s => CharParser a (Token s)
+inlineScript =
+  case parseInlineScript of
+    Nothing -> fail "no inline script parser specified." -- TODO: appropriate?
+    (Just parser) -> do string "{!" <?> "{! script !}"
+                        pos <- getPosition
+                        script <- parser
+                        spaces
+                        init <- (string "!}" >> return "") <|>
+                                (string "|||" >> initText >>= 
+                                 (\s -> string "!}" >> return s))
+                        return $ Inline pos script init
+
+
+-- Parses a stream of tokens, with a script parser, s and returns values of 
+-- type a.
+type TokenParser s a = GenParser (Token s) [Warning] a
+
+instance Script s => Show (Token s) where
+  show = tokenShow
+
+tokenShow token = case token of
+  (Text _ s)        -> s
+  (EntityToken _ s) -> "&" ++ s ++ ";"
+  (EntityInt _ n)   -> "&#" ++ show n ++ ";"
+  (Tag _ id attrs closed) -> 
+    "<" ++ id ++ " ... " ++ closing where
+      closing = if closed then "/>" else ">"
+  (Script _ s)  -> "/* script body omitted */"
+  (Inline _ s _)-> "{! /* script */ !}"
+  (EndTag _ id) -> "</" ++ show id ++ ">"
+  (Comment _ s) -> "<!-- " ++ show s ++ " -->"
+  (DoctypeToken _ top avail desc Nothing) ->
+    "<!DOCTYPE " ++ top ++ " " ++ avail ++ " " ++ show desc ++ ">"
+  (DoctypeToken _ top avail desc (Just uri)) ->
+    "<!DOCTYPE " ++ top ++ " " ++ avail ++ " " ++ show desc ++ " " 
+      ++ show uri ++ ">" 
+
+tokenPos tok = case tok of
+  (Text p _) -> p
+  (EntityToken p _) -> p
+  (EntityInt p _) -> p
+  (Tag p _ _ _) -> p
+  (Script p _) -> p
+  (Inline p _ _) -> p
+  (EndTag p _) -> p
+  (Comment p _) -> p
+  (DoctypeToken p _ _ _ _) -> p
+    
+textToken :: Script s => TokenParser s (ParsedHtml s)
+textToken = Parsec.token tokenShow tokenPos $ \t -> case t of
+  Text _ s -> Just (Html.Text s (tokenPos t))
+  otherwise -> Nothing
+             
+entityToken :: Script s => TokenParser s (ParsedHtml s)
+entityToken =
+  Parsec.token tokenShow tokenPos
+    (\t -> case t of
+             (EntityToken p s) -> Just (Html.Text ("&" ++ s ++ ";") p)
+             (EntityInt p n) -> Just (Html.Text ("&#" ++ show n ++ ";") p)
+             otherwise -> Nothing)
+           
+commentToken :: Script s => TokenParser s (ParsedHtml s)
+commentToken = 
+  Parsec.token tokenShow tokenPos
+    (\t -> case t of
+             (Comment _ s) -> Just (Html.Comment s (tokenPos t))
+             otherwise -> Nothing)
+
+scriptToken :: Script s => TokenParser s (ParsedHtml s) 
+scriptToken = 
+  Parsec.token tokenShow tokenPos
+    (\t -> case t of
+             (Script p s) -> Just (Html.Script s p)
+             otherwise    -> Nothing)
+
+inlineToken :: Script s => TokenParser s (ParsedHtml s)
+inlineToken = 
+  Parsec.token tokenShow tokenPos
+    (\t -> case t of
+             (Inline p s d) -> Just (Html.InlineScript s p d)
+             otherwise    -> Nothing)
+             
+endToken :: Script s => TokenParser s HtmlId
+endToken = 
+  Parsec.token tokenShow tokenPos
+    (\t -> case t of
+             (EndTag p s) -> Just s
+             otherwise    -> Nothing)
+
+tagToken :: Script s => TokenParser s (Token s)
+tagToken = 
+  Parsec.token tokenShow tokenPos
+  (\t -> case t of
+           (Tag p id attrs closed) -> Just t
+           otherwise               -> Nothing)
+
+doctypeToken :: Script s => TokenParser s (Token s)
+doctypeToken = Parsec.token tokenShow tokenPos $ \t -> case t of
+  DoctypeToken _ _ _ _ _ -> Just t
+  otherwise -> Nothing
+
+--------------------------------------------------------------------------------
+-- HTML fragments
+
+-- |An HTML fragment represents an HTML element with a sequence of children.
+data HtmlFragment s = Fragment {
+  fragmentPosition   :: SourcePos,
+  fragmentName       :: HtmlId,
+  fragmentAttributes :: [ParsedAttribute s],
+  fragmentChildren   :: [ParsedHtml s]
+}
+
+closeFragment:: HtmlFragment s -> ParsedHtml s
+closeFragment (Fragment p htmlId attrs children) =  
+  Html.Element htmlId attrs (reverse children) p
+
+appendChildToFragment child fragment =
+  fragment { fragmentChildren = child : (fragmentChildren fragment) }
+             
+atomic :: Script s => TokenParser s (ParsedHtml s)
+atomic =
+  textToken <|> commentToken <|> scriptToken <|> inlineToken <|> entityToken
+
+
+maybeClose :: Script s => [HtmlFragment s] -> TokenParser s [HtmlFragment s] 
+maybeClose es = do
+  htmlId <- endToken
+  let close [] = do 
+        warn $ "unmatched closing tag \"" ++ htmlId ++ "\"; ignoring"
+        return es
+      close (e:e2:es) | fragmentName e == htmlId = do
+        return $ (appendChildToFragment (closeFragment e) e2) : es
+      close (e:e2:es) | otherwise = 
+        let e2' = appendChildToFragment (closeFragment e) e2
+          in close (e2':es)
+      close [e] | fragmentName e == htmlId = do
+        return [e]
+      close [e] | otherwise = do
+        warn $ "unmatched closing tag \"" ++ htmlId ++ "\"; ignoring"
+        return [e]
+    in close es
+
+open :: Script s => [HtmlFragment s] -> TokenParser s [HtmlFragment s]
+open [] = fail "PermissiveParser.open: invalid state (1)"
+open (e:es) = do
+  (Tag p id attrs isClosed) <- tagToken
+  case isClosed of
+    True -> return $ (appendChildToFragment (Html.Element id attrs [] p) e) : es
+    False ->
+      case isEmptyElement id of
+        True -> do warn $ "empty-element, \"" ++ id 
+                            ++ "\" was not immediately closed"
+                   return $ (appendChildToFragment (Html.Element id attrs [] p)
+                               e) : es
+        False -> do
+          let fragment = Fragment p id attrs []
+              -- If we reach the root, simply make 'fragment' a child.
+          let insert [root] = [fragment,root]
+              -- The <html> element is the only child of the root.  This
+              -- catches all other elements and makes them children of <html>.
+              insert [html,root] = [fragment,html,root]
+              insert (e1:e2:es) | id `isLegalChildOf` (fragmentName e1) =
+                fragment:e1:e2:es
+              insert (e1:e2:es) | otherwise =
+                insert $ (appendChildToFragment (closeFragment e1) e2):es 
+              insert [] = fail "PermissiveParser.open: invalid state (2)"
+          return $ insert (e:es)
+
+structured es = do
+  maybeClose es <|> open es
+
+html' :: Script s => [HtmlFragment s] -> TokenParser s [HtmlFragment s]
+html' [] = fail "PermissiveParser.html': invalid state (1)"
+html' (e:es) =
+  (do a <- atomic
+      html' $ (appendChildToFragment a e):es) <|>
+  (structured (e:es) >>= html') <|>
+  (return (e:es))
+
+parseRoot = Fragment (error "parseRoot: position is meaningless") 
+                     "DOCROOT"  (error "parseRoot: attributes are meaningless")
+                     []
+
+html :: Script s => CharParser [Warning] (Html.Html SourcePos s)
+html = do
+  let parser = do
+        -- optional doctypeToken -- ignored
+        fragments <- html' [parseRoot]
+        case fragments of
+          [fragment] -> case closeFragment fragment of 
+                          Html.Element _ _ (c:_) _ -> do
+                            ws <- getState
+                            return (ws,head [c])
+                          otherwise -> fail "root element not found"
+          otherwise -> fail "no root / multiple roots"
+  toks <- tokens -- a stream of HTML entities
+  pos <- Parsec.getPosition
+  warnings <- Parsec.getState
+  case Parsec.runParser parser warnings (Parsec.sourceName pos) toks of
+    Left e -> fail  $ "unparsable HTML: " ++ (show e)
+    Right (ws,html) -> Parsec.setState ws >> return html 
+
+htmlWithWarnings :: Script s 
+                 => CharParser [Warning] (Html.Html SourcePos s,[Warning])
+htmlWithWarnings = do
+  h <- html
+  ws <- getState
+  return (h,ws)
+
+parseHtmlFromString :: Script s => String -> String -> Either Parsec.ParseError (Html.Html SourcePos s,[Warning])
+parseHtmlFromString sourceName sourceText = 
+  case Parsec.runParser htmlWithWarnings noWarnings sourceName sourceText of
+    Left err -> Left err
+    Right (html,ws) -> Right (html,ws) 
+
+parseHtmlFromFile :: Script s 
+                  => String 
+                  -> IO (Either Parsec.ParseError 
+                                (Html.Html SourcePos s,[Warning]))
+parseHtmlFromFile filename = do
+  chars <- readFile filename
+  case Parsec.runParser htmlWithWarnings noWarnings filename chars of
+    Left err -> return (Left err)
+    Right (html,ws) -> return $ Right (html,ws)
diff --git a/src/WebBits/Html/PrettyPrint.hs b/src/WebBits/Html/PrettyPrint.hs
new file mode 100644
--- /dev/null
+++ b/src/WebBits/Html/PrettyPrint.hs
@@ -0,0 +1,54 @@
+-- |Pretty-printer for HTML.  This modules exports no names.  It only defines
+-- instances of 'PrettyPrintable' for HTML. 
+module WebBits.Html.PrettyPrint
+  ( -- this module exports no names
+  ) where
+
+import qualified Data.List as List
+import qualified Data.Char as Char
+import Text.PrettyPrint.HughesPJ
+
+import WebBits.Common (PrettyPrintable(..))
+
+import WebBits.Html.Syntax
+
+vert [] = empty
+vert [doc] = doc
+vert (doc:docs) = doc <> text "<!--" $+$
+                  text "-->" <> vert docs
+
+instance PrettyPrintable s => PrettyPrintable (Attribute a s) where
+  pp (Attribute name value _) =
+    text name <> equals <> doubleQuotes (text value)
+  pp (AttributeExpr _ n v "") =
+    text n <> equals <> text "{!" <+> pp v <+> text "!}"
+  pp (AttributeExpr _ n v d) =
+    text n <> equals <> text "{!" <+> pp v <+> text "|||" <+> text d 
+      <+> text "!}"
+
+instance PrettyPrintable s => PrettyPrintable (Html a s) where
+  -- The <script> tag must be terminated by </script>.
+  -- <script lang= src= /> doesn't work.
+  -- pp (Element name attrs [] _) =
+  --   text "<" <> text name <+> hsep (map pp attrs) <+> text "/>"
+  pp (Element name attrs children _) =
+    -- WARNING: Spacing is very sensitive
+    text "<" <> text name <+> hsep (map pp attrs) <> text ">"  -- opening
+      $$ (nest 2 (vcat (map pp children)))                     -- body
+      $$ text "</" <> text name <> text ">"                    -- closing
+  -- Horizontally aligned material that is vertically represented in source.
+  pp (HtmlSeq xs) = vert (map pp xs)
+  pp (Text str _) =
+    text (skipWs str) where
+      skipWs str = List.dropWhile Char.isSpace str
+  pp (Comment str _) =
+    text "<!--" <+> text str <+> text "-->"
+  pp (ProcessingInstruction str _) =
+    text "<?" <> text str <> text ">"
+  pp (Script script _) =
+    pp script
+  pp (InlineScript script _ "") =
+    text "{!" <+> pp script <+> text "!}"
+  pp (InlineScript script _ init) =
+    text "{!" <+> pp script <+> text "|||" <+> text init <+> text "!}"
+
diff --git a/src/WebBits/Html/RawScript.hs b/src/WebBits/Html/RawScript.hs
new file mode 100644
--- /dev/null
+++ b/src/WebBits/Html/RawScript.hs
@@ -0,0 +1,34 @@
+module WebBits.Html.RawScript
+  ( RawScript (..)
+  , parseFromFile
+  , parseFromString
+  , RawHtml
+  ) where
+
+import Data.Generics (Data)
+import Data.Generics (Typeable)
+import Text.PrettyPrint.HughesPJ (text)
+import Text.ParserCombinators.Parsec
+import WebBits.Common
+import WebBits.Html.Html
+
+type RawHtml = Html SourcePos RawScript
+
+data RawScript = RawScript String deriving (Show,Eq,Typeable,Data)
+
+instance Script RawScript where
+  parseInlineScript = Nothing
+  
+  parseAttributeScript = Nothing
+  
+  parseScriptBlock _ = do
+    s <- manyTill anyChar (string "</script>")
+    return (RawScript s)
+    
+instance PrettyPrintable RawScript where
+  pp (RawScript s) = text s
+
+parseFromString :: String -> RawHtml
+parseFromString s = case parseHtmlFromString "" s of
+  Left e -> error (show e)
+  Right (html,_) -> html
diff --git a/src/WebBits/Html/Syntax.hs b/src/WebBits/Html/Syntax.hs
new file mode 100644
--- /dev/null
+++ b/src/WebBits/Html/Syntax.hs
@@ -0,0 +1,84 @@
+-- |Datatypes for HTML parameterized over an annotation type and a script type.
+module WebBits.Html.Syntax (
+  -- * HTML Data Structures
+    HtmlId,AttributeValue,Attribute(..),Html(..)
+  -- * The Script class
+  , Script(..)
+  -- * Miscellaneous Functions
+  , attributeValue,attributeUpdate,attributeSet,isAttributeExpr
+  ) where
+
+import Text.ParserCombinators.Parsec(CharParser,SourcePos)
+import Data.Generics(Data)
+import Data.Typeable(Typeable)
+
+--------------------------------------------------------------------------------
+-- Types
+
+type HtmlId = String
+type AttributeValue = String
+
+data Attribute a s
+  = Attribute HtmlId AttributeValue a
+  | AttributeExpr a HtmlId s String
+  deriving (Show,Eq,Typeable,Data)
+
+data Html a sc
+  = Element HtmlId [Attribute a sc] [Html a sc] a
+  | Text String a
+  | Comment String a
+  | HtmlSeq [Html a sc] -- ^must be a non-empty list
+  | ProcessingInstruction String a
+  | InlineScript sc a String
+  | Script sc a
+  deriving (Show,Eq,Typeable,Data)
+  
+--------------------------------------------------------------------------------
+-- The Script class
+
+-- |A type 't' of the 'Script' class can be parsed using 'Parsec'.  't' is of
+-- kind '* -> *', as the parsed AST should be annotated with souce locations
+-- (see 'Text.ParserCombinators.Parsec.SourcePos').
+--
+-- The big deal here is that we can embed a parser for some scripting language,
+-- (e.g. Javascript) into this HTML parser with ease, while preserving source
+-- locations.  The Html datatype is parameterized over a script parser (an
+-- instance of Script).
+class Script t where
+  parseScriptBlock:: [Attribute SourcePos t] -> CharParser a t
+  -- An inline script parser, which may be Nothing if the scripting language
+  -- does not support inline scripts.
+  parseInlineScript:: Maybe (CharParser a t)
+  -- A parser for script-expressions defined inline as attribute values.
+  parseAttributeScript:: Maybe (CharParser a t)
+  
+--------------------------------------------------------------------------------
+-- HTML navigation
+
+isAttributeExpr (AttributeExpr _ _ _ _) = True
+isAttributeExpr _                       = False
+
+-- |Returns the value of the attribute in the list, or 'Nothing' if it doesn't
+-- exist of the value is an inline-expression.
+attributeValue:: HtmlId -> [Attribute a s] -> Maybe String
+attributeValue name [] = Nothing
+attributeValue name ((AttributeExpr pos name' expr init):rest) =
+  if name == name' then Nothing
+                   else attributeValue name rest
+attributeValue name ((Attribute name' value _):rest) =
+  if name == name' then Just value
+                   else attributeValue name rest
+
+attributeSet:: HtmlId -> String -> [Attribute a s]  -> [Attribute a s]
+attributeSet n v attrs = attributeUpdate n (\_ -> v) attrs
+
+attributeUpdate:: HtmlId -> (String -> String) -> [Attribute a s] 
+               -> [Attribute a s]
+attributeUpdate n f [] = 
+  [Attribute n (f "") (error "attributeUpdate--no value")] -- TODO: undefined?!
+attributeUpdate n _ ((AttributeExpr _ _ _ _):_) =
+  error $ "attributeUpdate: " ++ n ++ " is an expression-attribute."
+attributeUpdate n f ((Attribute n' v p):attrs) =
+  if n' == n then (Attribute n (f v) p):attrs
+             else (Attribute n' v p):(attributeUpdate n f attrs)
+
diff --git a/src/WebBits/JavaScript/Combinators.hs b/src/WebBits/JavaScript/Combinators.hs
new file mode 100644
--- /dev/null
+++ b/src/WebBits/JavaScript/Combinators.hs
@@ -0,0 +1,39 @@
+module WebBits.JavaScript.Combinators 
+  ( scriptStatements
+  , isParenExpr
+  , syntaxAt
+  , expressionsAt
+  , statementsAt
+  ) where
+
+import Data.Generics (Data,Typeable, everything, mkQ)
+import Text.ParserCombinators.Parsec (SourcePos)
+import qualified Data.Foldable as F
+import Data.Foldable (Foldable)
+import WebBits.JavaScript.Syntax
+import WebBits.JavaScript.Instances ()
+import WebBits.Common () 
+
+scriptStatements:: JavaScript a -> [Statement a]
+scriptStatements (Script _ ss) = ss
+
+isParenExpr (ParenExpr _ _) = True
+isParenExpr _               = False
+
+syntaxAt :: (Data a, Typeable a, Data (t SourcePos), 
+             Typeable (t SourcePos), Foldable t)
+         => SourcePos -> a -> [t SourcePos]
+syntaxAt pos a = everything (++) (mkQ [] isMatch) a where
+  isMatch stx = case F.find (const True) stx of
+    Nothing -> []
+    Just pos' | pos == pos' -> [stx]
+              | otherwise   -> []
+
+expressionsAt :: (Data a, Typeable a) 
+              => SourcePos -> a -> [Expression SourcePos]
+expressionsAt = syntaxAt
+
+statementsAt :: (Data a, Typeable a) 
+              => SourcePos -> a -> [Statement SourcePos]
+statementsAt = syntaxAt
+
diff --git a/src/WebBits/JavaScript/Crawl.hs b/src/WebBits/JavaScript/Crawl.hs
new file mode 100644
--- /dev/null
+++ b/src/WebBits/JavaScript/Crawl.hs
@@ -0,0 +1,80 @@
+-- |Crawls an HTML page for JavaScript
+module WebBits.JavaScript.Crawl 
+  ( getPageJavaScript
+  ) where
+
+import WebBits.Common
+import Control.Monad
+import Data.Char (toLower)
+import Data.Generics
+import System.IO
+import Text.ParserCombinators.Parsec(parse,setPosition,incSourceColumn,Column,sourceLine,sourceColumn)
+
+import WebBits.Html.Syntax
+import qualified WebBits.JavaScript.JavaScript as Js
+
+-- |Returns the source of the script.
+scriptSrc:: Js.ParsedJsHtml -> [String]
+scriptSrc (Element tag attrs _ _) | (map toLower tag) == "script" =
+  case attributeValue "src" attrs of -- TODO: Check for type="javascript"?
+    Just ""  -> []
+    Just url -> [url]
+    Nothing  -> []
+scriptSrc _ =
+  []
+
+-- |Returns a list of URIs for external Javascript files referenced in the page.
+importedScripts:: Js.ParsedJsHtml -> [String]
+importedScripts = everything (++) (mkQ [] scriptSrc)
+
+-- |Returns the top-level statements of a script.
+scriptText :: Js.ParsedJsHtml -> [Js.ParsedStatement]
+scriptText (Script (Js.Script _ stmts) _) = stmts
+scriptText _ = []
+
+eventHandlers :: [String]
+eventHandlers = ["onload","onclick"]; 
+-- ,"onmousemove","onmouseover","onmousedown","onmouseout","onmouseup","onselectstart", "onkeypress"]
+
+attrScript :: Attribute SourcePos Js.ParsedJavaScript 
+           -> IO [Js.ParsedStatement]
+attrScript (Attribute id val loc) | id `elem` eventHandlers = do
+  let eventId = drop 2 id -- drop the "on" prefix
+  let scriptText = if "javascript:" `isPrefixOf` val then drop 11 val else val
+  let eventListenerPrefix = "addEventListener('" ++ eventId ++ "', function(event) { "
+  let prefixLen = length eventListenerPrefix
+  let eventListenerText = eventListenerPrefix ++ scriptText ++ " });"
+  let parser = do
+        setPosition (incSourceColumn loc (-prefixLen))
+        Js.parseExpression
+  case parse parser (sourceName loc) eventListenerText of
+    Left err -> do
+      fail $ "Error parsiing JavaScript in an attribute at " ++ show loc ++
+             "\nThe script was:\n\n" ++ eventListenerText
+    Right e -> return [Js.ExprStmt loc e]
+attrScript _ = return []
+
+inpageAttrScripts :: Js.ParsedJsHtml -> IO [Js.ParsedStatement]
+inpageAttrScripts = everything (liftM2 (++)) (mkQ (return []) attrScript)
+
+inpageScripts :: Js.ParsedJsHtml -> [Js.ParsedStatement]
+inpageScripts = everything (++) (mkQ [] scriptText)
+
+parseJsFile path = do
+  text <- readFile path
+  case Js.parseScriptFromString path text of
+    Left err -> fail (show err)
+    Right js -> hPutStrLn stderr ("Read file " ++ path) >> return js
+
+-- |Given an HTML page, crawls all external Javascript files and returns a list
+-- of statements, concatenated from all files.
+getPageJavascript:: Js.ParsedJsHtml -> IO [Js.ParsedStatement]
+getPageJavascript page = do
+  let importURIs = importedScripts page
+  let inpageJs   = inpageScripts page
+  attrScripts <- inpageAttrScripts page
+  importedScripts <- mapM parseJsFile importURIs
+  return $ (concatMap Js.scriptStatements importedScripts ++ attrScripts) ++ inpageJs
+
+getPageJavaScript:: Js.ParsedJsHtml -> IO [Js.ParsedStatement] -- monomorphism
+getPageJavaScript = getPageJavascript
diff --git a/src/WebBits/JavaScript/Environment.hs b/src/WebBits/JavaScript/Environment.hs
new file mode 100644
--- /dev/null
+++ b/src/WebBits/JavaScript/Environment.hs
@@ -0,0 +1,282 @@
+module WebBits.JavaScript.Environment 
+  ( staticEnvironment
+  , Ann
+  , LabelledStatement
+  , LabelledExpression
+  , Env
+  ) where
+
+import Data.Generics hiding (GT)
+import Data.Maybe (fromJust)
+import qualified Data.Set as S
+import WebBits.Data.Zipper (ZipperT,ZipperT)
+import qualified Data.Map as M
+import qualified WebBits.Data.Zipper as Z
+import Control.Monad.State
+import qualified Data.Foldable as F
+import qualified Data.List as L
+import WebBits.JavaScript.JavaScript
+import Text.ParserCombinators.Parsec.Pos (SourcePos,initialPos)
+
+---
+-- Add `this' and `arguments' to the formal parameters of all 
+-- functions 
+--
+-- TODO: Does a local var x shadow a formal argument x?  What about 'arguments'?
+
+thisStmt :: Statement SourcePos -> Statement SourcePos
+thisStmt (FunctionStmt loc id args body) = 
+  FunctionStmt loc id ((Id loc "this"):(Id loc "arguments"):args) body
+thisStmt s = s
+
+thisExpr :: Expression SourcePos -> Expression SourcePos
+thisExpr (FuncExpr l args s) = 
+  FuncExpr l ((Id l "this"):(Id l "arguments"):args) s
+thisExpr e = e
+
+removeParens :: Expression SourcePos -> Expression SourcePos
+removeParens (ParenExpr _ e) = e
+removeParens e = e
+
+removeSingletons :: Expression SourcePos -> Expression SourcePos
+removeSingletons (ListExpr _ [e]) = e
+removeSingletons e = e
+
+explicitThis :: [Statement SourcePos] -> [Statement SourcePos]
+explicitThis = everywhere $ (mkT removeSingletons) . (mkT removeParens) 
+  . (mkT thisExpr) . (mkT thisStmt)
+
+-- JavaScript has a global and function scopes.  Globals do not need to be
+-- declared.  Any "unbound identifier" in a function is treated as a reference
+-- to a global.
+
+-- For each FunctionExpr and FunctionStmt, we create a list of locally defined
+-- identifiers (var x = ...) and free identifiers.
+
+-- We build a tree of "partial environments."  Since a variable may be used
+-- before it is declared locally, we maintain a set of free identifiers and
+-- narrow the set when appropriate.
+type PartialEnv = (Env,S.Set String)
+
+type Env = M.Map String Int
+
+emptyPartialEnv :: PartialEnv
+emptyPartialEnv = (M.empty,S.empty)
+
+type RefM a = Z.ZipperT PartialEnv (State Int) a
+
+nextLabel :: (MonadTrans t, Monad (t (State Int))) => t (State Int) Int
+nextLabel = do
+  l <- lift get
+  lift $ modify (+1)
+  return l 
+  
+bind :: Id SourcePos -> RefM ()
+bind (Id _ s) = do
+  lbl <- nextLabel
+  (env,freeIds) <- Z.getNode
+  Z.setNode (M.insert s lbl env, S.delete s freeIds)
+  
+use :: Id SourcePos -> RefM ()
+use (Id _ s) = do
+  (env,freeIds) <- Z.getNode
+  case M.lookup s env of
+    Just _ -> return ()
+    Nothing -> Z.setNode (env, S.insert s freeIds)
+  
+
+buildExpr :: Expression SourcePos -> RefM (Expression SourcePos)
+buildExpr (FuncExpr loc args stmt) = do
+  stmt' <- Z.nest emptyPartialEnv (mapM_ bind args >> buildStmt stmt)
+  return (FuncExpr loc args stmt')
+buildExpr e@(VarRef _ id) = do
+  use id
+  return e
+buildExpr (AssignExpr loc op (VarRef loc' id) e) = do
+  use id
+  e' <- buildExpr e
+  return (AssignExpr loc op (VarRef loc' id) e')
+buildExpr e =
+  gmapM buildAny e
+
+buildCatchClause :: CatchClause SourcePos -> RefM (CatchClause SourcePos)
+buildCatchClause (CatchClause loc id stmt) = do
+  bind id
+  stmt' <- buildStmt stmt
+  return (CatchClause loc id stmt')
+  
+buildVarDecl :: VarDecl SourcePos -> RefM (VarDecl SourcePos)
+buildVarDecl (VarDecl loc id ye) = do
+  bind id
+  ye' <- gmapM buildAny ye
+  return (VarDecl loc id ye')
+
+buildForInInit :: ForInInit SourcePos -> RefM (ForInInit SourcePos)
+buildForInInit e@(ForInVar id) = do
+  bind id
+  return e
+buildForInInit e@(ForInNoVar id) = do
+  use id
+  return e
+  
+buildStmt :: Statement SourcePos -> RefM (Statement SourcePos)
+buildStmt (FunctionStmt loc id args stmt) = do
+  stmt' <- Z.nest emptyPartialEnv (mapM_ bind args >> buildStmt stmt)
+  return (FunctionStmt loc id args stmt')
+buildStmt s = gmapM buildAny s
+
+buildAny' :: (Data a, Typeable a) => a -> RefM a
+buildAny' v = gmapM buildAny v
+
+buildAny :: GenericM RefM
+buildAny =
+  buildAny' `extM` buildExpr `extM` buildCatchClause `extM`
+    buildVarDecl `extM` buildForInInit `extM` buildStmt
+
+--
+-- buildAny creates a tree of partial environments.  We now walk the tree and
+-- attempt to associate free identifiers with their bindings in enclosing
+-- scopes.  Any remaining free identifiers are globals.
+--
+
+resolveFreeId :: Env -> String -> StateT Env (State Int) Env
+resolveFreeId env freeId = case M.lookup freeId env of
+  Just lbl -> return env -- the free identifier was bound in an enclosing env
+  Nothing  -> do -- this is a global 
+    globals <- get
+    case M.lookup freeId globals of
+      Just lbl -> return (M.insert freeId lbl env) -- global already bound
+      Nothing -> do -- new global
+        lbl <- nextLabel
+        put (M.insert freeId lbl globals)
+        return (M.insert freeId lbl env)
+
+
+completeEnvM' :: Z.Tree PartialEnv -> StateT Env (State Int) (Z.Tree Env)
+completeEnvM' pt = Z.dfsFoldM f M.empty pt where
+  -- the union is left-biased; bindings in env shadow bindings in enclosingEnv
+  f enclosingEnv (env,freeIds) = 
+    foldM resolveFreeId (M.union env enclosingEnv) (S.elems freeIds) 
+
+completeEnvM :: Z.Tree PartialEnv -> StateT Env (State Int) (Z.Tree Env)
+completeEnvM pt = do
+  tree <- completeEnvM' pt
+  globals <- get
+  -- left-biased union: lexicals shadow globals
+  return (fmap (\lexicals -> M.union lexicals globals) tree)
+
+--
+-- completeEnvM creates a tree of environments whose structure is identical to
+-- the function-nesting structure of the JavaScript source.  We walk the tree
+-- and the code in step and annotate the code with environments.
+--
+
+type Ann = (Env,Int,SourcePos)
+
+type LabelledStatement = Statement Ann
+type LabelledExpression = Expression Ann
+
+-- Necessary for type-checking.  gmapM won't let us transform the type of the
+-- annotation.  So, we first inject SourcePos into a trivial Ann.
+insertEmptyAnn :: (Functor f) => f SourcePos -> f Ann
+insertEmptyAnn = fmap (\loc -> (M.empty,0,loc))
+
+
+locOf :: F.Foldable t => t SourcePos -> SourcePos
+locOf = fromJust . (F.find $ const True)
+
+labelEnv :: Env -> Z.ZipperT Env (State Int) Env
+labelEnv env = Z.getNode
+
+labelId :: Id Ann -> Z.ZipperT Env (State Int) (Id Ann)
+labelId id@(Id (_,_,loc) s) = do
+  env <- Z.getNode
+  case M.lookup s env of
+    Nothing -> fail $ "BUG: unbound identifier while labelling" ++ show id
+    Just lbl -> return (Id (env,lbl,loc) s)
+    
+labelIdNoVar :: Id Ann -> Z.ZipperT Env (State Int) (Id Ann)
+labelIdNoVar (Id (_,_,loc) s) = do
+  env <- Z.getNode
+  lbl <- nextLabel
+  return (Id (env,lbl,loc) s)
+
+labelProp :: Prop Ann -> Z.ZipperT Env (State Int) (Prop Ann)
+labelProp (PropId (_,_,loc) id) = do
+  env <- Z.getNode
+  lbl <- nextLabel
+  id' <- labelIdNoVar id
+  return (PropId (env,lbl,loc) id')
+labelProp e = gmapM labelAny e
+
+labelExpr :: Expression Ann 
+          -> Z.ZipperT Env (State Int) (Expression Ann)
+labelExpr (ThisRef (_,_,loc)) = do
+  env <- Z.getNode
+  lbl <- M.lookup "this" env
+  return (ThisRef (env,lbl,loc))
+labelExpr (DotRef (_,_,loc) expr id) = do
+  env <- Z.getNode
+  lbl <- nextLabel
+  id' <- labelIdNoVar id
+  expr' <- labelExpr expr
+  return (DotRef (env,lbl,loc) expr' id')
+labelExpr (FuncExpr (_,_,loc) args stmt) = do
+  env <- Z.getNode
+  lbl <- nextLabel
+  args' <- Z.withCurrentChild (mapM labelId args)
+  stmt' <- Z.withCurrentChild (labelStmt stmt)
+  Z.shiftRight'
+  return (FuncExpr (env,lbl,loc) args' stmt')
+labelExpr e = gmapM labelAny e
+  
+labelStmt :: Statement Ann
+          -> Z.ZipperT Env (State Int) (Statement Ann)
+labelStmt (BreakStmt (_,_,loc) (Just id)) = do
+  env <- Z.getNode
+  lbl <- nextLabel
+  id' <- labelIdNoVar id
+  return (BreakStmt (env,lbl,loc) (Just id'))
+labelStmt (ContinueStmt (_,_,loc) (Just id)) = do
+  env <- Z.getNode
+  lbl <- nextLabel
+  id' <- labelIdNoVar id
+  return (ContinueStmt (env,lbl,loc) (Just id'))
+labelStmt (LabelledStmt (_,_,loc) id stmt) = do
+  env <- Z.getNode
+  lbl <- nextLabel
+  id' <- labelIdNoVar id
+  stmt' <- labelStmt stmt
+  return (LabelledStmt (env,lbl,loc) id' stmt')  
+labelStmt (FunctionStmt (_,_,loc) id args stmt) = do
+  env <- Z.getNode
+  lbl <- nextLabel
+  args' <- Z.withCurrentChild (mapM labelId args)
+  stmt' <- Z.withCurrentChild (labelStmt stmt)
+  Z.shiftRight'
+  return (FunctionStmt (env,lbl,loc) id args' stmt')
+labelStmt e = gmapM labelAny e
+
+labelAny' :: (Data a, Typeable a) => a -> Z.ZipperT Env (State Int) a
+labelAny' a = gmapM labelAny a
+
+labelAny :: GenericM (Z.ZipperT Env (State Int)) 
+labelAny a = (labelAny' `extM` labelEnv `extM` labelId `extM` labelProp `extM`
+  labelExpr `extM` labelStmt) a
+
+-- |Annotates each expression with its static environment.  In addition,
+-- a map of free identifiers is returned, along with the next valid label.
+staticEnvironment :: [Statement SourcePos] 
+                  -> ([Statement Ann],Env,Int)
+staticEnvironment stmts =
+  let stmts' = explicitThis stmts
+      labelM = do
+        partialEnvTree <- Z.execZipperT (mapM buildStmt stmts')
+                            (Z.toLocation (Z.Node emptyPartialEnv []))
+        (envTree,globals) <- runStateT (completeEnvM partialEnvTree) M.empty
+        let stmts'' = map insertEmptyAnn stmts' 
+        labelledStmts <- Z.evalZipperT (mapM labelStmt stmts'') 
+                                       (Z.toLocation envTree)
+        return (labelledStmts,globals)
+      ((labelledStmts,globals),nextLabel) = runState labelM 0
+    in (labelledStmts,globals,nextLabel)
diff --git a/src/WebBits/JavaScript/HtmlEmbedding.hs b/src/WebBits/JavaScript/HtmlEmbedding.hs
new file mode 100644
--- /dev/null
+++ b/src/WebBits/JavaScript/HtmlEmbedding.hs
@@ -0,0 +1,26 @@
+module WebBits.JavaScript.HtmlEmbedding
+  ( JsHtml
+  , ParsedJavaScript
+  , ParsedJsHtml
+  ) where
+
+import WebBits.Html.Syntax(Html,Script,parseScriptBlock,parseInlineScript,
+                   parseAttributeScript)
+import WebBits.JavaScript.Parser(parseScript)
+import WebBits.JavaScript.Syntax(JavaScript)
+--import JavaScript.PrettyPrint -- for the instance declaration
+import Text.ParserCombinators.Parsec (SourcePos)
+
+type JsHtml a = Html SourcePos (JavaScript a)
+
+type ParsedJavaScript = JavaScript SourcePos
+
+type ParsedJsHtml = JsHtml SourcePos
+
+instance Script ParsedJavaScript where
+  parseScriptBlock attrs = do
+    parseScript
+  parseInlineScript = Nothing
+  parseAttributeScript = Nothing
+    
+  
diff --git a/src/WebBits/JavaScript/Instances.hs b/src/WebBits/JavaScript/Instances.hs
new file mode 100644
--- /dev/null
+++ b/src/WebBits/JavaScript/Instances.hs
@@ -0,0 +1,291 @@
+-- |Instances of 'Foldable' and 'Traversable' for JavaScript's syntax.
+module WebBits.JavaScript.Instances
+  ( -- This module does not export any names.
+  ) where
+
+import Prelude hiding (foldr,sequence,mapM)
+import qualified Prelude as Prelude
+
+import Data.Foldable (Foldable(..))
+import Data.Traversable(Traversable(..))
+import Control.Applicative
+
+import WebBits.JavaScript.Syntax
+
+yfoldr:: Foldable t => (a -> b -> b) -> b -> Maybe (t a) -> b
+yfoldr _ b Nothing = b
+yfoldr f b (Just t) = foldr f b t
+
+lfoldr:: Foldable t => (a -> b -> b) -> b -> [t a] -> b
+lfoldr f = Prelude.foldr (flip $ foldr f)
+
+ltraverse:: (Traversable t, Applicative f) => (a -> f b) -> [t a] -> f [t b]
+ltraverse _ [] = pure []
+ltraverse f (a:as) = (:) <$> traverse f a <*> ltraverse f as
+
+ytraverse:: (Traversable t, Applicative f) 
+         => (a -> f b) -> Maybe (t a) -> f (Maybe (t b))
+ytraverse _ Nothing = pure Nothing
+ytraverse f (Just t) = Just <$> traverse f t
+
+instance Functor Id where
+  fmap f (Id a v) = Id (f a) v
+
+instance Functor JavaScript where
+  fmap f (Script a stmts) = Script (f a) (map (fmap f) stmts)
+  
+instance Functor Prop where
+  fmap f (PropId a id) = PropId (f a) (fmap f id)
+  fmap f (PropString a s) = PropString (f a) s
+  fmap f (PropNum a n) = PropNum (f a) n
+
+instance Functor Expression where
+  fmap f expression = 
+    case expression of
+      StringLit a s -> StringLit (f a) s
+      RegexpLit a s g ci -> RegexpLit (f a) s g ci
+      NumLit a n -> NumLit (f a) n
+      BoolLit a b -> BoolLit (f a) b
+      NullLit a -> NullLit (f a)
+      ArrayLit a es -> ArrayLit (f a) (map (fmap f) es)
+      ObjectLit a pes -> ObjectLit (f a) (map f' pes) where
+        f' (p,e) = (fmap f p, fmap f e)
+      ThisRef a -> ThisRef (f a)
+      VarRef a id -> VarRef (f a) (fmap f id)
+      DotRef a e id -> DotRef (f a) (fmap f e) (fmap f id)
+      BracketRef a e1 e2 -> BracketRef (f a) (fmap f e1) (fmap f e2)
+      NewExpr a e es -> NewExpr (f a) (fmap f e) (map (fmap f) es)
+      PostfixExpr a op e -> PostfixExpr (f a) op (fmap f e)
+      PrefixExpr a op e -> PrefixExpr (f a) op (fmap f e)
+      InfixExpr a op e1 e2 -> InfixExpr (f a) op (fmap f e1) (fmap f e2)
+      CondExpr a e1 e2 e3 -> CondExpr (f a) (fmap f e1) (fmap f e2) (fmap f e3)
+      AssignExpr a op e1 e2 -> AssignExpr (f a) op (fmap f e1) (fmap f e2)
+      ParenExpr a e -> ParenExpr (f a) (fmap f e)
+      ListExpr a es -> ListExpr (f a) (map (fmap f) es)
+      CallExpr a e es -> CallExpr (f a) (fmap f e) (map (fmap f) es)
+      FuncExpr a args s -> FuncExpr (f a) (map (fmap f) args) (fmap f s)
+
+instance Functor CaseClause where
+  fmap f (CaseClause a e ss) = CaseClause (f a) (fmap f e) (map (fmap f) ss)
+  fmap f (CaseDefault a ss) = CaseDefault (f a) (map (fmap f) ss)
+  
+instance Functor CatchClause where
+  fmap f (CatchClause a id s) = CatchClause (f a) (fmap f id) (fmap f s)
+
+instance Functor VarDecl where
+  fmap f (VarDecl a id Nothing) = VarDecl (f a) (fmap f id) Nothing
+  fmap f (VarDecl a id (Just e)) = VarDecl (f a) (fmap f id) (Just $ fmap f e)
+  
+instance Functor ForInit where
+  fmap f NoInit = NoInit
+  fmap f (VarInit decls) = VarInit (map (fmap f) decls)
+  fmap f (ExprInit e) = ExprInit (fmap f e)
+
+instance Functor ForInInit where
+  fmap f (ForInVar id) = ForInVar (fmap f id)
+  fmap f (ForInNoVar id) = ForInNoVar (fmap f id)
+  
+instance Functor Statement where
+  fmap f s = 
+    case s of
+      BlockStmt a ss -> BlockStmt (f a) (map (fmap f) ss)
+      EmptyStmt a -> EmptyStmt (f a)
+      ExprStmt a e -> ExprStmt (f a) (fmap f e)
+      IfStmt a e s1 s2 -> IfStmt (f a) (fmap f e) (fmap f s1) (fmap f s2)
+      IfSingleStmt a e s -> IfSingleStmt (f a) (fmap f e) (fmap f s)
+      SwitchStmt a e cs -> SwitchStmt (f a) (fmap f e) (map (fmap f) cs)
+      WhileStmt a e s -> WhileStmt (f a) (fmap f e) (fmap f s)
+      DoWhileStmt a s e -> DoWhileStmt (f a) (fmap f s) (fmap f e)
+      BreakStmt a Nothing -> BreakStmt (f a) Nothing
+      BreakStmt a (Just id) -> BreakStmt (f a) (Just (fmap f id))
+      ContinueStmt a yid -> ContinueStmt (f a) (yid >>= return.(fmap f))
+      LabelledStmt a id s -> LabelledStmt (f a) (fmap f id) (fmap f s)
+      ForInStmt a init e s -> ForInStmt (f a) (fmap f init) (fmap f e)
+                                (fmap f s)
+      ForStmt a init yinc ytest body -> 
+        ForStmt (f a) (fmap f init) (yinc >>= return.(fmap f))
+          (ytest >>= return.(fmap f)) (fmap f body)
+      TryStmt a s cs ys -> 
+        TryStmt (f a) (fmap f s) (map (fmap f) cs) (ys >>= return.(fmap f))
+      ThrowStmt a e -> ThrowStmt (f a) (fmap f e)
+      ReturnStmt a ye -> ReturnStmt (f a) (ye >>= return.(fmap f))
+      WithStmt a e s -> WithStmt (f a) (fmap f e) (fmap f s)
+      VarDeclStmt a ds -> VarDeclStmt (f a) (map (fmap f) ds)
+      FunctionStmt a id args s -> 
+        FunctionStmt (f a) (fmap f id) (map (fmap f) args) (fmap f s)
+
+instance Foldable Id where
+  foldr f b (Id a _) = f a b
+
+instance Foldable Prop where
+  foldr f b (PropId a id) = f a (foldr f b id)
+  foldr f b (PropString a _) = f a b
+  foldr f b (PropNum a _) = f a b
+        
+instance Foldable Expression where
+  -- foldr:: (a -> b -> b) -> b -> Expression a -> b
+  foldr f b e =
+    case e of
+      StringLit a _ -> f a b
+      RegexpLit a _ _ _ -> f a b
+      NumLit a _ -> f a b
+      BoolLit a _ -> f a b
+      NullLit a -> f a b
+      ArrayLit a es -> f a (Prelude.foldr (flip $ foldr f) b es)
+      ObjectLit a pes -> f a (Prelude.foldr f' b pes) where
+        f' (p,e) b = foldr f (foldr f b e) p
+      ThisRef a -> f a b
+      VarRef a id -> f a (foldr f b id)
+      DotRef a e id -> f a (foldr f (foldr f b id) e)
+      BracketRef a e1 e2 -> f a (foldr f (foldr f b e2) e1)
+      NewExpr a e es -> f a (foldr f (Prelude.foldr (flip $ foldr f) b es) e)
+      PostfixExpr a _ e -> f a $ foldr f b e
+      PrefixExpr a _ e -> f a $ foldr f b e
+      InfixExpr a _ e1 e2 -> f a $ foldr f (foldr f b e2) e1
+      CondExpr a e1 e2 e3 -> f a $ foldr f (foldr f (foldr f b e3) e2) e1
+      AssignExpr a _ e1 e2 -> f a $ foldr f (foldr f b e2) e1
+      ParenExpr a e -> f a $ foldr f b e
+      ListExpr a es -> f a $ Prelude.foldr (flip $ foldr f) b es
+      CallExpr a e es -> f a $ foldr f (Prelude.foldr (flip $ foldr f) b es) e
+      FuncExpr a args s -> 
+        f a $ Prelude.foldr (flip $ foldr f) (foldr f b s) args
+
+instance Foldable CaseClause where
+  foldr f b (CaseClause a e ss) = 
+    f a $ foldr f (Prelude.foldr (flip $ foldr f) b ss) e
+  foldr f b (CaseDefault a ss) = f a $ Prelude.foldr (flip $ foldr f) b ss
+  
+instance Foldable CatchClause where
+  foldr f b (CatchClause a id s) = f a $ foldr f (foldr f b s) id
+
+instance Foldable VarDecl where
+  foldr f b (VarDecl a id ye) = f a $ foldr f (yfoldr f b ye) id
+
+instance Foldable ForInit where
+  foldr f b NoInit = b
+  foldr f b (VarInit ds) = Prelude.foldr (flip $ foldr f) b ds
+  foldr f b (ExprInit e) = foldr f b e
+
+instance Foldable ForInInit where
+ foldr f b (ForInVar id) = foldr f b id
+ foldr f b (ForInNoVar id) = foldr f b id
+
+instance Foldable Statement where
+  foldr f b statement =
+    case statement of
+      BlockStmt a ss -> f a $ lfoldr f b ss
+      EmptyStmt a -> f a b
+      ExprStmt a e -> f a $ foldr f b e
+      IfStmt a e s1 s2 -> f a $ foldr f (foldr f (foldr f b s2) s1) e
+      IfSingleStmt a e s -> f a $ foldr f (foldr f b s) e
+      SwitchStmt a e cs -> f a $ foldr f (lfoldr f b cs) e
+      WhileStmt a e s -> f a $ foldr f (foldr f b s) e
+      DoWhileStmt a s e -> f a $ foldr f (foldr f b e) s
+      BreakStmt a yid -> f a $ yfoldr f b yid
+      ContinueStmt a yid -> f a $ yfoldr f b yid
+      LabelledStmt a id s -> f a $ foldr f (foldr f b s) id
+      ForInStmt a init e s -> f a $ foldr f (foldr f (foldr f b s) e) init
+      ForStmt a init ye1 ye2 s ->
+        f a $ foldr f (yfoldr f (yfoldr f (foldr f b s) ye2) ye1) init
+      TryStmt a s cs ys -> f a $ foldr f (lfoldr f (yfoldr f b ys) cs) s
+      ThrowStmt a e -> f a $ foldr f b e
+      ReturnStmt a ys -> f a $ yfoldr f b ys
+      WithStmt a e s -> f a $ foldr f (foldr f b s) e
+      VarDeclStmt a ds -> f a $ lfoldr f b ds
+      FunctionStmt a id args s ->
+        f a $ lfoldr f (foldr f b s) (id:args)
+
+instance Traversable Id where
+  traverse f (Id a v) = Id <$> f a <*> pure v
+
+instance Traversable Prop where
+  traverse f (PropId a id) = PropId <$> f a <*> traverse f id
+  traverse f (PropString a s) = PropString <$> f a <*> pure s
+  traverse f (PropNum a n) = PropNum <$> f a <*> pure n
+  
+instance Traversable Expression where
+  traverse f expression =
+    case expression of
+      StringLit a s -> StringLit <$> f a <*> pure s
+      RegexpLit a s g ci -> RegexpLit <$> f a <*> pure s <*> pure g <*> pure ci
+      NumLit a n -> NumLit <$> f a <*> pure n
+      BoolLit a b -> BoolLit <$> f a <*> pure b
+      NullLit a -> NullLit <$> f a
+      ArrayLit a es -> ArrayLit <$> f a <*> ltraverse f es
+      ObjectLit a ps -> ObjectLit <$> f a <*>  (zip <$> props' <*> es') where
+        (props,es) = unzip ps
+        props' = ltraverse f props
+        es' = ltraverse f es
+      ThisRef a -> ThisRef <$> f a
+      VarRef a id -> VarRef <$> f a <*> traverse f id
+      DotRef a e id -> DotRef <$> f a <*> traverse f e <*> traverse f id
+      BracketRef a e es -> BracketRef <$> f a <*> traverse f e <*> traverse f es
+      NewExpr a e es -> NewExpr <$> f a <*> traverse f e <*> ltraverse f es
+      PostfixExpr a op e -> PostfixExpr <$> f a <*> pure op <*> traverse f e
+      PrefixExpr a op e -> PrefixExpr <$> f a <*> pure op <*> traverse f e
+      InfixExpr a op e1 e2 -> InfixExpr <$> f a <*> pure op <*> traverse f e1
+                                <*> traverse f e2
+      CondExpr a e1 e2 e3 ->
+        CondExpr <$> f a <*> traverse f e1 <*> traverse f e2 <*> traverse f e3
+      AssignExpr a op e1 e2 -> AssignExpr <$> f a <*> pure op <*> traverse f e1
+        <*> traverse f e2
+      ParenExpr a e -> ParenExpr <$> f a <*> traverse f e
+      ListExpr a es -> ListExpr <$> f a <*> ltraverse f es
+      CallExpr a e es -> CallExpr <$> f a <*> traverse f e <*> ltraverse f es
+      FuncExpr a ids s -> FuncExpr <$> f a <*> ltraverse f ids <*> traverse f s
+
+instance Traversable CaseClause where
+  traverse f (CaseClause a e ss) =
+    CaseClause <$> f a <*> traverse f e <*> ltraverse f ss
+  traverse f (CaseDefault a ss) = 
+    CaseDefault <$> f a <*> ltraverse f ss
+
+instance Traversable CatchClause where
+  traverse f (CatchClause a id s) = 
+    CatchClause <$> f a <*> traverse f id <*> traverse f s
+    
+instance Traversable VarDecl where
+  traverse f (VarDecl a id ye) =
+    VarDecl <$> f a <*> traverse f id <*> ytraverse f ye
+
+instance Traversable ForInit where
+  traverse f NoInit = pure NoInit
+  traverse f (VarInit ds) = VarInit <$> ltraverse f ds
+  traverse f (ExprInit e) = ExprInit <$> traverse f e
+
+instance Traversable ForInInit where
+ traverse f (ForInVar id) = ForInVar <$> traverse f id
+ traverse f (ForInNoVar id) = ForInNoVar <$> traverse f id
+
+instance Traversable Statement where
+  traverse f statement =
+    case statement of
+      BlockStmt a ss -> BlockStmt <$> f a <*> ltraverse f ss
+      EmptyStmt a -> EmptyStmt <$> f a
+      ExprStmt a e -> ExprStmt <$> f a <*> traverse f e
+      IfStmt a e s1 s2 ->
+        IfStmt <$> f a <*> traverse f e <*> traverse f s1 <*> traverse f s2
+      IfSingleStmt a e s ->
+        IfSingleStmt <$> f a <*> traverse f e <*> traverse f s
+      SwitchStmt a e cs ->
+        SwitchStmt <$> f a <*> traverse f e <*> ltraverse f cs
+      WhileStmt a e s -> WhileStmt <$> f a <*> traverse f e <*> traverse f s
+      DoWhileStmt a s e -> DoWhileStmt <$> f a <*> traverse f s <*> traverse f e
+      BreakStmt a yid -> BreakStmt <$> f a <*> ytraverse f yid
+      ContinueStmt a yid -> ContinueStmt <$> f a <*> ytraverse f yid
+      LabelledStmt a id s -> 
+        LabelledStmt <$> f a <*> traverse f id <*> traverse f s
+      ForInStmt a init e s ->
+        ForInStmt <$> f a <*> traverse f init <*> traverse f e <*> traverse f s
+      ForStmt a init yinc ytest s ->
+        ForStmt <$> f a <*> traverse f init <*> ytraverse f yinc 
+          <*> ytraverse f ytest <*> traverse f s
+      TryStmt a s cs ys ->
+        TryStmt <$> f a <*> traverse f s <*> ltraverse f cs <*> ytraverse f ys
+      ThrowStmt a e -> ThrowStmt <$> f a <*> traverse f e
+      ReturnStmt a ys -> ReturnStmt <$> f a <*> ytraverse f ys
+      WithStmt a e s -> WithStmt <$> f a <*> traverse f e <*> traverse f s
+      VarDeclStmt a ds -> VarDeclStmt <$> f a <*> ltraverse f ds
+      FunctionStmt a id args s ->
+        FunctionStmt <$> f a <*> traverse f id <*> ltraverse f args 
+          <*> traverse f s 
diff --git a/src/WebBits/JavaScript/JavaScript.hs b/src/WebBits/JavaScript/JavaScript.hs
new file mode 100644
--- /dev/null
+++ b/src/WebBits/JavaScript/JavaScript.hs
@@ -0,0 +1,17 @@
+-- |Re-exports commonly used modules.
+module WebBits.JavaScript.JavaScript
+  ( module WebBits.JavaScript.Syntax
+  , module WebBits.JavaScript.HtmlEmbedding
+  , module WebBits.JavaScript.Parser
+  , module WebBits.JavaScript.Combinators
+  -- JavaScript.Instances exports nothing
+  ) where
+
+-- 
+import WebBits.JavaScript.Syntax
+import WebBits.JavaScript.Parser
+import WebBits.JavaScript.PrettyPrint
+import WebBits.JavaScript.HtmlEmbedding
+import WebBits.JavaScript.Combinators
+
+import WebBits.JavaScript.Instances
diff --git a/src/WebBits/JavaScript/Lexer.hs b/src/WebBits/JavaScript/Lexer.hs
new file mode 100644
--- /dev/null
+++ b/src/WebBits/JavaScript/Lexer.hs
@@ -0,0 +1,63 @@
+{- This isn't a lexer in the sense that it provides a JavaScript token-stream.
+ - This module provides character-parsers for various JavaScript tokens.
+ -}
+module WebBits.JavaScript.Lexer(identifier,reserved,operator,reservedOp,charLiteral,
+                        stringLiteral,natural,integer,float,naturalOrFloat,
+                        decimal,hexadecimal,octal,symbol,whiteSpace,parens,
+                        braces,brackets,squares,semi,comma,colon,dot,
+                        identifierStart) where
+
+import Prelude hiding (lex)
+import Text.ParserCombinators.Parsec
+import qualified Text.ParserCombinators.Parsec.Token as T
+
+identifierStart = (letter <|> oneOf "$_")
+
+javascriptDef =
+  T.LanguageDef "/*"
+                "*/"
+                "//"
+                False -- no nested comments
+                {- Adapted from syntax/regexps.ss in Dave's code. -}
+                identifierStart
+                (alphaNum <|> oneOf "$_") -- identifier rest
+                (oneOf "{}<>()~.,?:|&^=!+-*/%!") -- operator start
+                (oneOf "=<>|&+") -- operator rest
+                ["break", "case", "catch", "const", "continue", "debugger", 
+                 "default", "delete", "do", "else", "enum", "false", "finally",
+                 "for", "function", "if", "instanceof", "in", "let", "new", 
+                 "null", "return", "switch", "this", "throw", "true", "try", 
+                 "typeof", "var", "void", "while", "with"]
+                ["|=", "^=", "&=", "<<=", ">>=", ">>>=", "+=", "-=", "*=", "/=", 
+                 "%=", "=", ";", ",", "?", ":", "||", "&&", "|", "^", "&", 
+                 "===", "==", "=", "!==", "!=", "<<", "<=", "<", ">>>", ">>", 
+                 ">=", ">", "++", "--", "+", "-", "*", "/", "%", "!", "~", ".", 
+                 "[", "]", "{", "}", "(", ")","</","instanceof"]
+                 True -- case-sensitive
+            
+lex = T.makeTokenParser javascriptDef
+
+-- everything but commaSep and semiSep
+identifier = T.identifier	 lex
+reserved = T.reserved	 lex
+operator = T.operator	 lex
+reservedOp = T.reservedOp lex	
+charLiteral = T.charLiteral lex	
+stringLiteral = T.stringLiteral lex	
+natural = T.natural lex	
+integer = T.integer lex	
+float = T.float lex	
+naturalOrFloat = T.naturalOrFloat lex	
+decimal = T.decimal lex	
+hexadecimal = T.hexadecimal lex	
+octal = T.octal lex	
+symbol = T.symbol lex	
+whiteSpace = T.whiteSpace lex	
+parens = T.parens	 lex
+braces = T.braces	 lex
+squares = T.squares lex	
+semi = T.semi	 lex
+comma = T.comma	 lex
+colon = T.colon lex	
+dot = T.dot lex
+brackets = T.brackets lex
diff --git a/src/WebBits/JavaScript/Parser.hs b/src/WebBits/JavaScript/Parser.hs
new file mode 100644
--- /dev/null
+++ b/src/WebBits/JavaScript/Parser.hs
@@ -0,0 +1,659 @@
+module WebBits.JavaScript.Parser(parseScript,parseExpression,parseStatement
+   , parseScriptFromString
+   , emptyParsedJavaScript
+   , ParsedStatement
+   , ParsedExpression
+   , parseJavaScriptFromFile
+   , parseSimpleExpr'
+   ) where
+
+import WebBits.JavaScript.Lexer hiding (identifier)
+import qualified WebBits.JavaScript.Lexer as Lexer
+import WebBits.JavaScript.Syntax
+import Text.ParserCombinators.Parsec
+import Text.ParserCombinators.Parsec.Expr
+import Control.Monad(liftM,liftM2)
+import Control.Monad.Trans (MonadIO,liftIO)
+import Numeric(readDec,readOct,readHex)
+import Data.Char(chr)
+
+-- We parameterize the parse tree over source-locations.
+type ParsedExpr = Expression SourcePos
+type ParsedStmt = Statement SourcePos
+
+type ParsedStatement = Statement SourcePos
+type ParsedExpression = Expression SourcePos
+
+
+-- These parsers can store some arbitrary state
+type StatementParser state = CharParser state ParsedStmt
+type ExpressionParser state = CharParser state ParsedExpr
+
+identifier =
+  liftM2 Id getPosition Lexer.identifier
+
+--{{{ Statements
+
+-- Keep in mind that Token.reserved parsers (exported from the lexer) do not
+-- consume any input on failure.  Note that all statements (expect for labelled
+-- and expression statements) begin with a reserved-word.  If we fail to parse
+-- this reserved-word, no input is consumed.  Hence, we can have the massive or
+-- block that is parseExpression.  Note that if the reserved-word is parsed, it 
+-- must be whatever statement the reserved-word indicates.  If we fail after the
+-- reserved-word, we truly have a syntax error.  Since input has been consumed,
+-- <|> will not try its alternate in parseExpression, and we will fail.
+
+parseIfStmt:: StatementParser st  
+parseIfStmt = do
+  pos <- getPosition
+  reserved "if"
+  test <- parseParenExpr <?> "parenthesized test-expression in if statement"
+  consequent <- parseStatement <?> "true-branch of if statement"
+  optional semi -- TODO: in spec?
+  ((do reserved "else"
+       alternate <- parseStatement
+       return (IfStmt pos test consequent alternate))
+    <|> return (IfSingleStmt pos test consequent))
+
+parseSwitchStmt:: StatementParser st
+parseSwitchStmt =
+  let parseDefault = do
+        pos <- getPosition
+        reserved "default"
+        colon
+        statements <- many parseStatement
+        return (CaseDefault pos statements)
+      parseCase = do
+         pos <- getPosition
+         reserved "case"
+         condition <- parseListExpr
+         colon
+         actions <- many parseStatement
+         return (CaseClause pos condition actions)
+    in do pos <- getPosition
+          reserved "switch"
+          test <- parseParenExpr
+          clauses <- braces $ many $ parseDefault <|> parseCase
+          return (SwitchStmt pos test clauses)
+
+parseWhileStmt:: StatementParser st
+parseWhileStmt = do
+  pos <- getPosition
+  reserved "while"
+  test <- parseParenExpr <?> "parenthesized test-expression in while loop"
+  body <- parseStatement
+  return (WhileStmt pos test body)
+
+parseDoWhileStmt:: StatementParser st
+parseDoWhileStmt = do
+  pos <- getPosition
+  reserved "do"
+  body <- parseStatement
+  reserved "while"
+  test <- parseParenExpr <?> "parenthesized test-expression in do loop"
+  optional semi
+  return (DoWhileStmt pos body test)
+
+parseContinueStmt:: StatementParser st
+parseContinueStmt = do
+  pos <- getPosition
+  reserved "continue"
+  pos' <- getPosition
+  -- Ensure that the identifier is on the same line as 'continue.'
+  id <- (if (sourceLine pos == sourceLine pos')
+           then (liftM Just identifier) <|> (return Nothing)
+           else return Nothing)
+  return (ContinueStmt pos id)
+
+parseBreakStmt:: StatementParser st
+parseBreakStmt = do
+  pos <- getPosition
+  reserved "break"
+  pos' <- getPosition
+  -- Ensure that the identifier is on the same line as 'break.'
+  id <- (if (sourceLine pos == sourceLine pos')
+           then (liftM Just identifier) <|> (return Nothing)
+           else return Nothing)
+  optional semi           
+  return (BreakStmt pos id)
+
+parseBlockStmt:: StatementParser st
+parseBlockStmt = do
+  pos <- getPosition
+  statements <- braces (many parseStatement)
+  return (BlockStmt pos statements)
+
+parseEmptyStmt:: StatementParser st 
+parseEmptyStmt = do
+  pos <- getPosition
+  semi
+  return (EmptyStmt pos)
+
+parseLabelledStmt:: StatementParser st
+parseLabelledStmt = do
+  pos <- getPosition
+  -- Lookahead for the colon.  If we don't see it, we are parsing an identifier
+  -- for an expression statement.
+  label <- try (do label <- identifier
+                   colon
+                   return label)
+  statement <- parseStatement
+  return (LabelledStmt pos label statement)
+
+parseExpressionStmt:: StatementParser st
+parseExpressionStmt = do
+  pos <- getPosition
+  expr <- parseListExpr -- TODO: spec 12.4?
+  optional semi
+  return (ExprStmt pos expr)
+
+
+parseForInStmt:: StatementParser st
+parseForInStmt =
+  let parseInit = (reserved "var" >> liftM ForInVar identifier)
+                  <|> (liftM ForInNoVar identifier)
+    in do pos <- getPosition
+          -- Lookahead, so that we don't clash with parseForStmt
+          (init,expr) <- try (do reserved "for"
+                                 parens (do init <- parseInit
+                                            reserved "in"
+                                            expr <- parseExpression
+                                            return (init,expr)))
+          body <- parseStatement
+          return (ForInStmt pos init expr body) 
+
+parseForStmt:: StatementParser st
+parseForStmt =
+  let parseInit =
+        (reserved "var" >> liftM VarInit (parseVarDecl `sepBy` comma)) <|>
+        (liftM ExprInit parseListExpr) <|>
+        (return NoInit)
+    in do pos <- getPosition
+          reserved "for"
+          reservedOp "("
+          init <- parseInit
+          semi
+          test <- (liftM Just parseExpression) <|> (return Nothing)
+          semi
+          iter <- (liftM Just parseExpression) <|> (return Nothing)
+          reservedOp ")" <?> "closing paren"
+          stmt <- parseStatement
+          return (ForStmt pos init test iter stmt)
+
+parseTryStmt:: StatementParser st
+parseTryStmt =
+  let parseCatchClause = do
+        pos <- getPosition
+        reserved "catch"
+        id <- parens identifier
+        stmt <- parseStatement
+        return (CatchClause pos id stmt)
+    in do reserved "try"
+          pos <- getPosition
+          guarded <- parseStatement
+          catches <- many parseCatchClause
+          finally <- (reserved "finally" >> liftM Just parseStatement) 
+                      <|> (return Nothing)
+          return (TryStmt pos guarded catches finally)
+
+parseThrowStmt:: StatementParser st
+parseThrowStmt = do
+  pos <- getPosition
+  reserved "throw"
+  expr <- parseExpression
+  optional semi
+  return (ThrowStmt pos expr)
+
+parseReturnStmt:: StatementParser st
+parseReturnStmt = do
+  pos <- getPosition
+  reserved "return"
+  expr <- (liftM Just parseListExpr) <|> (return Nothing)
+  optional semi
+  return (ReturnStmt pos expr)
+
+parseWithStmt:: StatementParser st
+parseWithStmt = do
+  pos <- getPosition
+  reserved "with"
+  context <- parseParenExpr
+  stmt <- parseStatement
+  return (WithStmt pos context stmt)
+
+parseVarDecl = do
+  pos <- getPosition
+  id <- identifier
+  init <- (reservedOp "=" >> liftM Just parseExpression) <|> (return Nothing)
+  return (VarDecl pos id init)
+
+parseVarDeclStmt:: StatementParser st
+parseVarDeclStmt = do 
+  pos <- getPosition
+  reserved "var"
+  decls <- parseVarDecl `sepBy` comma
+  optional semi
+  return (VarDeclStmt pos decls)
+
+parseFunctionStmt:: StatementParser st
+parseFunctionStmt = do
+  pos <- getPosition
+  name <- try (reserved "function" >> identifier) -- ambiguity with FuncExpr
+  args <- parens (identifier `sepBy` comma)
+  body <- parseBlockStmt <?> "function body in { ... }"
+  return (FunctionStmt pos name args body)
+
+parseStatement:: StatementParser st
+parseStatement = parseIfStmt <|> parseSwitchStmt <|> parseWhileStmt 
+  <|> parseDoWhileStmt <|> parseContinueStmt <|> parseBreakStmt 
+  <|> parseBlockStmt <|> parseEmptyStmt <|> parseForInStmt <|> parseForStmt
+  <|> parseTryStmt <|> parseThrowStmt <|> parseReturnStmt <|> parseWithStmt 
+  <|> parseVarDeclStmt  <|> parseFunctionStmt
+  -- labelled, expression and the error message always go last, in this order
+  <|> parseLabelledStmt <|> parseExpressionStmt <?> "statement"
+
+--}}}
+
+--{{{ Expressions
+
+-- References used to construct this stuff:
+-- + http://developer.mozilla.org/en/docs/
+--     Core_JavaScript_1.5_Reference:Operators:Operator_Precedence
+-- + http://www.mozilla.org/js/language/grammar14.html
+--
+-- Aren't expression tables nice?  Well, we can't quite use them, because of 
+-- JavaScript's ternary (?:) operator.  We have to use two expression tables.
+-- We use one expression table for the assignment operators that bind looser 
+-- than ?: (assignTable).  The terms of assignTable are ternary expressions 
+-- (parseTernaryExpr).  parseTernaryExpr left-factors the left-recursive
+-- production for ?:, and is defined over the second expression table, 
+-- exprTable, which consists of operators that bind tighter than ?:.  The terms
+-- of exprTable are atomic expressions, parenthesized expressions, functions and
+-- array references.
+
+--{{{ Primary expressions
+
+parseThisRef:: ExpressionParser st
+parseThisRef = do
+  pos <- getPosition
+  reserved "this"
+  return (ThisRef pos)
+
+parseNullLit:: ExpressionParser st
+parseNullLit = do
+  pos <- getPosition
+  reserved "null"
+  return (NullLit pos)
+
+
+parseBoolLit:: ExpressionParser st
+parseBoolLit =
+  let parseTrueLit = do
+        pos <- getPosition
+        reserved "true"
+        return (BoolLit pos True)
+      parseFalseLit = do
+        pos <- getPosition
+        reserved "false"
+        return (BoolLit pos False)
+    in parseTrueLit <|> parseFalseLit
+
+parseVarRef:: ExpressionParser st
+parseVarRef = liftM2 VarRef getPosition identifier
+
+parseArrayLit:: ExpressionParser st
+parseArrayLit = liftM2 ArrayLit getPosition (squares (parseExpression `sepBy` comma))
+  
+parseFuncExpr = do
+  pos <- getPosition
+  reserved "function"
+  args <- parens (identifier `sepBy` comma)
+  body <- parseBlockStmt
+  return $ FuncExpr pos args body
+
+--{{{ parsing strings
+
+escapeChars =
+ [('\'','\''),('\"','\"'),('\\','\\'),('b','\b'),('f','\f'),('n','\n'),
+  ('r','\r'),('t','\t'),('v','\v'),('/','/')]
+
+allEscapes:: String
+allEscapes = map fst escapeChars
+
+parseEscapeChar = do
+  c <- oneOf allEscapes
+  (Just c') <- return $ lookup c escapeChars
+  return c'
+
+parseAsciiHexChar = do
+  char 'x'
+  d1 <- hexDigit
+  d2 <- hexDigit
+  return ((chr.fst.head.readHex) (d1:d2:""))
+
+parseUnicodeHexChar = do
+  char 'u'
+  liftM (chr.fst.head.readHex) 
+        (sequence [hexDigit,hexDigit,hexDigit,hexDigit])
+        
+isWhitespace ch = ch `elem` " \t"
+
+-- The endWith argument is either single-quote or double-quote, depending on how
+-- we opened the string.
+parseStringLit' endWith =
+  (char endWith >> return "") <|>
+  (do try (string "\\'")
+      cs <- parseStringLit' endWith
+      return $ "'" ++ cs) <|>
+  (do char '\\'
+      c <- (parseEscapeChar <|> parseAsciiHexChar <|> parseUnicodeHexChar <|> char '\r' <|> char '\n')
+      cs <- parseStringLit' endWith
+      -- TODO: Leading whitespace on the new line is probably meant to be ignored.
+      if c == '\r' || c == '\n' then return (c:(dropWhile isWhitespace cs)) else return cs) <|>
+   (liftM2 (:) anyChar (parseStringLit' endWith))
+
+parseStringLit:: ExpressionParser st
+parseStringLit = do
+  pos <- getPosition
+  -- parseStringLit' takes as an argument the quote-character that opened the
+  -- string.
+  str <- (char '\'' >>= parseStringLit') <|> (char '\"' >>= parseStringLit')
+  -- CRUCIAL: Parsec.Token parsers expect to find their token on the first
+  -- character, and read whitespaces beyond their tokens.  Without this,
+  -- expressions like:
+  --   var s = "string"   ;
+  -- do not parse.
+  spaces 
+  return (StringLit pos str)
+
+--}}}
+
+parseRegexpLit:: ExpressionParser st
+parseRegexpLit = do
+  let parseFlags = do
+        flags <- many (oneOf "mgi")
+        return $ \f -> f ('g' `elem` flags) ('i' `elem` flags) 
+  let parseEscape = char '\\' >> anyChar
+  let parseChar = noneOf "/"
+  let parseRe = (char '/' >> return "") <|> (char '\\' >> liftM2 (:) anyChar parseRe) <|> (liftM2 (:) anyChar parseRe)
+  pos <- getPosition
+  char '/'
+  pat <- parseRe --many1 parseChar
+  flags <- parseFlags
+  spaces -- crucial for Parsec.Token parsers
+  return $ flags (RegexpLit pos pat)
+          
+parseObjectLit:: ExpressionParser st
+parseObjectLit =
+  let parseProp = do
+        -- Parses a string, identifier or integer as the property name.  I
+        -- apologize for the abstruse style, but it really does make the code
+        -- much shorter.
+        name <- (liftM (uncurry PropString) 
+                       (liftM (\(StringLit p s) -> (p,s)) parseStringLit))
+                <|> (liftM2 PropId getPosition identifier)
+                <|> (liftM2 PropNum getPosition decimal)
+        colon
+        val <- parseAssignExpr
+        return (name,val)
+    in do pos <- getPosition
+          props <- braces (parseProp `sepBy` comma) <?> "object literal"
+          return $ ObjectLit pos props
+
+--{{{ Parsing numbers.  From pg. 17-18 of ECMA-262.
+
+hexLit = do
+  try (string "0x")
+  digits <- many1 (oneOf "0123456789abcdefABCDEF")
+  [(hex,"")] <- return $ Numeric.readHex digits
+  return hex
+
+decimalDigit = oneOf "0123456789"
+
+-- Creates a decimal value from a whole, fractional and exponent part.
+mkDecimal:: Double -> Double -> Int -> Double
+mkDecimal w f e =
+  if (f >= 1.0)
+    then mkDecimal w (f / 10.0) e
+    else (w+f) * (10.0^e)
+
+decimalInteger = do
+  xs <- many1 decimalDigit
+  spaces
+  return $ (fst.head.readDec) xs
+
+{-  (try (char '0' >> spaces >> return 0)) <|>
+  (do xs <- many1 decimalDigit
+      return $ (fst.head.readDec) xs) -}
+
+exponentPart = do
+  oneOf "eE"
+  ((char '+' >> many1 decimalDigit >>= return.fst.head.readDec) <|> 
+   (char '-' >> many1 decimalDigit >>= return.negate.fst.head.readDec) <|>
+   (many1 decimalDigit >>= return.fst.head.readDec))
+  
+decLit =
+  (do whole <- decimalInteger
+      frac <- option 0 (char '.' >> decimalInteger)
+      exp <- option 0  exponentPart
+      return $ mkDecimal (fromIntegral whole) (fromIntegral frac) exp) <|>
+  (do frac <- char '.' >> decimalInteger
+      exp <- option 0  exponentPart
+      return $ mkDecimal 0.0 (fromIntegral frac) exp)
+
+parseNumLit:: ExpressionParser st
+parseNumLit = 
+  liftM2 NumLit getPosition
+    (do x <- hexLit <|> decLit
+        (notFollowedBy identifierStart <?> "whitespace") 
+        spaces
+        return x)
+
+--}}}
+
+parseParenExpr:: ExpressionParser st
+parseParenExpr = do
+  pos <- getPosition
+  expr <- parens parseListExpr
+  return (ParenExpr pos expr)
+
+-- everything above expect functions
+parseExprForNew = parseThisRef <|> parseNullLit <|> parseBoolLit <|> parseStringLit 
+  <|> parseArrayLit <|> parseParenExpr <|> parseNewExpr <|> parseNumLit 
+  <|> parseRegexpLit <|> parseObjectLit <|> parseVarRef
+
+-- all the expression parsers defined above
+parseSimpleExpr' = parseThisRef <|> parseNullLit <|> parseBoolLit 
+  <|> parseStringLit <|> parseArrayLit <|> parseParenExpr
+  <|> parseFuncExpr <|> parseNumLit <|> parseRegexpLit <|> parseObjectLit
+  <|> parseVarRef
+
+parseNewExpr =
+  (do pos <- getPosition
+      reserved "new"
+      constructor <- parseSimpleExprForNew Nothing -- right-associativity
+      arguments <- (try (parens (parseExpression `sepBy` comma))) <|> (return [])
+      return (NewExpr pos constructor arguments)) <|>
+  parseSimpleExpr'
+
+parseSimpleExpr (Just e) =
+  ((do reservedOp "." <?> "property.ref"
+       pos <- getPosition
+       key <- identifier
+       parseSimpleExpr $ Just (DotRef pos e key)) <|>
+   (do pos <- getPosition
+       reservedOp "(" <?> "(function application)" 
+       args <- parseExpression `sepBy` comma
+       --reservedOp ")"
+       spaces   -- This hack is needed as the token parser parses ")+", ")-",
+       char ')' -- etc. as a single token.
+       spaces
+       parseSimpleExpr $ Just (CallExpr pos e args)) <|>
+   (do reservedOp "[" <?> "[property-ref]"
+       pos <- getPosition
+       key <- parseExpression <?> "expression (2)"
+       char ']'
+       spaces
+       --reservedOp "]"
+       parseSimpleExpr $ Just (BracketRef pos e key)) <|>
+   (return e))
+parseSimpleExpr Nothing = do
+  e <- parseNewExpr <?> "expression (3)"
+  parseSimpleExpr (Just e)
+  
+parseSimpleExprForNew (Just e) =
+  ((do reservedOp "." <?> "property.ref"
+       pos <- getPosition
+       key <- identifier
+       parseSimpleExprForNew $ Just (DotRef pos e key)) <|>
+   (do reservedOp "[" <?> "[property-ref]"
+       pos <- getPosition
+       key <- parseExpression <?> "expression (2)"
+       char ']'
+       spaces
+       --reservedOp "]"
+       parseSimpleExprForNew $ Just (BracketRef pos e key)) <|>
+   (return e))
+parseSimpleExprForNew Nothing = do
+  e <- parseNewExpr <?> "expression (3)"
+  parseSimpleExprForNew (Just e)
+    
+--}}}
+
+makeInfixExpr str constr = Infix parser AssocLeft where
+  parser:: CharParser st (Expression SourcePos -> Expression SourcePos -> Expression SourcePos)
+  parser = do
+    pos <- getPosition
+    reservedOp str
+    return (InfixExpr pos constr)  -- points-free, returns a function
+
+makePrefixExpr str constr = Prefix parser where
+  parser = do
+    pos <- getPosition
+    (reservedOp str <|> reserved str)
+    return (PrefixExpr pos constr) -- points-free, returns a function
+    
+mkPrefix operator constr = Prefix $ do
+  pos <- getPosition
+  operator
+  return (\operand -> PrefixExpr pos constr operand)
+
+makePostfixExpr str constr = Postfix parser where
+  parser = do
+    pos <- getPosition
+    (reservedOp str <|> reserved str)
+    return (PostfixExpr pos constr) -- points-free, returns a function
+
+-- apparently, expression tables can't handle multiple prefixes (which makes sense, since chaining ++ and -- doesn't 
+-- make any sense)
+parsePrefixedExpr = do
+  pos <- getPosition 
+  op <- optionMaybe $ (reservedOp "!" >> return PrefixLNot) <|> (reservedOp "~" >> return PrefixBNot)
+  case op of
+    Nothing -> parseSimpleExpr Nothing  -- new is treated as a simple expr
+    Just op -> do
+      innerExpr <- parsePrefixedExpr
+      return (PrefixExpr pos op innerExpr)
+    
+exprTable:: [[Operator Char st ParsedExpr]]
+exprTable = 
+  [
+   [makePrefixExpr "++" PrefixInc,
+    makePostfixExpr "++" PostfixInc],
+   [makePrefixExpr "--" PrefixDec,
+    makePostfixExpr "--" PostfixDec],
+   -- What we really need here is a good, old-fashioned lexer.
+   [mkPrefix (try $ char '+' >> notFollowedBy (char '+')) PrefixPlus,
+    mkPrefix (try $ char '-' >> notFollowedBy (char '-')) PrefixMinus],
+    -- makePrefixExpr "-" PrefixMinus],
+   [makePrefixExpr "typeof" PrefixTypeof,
+    makePrefixExpr "void" PrefixVoid,
+    makePrefixExpr "delete" PrefixDelete],
+    
+   [makeInfixExpr "*" OpMul, makeInfixExpr "/" OpDiv, makeInfixExpr "%" OpMod],
+   [makeInfixExpr "+" OpAdd, makeInfixExpr "-" OpSub],
+   [makeInfixExpr "<<" OpLShift, makeInfixExpr ">>" OpSpRShift,
+    makeInfixExpr ">>>" OpZfRShift],
+   [makeInfixExpr "<" OpLT, makeInfixExpr "<=" OpLEq, makeInfixExpr ">" OpGT,
+    makeInfixExpr ">=" OpGEq, 
+    makeInfixExpr "instanceof" OpInstanceof, makeInfixExpr "in" OpIn],
+   [makeInfixExpr "&" OpBAnd], 
+   [makeInfixExpr "^" OpBXor], 
+   [makeInfixExpr "|" OpBOr],
+   [makeInfixExpr "&&" OpLAnd],
+   [makeInfixExpr "||" OpLOr],  
+   [makeInfixExpr "==" OpEq, makeInfixExpr "!=" OpNEq,
+    makeInfixExpr "===" OpStrictEq, makeInfixExpr "!==" OpStrictNEq]
+    ]
+  
+parseExpression' = 
+  buildExpressionParser exprTable parsePrefixedExpr <?> "simple expression"
+
+--{{{ Parsing ternary operators: left factored
+
+parseTernaryExpr':: CharParser st (Maybe (ParsedExpr,ParsedExpr))
+parseTernaryExpr' =
+  (do reservedOp "?"
+      l <- parseTernaryExpr
+      colon
+      r <- parseTernaryExpr
+      return $ Just (l,r)) <|>
+  (return Nothing)
+
+parseTernaryExpr:: ExpressionParser st
+parseTernaryExpr = do
+  e <- parseExpression'
+  e' <- parseTernaryExpr'
+  case e' of
+    Nothing -> return e
+    Just (l,r) -> do p <- getPosition
+                     return $ CondExpr p e l r
+--}}}
+
+-- Parsing assignment operations.
+makeAssignExpr str constr = Infix parser AssocRight where
+  parser:: CharParser st (ParsedExpr -> ParsedExpr -> ParsedExpr)
+  parser = do
+    pos <- getPosition
+    reservedOp str
+    return (AssignExpr pos constr)
+
+assignTable:: [[Operator Char st ParsedExpr]]
+assignTable = [
+  [makeAssignExpr "=" OpAssign, makeAssignExpr "+=" OpAssignAdd, 
+    makeAssignExpr "-=" OpAssignSub, makeAssignExpr "*=" OpAssignMul,
+    makeAssignExpr "/=" OpAssignDiv, makeAssignExpr "%=" OpAssignMod,
+    makeAssignExpr "<<=" OpAssignLShift, makeAssignExpr ">>=" OpAssignSpRShift,
+    makeAssignExpr ">>>=" OpAssignZfRShift, makeAssignExpr "&=" OpAssignBAnd,
+    makeAssignExpr "^=" OpAssignBXor, makeAssignExpr "|=" OpAssignBOr
+  ]]
+
+
+parseAssignExpr:: ExpressionParser st
+parseAssignExpr = buildExpressionParser assignTable parseTernaryExpr  
+
+parseExpression:: ExpressionParser st
+parseExpression = parseAssignExpr
+
+parseListExpr =
+  liftM2 ListExpr getPosition (parseAssignExpr `sepBy1` comma)
+
+--}}}
+
+parseScript:: CharParser state (JavaScript SourcePos)
+parseScript = do
+  whiteSpace
+  liftM2 Script getPosition (parseStatement `sepBy` whiteSpace)
+  
+parseJavaScriptFromFile :: MonadIO m => String -> m [Statement SourcePos]
+parseJavaScriptFromFile filename = do
+  chars <- liftIO $ readFile filename
+  case parse parseScript filename chars of
+    Left err               -> fail (show err)
+    Right (Script _ stmts) -> return stmts
+
+
+parseScriptFromString:: String -> String -> Either ParseError (JavaScript SourcePos)
+parseScriptFromString src script = parse parseScript src script
+
+emptyParsedJavaScript = 
+  Script (error "Parser.emptyParsedJavaScript--no annotation") []
diff --git a/src/WebBits/JavaScript/PrettyPrint.hs b/src/WebBits/JavaScript/PrettyPrint.hs
new file mode 100644
--- /dev/null
+++ b/src/WebBits/JavaScript/PrettyPrint.hs
@@ -0,0 +1,261 @@
+-- |Pretty-printing JavaScript.  This module doesn't export any names, but
+-- importing it declares PrettyPrintable instances for JavaScript.Syntax.
+module WebBits.JavaScript.PrettyPrint() where
+
+import Text.PrettyPrint.HughesPJ
+import WebBits.JavaScript.Syntax
+import WebBits.JavaScript.Combinators
+import WebBits.Common
+
+--{{{ Helper functions for common printing patterns
+
+-- Displays the statement in { ... }, unless it already is in a block.
+inBlock:: (Statement a) -> Doc
+inBlock stmt@(BlockStmt _ _) = pp stmt
+inBlock stmt                 = text "{" $+$ pp stmt $+$ text "}"
+
+-- Displays the expression in ( ... ), unless it already is in parens.
+inParens:: (Expression a) -> Doc
+inParens expr@(ParenExpr _ _) = pp expr
+inParens expr                 = parens (pp expr)
+
+commaSep:: (PrettyPrintable a) => [a] -> Doc
+commaSep = hsep.(punctuate comma).(map pp)
+
+--}}}
+
+instance PrettyPrintable (Id a) where
+  pp (Id _ str) = text str
+
+instance PrettyPrintable (ForInit a) where
+  pp NoInit         = empty
+  pp (VarInit vs) = text "var" <+> commaSep vs 
+  pp (ExprInit e) = pp e
+  
+instance PrettyPrintable (ForInInit a) where
+  pp (ForInVar id)   = text "var" <+> pp id
+  pp (ForInNoVar id) = pp id
+
+--{{{ Pretty-printing statements
+
+instance PrettyPrintable (CaseClause a) where
+  pp (CaseClause _ expr stmts) =
+    pp expr <+> colon $$ (nest 2 (vcat (map pp stmts)))
+  pp (CaseDefault _ stmts) =
+    text "default:" $$ (nest 2 (vcat (map pp stmts)))
+
+instance PrettyPrintable (CatchClause a) where
+  pp (CatchClause _ id stmt) =
+    text "catch" <+> (parens.pp) id <+> pp stmt
+
+
+instance PrettyPrintable (VarDecl a) where
+  pp (VarDecl _ id Nothing) =
+    pp id
+  pp (VarDecl _ id (Just expr)) =
+    pp id <+> equals <+> pp expr
+
+instance PrettyPrintable (Statement a) where
+  pp (BlockStmt _ stmts) =
+    text "{" $+$ nest 2 (vcat (map pp stmts)) $+$ text "}"
+  pp (EmptyStmt _) =
+    semi
+  pp (ExprStmt _ expr) =
+    pp expr <> semi
+  pp (IfSingleStmt _ test cons) =
+    text "if" <+> inParens test $$ (nest 2 (pp cons))
+  pp (IfStmt _ test cons alt) =
+    text "if" <+> inParens test $$ (nest 2 $ pp cons) $$ text "else"
+      $$ (nest 2 $ pp alt)
+  pp (SwitchStmt _ expr cases) =
+    text "switch" <+> inParens expr $$ braces (nest 2 (vcat (map pp cases)))
+  pp (WhileStmt _ test body) =
+    text "while" <+> inParens test $$ (nest 2 (pp body))
+  pp (ReturnStmt _ expr) =
+    text "return" <+> pp expr <> semi
+  pp (DoWhileStmt _ stmt expr) =
+    text "do" $$ (nest 2 (pp stmt <+> inParens expr))
+  pp (BreakStmt _ Nothing) =
+    text "break;"
+  pp (BreakStmt _ (Just label)) =
+    text "break" <+> pp label <> semi
+  pp (ContinueStmt _ Nothing) =
+    text "continue;"
+  pp (ContinueStmt _ (Just label)) =
+    text"continue" <+> pp label <> semi
+  pp (LabelledStmt _ label stmt) =
+    pp label <> colon $$ pp stmt
+  pp (ForInStmt p init expr body) =
+    text "for" <+> parens (pp init <+> text "in" <+> pp expr)
+      $$ (nest 2 (pp body))
+  pp (ForStmt _ init incr test body) =
+    text "for" <+> parens (pp init <> semi <+> pp incr <> semi <+> pp test)
+      $$ (nest 2 (pp body))
+  pp (TryStmt _ stmt catches finally) =
+    (text "try" $$ pp stmt $$ (vcat (map pp catches)) $$ ppFinally) where
+      ppFinally = 
+        case finally of
+          Nothing -> empty
+	  (Just stmt) -> text "finally" <> pp stmt
+  pp (ThrowStmt _ expr) =
+    text "throw" <+> pp expr <> semi
+  pp (WithStmt _ expr stmt) | isParenExpr expr =
+    (text "with" <+> inParens expr $$ pp stmt)
+  pp (WithStmt _ expr stmt) | otherwise =
+      (text "with" <+> inParens expr $$ pp stmt)
+  pp (VarDeclStmt _ decls) =
+    text "var" <+> commaSep decls <> semi
+  pp (FunctionStmt _ name args stmt) =
+    text "function" <+> pp name <> (parens.commaSep) args $$ inBlock stmt
+
+--}}}
+
+instance PrettyPrintable (Prop a) where
+  pp (PropId _ id) = pp id
+  pp (PropString _ str) = text str
+  pp (PropNum _ n) = text (show n)
+
+
+--{{{ infix-operators
+
+showInfix op =
+  case op of
+    OpMul -> "*"
+    OpDiv -> "/"
+    OpMod -> "%" 
+    OpAdd -> "+" 
+    OpSub -> "-"
+    OpLShift -> "<<"
+    OpSpRShift -> ">>"
+    OpZfRShift -> ">>>"
+    OpLT -> "<"
+    OpLEq -> "<="
+    OpGT -> ">"
+    OpGEq -> ">="
+    OpIn -> "in"
+    OpInstanceof -> "instanceof"
+    OpEq -> "=="
+    OpNEq -> "!="
+    OpStrictEq -> "==="
+    OpStrictNEq -> "!=="
+    OpBAnd -> "&"
+    OpBXor -> "^"
+    OpBOr -> "|"
+    OpLAnd -> "&&"
+    OpLOr -> "||"
+
+instance PrettyPrintable InfixOp where
+  pp op = text (showInfix op)
+--}}}
+
+--{{{ prefix operators
+
+showPrefix PrefixInc = "++"
+showPrefix PrefixDec = "--"
+showPrefix PrefixLNot = "!"
+showPrefix PrefixBNot = "~"
+showPrefix PrefixPlus = "+"
+showPrefix PrefixMinus = "-"
+showPrefix PrefixTypeof = "typeof"
+showPrefix PrefixVoid = "void"
+showPrefix PrefixDelete = "delete"
+
+instance PrettyPrintable PrefixOp where
+  pp op = text (showPrefix op)
+
+--}}}
+
+--{{{ postfix operators
+
+instance PrettyPrintable PostfixOp where
+  pp PostfixInc = text "++"
+  pp PostfixDec = text "--"
+
+--}}}
+
+--{{{ assignment operators
+
+showAssignOp OpAssign = "="
+showAssignOp OpAssignAdd = "+="
+showAssignOp OpAssignSub = "-="
+showAssignOp OpAssignMul = "*="
+showAssignOp OpAssignDiv = "/="
+showAssignOp OpAssignMod = "%="
+showAssignOp OpAssignLShift = "<<="
+showAssignOp OpAssignSpRShift = ">>="
+showAssignOp OpAssignZfRShift = ">>>="
+showAssignOp OpAssignBAnd = "&="
+showAssignOp OpAssignBXor = "^="
+showAssignOp OpAssignBOr = "|="
+
+instance PrettyPrintable AssignOp where
+  pp = text.showAssignOp
+
+--}}}
+
+--{{{ expressions
+
+-- Based on:
+--   http://developer.mozilla.org/en/docs/Core_JavaScript_1.5_Guide:Literals
+jsEscape:: String -> String
+jsEscape str =
+  if str == ""  then "" else (sel (head str)) ++ (jsEscape (tail str)) where
+    sel '\b' = "\\b"
+    sel '\f' = "\\f"
+    sel '\n' = "\\n"
+    sel '\r' = "\\r"
+    sel '\t' = "\\t"
+    sel '\v' = "\\v"
+    sel '\'' = "\\'"
+    sel '\"' = "\\\""
+    sel x    = [x]
+    -- We don't have to do anything about \X, \x and \u escape sequences.
+
+  
+instance PrettyPrintable (Expression a) where
+  pp (StringLit _ str) = doubleQuotes (text (jsEscape str))
+  pp (RegexpLit _ re global ci) =
+    text "/" <> text re <> text "/" <> g <> i where
+      g = if global then text "g" else empty
+      i = if ci then text "i" else empty
+  pp (NumLit _ n) =  text (show n)
+  pp (BoolLit _ True) = text "true"
+  pp (BoolLit _ False) = text "false"
+  pp (NullLit _) = text "null"
+  pp (ArrayLit _ xs) = 
+    (brackets.commaSep) xs
+  pp (ObjectLit _ xs) = 
+    braces (hsep (punctuate comma (map pp' xs))) where
+      pp' (n,v) = pp n <> colon <+> pp v
+  pp (ThisRef _) = text "this"
+  pp (VarRef _ id) = pp id
+  pp (DotRef _ expr id) =
+    pp expr <> text "." <> pp id
+  pp (BracketRef _ container key) =
+    pp container <> brackets (pp key)
+  pp (NewExpr _ constr args) =
+    text "new" <+> pp constr <> (parens.commaSep) args
+  pp (PrefixExpr _ op expr) =
+    pp op <+> pp expr
+  pp (PostfixExpr _ op expr) =
+    pp expr <+> pp op
+  pp (InfixExpr _ op left right) = 
+    pp left <+> pp op <+> pp right
+  pp (CondExpr _ test cons alt) =
+    inParens test <+> text "?" <+> inParens cons <+> colon <+> inParens alt
+  pp (AssignExpr _ op l r) =
+    pp l <+> pp op <+> pp r
+  pp (ParenExpr _ expr) =
+    parens (pp expr)
+  pp (ListExpr _ exprs) = commaSep exprs
+  pp (CallExpr _ f args) =
+    pp f <> (parens.commaSep) args
+  pp (FuncExpr _ args body) =
+    text "function" <+> (parens.commaSep) args $$ inBlock body
+
+instance PrettyPrintable (JavaScript a) where
+  pp (Script _ stmts) =
+    vcat (map pp stmts)
+
+--}}}
+
diff --git a/src/WebBits/JavaScript/Syntax.hs b/src/WebBits/JavaScript/Syntax.hs
new file mode 100644
--- /dev/null
+++ b/src/WebBits/JavaScript/Syntax.hs
@@ -0,0 +1,117 @@
+-- |JavaScript's syntax.
+module WebBits.JavaScript.Syntax(Expression(..),CaseClause(..),Statement(..),
+         InfixOp(..),CatchClause(..),VarDecl(..),JavaScript(..),
+         AssignOp(..),Id(..),PrefixOp(..),PostfixOp(..),Prop(..),
+         ForInit(..),ForInInit(..)) where
+
+import Text.ParserCombinators.Parsec(SourcePos) -- used by data JavaScript
+import Data.Generics(Data,Typeable)
+
+data JavaScript a
+  -- |A script in <script> ... </script> tags.  This may seem a little silly,
+  -- but the Flapjax analogue has an inline variant and attribute-inline 
+  -- variant.
+  = Script a [Statement a] 
+  deriving (Show,Data,Typeable,Eq,Ord)
+
+data Id a = Id a String deriving (Show,Eq,Ord,Data,Typeable)
+
+-- http://developer.mozilla.org/en/docs/
+--   Core_JavaScript_1.5_Reference:Operators:Operator_Precedence
+data InfixOp = OpLT | OpLEq | OpGT | OpGEq  | OpIn  | OpInstanceof | OpEq | OpNEq
+             | OpStrictEq | OpStrictNEq | OpLAnd | OpLOr 
+             | OpMul | OpDiv | OpMod  | OpSub | OpLShift | OpSpRShift
+             | OpZfRShift | OpBAnd | OpBXor | OpBOr | OpAdd
+    deriving (Show,Data,Typeable,Eq,Ord,Enum)
+
+data AssignOp = OpAssign | OpAssignAdd | OpAssignSub | OpAssignMul | OpAssignDiv
+  | OpAssignMod | OpAssignLShift | OpAssignSpRShift | OpAssignZfRShift
+  | OpAssignBAnd | OpAssignBXor | OpAssignBOr
+  deriving (Show,Data,Typeable,Eq,Ord)
+
+data PrefixOp = PrefixInc | PrefixDec | PrefixLNot | PrefixBNot | PrefixPlus
+  | PrefixMinus | PrefixTypeof | PrefixVoid | PrefixDelete
+  deriving (Show,Data,Typeable,Eq,Ord)
+  
+data PostfixOp 
+  = PostfixInc | PostfixDec
+  deriving (Show,Data,Typeable,Eq,Ord)
+  
+data Prop a 
+  = PropId a (Id a) | PropString a String | PropNum a Integer
+  deriving (Show,Data,Typeable,Eq,Ord)
+
+data Expression a
+  = StringLit a String
+  | RegexpLit a String Bool {- global? -} Bool {- case-insensitive? -}
+  | NumLit a Double -- pg. 5 of ECMA-262
+  | BoolLit a Bool
+  | NullLit a
+  | ArrayLit a [Expression a]
+  | ObjectLit a [(Prop a, Expression a)]
+  | ThisRef a
+  | VarRef a (Id a)
+  | DotRef a (Expression a) (Id a)
+  | BracketRef a (Expression a) {- container -} (Expression a) {- key -}
+  | NewExpr a (Expression a) {- constructor -} [Expression a]
+  | PostfixExpr a PostfixOp (Expression a)
+  | PrefixExpr a PrefixOp (Expression a)
+  | InfixExpr a InfixOp (Expression a) (Expression a)
+  | CondExpr a (Expression a) (Expression a) (Expression a)
+  | AssignExpr a AssignOp (Expression a) (Expression a)
+  | ParenExpr a (Expression a)
+  | ListExpr a [Expression a]
+  | CallExpr a (Expression a) [Expression a]
+  | FuncExpr a [(Id a)] (Statement a)
+  deriving (Show,Data,Typeable,Eq,Ord)
+
+data CaseClause a 
+  = CaseClause a (Expression a) [Statement a]
+  | CaseDefault a [Statement a]
+  deriving (Show,Data,Typeable,Eq,Ord)
+  
+data CatchClause a 
+  = CatchClause a (Id a) (Statement a) 
+  deriving (Show,Data,Typeable,Eq,Ord)
+
+data VarDecl a 
+  = VarDecl a (Id a) (Maybe (Expression a)) 
+  deriving (Show,Data,Typeable,Eq,Ord)
+  
+data ForInit a
+  = NoInit
+  | VarInit [VarDecl a]
+  | ExprInit (Expression a)
+  deriving (Show,Data,Typeable,Eq,Ord)
+
+data ForInInit a
+ = ForInVar (Id a)
+ | ForInNoVar (Id a)
+ deriving (Show,Data,Typeable,Eq,Ord)
+  
+  
+data Statement a
+  = BlockStmt a [Statement a]
+  | EmptyStmt a
+  | ExprStmt a (Expression a)
+  | IfStmt a (Expression a) (Statement a) (Statement a)
+  | IfSingleStmt a (Expression a) (Statement a)
+  | SwitchStmt a (Expression a) [CaseClause a]
+  | WhileStmt a (Expression a) (Statement a)
+  | DoWhileStmt a (Statement a) (Expression a)
+  | BreakStmt a (Maybe (Id a))
+  | ContinueStmt a (Maybe (Id a))
+  | LabelledStmt a (Id a) (Statement a)
+  | ForInStmt a (ForInInit a) (Expression a) (Statement a)
+  | ForStmt a (ForInit a)        
+              (Maybe (Expression a)) -- increment
+              (Maybe (Expression a)) -- test
+              (Statement a)          -- body
+  | TryStmt a (Statement a) {-body-} [CatchClause a] {-catches-}
+      (Maybe (Statement a)) {-finally-}
+  | ThrowStmt a (Expression a)
+  | ReturnStmt a (Maybe (Expression a))
+  | WithStmt a (Expression a) (Statement a)
+  | VarDeclStmt a [VarDecl a]
+  | FunctionStmt a (Id a) {-name-} [(Id a)] {-args-} (Statement a) {-body-}
+  deriving (Show,Data,Typeable,Eq,Ord)