git.iko.soy/elk
on master help sign in
Remove Var.Canonical
fe6f91bEvan Czaplicki
src/AST/Variable.hs+4−290
compare with master
unifiedsplit
@@ -1,287 +1,26 @@
1{-# OPTIONS_GHC -Wall #-}
1{-# OPTIONS_GHC -Wall #-}
2{-# LANGUAGE OverloadedStrings #-}
2{-# LANGUAGE OverloadedStrings #-}
3module AST.Variable
3module AST.Variable
4− ( Canonical(..), Home(..)
5− , Global(..)
4+ ( Global(..)
6− , local, topLevel, fromModule
7− , inCore, inHtml
8− , int, float, char, string
9− , list, cons, nil
10− , bool, true, false
11− , never, task, router, shader, decoder
12− , isLocalHome, isCons
13− , is, isJson, isMaybe, isArray, isTask, isList
14− , isKernel, isPrim, isLocal
15− , toText
16 )
5 )
17 where
6 where
18
7
8+
19import Data.Binary
9import Data.Binary
20−import Data.Monoid ((<>))
21−import Data.Text (Text)
22
10
23import qualified AST.Module.Name as ModuleName
11import qualified AST.Module.Name as ModuleName
24−import qualified Elm.Package as Pkg
12+import qualified Elm.Name as N
25−
26−
27−
28−-- CANONICAL NAMES
29−
30−
31−data Home
32− = BuiltIn
33− | Module !ModuleName.Canonical
34− | TopLevel !ModuleName.Canonical
35− | Local
36− deriving (Eq, Ord)
37−
38−
39−data Canonical =
40− Canonical
41− { _home :: !Home
42− , _name :: !Text
43− }
44− deriving (Eq, Ord)
45
13
46
14
47
15
48-- GLOBAL NAMES
16-- GLOBAL NAMES
49
17
50
18
51−data Global = Global !ModuleName.Canonical !Text
19+data Global = Global !ModuleName.Canonical !N.Name
52 deriving (Eq, Ord)
20 deriving (Eq, Ord)
53
21
54
22
55
23
56−-- HELPERS
57−
58−
59−local :: Text -> Canonical
60−local x =
61− Canonical Local x
62−
63−
64−topLevel :: ModuleName.Canonical -> Text -> Canonical
65−topLevel home x =
66− Canonical (TopLevel home) x
67−
68−
69−fromModule :: ModuleName.Canonical -> Text -> Canonical
70−fromModule home name =
71− Canonical (Module home) name
72−
73−
74−inCore :: ModuleName.Raw -> Text -> Canonical
75−inCore home name =
76− Canonical (Module (ModuleName.inCore home)) name
77−
78−
79−inHtml :: ModuleName.Raw -> Text -> Canonical
80−inHtml home name =
81− Canonical (Module (ModuleName.inHtml home)) name
82−
83−
84−
85−-- BUILT IN TYPES
86−
87−
88−int :: Canonical
89−int =
90− Canonical BuiltIn "Int"
91−
92−
93−float :: Canonical
94−float =
95− Canonical BuiltIn "Float"
96−
97−
98−char :: Canonical
99−char =
100− Canonical BuiltIn "Char"
101−
102−
103−string :: Canonical
104−string =
105− Canonical BuiltIn "String"
106−
107−
108−
109−-- LIST
110−
111−
112−list :: Canonical
113−list =
114− Canonical BuiltIn "List"
115−
116−
117−cons :: Canonical
118−cons =
119− Canonical BuiltIn "::"
120−
121−
122−nil :: Canonical
123−nil =
124− Canonical BuiltIn "[]"
125−
126−
127−
128−-- BOOLEANS
129−
130−
131−bool :: Canonical
132−bool =
133− Canonical BuiltIn "Bool"
134−
135−
136−true :: Canonical
137−true =
138− Canonical BuiltIn "True"
139−
140−
141−false :: Canonical
142−false =
143− Canonical BuiltIn "False"
144−
145−
146−
147−-- CORE TYPES
148−
149−
150−never :: Canonical
151−never =
152− inCore "Basics" "Never"
153−
154−
155−task :: Canonical
156−task =
157− inCore "Platform" "Task"
158−
159−
160−router :: Canonical
161−router =
162− inCore "Platform" "Router"
163−
164−
165−shader :: Canonical
166−shader =
167− fromModule (ModuleName.Canonical Pkg.webgl "WebGL") "Shader"
168−
169−
170−decoder :: Canonical
171−decoder =
172− inCore "Json.Decode" "Decoder"
173−
174−
175−
176−-- VARIABLE RECOGNIZERS
177−
178−
179−isLocalHome :: Home -> Bool
180−isLocalHome home =
181− case home of
182− BuiltIn ->
183− False
184−
185− Module _ ->
186− False
187−
188− TopLevel _ ->
189− True
190−
191− Local ->
192− True
193−
194−
195−isCons :: Canonical -> Bool
196−isCons var =
197− case var of
198− Canonical BuiltIn "::" ->
199− True
200−
201− _ ->
202− False
203−
204−
205−is :: ModuleName.Raw -> Text -> Canonical -> Bool
206−is home name var =
207− var == inCore home name
208−
209−
210−isJson :: Canonical -> Bool
211−isJson =
212− is "Json.Encode" "Value"
213−
214−
215−isMaybe :: Canonical -> Bool
216−isMaybe =
217− is "Maybe" "Maybe"
218−
219−isArray :: Canonical -> Bool
220−isArray =
221− is "Array" "Array"
222−
223−
224−isTask :: Canonical -> Bool
225−isTask =
226− is "Task" "Task"
227−
228−
229−isList :: Canonical -> Bool
230−isList var =
231− var == Canonical BuiltIn "List"
232−
233−
234−isKernel :: Canonical -> Bool
235−isKernel var =
236− case var of
237− Canonical (Module name) _ ->
238− ModuleName.canonicalIsKernel name
239−
240− _ ->
241− False
242−
243−
244−isPrim :: Text -> Canonical -> Bool
245−isPrim prim (Canonical home name) =
246− case home of
247− BuiltIn ->
248− name == prim
249−
250− _ ->
251− False
252−
253−
254−isLocal :: (Text -> Bool) -> Canonical -> Bool
255−isLocal check (Canonical home name) =
256− case home of
257− Local ->
258− check name
259−
260− _ ->
261− False
262−
263−
264−
265−-- VARIABLE TO TEXT
266−
267−
268−toText :: Canonical -> Text
269−toText (Canonical home name) =
270− case home of
271− BuiltIn ->
272− name
273−
274− Module moduleName ->
275− ModuleName.canonicalToText moduleName <> "." <> name
276−
277− TopLevel _ ->
278− name
279−
280− Local ->
281− name
282−
283−
284−
285-- BINARY SERIALIZATION
24-- BINARY SERIALIZATION
286
25
287
26
@@ -291,28 +30,3 @@ instance Binary Global where
291
30
292 get =
31 get =
293 Global <$> get <*> get
32 Global <$> get <*> get
294−
295−
296−instance Binary Canonical where
297− put (Canonical home name) =
298− case home of
299− BuiltIn ->
300− putWord8 0 >> put name
301−
302− Module path ->
303− putWord8 1 >> put path >> put name
304−
305− TopLevel path ->
306− putWord8 2 >> put path >> put name
307−
308− Local ->
309− putWord8 3 >> put name
310−
311− get =
312− do tag <- getWord8
313− case tag of
314− 0 -> Canonical BuiltIn <$> get
315− 1 -> Canonical . Module <$> get <*> get
316− 2 -> Canonical . TopLevel <$> get <*> get
317− 3 -> Canonical Local <$> get
318− _ -> error "Unexpected tag when deserializing canonical variable"
src/Canonicalize/Environment.hs+2−1
@@ -23,6 +23,7 @@ import qualified Canonicalize.Environment.Foreign as Foreign
23import qualified Canonicalize.Environment.Internals as Env
23import qualified Canonicalize.Environment.Internals as Env
24import qualified Canonicalize.Environment.Local as Local
24import qualified Canonicalize.Environment.Local as Local
25import qualified Elm.Interface as I
25import qualified Elm.Interface as I
26+import qualified Elm.Name as N
26import qualified Elm.Package as Package
27import qualified Elm.Package as Package
27import qualified Reporting.Error.Canonicalize as Error
28import qualified Reporting.Error.Canonicalize as Error
28import qualified Reporting.Result as Result
29import qualified Reporting.Result as Result
@@ -42,7 +43,7 @@ type Result a =
42
43
43
44
44type ImportDict =
45type ImportDict =
45− Map.Map ModuleName.Raw ModuleName.Canonical
46+ Map.Map N.Name ModuleName.Canonical
46
47
47
48
48create :: Package.Name -> ImportDict -> I.Interfaces -> Valid.Module -> Result Env.Env
49create :: Package.Name -> ImportDict -> I.Interfaces -> Valid.Module -> Result Env.Env
src/Canonicalize/Environment/Foreign.hs+6−6
@@ -76,7 +76,7 @@ emptyEnv =
76
76
77
77
78type ImportDict =
78type ImportDict =
79− Map.Map ModuleName.Raw ModuleName.Canonical
79+ Map.Map N.Name ModuleName.Canonical
80
80
81
81
82createInitialEnv :: ModuleName.Canonical -> ImportDict -> I.Interfaces -> [Src.Import] -> Result Env.Env
82createInitialEnv :: ModuleName.Canonical -> ImportDict -> I.Interfaces -> [Src.Import] -> Result Env.Env
@@ -269,14 +269,14 @@ verifyImport importDict interfaces (Src.Import (A.A region name) alias exposing)
269 Result.ok (Explicit (Map.fromList (concat pairLists)))
269 Result.ok (Explicit (Map.fromList (concat pairLists)))
270
270
271
271
272−throwImportNotFound :: R.Region -> ModuleName.Raw -> [ModuleName.Canonical] -> Result a
272+throwImportNotFound :: R.Region -> N.Name -> [ModuleName.Canonical] -> Result a
273throwImportNotFound region name knownModules =
273throwImportNotFound region name knownModules =
274 Result.throw region $ Error.ImportNotFound name $
274 Result.throw region $ Error.ImportNotFound name $
275− Help.nearbyNames ModuleName.toString name $
275+ Help.nearbyNames N.toString name $
276 map ModuleName._module knownModules
276 map ModuleName._module knownModules
277
277
278
278
279−verifyExposed :: ModuleName.Raw -> I.Interface -> A.Located Src.Exposed -> Result [(N.Name, Exposed)]
279+verifyExposed :: N.Name -> I.Interface -> A.Located Src.Exposed -> Result [(N.Name, Exposed)]
280verifyExposed moduleName interface@(I.Interface _ unions aliases _) (A.A region exposed) =
280verifyExposed moduleName interface@(I.Interface _ unions aliases _) (A.A region exposed) =
281 case exposed of
281 case exposed of
282 Src.Operator name ->
282 Src.Operator name ->
@@ -300,7 +300,7 @@ verifyExposed moduleName interface@(I.Interface _ unions aliases _) (A.A region
300 throwExposingNotFound moduleName region name interface
300 throwExposingNotFound moduleName region name interface
301
301
302
302
303−verifyValue :: ModuleName.Raw -> R.Region -> N.Name -> I.Interface -> Result [(N.Name, Exposed)]
303+verifyValue :: N.Name -> R.Region -> N.Name -> I.Interface -> Result [(N.Name, Exposed)]
304verifyValue moduleName region name interface@(I.Interface types _ _ _) =
304verifyValue moduleName region name interface@(I.Interface types _ _ _) =
305 case Map.lookup name types of
305 case Map.lookup name types of
306 Nothing ->
306 Nothing ->
@@ -320,7 +320,7 @@ verifyAlias region name privacy =
320 Result.ok [(name, Alias)]
320 Result.ok [(name, Alias)]
321
321
322
322
323−throwExposingNotFound :: ModuleName.Raw -> R.Region -> N.Name -> I.Interface -> Result a
323+throwExposingNotFound :: N.Name -> R.Region -> N.Name -> I.Interface -> Result a
324throwExposingNotFound moduleName region name (I.Interface types unions aliases _) =
324throwExposingNotFound moduleName region name (I.Interface types unions aliases _) =
325 let
325 let
326 toCtorPairs (tipe, Can.Union _ ctors) =
326 toCtorPairs (tipe, Can.Union _ ctors) =