on master help sign in
Start generating shorter field names for union types
commit08a8971bfad5aaed0962b2980eddb73870f47c45 authorEvan Czaplicki <evancz@users.noreply.github.com> dateTue 23 May 2017, 18:34 (9 years ago) parent01ff2a9
2 files changed+38−6
src/Generate/JavaScript/Expression.hs+6−6 src/Generate/JavaScript/Helpers.hs+32
src/Generate/JavaScript/Expression.hs+6−6
@@ -179,18 +179,18 @@ generateCode expr =
179179
180180 Ctor tag members ->
181181 let
182− ctor =
183− "ctor" ==> JS.String tag
182+ tagField =
183+ "$" ==> JS.String tag
184184
185185 toEntry entry n =
186− ("_" <> Text.pack (show n)) ==> entry
186+ (Help.toFieldName n) ==> entry
187187 in
188188 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 .. ])
190190
191191 CtorAccess dataExpr index ->
192192 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))
194194
195195 Cmd moduleName _ ->
196196 JsExpr <$> BuiltIn.effect moduleName
@@ -515,7 +515,7 @@ pathToTestableExpr root path exampleTest =
515515 do accessExpr <- generateJsExpr (pathToExpr root path)
516516 case exampleTest of
517517 DT.Constructor _ ->
518− return $ JS.DotRef accessExpr (JS.Id "ctor")
518+ return $ JS.DotRef accessExpr (JS.Id "$")
519519
520520 DT.Literal (L.Chr _) ->
521521 return $ JS.Call (JS.DotRef accessExpr (JS.Id "valueOf")) []
src/Generate/JavaScript/Helpers.hs+32
@@ -7,10 +7,15 @@ module Generate.JavaScript.Helpers
77 , obj
88 , (<|)
99 , function
10+ , toFieldName
1011 )
1112 where
1213
14+
15+import qualified Data.Char as Char
16+import qualified Data.Text as Text
1317import Data.Text (Text)
18+
1419import Generate.JavaScript.Builder
1520
1621
@@ -64,3 +69,30 @@ obj vars =
6469function :: [Text] -> [Stmt] -> Expr
6570function args stmts =
6671 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)