git.iko.soy/elk
on master help sign in
Start generating shorter field names for union types
08a8971Evan Czaplicki
src/Generate/JavaScript/Expression.hs+6−6
compare with master
unifiedsplit
@@ -179,18 +179,18 @@ generateCode expr =
179
179
180 Ctor tag members ->
180 Ctor tag members ->
181 let
181 let
182− ctor =
182+ tagField =
183− "ctor" ==> JS.String tag
183+ "$" ==> JS.String tag
184
184
185 toEntry entry n =
185 toEntry entry n =
186− ("_" <> Text.pack (show n)) ==> entry
186+ (Help.toFieldName n) ==> entry
187 in
187 in
188 do jsMembers <- mapM generateJsExpr members
188 do jsMembers <- mapM generateJsExpr members
189− jsExpr $ JS.Object (ctor : zipWith toEntry jsMembers [ 0 :: Int .. ])
189+ jsExpr $ JS.Object (tagField : zipWith toEntry jsMembers [ 0 :: Int .. ])
190
190
191 CtorAccess dataExpr index ->
191 CtorAccess dataExpr index ->
192 do jsDataExpr <- generateJsExpr dataExpr
192 do jsDataExpr <- generateJsExpr dataExpr
193− jsExpr $ JS.DotRef jsDataExpr (JS.Id ("_" <> Text.pack (show index)))
193+ jsExpr $ JS.DotRef jsDataExpr (JS.Id (Help.toFieldName index))
194
194
195 Cmd moduleName _ ->
195 Cmd moduleName _ ->
196 JsExpr <$> BuiltIn.effect moduleName
196 JsExpr <$> BuiltIn.effect moduleName
@@ -515,7 +515,7 @@ pathToTestableExpr root path exampleTest =
515 do accessExpr <- generateJsExpr (pathToExpr root path)
515 do accessExpr <- generateJsExpr (pathToExpr root path)
516 case exampleTest of
516 case exampleTest of
517 DT.Constructor _ ->
517 DT.Constructor _ ->
518− return $ JS.DotRef accessExpr (JS.Id "ctor")
518+ return $ JS.DotRef accessExpr (JS.Id "$")
519
519
520 DT.Literal (L.Chr _) ->
520 DT.Literal (L.Chr _) ->
521 return $ JS.Call (JS.DotRef accessExpr (JS.Id "valueOf")) []
521 return $ JS.Call (JS.DotRef accessExpr (JS.Id "valueOf")) []
src/Generate/JavaScript/Helpers.hs+32
@@ -7,10 +7,15 @@ module Generate.JavaScript.Helpers
7 , obj
7 , obj
8 , (<|)
8 , (<|)
9 , function
9 , function
10+ , toFieldName
10 )
11 )
11 where
12 where
12
13
14+
15+import qualified Data.Char as Char
16+import qualified Data.Text as Text
13import Data.Text (Text)
17import Data.Text (Text)
18+
14import Generate.JavaScript.Builder
19import Generate.JavaScript.Builder
15
20
16
21
@@ -64,3 +69,30 @@ obj vars =
64function :: [Text] -> [Stmt] -> Expr
69function :: [Text] -> [Stmt] -> Expr
65function args stmts =
70function args stmts =
66 Function Nothing (map Id args) stmts
71 Function Nothing (map Id args) stmts
72+
73+
74+
75+-- FIELD NAMES
76+
77+
78+toFieldName :: Int -> Text
79+toFieldName word =
80+ Text.pack (toFieldNameHelp word [])
81+
82+
83+toFieldNameHelp :: Int -> [Char] -> [Char]
84+toFieldNameHelp word str =
85+ if word < 52 then
86+ toChar word : str
87+
88+ else
89+ let
90+ (next, remainder) =
91+ quotRem word 52
92+ in
93+ toFieldNameHelp next (toChar remainder : str)
94+
95+
96+toChar :: Int -> Char
97+toChar word =
98+ Char.chr $ fromIntegral $ word + (if word < 26 then 97 else 39)