git.iko.soy/elk
on bca019d help sign in
elk/src/AST/Variable.hs
353 lines 5.1 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
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"
196-- VARIABLE RECOGNIZERS
199isLocalHome :: Home -> Bool
200isLocalHome home =
201 case home of
202 BuiltIn ->
203 False
205 Module _ ->
206 False
208 TopLevel _ ->
209 True
211 Local ->
212 True
215isCons :: Canonical -> Bool
216isCons var =
217 case var of
218 Canonical BuiltIn "::" ->
219 True
221 _ ->
222 False
225is :: ModuleName.Raw -> Text -> Canonical -> Bool
226is home name var =
227 var == inCore home name
230isJson :: Canonical -> Bool
231isJson =
232 is "Json.Encode" "Value"
235isMaybe :: Canonical -> Bool
236isMaybe =
237 is "Maybe" "Maybe"
239isArray :: Canonical -> Bool
240isArray =
241 is "Array" "Array"
244isTask :: Canonical -> Bool
245isTask =
246 is "Task" "Task"
249isList :: Canonical -> Bool
250isList var =
251 var == Canonical BuiltIn "List"
254isKernel :: Canonical -> Bool
255isKernel var =
256 case var of
257 Canonical (Module name) _ ->
258 ModuleName.canonicalIsKernel name
260 _ ->
261 False
264isTuple :: Canonical -> Bool
265isTuple var =
266 case var of
267 Canonical BuiltIn name ->
268 Help.isTuple name
270 _ ->
271 False
274isPrim :: Text -> Canonical -> Bool
275isPrim prim (Canonical home name) =
276 case home of
277 BuiltIn ->
278 name == prim
280 _ ->
281 False
284isLocal :: (Text -> Bool) -> Canonical -> Bool
285isLocal check (Canonical home name) =
286 case home of
287 Local ->
288 check name
290 _ ->
291 False
295-- VARIABLE TO TEXT
298rawToText :: Raw -> Text
299rawToText (Raw name) =
300 name
303toText :: Canonical -> Text
304toText (Canonical home name) =
305 case home of
306 BuiltIn ->
307 name
309 Module moduleName ->
310 ModuleName.canonicalToText moduleName <> "." <> name
312 TopLevel _ ->
313 name
315 Local ->
316 name
320-- BINARY SERIALIZATION
323instance Binary Global where
324 put (Global home name) =
325 put home >> put name
327 get =
328 Global <$> get <*> get
331instance Binary Canonical where
332 put (Canonical home name) =
333 case home of
334 BuiltIn ->
335 putWord8 0 >> put name
337 Module path ->
338 putWord8 1 >> put path >> put name
340 TopLevel path ->
341 putWord8 2 >> put path >> put name
343 Local ->
344 putWord8 3 >> put name
346 get =
347 do tag <- getWord8
348 case tag of
349 0 -> Canonical BuiltIn <$> get
350 1 -> Canonical . Module <$> get <*> get
351 2 -> Canonical . TopLevel <$> get <*> get
352 3 -> Canonical Local <$> get
353 _ -> error "Unexpected tag when deserializing canonical variable"