version 0.1.90.1.9

18 files changed, 406 insertions, 206 deletions

diff --git a/purescript.cabal b/purescript.cabal
index 86e7553..ed7de6e 100644
--- a/purescript.cabal
+++ b/purescript.cabal
@@ -1,5 +1,5 @@
 name: purescript
-version: 0.1.8
+version: 0.1.9
 cabal-version: >=1.8
 build-type: Simple
 license: MIT
@@ -17,17 +17,17 @@ library
     build-depends: base >=4 && <5, syb -any, cmdtheline -any,
                    containers -any, mtl -any, transformers -any, parsec -any,
                    utf8-string -any
-    exposed-modules: Language.PureScript.Optimize
-                     Language.PureScript.Pretty.JS Language.PureScript.CodeGen.JS.AST
-                     Main Language.PureScript Language.PureScript.Declarations
-                     Language.PureScript.Names Language.PureScript.Types
-                     Language.PureScript.Values Language.PureScript.Kinds
-                     Language.PureScript.Pretty Language.PureScript.Pretty.Common
-                     Language.PureScript.Pretty.Values Language.PureScript.Pretty.Types
-                     Language.PureScript.Pretty.Kinds Language.PureScript.CodeGen
-                     Language.PureScript.CodeGen.Externs Language.PureScript.CodeGen.JS
-                     Language.PureScript.CodeGen.Monad Language.PureScript.Parser
-                     Language.PureScript.Parser.Common
+    exposed-modules: Data.Generics.Extras Language.PureScript.Operators
+                     Language.PureScript.Optimize Language.PureScript.Pretty.JS
+                     Language.PureScript.CodeGen.JS.AST Main Language.PureScript
+                     Language.PureScript.Declarations Language.PureScript.Names
+                     Language.PureScript.Types Language.PureScript.Values
+                     Language.PureScript.Kinds Language.PureScript.Pretty
+                     Language.PureScript.Pretty.Common Language.PureScript.Pretty.Values
+                     Language.PureScript.Pretty.Types Language.PureScript.Pretty.Kinds
+                     Language.PureScript.CodeGen Language.PureScript.CodeGen.Externs
+                     Language.PureScript.CodeGen.JS Language.PureScript.CodeGen.Monad
+                     Language.PureScript.Parser Language.PureScript.Parser.Common
                      Language.PureScript.Parser.Declarations
                      Language.PureScript.Parser.Types Language.PureScript.Parser.Values
                      Language.PureScript.Parser.State Language.PureScript.Parser.Kinds
@@ -47,7 +47,7 @@ executable psc
     main-is: Main.hs
     buildable: True
     hs-source-dirs: src
-    other-modules: Language.PureScript.Optimize
+    other-modules:
 
 test-suite tests
     build-depends: base >=4 && <5, syb -any, directory -any,
