git.iko.soy/elk
on bfb8eca help sign in
elk/src/AST/Variable.hs
318 lines 4.7 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2{-# LANGUAGE OverloadedStrings #-}
3module 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
16 )
17 where
19import Data.Binary
20import Data.Monoid ((<>))
21import Data.Text (Text)
23import qualified AST.Module.Name as ModuleName
24import qualified Elm.Package as Pkg
28-- CANONICAL NAMES
31data Home
32 = BuiltIn
33 | Module !ModuleName.Canonical
34 | TopLevel !ModuleName.Canonical
35 | Local
36 deriving (Eq, Ord)
39data Canonical =
40 Canonical
41 { _home :: !Home
42 , _name :: !Text
43 }
44 deriving (Eq, Ord)
48-- GLOBAL NAMES
51data Global = Global !ModuleName.Canonical !Text
52 deriving (Eq, Ord)
56-- HELPERS
59local :: Text -> Canonical
60local x =
61 Canonical Local x
64topLevel :: ModuleName.Canonical -> Text -> Canonical
65topLevel home x =
66 Canonical (TopLevel home) x
69fromModule :: ModuleName.Canonical -> Text -> Canonical
70fromModule home name =
71 Canonical (Module home) name
74inCore :: ModuleName.Raw -> Text -> Canonical
75inCore home name =
76 Canonical (Module (ModuleName.inCore home)) name
79inHtml :: ModuleName.Raw -> Text -> Canonical
80inHtml home name =
81 Canonical (Module (ModuleName.inHtml home)) name
85-- BUILT IN TYPES
88int :: Canonical
89int =
90 Canonical BuiltIn "Int"
93float :: Canonical
94float =
95 Canonical BuiltIn "Float"
98char :: Canonical
99char =
100 Canonical BuiltIn "Char"
103string :: Canonical
104string =
105 Canonical BuiltIn "String"
109-- LIST
112list :: Canonical
113list =
114 Canonical BuiltIn "List"
117cons :: Canonical
118cons =
119 Canonical BuiltIn "::"
122nil :: Canonical
123nil =
124 Canonical BuiltIn "[]"
128-- BOOLEANS
131bool :: Canonical
132bool =
133 Canonical BuiltIn "Bool"
136true :: Canonical
137true =
138 Canonical BuiltIn "True"
141false :: Canonical
142false =
143 Canonical BuiltIn "False"
147-- CORE TYPES
150never :: Canonical
151never =
152 inCore "Basics" "Never"
155task :: Canonical
156task =
157 inCore "Platform" "Task"
160router :: Canonical
161router =
162 inCore "Platform" "Router"
165shader :: Canonical
166shader =
167 fromModule (ModuleName.Canonical Pkg.webgl "WebGL") "Shader"
170decoder :: Canonical
171decoder =
172 inCore "Json.Decode" "Decoder"
176-- VARIABLE RECOGNIZERS
179isLocalHome :: Home -> Bool
180isLocalHome home =
181 case home of
182 BuiltIn ->
183 False
185 Module _ ->
186 False
188 TopLevel _ ->
189 True
191 Local ->
192 True
195isCons :: Canonical -> Bool
196isCons var =
197 case var of
198 Canonical BuiltIn "::" ->
199 True
201 _ ->
202 False
205is :: ModuleName.Raw -> Text -> Canonical -> Bool
206is home name var =
207 var == inCore home name
210isJson :: Canonical -> Bool
211isJson =
212 is "Json.Encode" "Value"
215isMaybe :: Canonical -> Bool
216isMaybe =
217 is "Maybe" "Maybe"
219isArray :: Canonical -> Bool
220isArray =
221 is "Array" "Array"
224isTask :: Canonical -> Bool
225isTask =
226 is "Task" "Task"
229isList :: Canonical -> Bool
230isList var =
231 var == Canonical BuiltIn "List"
234isKernel :: Canonical -> Bool
235isKernel var =
236 case var of
237 Canonical (Module name) _ ->
238 ModuleName.canonicalIsKernel name
240 _ ->
241 False
244isPrim :: Text -> Canonical -> Bool
245isPrim prim (Canonical home name) =
246 case home of
247 BuiltIn ->
248 name == prim
250 _ ->
251 False
254isLocal :: (Text -> Bool) -> Canonical -> Bool
255isLocal check (Canonical home name) =
256 case home of
257 Local ->
258 check name
260 _ ->
261 False
265-- VARIABLE TO TEXT
268toText :: Canonical -> Text
269toText (Canonical home name) =
270 case home of
271 BuiltIn ->
272 name
274 Module moduleName ->
275 ModuleName.canonicalToText moduleName <> "." <> name
277 TopLevel _ ->
278 name
280 Local ->
281 name
285-- BINARY SERIALIZATION
288instance Binary Global where
289 put (Global home name) =
290 put home >> put name
292 get =
293 Global <$> get <*> get
296instance Binary Canonical where
297 put (Canonical home name) =
298 case home of
299 BuiltIn ->
300 putWord8 0 >> put name
302 Module path ->
303 putWord8 1 >> put path >> put name
305 TopLevel path ->
306 putWord8 2 >> put path >> put name
308 Local ->
309 putWord8 3 >> put name
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"