git.iko.soy/elk
on b88742e help sign in
elk/src/AST/Variable.hs
358 lines 5.2 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2{-# LANGUAGE OverloadedStrings #-}
3module AST.Variable
4 ( Raw(..)
5 , Canonical(..), Home(..)
6 , Global(..)
7 , local, topLevel, fromModule
8 , inCore, inHtml
9 , int, float, char, string, tuple
10 , list, cons, nil
11 , bool, true, false
12 , never, task, cmd, sub, router, shader, decoder
13 , isLocalHome, isCons
14 , is, isJson, isMaybe, isArray, isTask, isList
15 , isKernel, isTuple, isPrim, isLocal
16 , rawToText, toText
17 )
18 where
20import Data.Binary
21import Data.Monoid ((<>))
22import Data.Text (Text)
24import qualified AST.Helpers as Help
25import qualified AST.Module.Name as ModuleName
26import qualified Elm.Package as Pkg
30-- RAW NAMES
33newtype Raw = Raw Text
34 deriving (Eq, Ord)
38-- CANONICAL NAMES
41data Home
42 = BuiltIn
43 | Module !ModuleName.Canonical
44 | TopLevel !ModuleName.Canonical
45 | Local
46 deriving (Eq, Ord)
49data Canonical =
50 Canonical
51 { _home :: !Home
52 , _name :: !Text
53 }
54 deriving (Eq, Ord)
58-- GLOBAL NAMES
61data Global = Global !ModuleName.Canonical !Text
62 deriving (Eq, Ord)
66-- HELPERS
69local :: Text -> Canonical
70local x =
71 Canonical Local x
74topLevel :: ModuleName.Canonical -> Text -> Canonical
75topLevel home x =
76 Canonical (TopLevel home) x
79fromModule :: ModuleName.Canonical -> Text -> Canonical
80fromModule home name =
81 Canonical (Module home) name
84inCore :: ModuleName.Raw -> Text -> Canonical
85inCore home name =
86 Canonical (Module (ModuleName.inCore home)) name
89inHtml :: ModuleName.Raw -> Text -> Canonical
90inHtml home name =
91 Canonical (Module (ModuleName.inHtml home)) name
95-- BUILT IN TYPES
98int :: Canonical
99int =
100 Canonical BuiltIn "Int"
103float :: Canonical
104float =
105 Canonical BuiltIn "Float"
108char :: Canonical
109char =
110 Canonical BuiltIn "Char"
113string :: Canonical
114string =
115 Canonical BuiltIn "String"
118tuple :: Int -> Canonical
119tuple size =
120 Canonical BuiltIn (Help.makeTuple size)
124-- LIST
127list :: Canonical
128list =
129 Canonical BuiltIn "List"
132cons :: Canonical
133cons =
134 Canonical BuiltIn "::"
137nil :: Canonical
138nil =
139 Canonical BuiltIn "[]"
143-- BOOLEANS
146bool :: Canonical
147bool =
148 Canonical BuiltIn "Bool"
151true :: Canonical
152true =
153 Canonical BuiltIn "True"
156false :: Canonical
157false =
158 Canonical BuiltIn "False"
162-- CORE TYPES
165never :: Canonical
166never =
167 inCore "Basics" "Never"
170task :: Canonical
171task =
172 inCore "Platform" "Task"
175cmd :: Canonical
176cmd =
177 inCore "Platform.Cmd" "Cmd"
180sub :: Canonical
181sub =
182 inCore "Platform.Sub" "Sub"
185router :: Canonical
186router =
187 inCore "Platform" "Router"
190shader :: Canonical
191shader =
192 fromModule (ModuleName.Canonical Pkg.webgl "WebGL") "Shader"
195decoder :: Canonical
196decoder =
197 inCore "Json.Decode" "Decoder"
201-- VARIABLE RECOGNIZERS
204isLocalHome :: Home -> Bool
205isLocalHome home =
206 case home of
207 BuiltIn ->
208 False
210 Module _ ->
211 False
213 TopLevel _ ->
214 True
216 Local ->
217 True
220isCons :: Canonical -> Bool
221isCons var =
222 case var of
223 Canonical BuiltIn "::" ->
224 True
226 _ ->
227 False
230is :: ModuleName.Raw -> Text -> Canonical -> Bool
231is home name var =
232 var == inCore home name
235isJson :: Canonical -> Bool
236isJson =
237 is "Json.Encode" "Value"
240isMaybe :: Canonical -> Bool
241isMaybe =
242 is "Maybe" "Maybe"
244isArray :: Canonical -> Bool
245isArray =
246 is "Array" "Array"
249isTask :: Canonical -> Bool
250isTask =
251 is "Task" "Task"
254isList :: Canonical -> Bool
255isList var =
256 var == Canonical BuiltIn "List"
259isKernel :: Canonical -> Bool
260isKernel var =
261 case var of
262 Canonical (Module name) _ ->
263 ModuleName.canonicalIsKernel name
265 _ ->
266 False
269isTuple :: Canonical -> Bool
270isTuple var =
271 case var of
272 Canonical BuiltIn name ->
273 Help.isTuple name
275 _ ->
276 False
279isPrim :: Text -> Canonical -> Bool
280isPrim prim (Canonical home name) =
281 case home of
282 BuiltIn ->
283 name == prim
285 _ ->
286 False
289isLocal :: (Text -> Bool) -> Canonical -> Bool
290isLocal check (Canonical home name) =
291 case home of
292 Local ->
293 check name
295 _ ->
296 False
300-- VARIABLE TO TEXT
303rawToText :: Raw -> Text
304rawToText (Raw name) =
305 name
308toText :: Canonical -> Text
309toText (Canonical home name) =
310 case home of
311 BuiltIn ->
312 name
314 Module moduleName ->
315 ModuleName.canonicalToText moduleName <> "." <> name
317 TopLevel _ ->
318 name
320 Local ->
321 name
325-- BINARY SERIALIZATION
328instance Binary Global where
329 put (Global home name) =
330 put home >> put name
332 get =
333 Global <$> get <*> get
336instance Binary Canonical where
337 put (Canonical home name) =
338 case home of
339 BuiltIn ->
340 putWord8 0 >> put name
342 Module path ->
343 putWord8 1 >> put path >> put name
345 TopLevel path ->
346 putWord8 2 >> put path >> put name
348 Local ->
349 putWord8 3 >> put name
351 get =
352 do tag <- getWord8
353 case tag of
354 0 -> Canonical BuiltIn <$> get
355 1 -> Canonical . Module <$> get <*> get
356 2 -> Canonical . TopLevel <$> get <*> get
357 3 -> Canonical Local <$> get
358 _ -> error "Unexpected tag when deserializing canonical variable"