@@ -0,0 +1,78 @@
1+{-# OPTIONS_GHC -Wall #-}
2+module Transform.SafeNames (metadataModule) where
3+
4+import Control.Arrow (first, (***))
5+import SourceSyntax.Expression
6+import SourceSyntax.Location
7+import SourceSyntax.Module
8+import SourceSyntax.Pattern
9+import qualified Data.Set as Set
10+import qualified Parse.Helpers as PHelp
11+
12+var :: String -> String
13+var = dereserve . deprime
14+ where
15+ deprime = map (\c -> if c == '\'' then '$' else c)
16+ dereserve x = case Set.member x PHelp.jsReserveds of
17+ False -> x
18+ True -> "$" ++ x
19+
20+pattern :: Pattern -> Pattern
21+pattern pat =
22+ case pat of
23+ PVar x -> PVar (var x)
24+ PLiteral _ -> pat
25+ PRecord fs -> PRecord (map var fs)
26+ PAnything -> pat
27+ PAlias x p -> PAlias (var x) (pattern p)
28+ PData name ps -> PData name (map pattern ps)
29+
30+expression :: LExpr t v -> LExpr t v
31+expression (L loc expr) =
32+ let f = expression in
33+ L loc $
34+ case expr of
35+ Literal _ -> expr
36+ Var x -> Var (var x)
37+ Range e1 e2 -> Range (f e1) (f e2)
38+ ExplicitList es -> ExplicitList (map f es)
39+ Binop op e1 e2 -> Binop op (f e1) (f e2)
40+ Lambda p e -> Lambda (pattern p) (f e)
41+ App e1 e2 -> App (f e1) (f e2)
42+ MultiIf ps -> MultiIf (map (f *** f) ps)
43+ Let defs body -> Let (map definition defs) (f body)
44+ Case e cases -> Case (f e) $ map (pattern *** f) cases
45+ Data name es -> Data name (map f es)
46+ Access e x -> Access (f e) (var x)
47+ Remove e x -> Remove (f e) (var x)
48+ Insert e x v -> Insert (f e) (var x) (f v)
49+ Modify r fs -> Modify (f r) (map (var *** f) fs)
50+ Record fs -> Record (map (var *** f) fs)
51+ Markdown uid md es -> Markdown uid md (map f es)
52+
53+definition :: Def t v -> Def t v
54+definition def =
55+ case def of
56+ Def p e -> Def (pattern p) (expression e)
57+ TypeAnnotation name t -> TypeAnnotation (var name) t
58+
59+metadataModule :: MetadataModule t v -> MetadataModule t v
60+metadataModule modul =
61+ modul
62+ { names = map var (names modul)
63+ , exports = map var (exports modul)
64+ , imports = map (first var) (imports modul)
65+ , program = expression (program modul)
66+ , aliases =
67+ let makeSafe (name, tvars, tipe) = (var name, tvars, tipe)
68+ in map makeSafe (aliases modul)
69+ , datatypes =
70+ let makeSafe (name,tvars,ctors) = (var name, tvars, map (first var) ctors)
71+ in map makeSafe (datatypes modul)
72+ , foreignImports =
73+ let makeSafe (js,expr,elm,tipe) = (js, expression expr, var elm, tipe)
74+ in map makeSafe (foreignImports modul)
75+ , foreignExports =
76+ let makeSafe (js,elm,tipe) = (js, var elm, tipe)
77+ in map makeSafe (foreignExports modul)
78+ }