diff --git a/src/Data/Generics/Extras.hs b/src/Data/Generics/Extras.hs
new file mode 100644
index 0000000..89d05f0
--- /dev/null
+++ b/src/Data/Generics/Extras.hs
@@ -0,0 +1,24 @@
+-----------------------------------------------------------------------------
+--
+-- Module      :  Data.Generics.Extras
+-- Copyright   :  (c) Phil Freeman 2013
+-- License     :  MIT
+--
+-- Maintainer  :  Phil Freeman <paf31@cantab.net>
+-- Stability   :  experimental
+-- Portability :
+--
+-- |
+--
+-----------------------------------------------------------------------------
+
+{-# LANGUAGE Rank2Types #-}
+
+module Data.Generics.Extras where
+
+import Data.Data
+
+everywhereM' :: (Monad m, Data d) => (forall d. (Data d) => d -> m d) -> d -> m d
+everywhereM' f x = do
+  y <- f x
+  gmapM (everywhereM' f) y
diff --git a/src/Language/PureScript.hs b/src/Language/PureScript.hs
index 1542f7b..df229aa 100644
--- a/src/Language/PureScript.hs
+++ b/src/Language/PureScript.hs
@@ -12,7 +12,7 @@
 --
 -----------------------------------------------------------------------------
 
-module Language.PureScript (module P) where
+module Language.PureScript (module P, compile) where
 
 import Language.PureScript.Values as P
 import Language.PureScript.Types as P
@@ -24,6 +24,15 @@ import Language.PureScript.CodeGen as P
 import Language.PureScript.TypeChecker as P
 import Language.PureScript.Pretty as P
 import Language.PureScript.Optimize as P
+import Language.PureScript.Operators as P
 
+import Data.List (intercalate)
+import Data.Maybe (mapMaybe)
 
-
+compile :: [Declaration] -> Either String (String, String, Environment)
+compile decls = do
+  bracketted <- rebracket decls
+  (_, env) <- check (typeCheckAll bracketted)
+  let js = prettyPrintJS . map optimize . concat . mapMaybe (declToJs Nothing global) $ bracketted
+  let exts = intercalate "\n" . mapMaybe (externToPs 0 global env) $ bracketted
+  return (js, exts, env)
diff --git a/src/Language/PureScript/CodeGen/JS.hs b/src/Language/PureScript/CodeGen/JS.hs
index 6fa5be8..f13bc29 100644
--- a/src/Language/PureScript/CodeGen/JS.hs
+++ b/src/Language/PureScript/CodeGen/JS.hs
@@ -36,10 +36,10 @@ import Language.PureScript.CodeGen.JS.AST as AST
 declToJs :: Maybe Ident -> ModulePath -> Declaration -> Maybe [JS]
 declToJs mod mp (ValueDeclaration ident (Abs args ret)) =
   Just $ JSFunction (Just ident) args (JSBlock [JSReturn (valueToJs mp ret)]) :
-         maybe [] (return . setProperty (show ident) (JSVar ident)) mod
+         maybe [] (return . setProperty (identToJs ident) (JSVar ident)) mod
 declToJs mod mp (ValueDeclaration ident val) =
   Just $ JSVariableIntroduction ident (Just (valueToJs mp val)) :
-         maybe [] (return . setProperty (show ident) (JSVar ident)) mod
+         maybe [] (return . setProperty (identToJs ident) (JSVar ident)) mod
 declToJs mod _ (ExternMemberDeclaration member ident _) =
   Just $ JSFunction (Just ident) [Ident "value"] (JSBlock [JSReturn (JSAccessor member (JSVar (Ident "value")))]) :
          maybe [] (return . setProperty (show ident) (JSVar ident)) mod
diff --git a/src/Language/PureScript/Operators.hs b/src/Language/PureScript/Operators.hs
new file mode 100644
index 0000000..f957315
--- /dev/null
+++ b/src/Language/PureScript/Operators.hs
@@ -0,0 +1,129 @@
+-----------------------------------------------------------------------------
+--
+-- Module      :  Language.PureScript.Operators
+-- Copyright   :  (c) Phil Freeman 2013
+-- License     :  MIT
+--
+-- Maintainer  :  Phil Freeman <paf31@cantab.net>
+-- Stability   :  experimental
+-- Portability :
+--
+-- |
+--
+-----------------------------------------------------------------------------
+
+{-# LANGUAGE Rank2Types #-}
+
+module Language.PureScript.Operators (
+  rebracket
+) where
+
+import Language.PureScript.Names
+import Language.PureScript.Declarations
+import Language.PureScript.Values
+
+import qualified Data.Data as D
+import Data.Function (on)
+import Data.List (groupBy, sortBy)
+import qualified Data.Map as M
+import qualified Data.Generics as G
+import qualified Data.Generics.Extras as G
+import Control.Monad.State
+import Control.Applicative
+import qualified Text.Parsec as P
+import qualified Text.Parsec.Pos as P
+import qualified Text.Parsec.Expr as P
+
+rebracket :: [Declaration] -> Either String [Declaration]
+rebracket ds = do
+  m <- collectFixities ds
+  let opTable = customOperatorTable m
+  ds' <- G.everywhereM' (G.mkM (matchOperators opTable)) ds
+  return $ G.everywhere (G.mkT removeParens) ds'
+
+removeParens :: Value -> Value
+removeParens (Parens val) = val
+removeParens val = val
+
+customOperatorTable :: M.Map (Qualified Ident) Fixity -> [[(Qualified Ident, Value -> Value -> Value, Associativity)]]
+customOperatorTable fixities =
+  let
+    applyUserOp name t1 t2 = App (App (Var name) [t1]) [t2]
+    userOps = map (\(name, Fixity a p) -> (name, applyUserOp name, p, a)) . M.toList $ fixities
+    sorted = sortBy (compare `on` (\(_, _, p, _) -> p)) (userOps ++ builtIns)
+    groups = groupBy ((==) `on` (\(_, _, p, _) -> p)) sorted
+  in
+    map (map (\(name, f, _, a) -> (name, f, a))) groups
+
+type Chain = [Either Value (Qualified Ident)]
+
+matchOperators :: [[(Qualified Ident, Value -> Value -> Value, Associativity)]] -> Value -> Either String Value
+matchOperators ops val = G.everywhereM' (G.mkM parseChains) val
+  where
+  parseChains :: Value -> Either String Value
+  parseChains b@(BinaryNoParens _ _ _) = bracketChain (extendChain b)
+  parseChains val = return val
+  extendChain :: Value -> Chain
+  extendChain (BinaryNoParens name l r) = Left l : Right name : extendChain r
+  extendChain val = [Left val]
+  bracketChain :: Chain -> Either String Value
+  bracketChain = either (Left . show) Right . P.parse (P.buildExpressionParser opTable parseValue <* P.eof) "operator expression"
+  opTable = map (map (\(name, f, a) -> P.Infix (P.try (matchOp name) >> return f) (toAssoc a))) ops
+    ++ [[P.Infix (P.try (parseOp >>= \ident -> return (\t1 t2 -> App (App (Var ident) [t1]) [t2]))) P.AssocLeft]]
+
+toAssoc :: Associativity -> P.Assoc
+toAssoc Infixl = P.AssocLeft
+toAssoc Infixr = P.AssocRight
+
+parseValue :: P.Parsec Chain () Value
+parseValue = P.token show (const (P.initialPos "")) (either Just (const Nothing)) P.<?> "expression"
+
+parseOp :: P.Parsec Chain () (Qualified Ident)
+parseOp = P.token show (const (P.initialPos "")) (either (const Nothing) Just) P.<?> "operator"
+
+matchOp :: Qualified Ident -> P.Parsec Chain () ()
+matchOp op = do
+  ident <- parseOp
+  guard (ident == op)
+
+collectFixities :: [Declaration] -> Either String (M.Map (Qualified Ident) Fixity)
+collectFixities = go M.empty global
+  where
+  go :: M.Map (Qualified Ident) Fixity -> ModulePath -> [Declaration] -> Either String (M.Map (Qualified Ident) Fixity)
+  go m _ [] = return m
+  go m p (FixityDeclaration fixity name : rest) = do
+    let qual = Qualified p (Op name)
+    when (qual `M.member` m) (Left $ "redefined fixity for " ++ show name)
+    go (M.insert qual fixity m) p rest
+  go m p (ModuleDeclaration name decls : rest) = do
+    m' <- go m (subModule p name) decls
+    go m' p rest
+  go m p (_:ds) = go m p ds
+
+globalOp :: String -> Qualified Ident
+globalOp = Qualified global . Op
+
+builtIns :: [(Qualified Ident, Value -> Value -> Value, Precedence, Associativity)]
+builtIns = [ (globalOp "<", Binary LessThan, 3, Infixl)
+           , (globalOp "<=", Binary LessThanOrEqualTo, 3, Infixl)
+           , (globalOp ">", Binary GreaterThan, 3, Infixl)
+           , (globalOp ">=", Binary GreaterThanOrEqualTo, 3, Infixl)
+           , (globalOp "!!", flip Indexer, 4, Infixl)
+           , (globalOp "*", Binary Multiply, 5, Infixl)
+           , (globalOp "/", Binary Divide, 5, Infixl)
+           , (globalOp "%", Binary Modulus, 5, Infixl)
+           , (globalOp "++", Binary Concat, 6, Infixr)
+           , (globalOp "+", Binary Add, 7, Infixl)
+           , (globalOp "-", Binary Subtract, 7, Infixl)
+           , (globalOp "<<", Binary ShiftLeft, 8, Infixl)
+           , (globalOp ">>", Binary ShiftRight, 8, Infixl)
+           , (globalOp ">>>", Binary ZeroFillShiftRight, 8, Infixl)
+           , (globalOp "==", Binary EqualTo, 9, Infixl)
+           , (globalOp "!=", Binary NotEqualTo, 9, Infixl)
+           , (globalOp "&", Binary BitwiseAnd, 10, Infixl)
+           , (globalOp "^", Binary BitwiseXor, 10, Infixl)
+           , (globalOp "|", Binary BitwiseOr, 10, Infixl)
+           , (globalOp "&&", Binary And, 11, Infixr)
+           , (globalOp "||", Binary Or, 11, Infixr)
+           ]
+
diff --git a/src/Language/PureScript/Parser/Common.hs b/src/Language/PureScript/Parser/Common.hs
index fc359d3..2bfda2b 100644
--- a/src/Language/PureScript/Parser/Common.hs
+++ b/src/Language/PureScript/Parser/Common.hs
@@ -75,9 +75,12 @@ reservedNames = [ "case"
                 , "infixr"
                 , "module" ]
 
+builtInOperators :: [String]
+builtInOperators = [ "~", "-", "<=", ">=", "<", ">", "*", "/", "%", "++", "+", "<<", ">>>", ">>"
+                  , "==", "!=", "&&", "||", "&", "^", "|", "!!", "!" ]
+
 reservedOpNames :: [String]
-reservedOpNames = [ "!", "~", "-", "<=", ">=", "<", ">", "*", "/", "%", "++", "+", "<<", ">>>", ">>"
-                  , "==", "!=", "&", "^", "|", "&&", "||", "->", "!" ]
+reservedOpNames = builtInOperators ++ [ "->" ]
 
 identStart :: P.Parsec String u Char
 identStart = P.lower <|> P.oneOf "_$"
@@ -89,7 +92,7 @@ identLetter :: P.Parsec String u Char
 identLetter = P.alphaNum <|> P.oneOf "_'"
 
 opStart :: P.Parsec String u Char
-opStart = P.oneOf "!#$%&*+/<=>?@^|-~"
+opStart = P.oneOf "!#$%&*+/<=>?@^|~"
 
 opLetter :: P.Parsec String u Char
 opLetter = P.oneOf ":#$%&*+./<=>?@^|"
@@ -161,11 +164,14 @@ fold first more combine = do
 buildPostfixParser :: P.Stream s m t => [P.ParsecT s u m (a -> a)] -> P.ParsecT s u m a -> P.ParsecT s u m a
 buildPostfixParser f x = fold x (P.choice f) (flip ($))
 
+operatorOrBuiltIn :: P.Parsec String u String
+operatorOrBuiltIn = P.try operator <|> P.choice (map (\s -> P.try (reservedOp s) >> return s) builtInOperators)
+
 parseIdent :: P.Parsec String u Ident
-parseIdent = (Ident <$> identifier) <|> (Op <$> parens operator)
+parseIdent = (Ident <$> identifier) <|> (Op <$> parens operatorOrBuiltIn)
 
-parseIdentInfix :: P.Parsec String u Ident
-parseIdentInfix = (Ident <$> P.between tick tick identifier) <|> (Op <$> operator)
+parseIdentInfix :: P.Parsec String ParseState (Qualified Ident)
+parseIdentInfix = (P.between tick tick (parseQualified (Ident <$> identifier))) <|> parseQualified (Op <$> operatorOrBuiltIn)
 
 mark :: P.Parsec String ParseState a -> P.Parsec String ParseState a
 mark p = do
@@ -189,4 +195,4 @@ same :: P.Parsec String ParseState ()
 same = checkIndentation (==) P.<?> "no indentation"
 
 runIndentParser :: P.Parsec String ParseState a -> String -> Either P.ParseError a
-runIndentParser p = P.runParser p (ParseState 0 M.empty) ""
+runIndentParser p = P.runParser p (ParseState 0) ""
diff --git a/src/Language/PureScript/Parser/Declarations.hs b/src/Language/PureScript/Parser/Declarations.hs
index 7933cef..a0a28ca 100644
--- a/src/Language/PureScript/Parser/Declarations.hs
+++ b/src/Language/PureScript/Parser/Declarations.hs
@@ -85,9 +85,6 @@ parseFixityDeclaration = do
   fixity <- parseFixity
   indented
   name <- operator
-  current <- fixities <$> P.getState
-  when (name `M.member` current) (P.unexpected $ "redefined fixity for " ++ show name)
-  P.modifyState $ \st -> st { fixities = M.insert name fixity current }
   return $ FixityDeclaration fixity name
 
 parseModuleDeclaration :: P.Parsec String ParseState Declaration
diff --git a/src/Language/PureScript/Parser/State.hs b/src/Language/PureScript/Parser/State.hs
index 98cf531..94cf567 100644
--- a/src/Language/PureScript/Parser/State.hs
+++ b/src/Language/PureScript/Parser/State.hs
@@ -21,7 +21,6 @@ import qualified Text.Parsec as P
 import qualified Data.Map as M
 
 data ParseState = ParseState
-  { indentationLevel :: P.Column
-  , fixities :: M.Map String Fixity } deriving Show
+  { indentationLevel :: P.Column } deriving Show
 
 
diff --git a/src/Language/PureScript/Parser/Values.hs b/src/Language/PureScript/Parser/Values.hs
index 4570edf..6efb254 100644
--- a/src/Language/PureScript/Parser/Values.hs
+++ b/src/Language/PureScript/Parser/Values.hs
@@ -117,7 +117,7 @@ parseValueAtom = C.indented *> P.choice
             , parseBlock
             , parseCase
             , parseIfThenElse
-            , C.parens parseValue ]
+            , Parens <$> C.parens parseValue ]
 
 parsePropertyUpdate :: P.Parsec String ParseState (String, Value)
 parsePropertyUpdate = do
@@ -127,9 +127,8 @@ parsePropertyUpdate = do
   return (name, value)
 
 parseValue :: P.Parsec String ParseState Value
-parseValue = do
-  customOps <- fixities <$> P.getState
-  (buildExpressionParser (operators customOps)
+parseValue =
+  (buildExpressionParser operators
    . C.buildPostfixParser postfixTable2
    $ indexersAndAccessors) P.<?> "expression"
   where
@@ -139,55 +138,14 @@ parseValue = do
   postfixTable2 = [ P.try (C.indented *> indexersAndAccessors >>= \t2 -> return (\t1 -> App t1 [t2]))
                   , P.try $ flip App <$> (C.indented *> C.parens (parseValue `P.sepBy` (C.indented *> C.comma)))
                   , flip TypedValue <$> (P.try (C.lexeme (C.indented *> P.string "::")) *> parsePolyType) ]
-  operators user =
-              [ [ Prefix $ C.lexeme (P.try $ C.indented *> C.reservedOp "!") >> return (Unary Not)
+  operators = [ [ Prefix $ C.lexeme (P.try $ C.indented *> C.reservedOp "!") >> return (Unary Not)
                 , Prefix $ C.lexeme (P.try $ C.indented *> C.reservedOp "~") >> return (Unary BitwiseNot)
                 , Prefix $ C.lexeme (P.try $ C.indented *> C.reservedOp "-") >> return (Unary Negate)
                 , Prefix $ C.lexeme (P.try $ C.indented *> C.reservedOp "+") >> return id ]
-              ] ++ customOperatorTable user ++
-              [ [ Infix (C.lexeme (P.try (C.indented *> C.parseQualified C.parseIdentInfix P.<?> "operator") >>= \ident -> return $ \t1 t2 -> App (App (Var ident) [t1]) [t2])) AssocLeft ]
-              , [ Infix (C.lexeme (P.try $ C.indented *> C.reservedOp "!!") >> return (flip Indexer)) AssocRight ]
-              , [ Infix (C.lexeme (P.try $ C.indented *> C.reservedOp "<=") >> return (Binary LessThanOrEqualTo)) AssocRight
-                , Infix (C.lexeme (P.try $ C.indented *> C.reservedOp ">=") >> return (Binary GreaterThanOrEqualTo)) AssocRight ]
-              , [ Infix (C.lexeme (P.try $ C.indented *> C.reservedOp "<") >> return (Binary LessThan)) AssocRight
-                , Infix (C.lexeme (P.try $ C.indented *> C.reservedOp ">") >> return (Binary GreaterThan)) AssocRight ]
-              , [ Infix (C.lexeme (P.try $ C.indented *> C.reservedOp "*") >> return (Binary Multiply)) AssocRight
-                , Infix (C.lexeme (P.try $ C.indented *> C.reservedOp "/") >> return (Binary Divide)) AssocRight
-                , Infix (C.lexeme (P.try $ C.indented *> C.reservedOp "%") >> return (Binary Modulus)) AssocRight ]
-              , [ Infix (C.lexeme (P.try $ C.indented *> C.reservedOp "++") >> return (Binary Concat)) AssocRight
-                , Infix (C.lexeme (P.try $ C.indented *> C.reservedOp "+") >> return (Binary Add)) AssocRight
-                , Infix (C.lexeme (P.try $ C.indented *> C.reservedOp "-") >> return (Binary Subtract)) AssocRight ]
-              , [ Infix (C.lexeme (P.try $ C.indented *> C.reservedOp "<<") >> return (Binary ShiftLeft)) AssocRight
-                , Infix (C.lexeme (P.try $ C.indented *> C.reservedOp ">>>") >> return (Binary ZeroFillShiftRight)) AssocRight
-                , Infix (C.lexeme (P.try $ C.indented *> C.reservedOp ">>") >> return (Binary ShiftRight)) AssocRight ]
-              , [ Infix (C.lexeme (P.try $ C.indented *> C.reservedOp "==") >> return (Binary EqualTo)) AssocRight
-                , Infix (C.lexeme (P.try $ C.indented *> C.reservedOp "!=") >> return (Binary NotEqualTo)) AssocRight ]
-              , [ Infix (C.lexeme (P.try $ C.indented *> C.reservedOp "&") >> return (Binary BitwiseAnd)) AssocRight ]
-              , [ Infix (C.lexeme (P.try $ C.indented *> C.reservedOp "^") >> return (Binary BitwiseXor)) AssocRight ]
-              , [ Infix (C.lexeme (P.try $ C.indented *> C.reservedOp "|") >> return (Binary BitwiseOr)) AssocRight ]
-              , [ Infix (C.lexeme (P.try $ C.indented *> C.reservedOp "&&") >> return (Binary And)) AssocRight ]
-              , [ Infix (C.lexeme (P.try $ C.indented *> C.reservedOp "||") >> return (Binary Or)) AssocRight ]
+              , [ Infix (C.lexeme (P.try (C.indented *> C.parseIdentInfix P.<?> "operator") >>= \ident ->
+                    return (BinaryNoParens ident))) AssocRight ]
               ]
 
-customOperatorTable :: M.Map String Fixity -> OperatorTable String ParseState Identity Value
-customOperatorTable fixities =
-  let
-    ops = map (\(name, Fixity a p) -> (name, (a, p))) . M.toList $ fixities
-    sorted = sortBy (compare `on` (snd . snd)) ops
-    levels = groupBy ((==) `on` (snd . snd)) sorted
-  in
-    map (map $ \(name, (a, _)) ->
-      flip Infix (toAssoc a) $
-        C.lexeme $ P.try $ do
-          C.indented
-          C.reservedOp name P.<?> "operator"
-          return $ \t1 t2 -> App (App (Var (Qualified global (Op name))) [t1]) [t2])
-      levels
-
-toAssoc :: Associativity -> Assoc
-toAssoc Infixl = AssocLeft
-toAssoc Infixr = AssocRight
-
 parseVariableIntroduction :: P.Parsec String ParseState Statement
 parseVariableIntroduction = do
   C.reserved "var"
diff --git a/src/Language/PureScript/Pretty/Common.hs b/src/Language/PureScript/Pretty/Common.hs
index f480006..602e5b6 100644
--- a/src/Language/PureScript/Pretty/Common.hs
+++ b/src/Language/PureScript/Pretty/Common.hs
@@ -39,38 +39,44 @@ identToJs (Op op) = concatMap opCharToString op
   opCharToString :: Char -> String
   opCharToString = (:) '$'. show . ord
 
-newtype Pattern a b = Pattern { runPattern :: A.Kleisli Maybe a b } deriving (C.Category, A.Arrow, A.ArrowZero, A.ArrowPlus)
+newtype Pattern u a b = Pattern { runPattern :: A.Kleisli (StateT u Maybe) a b } deriving (C.Category, A.Arrow, A.ArrowZero, A.ArrowPlus)
 
-instance Functor (Pattern a) where
+instance Functor (Pattern u a) where
   fmap f (Pattern p) = Pattern $ A.Kleisli $ fmap f . A.runKleisli p
 
-pattern :: Pattern a b -> a -> Maybe b
-pattern = A.runKleisli . runPattern
+pattern :: Pattern u a b -> u -> a -> Maybe b
+pattern p u = flip evalStateT u . A.runKleisli (runPattern p)
+
+mkPattern :: (a -> Maybe b) -> Pattern u a b
+mkPattern f = Pattern $ A.Kleisli (lift . f)
+
+mkPattern' :: (a -> StateT u Maybe b) -> Pattern u a b
+mkPattern' = Pattern . A.Kleisli
 
 parens :: String -> String
 parens s = ('(':s) ++ ")"
 
-chainl :: Pattern a (a, a) -> (r -> r -> r) -> Pattern a r -> Pattern a r
+chainl :: Pattern u a (a, a) -> (r -> r -> r) -> Pattern u a r -> Pattern u a r
 chainl split f p = fix $ \c -> split >>> ((c <+> p) *** p) >>> A.arr (uncurry f)
 
-chainr :: Pattern a (a, a) -> (r -> r -> r) -> Pattern a r -> Pattern a r
+chainr :: Pattern u a (a, a) -> (r -> r -> r) -> Pattern u a r -> Pattern u a r
 chainr split f p = fix $ \c -> split >>> (p *** (c <+> p)) >>> A.arr (uncurry f)
 
-wrap :: Pattern a (s, a) -> (s -> r -> r) -> Pattern a r -> Pattern a r
+wrap :: Pattern u a (s, a) -> (s -> r -> r) -> Pattern u a r -> Pattern u a r
 wrap split f p = fix $ \c -> split >>> (C.id *** (c <+> p)) >>> A.arr (uncurry f)
 
-split :: Pattern a (s, t) -> (s -> t -> r) -> Pattern a r -> Pattern a r
+split :: Pattern u a (s, t) -> (s -> t -> r) -> Pattern u a r -> Pattern u a r
 split s f p = s >>> A.arr (uncurry f)
 
-data OperatorTable a r = OperatorTable { runOperatorTable :: [ [Operator a r] ] }
+data OperatorTable u a r = OperatorTable { runOperatorTable :: [ [Operator u a r] ] }
 
-data Operator a r where
-  AssocL :: Pattern a (a, a) -> (r -> r -> r) -> Operator a r
-  AssocR :: Pattern a (a, a) -> (r -> r -> r) -> Operator a r
-  Wrap   :: Pattern a (s, a) -> (s -> r -> r) -> Operator a r
-  Split  :: Pattern a (s, t) -> (s -> t -> r) -> Operator a r
+data Operator u a r where
+  AssocL :: Pattern u a (a, a) -> (r -> r -> r) -> Operator u a r
+  AssocR :: Pattern u a (a, a) -> (r -> r -> r) -> Operator u a r
+  Wrap   :: Pattern u a (s, a) -> (s -> r -> r) -> Operator u a r
+  Split  :: Pattern u a (s, t) -> (s -> t -> r) -> Operator u a r
 
-buildPrettyPrinter :: OperatorTable a r -> Pattern a r -> Pattern a r
+buildPrettyPrinter :: OperatorTable u a r -> Pattern u a r -> Pattern u a r
 buildPrettyPrinter table p = foldl (\p' ops -> foldl1 (<+>) (flip map ops $ \op ->
   case op of
     AssocL pat g -> chainl pat g p'
diff --git a/src/Language/PureScript/Pretty/JS.hs b/src/Language/PureScript/Pretty/JS.hs
index e449a25..5d33ab1 100644
--- a/src/Language/PureScript/Pretty/JS.hs
+++ b/src/Language/PureScript/Pretty/JS.hs
@@ -25,94 +25,171 @@ import Data.List
 import Data.Maybe (fromMaybe)
 import qualified Control.Arrow as A
 import Control.Arrow ((***), (<+>), first, second)
+import Control.Applicative
+import Control.Monad.State
 
-literals :: Pattern JS String
-literals = Pattern $ A.Kleisli match
+newtype PrinterState = PrinterState { indent :: Int } deriving (Show, Eq, Ord)
+
+blockIndent :: Int
+blockIndent = 4
+
+withIndent :: StateT PrinterState Maybe String -> StateT PrinterState Maybe String
+withIndent s = do
+  current <- get
+  modify $ \s -> s { indent = indent s + blockIndent }
+  result <- s
+  modify $ \s -> s { indent = indent s - blockIndent }
+  return result
+
+currentIndent :: StateT PrinterState Maybe String
+currentIndent = do
+  current <- get
+  return $ replicate (indent current) ' '
+
+literals :: Pattern PrinterState JS String
+literals = mkPattern' match
   where
-  match (JSNumericLiteral n) = Just $ either show show n
-  match (JSStringLiteral s) = Just $ show s
-  match (JSBooleanLiteral True) = Just "true"
-  match (JSBooleanLiteral False) = Just "false"
-  match (JSArrayLiteral xs) = Just $ "[" ++ intercalate ", " (map prettyPrintJS xs) ++ "]"
-  match (JSObjectLiteral ps) = Just $ "{ " ++ intercalate ", " (map (\(key, value) -> key ++ ": " ++ prettyPrintJS value) ps) ++ " }"
-  match (JSBlock sts) = Just $ "{ " ++ intercalate "; " (map prettyPrintJS sts) ++ " }"
-  match (JSVar ident) = Just (identToJs ident)
-  match (JSVariableIntroduction ident value) = Just $ "var " ++ identToJs ident ++ maybe "" ((" = " ++) . prettyPrintJS) value
-  match (JSAssignment target value) = Just $ targetToJs target ++ " = " ++ prettyPrintJS value
-  match (JSWhile cond sts) = Just $ "while ("
-    ++ prettyPrintJS cond ++ ") "
-    ++ prettyPrintJS sts
-  match (JSFor ident start end sts) = Just $ "for ("
-    ++ identToJs ident ++ " = " ++ prettyPrintJS start ++ "; "
-    ++ identToJs ident ++ " < " ++ prettyPrintJS end ++ "; "
-    ++ identToJs ident ++ "++) "
-    ++ prettyPrintJS sts
-  match (JSIfElse cond thens elses) = Just $ "if ("
-    ++ prettyPrintJS cond ++ ") "
-    ++ prettyPrintJS thens
-    ++ maybe "" ((" else " ++) . prettyPrintJS) elses
-  match (JSReturn value) = Just $ "return " ++ prettyPrintJS value
-  match (JSThrow value) = Just $ "throw " ++ prettyPrintJS value
-  match _ = Nothing
+  match :: JS -> StateT PrinterState Maybe String
+  match (JSNumericLiteral n) = return $ either show show n
+  match (JSStringLiteral s) = return $ show s
+  match (JSBooleanLiteral True) = return "true"
+  match (JSBooleanLiteral False) = return "false"
+  match (JSArrayLiteral xs) = fmap concat $ sequence
+    [ return "[ "
+    , fmap (intercalate ", ") $ forM xs prettyPrintJS'
+    , return " ]"
+    ]
+  match (JSObjectLiteral ps) = fmap concat $ sequence
+    [ return "{\n"
+    , withIndent $ do
+        jss <- forM ps $ \(key, value) -> fmap ((key ++ ": ") ++) . prettyPrintJS' $ value
+        indentString <- currentIndent
+        return $ intercalate ", \n" $ map (indentString ++) jss
+    , return "\n"
+    , currentIndent
+    , return "}"
+    ]
+  match (JSBlock sts) = fmap concat $ sequence
+    [ return "{\n"
+    , withIndent $ do
+        jss <- forM sts prettyPrintJS'
+        indentString <- currentIndent
+        return $ intercalate "\n" $ map (++ "; ") $ map (indentString ++) jss
+    , return "\n"
+    , currentIndent
+    , return "}"
+    ]
+  match (JSVar ident) = return (identToJs ident)
+  match (JSVariableIntroduction ident value) = fmap concat $ sequence
+    [ return "var "
+    , return $ identToJs ident
+    , maybe (return "") (fmap (" = " ++) . prettyPrintJS') value
+    ]
+  match (JSAssignment target value) = fmap concat $ sequence
+    [ return $ targetToJs target
+    , return " = "
+    , prettyPrintJS' value
+    ]
+  match (JSWhile cond sts) = fmap concat $ sequence
+    [ return "while ("
+    , prettyPrintJS' cond
+    , return ") "
+    , prettyPrintJS' sts
+    ]
+  match (JSFor ident start end sts) = fmap concat $ sequence
+    [ return $ "for (" ++ identToJs ident ++ " = "
+    , prettyPrintJS' start
+    , return $ "; " ++ identToJs ident ++ " < "
+    , prettyPrintJS' end
+    , return $ "; " ++ identToJs ident ++ "++) "
+    , prettyPrintJS' sts
+    ]
+  match (JSIfElse cond thens elses) = fmap concat $ sequence
+    [ return "if ("
+    , prettyPrintJS' cond
+    , return ") "
+    , prettyPrintJS' thens
+    , maybe (return "") (fmap (" else " ++) . prettyPrintJS') elses
+    ]
+  match (JSReturn value) = fmap concat $ sequence
+    [ return "return "
+    , prettyPrintJS' value
+    ]
+  match (JSThrow value) = fmap concat $ sequence
+    [ return "throw "
+    , prettyPrintJS' value
+    ]
+  match _ = mzero
 
 targetToJs :: JSAssignment -> String
 targetToJs (JSAssignVariable ident) = identToJs ident
 targetToJs (JSAssignProperty prop target) = targetToJs target ++ "." ++ prop
 
-conditional :: Pattern JS ((JS, JS), JS)
-conditional = Pattern $ A.Kleisli match
+conditional :: Pattern PrinterState JS ((JS, JS), JS)
+conditional = mkPattern match
   where
   match (JSConditional cond th el) = Just ((th, el), cond)
   match _ = Nothing
 
-accessor :: Pattern JS (String, JS)
-accessor = Pattern $ A.Kleisli match
+accessor :: Pattern PrinterState JS (String, JS)
+accessor = mkPattern match
   where
   match (JSAccessor prop val) = Just (prop, val)
   match _ = Nothing
 
-indexer :: Pattern JS (String, JS)
-indexer = Pattern $ A.Kleisli match
+indexer :: Pattern PrinterState JS (String, JS)
+indexer = mkPattern' match
   where
-  match (JSIndexer index val) = Just (prettyPrintJS index, val)
-  match _ = Nothing
+  match (JSIndexer index val) = (,) <$> prettyPrintJS' index <*> pure val
+  match _ = mzero
 
-lam :: Pattern JS ((Maybe Ident, [Ident]), JS)
-lam = Pattern $ A.Kleisli match
+lam :: Pattern PrinterState JS ((Maybe Ident, [Ident]), JS)
+lam = mkPattern match
   where
   match (JSFunction name args ret) = Just ((name, args), ret)
   match _ = Nothing
 
-app :: Pattern JS (String, JS)
-app = Pattern $ A.Kleisli match
+app :: Pattern PrinterState JS (String, JS)
+app = mkPattern' match
   where
-  match (JSApp val args) = Just (intercalate "," (map prettyPrintJS args), val)
-  match _ = Nothing
+  match (JSApp val args) = do
+    jss <- mapM prettyPrintJS' args
+    return (intercalate ", " jss, val)
+  match _ = mzero
 
-unary :: UnaryOperator -> String -> Operator JS String
+unary :: UnaryOperator -> String -> Operator PrinterState JS String
 unary op str = Wrap pattern (++)
   where
-  pattern :: Pattern JS (String, JS)
-  pattern = Pattern $ A.Kleisli match
+  pattern :: Pattern PrinterState JS (String, JS)
+  pattern = mkPattern match
     where
     match (JSUnary op' val) | op' == op = Just (str, val)
     match _ = Nothing
 
-binary :: BinaryOperator -> String -> Operator JS String
+binary :: BinaryOperator -> String -> Operator PrinterState JS String
 binary op str = AssocR pattern (\v1 v2 -> v1 ++ " " ++ str ++ " " ++ v2)
   where
-  pattern :: Pattern JS (JS, JS)
-  pattern = Pattern $ A.Kleisli match
+  pattern :: Pattern PrinterState JS (JS, JS)
+  pattern = mkPattern match
     where
     match (JSBinary op' v1 v2) | op' == op = Just (v1, v2)
     match _ = Nothing
 
-prettyPrintJS :: JS -> String
-prettyPrintJS = fromMaybe (error "Incomplete pattern") . pattern matchValue
+prettyPrintJS1 :: JS -> String
+prettyPrintJS1 = fromMaybe (error "Incomplete pattern") . flip evalStateT (PrinterState 0) . prettyPrintJS'
+
+prettyPrintJS :: [JS] -> String
+prettyPrintJS sts = fromMaybe (error "Incomplete pattern") . flip evalStateT (PrinterState 0) $ do
+  jss <- forM sts prettyPrintJS'
+  indentString <- currentIndent
+  return $ intercalate "\n" $ map (++ "; ") $ map (indentString ++) jss
+
+prettyPrintJS' :: JS -> StateT PrinterState Maybe String
+prettyPrintJS' = A.runKleisli $ runPattern matchValue
   where
-  matchValue :: Pattern JS String
+  matchValue :: Pattern PrinterState JS String
   matchValue = buildPrettyPrinter operators (literals <+> fmap parens matchValue)
-  operators :: OperatorTable JS String
+  operators :: OperatorTable PrinterState JS String
   operators =
     OperatorTable [ [ Wrap accessor $ \prop val -> val ++ "." ++ prop ]
                   , [ Wrap indexer $ \index val -> val ++ "[" ++ index ++ "]" ]
@@ -121,7 +198,7 @@ prettyPrintJS = fromMaybe (error "Incomplete pattern") . pattern matchValue
                         ++ maybe "" identToJs name
                         ++ "(" ++ intercalate ", " (map identToJs args) ++ ") "
                         ++ ret ]
-                  , [ Wrap conditional $ \(th, el) cond -> cond ++ " ? " ++ prettyPrintJS th ++ " : " ++ prettyPrintJS el ]
+                  , [ Wrap conditional $ \(th, el) cond -> cond ++ " ? " ++ prettyPrintJS1 th ++ " : " ++ prettyPrintJS1 el ]
                   , [ binary    LessThan             "<" ]
                   , [ binary    LessThanOrEqualTo    "<=" ]
                   , [ binary    GreaterThan          ">" ]
diff --git a/src/Language/PureScript/Pretty/Kinds.hs b/src/Language/PureScript/Pretty/Kinds.hs
index a002a0a..06dfb20 100644
--- a/src/Language/PureScript/Pretty/Kinds.hs
+++ b/src/Language/PureScript/Pretty/Kinds.hs
@@ -26,25 +26,25 @@ import Control.Applicative
 import Language.PureScript.Kinds
 import Language.PureScript.Pretty.Common
 
-typeLiterals :: Pattern Kind String
-typeLiterals = Pattern $ A.Kleisli match
+typeLiterals :: Pattern () Kind String
+typeLiterals = mkPattern match
   where
   match Star = Just "*"
   match Row = Just "#"
   match (KUnknown u) = Just $ 'u' : show u
   match _ = Nothing
 
-funKind :: Pattern Kind (Kind, Kind)
-funKind = Pattern $ A.Kleisli match
+funKind :: Pattern () Kind (Kind, Kind)
+funKind = mkPattern match
   where
   match (FunKind arg ret) = Just (arg, ret)
   match _ = Nothing
 
 prettyPrintKind :: Kind -> String
-prettyPrintKind = fromMaybe (error "Incomplete pattern") . pattern matchKind
+prettyPrintKind = fromMaybe (error "Incomplete pattern") . pattern matchKind ()
   where
-  matchKind :: Pattern Kind String
+  matchKind :: Pattern () Kind String
   matchKind = buildPrettyPrinter operators (typeLiterals <+> fmap parens matchKind)
-  operators :: OperatorTable Kind String
+  operators :: OperatorTable () Kind String
   operators =
     OperatorTable [ [ AssocR funKind $ \arg ret -> arg ++ " -> " ++ ret ] ]
diff --git a/src/Language/PureScript/Pretty/Types.hs b/src/Language/PureScript/Pretty/Types.hs
index 5142416..e987792 100644
--- a/src/Language/PureScript/Pretty/Types.hs
+++ b/src/Language/PureScript/Pretty/Types.hs
@@ -32,8 +32,8 @@ import Language.PureScript.Declarations
 import Language.PureScript.TypeChecker.Monad
 import Language.PureScript.Pretty.Common
 
-typeLiterals :: Pattern Type String
-typeLiterals = Pattern $ A.Kleisli match
+typeLiterals :: Pattern () Type String
+typeLiterals = mkPattern match
   where
   match Number = Just "Number"
   match String = Just "String"
@@ -59,30 +59,30 @@ prettyPrintRow = (\(tys, tail) -> intercalate ", " (map (uncurry nameAndTypeToPs
   toList tys (RCons name ty row) = toList ((name, ty):tys) row
   toList tys r = (tys, r)
 
-typeApp :: Pattern Type (Type, Type)
-typeApp = Pattern $ A.Kleisli match
+typeApp :: Pattern () Type (Type, Type)
+typeApp = mkPattern match
   where
   match (TypeApp f x) = Just (f, x)
   match _ = Nothing
 
-singleArgumentFunction :: Pattern Type (Type, Type)
-singleArgumentFunction = Pattern $ A.Kleisli match
+singleArgumentFunction :: Pattern () Type (Type, Type)
+singleArgumentFunction = mkPattern match
   where
   match (Function [arg] ret) = Just (arg, ret)
   match _ = Nothing
 
-function :: Pattern Type ([Type], Type)
-function = Pattern $ A.Kleisli match
+function :: Pattern () Type ([Type], Type)
+function = mkPattern match
   where
   match (Function args ret) = Just (args, ret)
   match _ = Nothing
 
 prettyPrintType :: Type -> String
-prettyPrintType = fromMaybe (error "Incomplete pattern") . pattern matchType
+prettyPrintType = fromMaybe (error "Incomplete pattern") . pattern matchType ()
   where
-  matchType :: Pattern Type String
+  matchType :: Pattern () Type String
   matchType = buildPrettyPrinter operators (typeLiterals <+> fmap parens matchType)
-  operators :: OperatorTable Type String
+  operators :: OperatorTable () Type String
   operators =
     OperatorTable [ [ AssocL typeApp $ \f x -> f ++ " " ++ x ]
                   , [ AssocR singleArgumentFunction $ \arg ret -> arg ++ " -> " ++ ret
diff --git a/src/Language/PureScript/Pretty/Values.hs b/src/Language/PureScript/Pretty/Values.hs
index eff00eb..06a2f82 100644
--- a/src/Language/PureScript/Pretty/Values.hs
+++ b/src/Language/PureScript/Pretty/Values.hs
@@ -29,8 +29,8 @@ import Language.PureScript.Values
 import Language.PureScript.Names
 import Language.PureScript.Pretty.Common
 
-literals :: Pattern Value String
-literals = Pattern $ A.Kleisli match
+literals :: Pattern () Value String
+literals = mkPattern match
   where
   match (NumericLiteral n) = Just $ either show show n
   match (StringLiteral s) = Just $ show s
@@ -47,66 +47,66 @@ literals = Pattern $ A.Kleisli match
 prettyPrintCaseAlternative :: Binder -> Value -> String
 prettyPrintCaseAlternative binder val = prettyPrintBinder binder ++ " -> " ++ prettyPrintValue val
 
-ifThenElse :: Pattern Value ((Value, Value), Value)
-ifThenElse = Pattern $ A.Kleisli match
+ifThenElse :: Pattern () Value ((Value, Value), Value)
+ifThenElse = mkPattern match
   where
   match (IfThenElse cond th el) = Just ((th, el), cond)
   match _ = Nothing
 
-accessor :: Pattern Value (String, Value)
-accessor = Pattern $ A.Kleisli match
+accessor :: Pattern () Value (String, Value)
+accessor = mkPattern match
   where
   match (Accessor prop val) = Just (prop, val)
   match _ = Nothing
 
-indexer :: Pattern Value (Value, Value)
-indexer = Pattern $ A.Kleisli match
+indexer :: Pattern () Value (Value, Value)
+indexer = mkPattern match
   where
   match (Indexer index val) = Just (index, val)
   match _ = Nothing
 
-objectUpdate :: Pattern Value ([String], Value)
-objectUpdate = Pattern $ A.Kleisli match
+objectUpdate :: Pattern () Value ([String], Value)
+objectUpdate = mkPattern match
   where
   match (ObjectUpdate o ps) = Just (flip map ps $ \(key, val) -> key ++ " = " ++ prettyPrintValue val, o)
   match _ = Nothing
 
-app :: Pattern Value (String, Value)
-app = Pattern $ A.Kleisli match
+app :: Pattern () Value (String, Value)
+app = mkPattern match
   where
   match (App val args) = Just (intercalate "," (map prettyPrintValue args), val)
   match _ = Nothing
 
-lam :: Pattern Value ([String], Value)
-lam = Pattern $ A.Kleisli match
+lam :: Pattern () Value ([String], Value)
+lam = mkPattern match
   where
   match (Abs args val) = Just (map show args, val)
   match _ = Nothing
 
-unary :: UnaryOperator -> String -> Operator Value String
+unary :: UnaryOperator -> String -> Operator () Value String
 unary op str = Wrap pattern (++)
   where
-  pattern :: Pattern Value (String, Value)
-  pattern = Pattern $ A.Kleisli match
+  pattern :: Pattern () Value (String, Value)
+  pattern = mkPattern match
     where
     match (Unary op' val) | op' == op = Just (str, val)
     match _ = Nothing
 
-binary :: BinaryOperator -> String -> Operator Value String
+binary :: BinaryOperator -> String -> Operator () Value String
 binary op str = AssocR pattern (\v1 v2 -> v1 ++ " " ++ str ++ " " ++ v2)
   where
-  pattern :: Pattern Value (Value, Value)
-  pattern = Pattern $ A.Kleisli match
+  pattern :: Pattern () Value (Value, Value)
+  pattern = mkPattern match
     where
     match (Binary op' v1 v2) | op' == op = Just (v1, v2)
     match _ = Nothing
 
 prettyPrintValue :: Value -> String
-prettyPrintValue = fromMaybe (error "Incomplete pattern") . pattern matchValue
+prettyPrintValue = fromMaybe (error "Incomplete pattern") . pattern matchValue ()
   where
-  matchValue :: Pattern Value String
+  matchValue :: Pattern () Value String
   matchValue = buildPrettyPrinter operators (literals <+> fmap parens matchValue)
-  operators :: OperatorTable Value String
+  operators :: OperatorTable () Value String
   operators =
     OperatorTable [ [ Wrap accessor $ \prop val -> val ++ "." ++ prop ]
                   , [ Wrap objectUpdate $ \ps val -> val ++ "{ " ++ intercalate ", " ps ++ " }" ]
diff --git a/src/Language/PureScript/TypeChecker/Synonyms.hs b/src/Language/PureScript/TypeChecker/Synonyms.hs
index 8899fef..0c990b7 100644
--- a/src/Language/PureScript/TypeChecker/Synonyms.hs
+++ b/src/Language/PureScript/TypeChecker/Synonyms.hs
@@ -12,8 +12,6 @@
 --
 -----------------------------------------------------------------------------
 
-{-# LANGUAGE Rank2Types #-}
-
 module Language.PureScript.TypeChecker.Synonyms (
     saturateTypeSynonym,
     saturateAllTypeSynonyms
@@ -26,6 +24,7 @@ import Language.PureScript.Names
 import Data.Maybe (fromMaybe)
 import Data.Data
 import Data.Generics
+import Data.Generics.Extras
 import Control.Arrow
 import Control.Monad.Writer
 import Control.Monad.Error
@@ -40,11 +39,6 @@ buildTypeSubstitution name n = go n []
   go n args (TypeApp f arg) = go (n - 1) (arg:args) f
   go _ _ _ = return Nothing
 
-everywhereM' :: (Monad m, Data d) => (forall d. (Data d) => d -> m d) -> d -> m d
-everywhereM' f x = do
-  y <- f x
-  gmapM (everywhereM' f) y
-
 saturateTypeSynonym :: (Data d) => Qualified ProperName -> Int -> d -> Either String d
 saturateTypeSynonym name n = everywhereM' (mkM replace)
   where
diff --git a/src/Language/PureScript/Values.hs b/src/Language/PureScript/Values.hs
index a486173..402ec1b 100644
--- a/src/Language/PureScript/Values.hs
+++ b/src/Language/PureScript/Values.hs
@@ -54,6 +54,8 @@ data Value
   | BooleanLiteral Bool
   | Unary UnaryOperator Value
   | Binary BinaryOperator Value Value
+  | BinaryNoParens (Qualified Ident) Value Value
+  | Parens Value
   | ArrayLiteral [Value]
   | Indexer Value Value
   | ObjectLiteral [(String, Value)]
diff --git a/src/Main.hs b/src/Main.hs
index 4cdcdfc..adada98 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -14,7 +14,7 @@
 
 module Main where
 
-import Language.PureScript
+import qualified Language.PureScript as P
 import Data.Maybe (mapMaybe)
 import Data.List (intercalate)
 import System.Console.CmdTheLine
@@ -29,24 +29,23 @@ compile :: [FilePath] -> Maybe FilePath -> Maybe FilePath -> IO ()
 compile inputFiles outputFile externsFile = do
   asts <- fmap (fmap concat . sequence) $ forM inputFiles $ \inputFile -> do
     text <- U.readFile inputFile
-    return $ runIndentParser parseDeclarations text
+    return $ P.runIndentParser P.parseDeclarations text
   case asts of
     Left err -> do
       U.print err
       exitFailure
     Right decls ->
-      case check (typeCheckAll decls) of
-        Left typeError -> do
-          U.putStrLn typeError
+      case P.compile decls of
+        Left error -> do
+          U.putStrLn error
           exitFailure
-        Right (_, env) -> do
-          let js = intercalate "; " . map (prettyPrintJS . optimize) . concat . mapMaybe (declToJs Nothing global) $ decls
+        Right (js, exts, _) -> do
           case outputFile of
             Just path -> U.writeFile path js
             Nothing -> U.putStrLn js
           case externsFile of
             Nothing -> return ()
-            Just filePath -> U.writeFile filePath $ intercalate "\n" $ mapMaybe (externToPs 0 global env) decls
+            Just filePath -> U.writeFile filePath exts
           exitSuccess
 
 inputFiles :: Term [FilePath]
diff --git a/tests/Main.hs b/tests/Main.hs
index c81a374..74dfd19 100644
--- a/tests/Main.hs
+++ b/tests/Main.hs
@@ -14,7 +14,7 @@
 
 module Main (main) where
 
-import Language.PureScript
+import qualified Language.PureScript as P
 
 import Data.List (isSuffixOf)
 import Control.Applicative
@@ -25,20 +25,20 @@ import System.Directory (getCurrentDirectory, getDirectoryContents)
 import qualified System.IO.UTF8 as U
 import qualified Data.Map as M
 
-compile :: FilePath -> IO (Either String Environment)
+compile :: FilePath -> IO (Either String P.Environment)
 compile inputFile = do
-  ast <- runIndentParser parseDeclarations <$> U.readFile inputFile
+  ast <- P.runIndentParser P.parseDeclarations <$> U.readFile inputFile
   case ast of
     Left parseError -> do
       return (Left $ show parseError)
     Right decls -> do
-      case check (typeCheckAll decls) of
+      case P.compile decls of
         Left typeError -> do
           return (Left typeError)
-        Right (_, env) -> do
+        Right (_, _, env) -> do
           return (Right env)
 
-assert :: FilePath -> (Either String Environment -> Maybe String) -> IO ()
+assert :: FilePath -> (Either String P.Environment -> Maybe String) -> IO ()
 assert inputFile f = do
   e <- compile inputFile
   case f e of