Make sure that all names in a program are safe for use in JS code

Elm.cabal

@@ -54,6 +54,7 @@ Library
                        Generate.Cases,
                        Transform.Canonicalize,
                        Transform.Check,
+                       Transform.SafeNames,
                        Transform.SortDefinitions,
                        Transform.Substitute,
                        Transform.Optimize,
@@ -132,6 +133,7 @@ Executable elm
                        Generate.Cases,
                        Transform.Canonicalize,
                        Transform.Check,
+                       Transform.SafeNames,
                        Transform.SortDefinitions,
                        Transform.Substitute,
                        Transform.Optimize,

compiler/Generate/JavaScript.hs

@@ -1,4 +1,4 @@
-module Generate.JavaScript where
+module Generate.JavaScript (generate) where
 
 import Control.Arrow (first,(***))
 import Control.Applicative ((<$>),(<*>))
@@ -14,15 +14,7 @@ import SourceSyntax.Location
 import qualified Transform.SortDefinitions as SD
 import Language.ECMAScript3.Syntax
 import Language.ECMAScript3.PrettyPrint
-import Parse.Helpers (jsReserveds)
-
-makeSafe :: String -> String
-makeSafe = List.intercalate "." . map dereserve . split . deprime
-  where
-    deprime = map (\c -> if c == '\'' then '$' else c)
-    dereserve x = case Set.member x jsReserveds of
-                    False -> x
-                    True  -> "$" ++ x
+import qualified Transform.SafeNames as MakeSafe
 
 split :: String -> [String]
 split = go []
@@ -33,7 +25,7 @@ split = go []
                        | otherwise -> go (vars ++ [x]) rest
           (x,[]) -> vars ++ [x]
 
-var name = Id () (makeSafe name)
+var name = Id () name
 ref name = VarRef () (var name)
 prop name = PropId () (var name)
 f <| x = CallExpr () f [x]
@@ -185,7 +177,7 @@ expression (L span expr) =
           do es' <- mapM expression es
              return $ ObjectLit () (ctor : fields es')
           where
-            ctor = (prop "ctor", string (makeSafe name))
+            ctor = (prop "ctor", string name)
             fields = zipWith (\n e -> (prop ("_" ++ show n), e)) [0..]
 
       Markdown uid doc es ->
@@ -291,10 +283,11 @@ clause span variable (Case.Clause value vars mtch) =
 
 
 generate :: MetadataModule () () -> String 
-generate modul =
+generate unsafeModule =
     show . prettyPrint $ setup (Just "Elm") (names modul ++ ["make"]) ++
              [ assign ("Elm" : names modul ++ ["make"]) (function ["_elm"] programStmts) ]
   where
+    modul = MakeSafe.metadataModule unsafeModule
     thisModule = dotSep ("_elm" : names modul ++ ["values"])
     programStmts =
         concat [ setup (Just "_elm") (names modul ++ ["values"])

compiler/Parse/Helpers.hs

@@ -36,6 +36,10 @@ jsReserveds = Set.fromList
     , "const", "enum", "export", "extends", "import", "super", "implements"
     , "interface", "let", "package", "private", "protected", "public"
     , "static", "yield"
+    -- reserved by the Elm runtime system
+    , "Elm", "ElmRuntime"
+    , "F2", "F3", "F4", "F5", "F6", "F7", "F8", "F9"
+    , "A2", "A3", "A4", "A5", "A6", "A7", "A8", "A9"
     ]
 
 expecting = flip (<?>)

compiler/Transform/SafeNames.hs

@@ -0,0 +1,78 @@
+{-# OPTIONS_GHC -Wall #-}
+module Transform.SafeNames (metadataModule) where
+
+import Control.Arrow (first, (***))
+import SourceSyntax.Expression
+import SourceSyntax.Location
+import SourceSyntax.Module
+import SourceSyntax.Pattern
+import qualified Data.Set as Set
+import qualified Parse.Helpers as PHelp
+
+var :: String -> String
+var = dereserve . deprime
+  where
+    deprime = map (\c -> if c == '\'' then '$' else c)
+    dereserve x = case Set.member x PHelp.jsReserveds of
+                    False -> x
+                    True  -> "$" ++ x
+
+pattern :: Pattern -> Pattern
+pattern pat =
+    case pat of
+      PVar x -> PVar (var x)
+      PLiteral _ -> pat
+      PRecord fs -> PRecord (map var fs)
+      PAnything -> pat
+      PAlias x p -> PAlias (var x) (pattern p)
+      PData name ps -> PData name (map pattern ps)
+
+expression :: LExpr t v -> LExpr t v
+expression (L loc expr) =
+    let f = expression in
+    L loc $
+    case expr of
+      Literal _ -> expr
+      Var x -> Var (var x)
+      Range e1 e2 -> Range (f e1) (f e2)
+      ExplicitList es -> ExplicitList (map f es)
+      Binop op e1 e2 -> Binop op (f e1) (f e2)
+      Lambda p e -> Lambda (pattern p) (f e)
+      App e1 e2 -> App (f e1) (f e2)
+      MultiIf ps -> MultiIf (map (f *** f) ps)
+      Let defs body -> Let (map definition defs) (f body)
+      Case e cases -> Case (f e) $ map (pattern *** f) cases
+      Data name es -> Data name (map f es)
+      Access e x -> Access (f e) (var x)
+      Remove e x -> Remove (f e) (var x)
+      Insert e x v -> Insert (f e) (var x) (f v)
+      Modify r fs -> Modify (f r) (map (var *** f) fs)
+      Record fs -> Record (map (var *** f) fs)
+      Markdown uid md es -> Markdown uid md (map f es)
+
+definition :: Def t v -> Def t v
+definition def =
+    case def of
+      Def p e -> Def (pattern p) (expression e)
+      TypeAnnotation name t -> TypeAnnotation (var name) t
+
+metadataModule :: MetadataModule t v -> MetadataModule t v
+metadataModule modul =
+    modul
+    { names = map var (names modul)
+    , exports = map var (exports modul)
+    , imports = map (first var) (imports modul)
+    , program = expression (program modul)
+    , aliases =
+        let makeSafe (name, tvars, tipe) = (var name, tvars, tipe)
+        in  map makeSafe (aliases modul)
+    , datatypes =
+        let makeSafe (name,tvars,ctors) = (var name, tvars, map (first var) ctors)
+        in  map makeSafe (datatypes modul)
+    , foreignImports =
+        let makeSafe (js,expr,elm,tipe) = (js, expression expr, var elm, tipe)
+        in  map makeSafe (foreignImports modul)
+    , foreignExports =
+        let makeSafe (js,elm,tipe) = (js, var elm, tipe)
+        in  map makeSafe (foreignExports modul)
+    }