git.iko.soy/elk
on 84a9cdf help sign in
elk/src/Generate/JavaScript/Name.hs
314 lines 7.1 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2{-# LANGUAGE OverloadedStrings #-}
3module Generate.JavaScript.Name
4 ( Name
5 , Mode(..)
6 , Target(..)
7 , isServer
8 , toBuilder
9 , fromInt
10 , fromLocal
11 , fromGlobal
12 , fromCycle
13 , fromKernel
14 , fromField
15 , makeLabel
16 , makeTemp
17 , dollar
18 , shortenFieldNames
19 )
20 where
23import qualified Data.ByteString.Builder as B
24import qualified Data.ByteString.Short as S
25import qualified Data.List as List
26import Data.Monoid ((<>))
27import Data.Map ((!))
28import qualified Data.Map as Map
29import qualified Data.Set as Set
30import qualified Data.Text as Text
31import qualified Data.Text.Encoding as Text
32import Data.Word (Word8)
34import qualified AST.Module.Name as ModuleName
35import qualified Elm.Name as N
36import qualified Elm.Package as Pkg
40-- NAME
43newtype Name =
44 Name { toBuilder :: B.Builder }
48-- MODE
51data Mode
52 = Debug Target
53 | Prod Target ShortFieldNames
56data Target = Client | Server
59type ShortFieldNames =
60 Map.Map N.Name Name
63isServer :: Mode -> Bool
64isServer mode =
65 case mode of
66 Debug target -> isServerHelp target
67 Prod target _ -> isServerHelp target
70isServerHelp :: Target -> Bool
71isServerHelp target =
72 case target of { Client -> False ; Server -> True }
76-- CONSTRUCTORS
79fromInt :: Int -> Name
80fromInt n =
81 Name (B.shortByteString (intToAscii n))
84fromLocal :: N.Name -> Name
85fromLocal name =
86 if Set.member name reservedNames then
87 Name ("_" <> N.toBuilder name)
88 else
89 Name (N.toBuilder name)
92fromGlobal :: ModuleName.Canonical -> N.Name -> Name
93fromGlobal (ModuleName.Canonical (Pkg.Name user project) home) name =
94 Name $
95 Text.encodeUtf8Builder (Text.replace "-" "_" user)
96 <> "$" <> Text.encodeUtf8Builder (Text.replace "-" "_" project) -- TODO store this in a better way
97 <> "$" <> N.toBuilder home
98 <> "$" <> N.toBuilder name
101fromCycle :: ModuleName.Canonical -> N.Name -> Name
102fromCycle (ModuleName.Canonical (Pkg.Name user project) home) name =
103 Name $
104 Text.encodeUtf8Builder (Text.replace "-" "_" user)
105 <> "$" <> Text.encodeUtf8Builder (Text.replace "-" "_" project) -- TODO store this in a better way
106 <> "$" <> N.toBuilder home
107 <> "$cyclic$" <> N.toBuilder name
110fromKernel :: N.Name -> N.Name -> Name
111fromKernel home name =
112 Name ("_" <> N.toBuilder home <> "_" <> N.toBuilder name)
115fromField :: Mode -> N.Name -> Name
116fromField mode name =
117 case mode of
118 Debug _ ->
119 Name (N.toBuilder name)
121 Prod _ fields ->
122 fields ! name
126-- TEMPORARY NAMES
129makeLabel :: N.Name -> Int -> Name
130makeLabel name index =
131 Name (N.toBuilder name <> "$" <> B.intDec index)
134makeTemp :: N.Name -> Name
135makeTemp name =
136 Name ("$temp$" <> N.toBuilder name)
139dollar :: Name
140dollar =
141 Name (N.toBuilder N.dollar)
145-- SHORTEN FIELD NAMES
148shortenFieldNames :: Map.Map N.Name Int -> ShortFieldNames
149shortenFieldNames frequencies =
150 Map.foldr addToShortNames Map.empty $
151 Map.foldrWithKey addToBuckets Map.empty frequencies
154addToBuckets :: N.Name -> Int -> Map.Map Int [N.Name] -> Map.Map Int [N.Name]
155addToBuckets field frequency buckets =
156 -- TODO try using an IntMap for buckets
157 Map.insertWith (++) frequency [field] buckets
160addToShortNames :: [N.Name] -> ShortFieldNames -> ShortFieldNames
161addToShortNames fields shortNames =
162 List.foldl' addField shortNames fields
165addField :: ShortFieldNames -> N.Name -> ShortFieldNames
166addField shortNames field =
167 let rename = fromInt (Map.size shortNames) in
168 Map.insert field rename shortNames
172-- RESERVED NAMES
175{-# NOINLINE reservedNames #-}
176reservedNames :: Set.Set N.Name
177reservedNames =
178 Set.union jsReservedWords elmReservedWords
181jsReservedWords :: Set.Set N.Name
182jsReservedWords =
183 Set.fromList
184 [ "do", "if", "in"
185 , "NaN", "int", "for", "new", "try", "var", "let"
186 , "null", "true", "eval", "byte", "char", "goto", "long", "case", "else", "this", "void", "with", "enum"
187 , "false", "final", "float", "short", "break", "catch", "throw", "while", "class", "const", "super", "yield"
188 , "double", "native", "throws", "delete", "return", "switch", "typeof", "export", "import", "public", "static"
189 , "boolean", "default", "finally", "extends", "package", "private"
190 , "Infinity", "abstract", "volatile", "function", "continue", "debugger", "function"
191 , "undefined", "arguments", "transient", "interface", "protected"
192 , "instanceof", "implements"
193 , "synchronized"
194 ]
197elmReservedWords :: Set.Set N.Name
198elmReservedWords =
199 Set.fromList
200 [ "F2", "F3", "F4", "F5", "F6", "F7", "F8", "F9"
201 , "A2", "A3", "A4", "A5", "A6", "A7", "A8", "A9"
202 ]
206-- INT TO ASCII
209intToAscii :: Int -> S.ShortByteString
210intToAscii n =
211 if n < 53 then -- skip $ as a standalone name
212 S.pack [toByte n]
214 else
215 intToAsciiHelp (numStartBytes * numInnerBytes) allBadFields (n - 53)
218intToAsciiHelp :: Int -> [BadFields] -> Int -> S.ShortByteString
219intToAsciiHelp blockSize badFields n =
220 case badFields of
221 [] ->
222 if n < blockSize then
223 unsafeIntToAscii n
224 else
225 intToAsciiHelp (blockSize * numInnerBytes) [] (n - blockSize)
227 BadFields renamings : biggerBadFields ->
228 let availableSize = blockSize - Map.size renamings in
229 if n < availableSize then
230 let name = unsafeIntToAscii n in
231 Map.findWithDefault name name renamings
232 else
233 intToAsciiHelp (blockSize * numInnerBytes) biggerBadFields (n - availableSize)
237-- UNSAFE INT TO ASCII
240unsafeIntToAscii :: Int -> S.ShortByteString
241unsafeIntToAscii n =
242 let
243 (quotient, remainder) =
244 quotRem n numStartBytes
245 in
246 S.pack $ toByte remainder : unsafeIntToAsciiHelp quotient
249unsafeIntToAsciiHelp :: Int -> [Word8]
250unsafeIntToAsciiHelp n =
251 if n == 0 then
252 []
253 else
254 let (quotient, remainder) = quotRem n numInnerBytes in
255 toByte remainder : unsafeIntToAsciiHelp quotient
259-- ASCII BYTES
262numStartBytes :: Int
263numStartBytes =
264 54
267numInnerBytes :: Int
268numInnerBytes =
269 64
272toByte :: Int -> Word8
273toByte n
274 | n < 26 = fromIntegral (97 + n ) {- lower -}
275 | n < 52 = fromIntegral (65 + n - 26) {- upper -}
276 | n == 53 = 95 {- _ -}
277 | n == 54 = 36 {- $ -}
278 | n < 64 = fromIntegral (48 + n - 54) {- digit -}
279 | True = error $ "cannot convert int " ++ show n ++ " to ASCII"
283-- BAD FIELDS
286newtype BadFields =
287 BadFields { _renamings :: Renamings }
290type Renamings =
291 Map.Map S.ShortByteString S.ShortByteString
294allBadFields :: [BadFields]
295allBadFields =
296 let
297 add keyword dict =
298 Map.alter (Just . addRenaming keyword) (N.length keyword) dict
299 in
300 Map.elems $ Set.foldr add Map.empty jsReservedWords
303addRenaming :: N.Name -> Maybe BadFields -> BadFields
304addRenaming keyword maybeBadFields =
305 let
306 maxName =
307 numStartBytes * numInnerBytes ^ (N.length keyword - 1) - 1
308 in
309 case maybeBadFields of
310 Nothing ->
311 BadFields $ Map.singleton (N.toShort keyword) (unsafeIntToAscii maxName)
313 Just (BadFields renamings) ->
314 BadFields $ Map.insert (N.toShort keyword) (unsafeIntToAscii (maxName - Map.size renamings)) renamings