git.iko.soy/elk
on master help sign in
Fix kernel import processing / assign Elm vs JS vars properly
27ffde4Evan Czaplicki
src/Elm/Kernel.hs+135−82
compare with master
unifiedsplit
@@ -1,15 +1,17 @@
1{-# OPTIONS_GHC -Wall #-}
1{-# OPTIONS_GHC -Wall #-}
2{-# LANGUAGE OverloadedStrings #-}
2{-# LANGUAGE OverloadedStrings #-}
3module Elm.Kernel
3module Elm.Kernel
4− ( Kernel(..)
4+ ( Opt.KContent(..)
5 , parse
5 , parse
6 )
6 )
7 where
7 where
8
8
9
9
10import qualified Data.ByteString as B
10import qualified Data.ByteString as B
11+import qualified Data.List as List
11import qualified Data.Map as Map
12import qualified Data.Map as Map
12import Data.Monoid ((<>))
13import Data.Monoid ((<>))
14+import qualified Data.Set as Set
13import qualified Data.Text as Text
15import qualified Data.Text as Text
14import Data.Word (Word8)
16import Data.Word (Word8)
15
17
@@ -18,6 +20,7 @@ import qualified AST.Optimized as Opt
18import qualified AST.Source as Src
20import qualified AST.Source as Src
19import qualified AST.Module.Name as ModuleName
21import qualified AST.Module.Name as ModuleName
20import qualified Elm.Name as N
22import qualified Elm.Name as N
23+import qualified Elm.Package as Pkg
21import Parse.Primitives (Parser, run)
24import Parse.Primitives (Parser, run)
22import qualified Parse.Primitives.Kernel as K
25import qualified Parse.Primitives.Kernel as K
23import qualified Parse.Primitives.Symbol as Symbol
26import qualified Parse.Primitives.Symbol as Symbol
@@ -30,16 +33,13 @@ import qualified Reporting.Error as E
30-- PARSE
33-- PARSE
31
34
32
35
33−data Kernel =
36+type ImportDict =
34− Kernel
37+ Map.Map N.Name [Pkg.Name]
35− { _imports :: [(N.Name, N.Name)]
36− , _chunks :: [Opt.KChunk]
37− }
38
38
39
39
40−parse :: B.ByteString -> Either E.Error Kernel
40+parse :: ImportDict -> B.ByteString -> Either E.Error Opt.KContent
41−parse sourceCode =
41+parse importDict sourceCode =
42− case run parser sourceCode of
42+ case run (parser importDict) sourceCode of
43 Right kernel ->
43 Right kernel ->
44 Right kernel
44 Right kernel
45
45
@@ -47,23 +47,128 @@ parse sourceCode =
47 Left (E.Syntax err)
47 Left (E.Syntax err)
48
48
49
49
50−
51−-- PARSER
52−
53−
54−parser :: Parser Kernel
50+parser :: ImportDict -> Parser Opt.KContent
55−parser =
51+parser importDict =
56 do Symbol.jsMultiCommentOpen
52 do Symbol.jsMultiCommentOpen
57 Module.freshLine
53 Module.freshLine
58− srcImports <- Module.chompImports []
54+ imports <- Module.chompImports []
59 Symbol.jsMultiCommentClose
55 Symbol.jsMultiCommentClose
60− let imports = Map.unions (map destructImport srcImports)
56+
57+ let (State vtable deps) = processImports importDict imports
58+
61− chunks <- parserHelp imports Map.empty Map.empty []
59+ chunks <- chompChunks vtable Map.empty Map.empty []
62− return $ Kernel (Map.elems imports) chunks
60+
61+ return $ Opt.KContent chunks deps
62+
63+
64+
65+-- PROCESS IMPORTS
66+
67+
68+type VarTable =
69+ Map.Map Text.Text Opt.KChunk
70+
71+
72+data State =
73+ State VarTable (Set.Set Opt.Global)
74+
75+
76+processImports :: ImportDict -> [Src.Import] -> State
77+processImports importDict imports =
78+ List.foldl' (addImport importDict) (State Map.empty Set.empty) imports
79+
80+
81+addImport :: ImportDict -> State -> Src.Import -> State
82+addImport importDict state (Src.Import (A.At _ home) maybeAlias exposing) =
83+ if ModuleName.isKernel home then
84+ case maybeAlias of
85+ Just _ ->
86+ error ("Cannot use aliases on kernel import of: " ++ show home)
87+
88+ Nothing ->
89+ addKernelImport (ModuleName.getKernel home) exposing state
90+
91+ else
92+ case Map.lookup home importDict of
93+ Just [pkg] ->
94+ let
95+ canonicalHome = ModuleName.Canonical pkg home
96+ prefix = toPrefix home maybeAlias
97+ in
98+ addNormalImport canonicalHome prefix exposing state
99+
100+ _ ->
101+ error ("Cannot find kernel import of: " ++ show home)
102+
103+
104+-- INVARIANT: the `home` is the * in `Elm.Kernel.*`
105+--
106+addKernelImport :: N.Name -> Src.Exposing -> State -> State
107+addKernelImport home exposing (State vtable deps) =
108+ let
109+ addVar table name =
110+ Map.insert (home <> "_" <> name) (Opt.JsVar home name) table
111+ in
112+ State
113+ (List.foldl' addVar vtable (toNames exposing))
114+ (Set.insert (Opt.kernel home) deps)
115+
116+
117+addNormalImport :: ModuleName.Canonical -> N.Name -> Src.Exposing -> State -> State
118+addNormalImport home prefix exposing state =
119+ let
120+ addVar (State vtable deps) name =
121+ State
122+ (Map.insert (prefix <> "_" <> name) (Opt.ElmVar home name) vtable)
123+ (Set.insert (Opt.Global home name) deps)
124+ in
125+ List.foldl' addVar state (toNames exposing)
126+
127+
128+toPrefix :: N.Name -> Maybe N.Name -> N.Name
129+toPrefix home maybeAlias =
130+ case maybeAlias of
131+ Just alias ->
132+ alias
133+
134+ Nothing ->
135+ if Text.isInfixOf "." home then
136+ error ("kernel imports with dots need an alias: " ++ show home)
137+ else
138+ home
139+
140+toNames :: Src.Exposing -> [N.Name]
141+toNames exposing =
142+ case exposing of
143+ Src.Open ->
144+ error "Cannot have `exposing (..)` in kernel code."
145+
146+ Src.Explicit exposedList ->
147+ map toName exposedList
148+
149+
150+toName :: A.Located Src.Exposed -> N.Name
151+toName (A.At _ exposed) =
152+ case exposed of
153+ Src.Lower name ->
154+ name
155+
156+ Src.Upper name Src.Private ->
157+ name
158+
159+ Src.Upper _ Src.Public ->
160+ error "cannot have Maybe(..) syntax in kernel code header"
161+
162+ Src.Operator _ ->
163+ error "cannot use binops in kernel code"
63
164
64
165
166+
167+-- PARSE CHUNKS
168+
169+
65−parserHelp :: Imports -> Enums -> Fields -> [Opt.KChunk] -> Parser [Opt.KChunk]
170+chompChunks :: VarTable -> Enums -> Fields -> [Opt.KChunk] -> Parser [Opt.KChunk]
66−parserHelp imports enums fields chunks =
171+chompChunks vtable enums fields chunks =
67 do (javascript, maybeTag) <- K.chunk
172 do (javascript, maybeTag) <- K.chunk
68 case maybeTag of
173 case maybeTag of
69 Nothing ->
174 Nothing ->
@@ -72,34 +177,34 @@ parserHelp imports enums fields chunks =
72 Just tag ->
177 Just tag ->
73 case tag of
178 case tag of
74 K.Prod ->
179 K.Prod ->
75− parserHelp imports enums fields $
180+ chompChunks vtable enums fields $
76 Opt.Prod : Opt.JS javascript : chunks
181 Opt.Prod : Opt.JS javascript : chunks
77
182
78 K.Debug ->
183 K.Debug ->
79− parserHelp imports enums fields $
184+ chompChunks vtable enums fields $
80 Opt.Debug : Opt.JS javascript : chunks
185 Opt.Debug : Opt.JS javascript : chunks
81
186
82 K.Import var ->
187 K.Import var ->
83− case Map.lookup var imports of
188+ case Map.lookup var vtable of
84 Nothing ->
189 Nothing ->
85 error ("Bad kernel symbol: " ++ Text.unpack var)
190 error ("Bad kernel symbol: " ++ Text.unpack var)
86
191
87− Just (home, name) ->
192+ Just chunk ->
88− parserHelp imports enums fields $
193+ chompChunks vtable enums fields $
89− Opt.Var home name : Opt.JS javascript : chunks
194+ chunk : Opt.JS javascript : chunks
90
195
91 K.Enum n var ->
196 K.Enum n var ->
92 let (enum, newEnums) = lookupEnum n var enums in
197 let (enum, newEnums) = lookupEnum n var enums in
93− parserHelp imports newEnums fields $
198+ chompChunks vtable newEnums fields $
94 Opt.Enum enum : Opt.JS javascript : chunks
199 Opt.Enum enum : Opt.JS javascript : chunks
95
200
96 K.ElmField name ->
201 K.ElmField name ->
97− parserHelp imports enums fields $
202+ chompChunks vtable enums fields $
98 Opt.ElmField name : Opt.JS javascript : chunks
203 Opt.ElmField name : Opt.JS javascript : chunks
99
204
100 K.JsField name ->
205 K.JsField name ->
101 let (field, newFields) = lookupField name fields in
206 let (field, newFields) = lookupField name fields in
102− parserHelp imports enums newFields $
207+ chompChunks vtable enums newFields $
103 Opt.JsField field : Opt.JS javascript : chunks
208 Opt.JsField field : Opt.JS javascript : chunks
104
209
105
210
@@ -143,55 +248,3 @@ lookupEnum word var allEnums =
143 Nothing ->
248 Nothing ->
144 let n = Map.size enums in
249 let n = Map.size enums in
145 ( n, Map.insert word (Map.insert var n enums) allEnums )
250 ( n, Map.insert word (Map.insert var n enums) allEnums )
146−
147−
148−
149−-- IMPORTS
150−
151−
152−type Imports =
153− Map.Map Text.Text (N.Name, N.Name)
154−
155−
156−destructImport :: Src.Import -> Imports
157−destructImport (Src.Import (A.At _ moduleName) maybeAlias exposing) =
158− let
159− shortName =
160− case maybeAlias of
161− Just alias ->
162− alias
163−
164− Nothing ->
165− if ModuleName.isKernel moduleName then
166− ModuleName.getKernel moduleName
167− else if Text.isInfixOf "." moduleName then
168− error ("modules with dots in kernel code need an alias: " ++ show moduleName)
169− else
170− moduleName
171−
172− toEntry name =
173− ( shortName <> "_" <> name, ( moduleName, name ) )
174− in
175− Map.fromList $ map toEntry $
176− case exposing of
177− Src.Open ->
178− error "cannot have open imports in kernel code"
179−
180− Src.Explicit exposed ->
181− map exposedToName exposed
182−
183−
184−exposedToName :: A.Located Src.Exposed -> N.Name
185−exposedToName (A.At _ exposed) =
186− case exposed of
187− Src.Lower name ->
188− name
189−
190− Src.Upper name Src.Private ->
191− name
192−
193− Src.Upper _ Src.Public ->
194− error "cannot have Maybe(..) syntax in kernel code header"
195−
196− Src.Operator _ ->
197− error "cannot use binops in kernel code"