git.iko.soy/elk
on 8f032c9 help sign in
elk/src/AST/Variable.hs
339 lines 5.8 kB history raw
1module AST.Variable where
3import Data.Binary
4import qualified Data.Maybe as Maybe
6import qualified AST.Helpers as Help
7import qualified AST.Module.Name as ModuleName
11-- RAW NAMES
14newtype Raw = Raw String
15 deriving (Eq, Ord)
19-- TOP LEVEL NAMES
22data TopLevel = TopLevelVar
23 { topHome :: ModuleName.Canonical
24 , topName :: String
25 }
26 deriving (Eq, Ord)
30-- CANONICAL NAMES
33data Home
34 = BuiltIn
35 | Module ModuleName.Canonical
36 | TopLevel ModuleName.Canonical
37 | Local
38 deriving (Eq, Ord)
41data Canonical = Canonical
42 { home :: !Home
43 , name :: !String
44 }
45 deriving (Eq, Ord)
48local :: String -> Canonical
49local x =
50 Canonical Local x
53topLevel :: ModuleName.Canonical -> String -> Canonical
54topLevel home x =
55 Canonical (TopLevel home) x
58builtin :: String -> Canonical
59builtin x =
60 Canonical BuiltIn x
63fromModule :: ModuleName.Canonical -> String -> Canonical
64fromModule home name =
65 Canonical (Module home) name
68inCore :: ModuleName.Raw -> String -> Canonical
69inCore home name =
70 Canonical (Module (ModuleName.inCore home)) name
73cmd :: Canonical
74cmd =
75 inCore ["Platform"] "Cmd"
78sub :: Canonical
79sub =
80 inCore ["Platform"] "Sub"
84-- VARIABLE RECOGNIZERS
87isLocalHome :: Home -> Bool
88isLocalHome home =
89 case home of
90 BuiltIn ->
91 False
93 Module _ ->
94 False
96 TopLevel _ ->
97 True
99 Local ->
100 True
103is :: ModuleName.Raw -> String -> Canonical -> Bool
104is home name var =
105 var == inCore home name
108isJson :: Canonical -> Bool
109isJson =
110 is ["Json", "Encode"] "Value"
113isMaybe :: Canonical -> Bool
114isMaybe =
115 is ["Maybe"] "Maybe"
117isArray :: Canonical -> Bool
118isArray =
119 is ["Array"] "Array"
122isTask :: Canonical -> Bool
123isTask =
124 is ["Task"] "Task"
127isSignal :: Canonical -> Bool
128isSignal =
129 is ["Signal"] "Signal"
132isText :: Canonical -> Bool
133isText =
134 is ["Text"] "Text"
137isList :: Canonical -> Bool
138isList v =
139 v == Canonical BuiltIn "List"
142isTuple :: Canonical -> Bool
143isTuple v =
144 case v of
145 Canonical BuiltIn name -> Help.isTuple name
146 _ -> False
149isPrimitive :: Canonical -> Bool
150isPrimitive v =
151 case v of
152 Canonical BuiltIn name ->
153 name `elem` ["Int","Float","String","Bool"]
154 _ ->
155 False
158isPrim :: String -> Canonical -> Bool
159isPrim prim (Canonical home name) =
160 case home of
161 BuiltIn ->
162 name == prim
164 _ ->
165 False
168isLocal :: (String -> Bool) -> Canonical -> Bool
169isLocal check (Canonical home name) =
170 case home of
171 Local ->
172 check name
174 _ ->
175 False
179-- VARIABLE TO STRING
182class ToString a where
183 toString :: a -> String
186instance ToString Raw where
187 toString (Raw name) =
188 name
191instance ToString Canonical where
192 toString (Canonical home name) =
193 case home of
194 BuiltIn ->
195 name
197 Module moduleName ->
198 ModuleName.canonicalToString moduleName ++ "." ++ name
200 TopLevel _ ->
201 name
203 Local ->
204 name
208-- LISTINGS
211-- | A listing of values. Something like (a,b,c) or (..) or (a,b,..)
212data Listing a = Listing
213 { _explicits :: [a]
214 , _open :: Bool
215 }
216 deriving (Eq, Ord)
219openListing :: Listing a
220openListing =
221 Listing [] True
224closedListing :: Listing a
225closedListing =
226 Listing [] False
229listing :: [a] -> Listing a
230listing xs =
231 Listing xs False
234-- | A value that can be imported or exported
235data Value
236 = Value !String
237 | Alias !String
238 | Union !String !(Listing String)
239 deriving (Eq, Ord)
243-- CATEGORIZING VALUES
246getValues :: [Value] -> [String]
247getValues values =
248 Maybe.mapMaybe getValue values
251getValue :: Value -> Maybe String
252getValue value =
253 case value of
254 Value name -> Just name
255 Alias _ -> Nothing
256 Union _ _ -> Nothing
259getAliases :: [Value] -> [String]
260getAliases values =
261 Maybe.mapMaybe getAlias values
264getAlias :: Value -> Maybe String
265getAlias value =
266 case value of
267 Value _-> Nothing
268 Alias name -> Just name
269 Union _ _ -> Nothing
272getUnions :: [Value] -> [(String, Listing String)]
273getUnions values =
274 Maybe.mapMaybe getUnion values
277getUnion :: Value -> Maybe (String, Listing String)
278getUnion value =
279 case value of
280 Value _ -> Nothing
281 Alias _ -> Nothing
282 Union name ctors -> Just (name, ctors)
286-- BINARY SERIALIZATION
289instance Binary Canonical where
290 put (Canonical home name) =
291 case home of
292 BuiltIn ->
293 putWord8 0 >> put name
295 Module path ->
296 putWord8 1 >> put path >> put name
298 TopLevel path ->
299 putWord8 2 >> put path >> put name
301 Local ->
302 putWord8 3 >> put name
304 get =
305 do tag <- getWord8
306 case tag of
307 0 -> Canonical BuiltIn <$> get
308 1 -> Canonical . Module <$> get <*> get
309 2 -> Canonical . TopLevel <$> get <*> get
310 3 -> Canonical Local <$> get
311 _ -> error "Unexpected tag when deserializing canonical variable"
314instance Binary Value where
315 put portable =
316 case portable of
317 Value name ->
318 putWord8 0 >> put name
320 Alias name ->
321 putWord8 1 >> put name
323 Union name ctors ->
324 putWord8 2 >> put name >> put ctors
326 get =
327 do tag <- getWord8
328 case tag of
329 0 -> Value <$> get
330 1 -> Alias <$> get
331 2 -> Union <$> get <*> get
332 _ -> error "Error reading valid import/export information from serialized string"
335instance (Binary a) => Binary (Listing a) where
336 put (Listing explicits open) =
337 put explicits >> put open
339 get = Listing <$> get <*> get