@@ -1,287 +1,26 @@
11{-# OPTIONS_GHC -Wall #-}
22{-# LANGUAGE OverloadedStrings #-}
33module AST.Variable
4− ( Canonical(..), Home(..)
5− , 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
4+ ( Global(..)
165 )
176 where
187
8+
199import Data.Binary
20−import Data.Monoid ((<>))
21−import Data.Text (Text)
2210
2311import qualified AST.Module.Name as ModuleName
24−import qualified Elm.Package as Pkg
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)
12+import qualified Elm.Name as N
4513
4614
4715
4816-- GLOBAL NAMES
4917
5018
51−data Global = Global !ModuleName.Canonical !Text
19+data Global = Global !ModuleName.Canonical !N.Name
5220 deriving (Eq, Ord)
5321
5422
5523
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−
28524-- BINARY SERIALIZATION
28625
28726
@@ -291,28 +30,3 @@ instance Binary Global where
29130
29231 get =
29332 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"