git.iko.soy/elk
on e53128c help sign in
elk/src/AST/Variable.hs
352 lines 6.2 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2{-# LANGUAGE OverloadedStrings #-}
3module AST.Variable where
5import Data.Binary
6import qualified Data.Maybe as Maybe
7import qualified Data.Text as Text
8import Data.Text (Text)
10import qualified AST.Helpers as Help
11import qualified AST.Module.Name as ModuleName
15-- RAW NAMES
18newtype Raw = Raw Text
19 deriving (Eq, Ord)
23-- CANONICAL NAMES
26data Home
27 = BuiltIn
28 | Module ModuleName.Canonical
29 | TopLevel ModuleName.Canonical
30 | Local
31 deriving (Eq, Ord)
34data Canonical = Canonical
35 { _home :: !Home
36 , _name :: !Text
37 }
38 deriving (Eq, Ord)
41local :: Text -> Canonical
42local x =
43 Canonical Local x
46topLevel :: ModuleName.Canonical -> Text -> Canonical
47topLevel home x =
48 Canonical (TopLevel home) x
51builtin :: Text -> Canonical
52builtin x =
53 Canonical BuiltIn x
56fromModule :: ModuleName.Canonical -> Text -> Canonical
57fromModule home name =
58 Canonical (Module home) name
61inCore :: ModuleName.Raw -> Text -> Canonical
62inCore home name =
63 Canonical (Module (ModuleName.inCore home)) name
66inHtml :: ModuleName.Raw -> Text -> Canonical
67inHtml home name =
68 Canonical (Module (ModuleName.inHtml home)) name
71inWebGL :: ModuleName.Raw -> Text -> Canonical
72inWebGL home name =
73 Canonical (Module (ModuleName.inWebGL home)) name
76inLinearAlgebra :: ModuleName.Raw -> Text -> Canonical
77inLinearAlgebra home name =
78 Canonical (Module (ModuleName.inLinearAlgebra home)) name
81cmd :: Canonical
82cmd =
83 inCore "Platform.Cmd" "Cmd"
86sub :: Canonical
87sub =
88 inCore "Platform.Sub" "Sub"
92-- VARIABLE RECOGNIZERS
95isLocalHome :: Home -> Bool
96isLocalHome home =
97 case home of
98 BuiltIn ->
99 False
101 Module _ ->
102 False
104 TopLevel _ ->
105 True
107 Local ->
108 True
111is :: ModuleName.Raw -> Text -> Canonical -> Bool
112is home name var =
113 var == inCore home name
116isJson :: Canonical -> Bool
117isJson =
118 is "Json.Encode" "Value"
121isMaybe :: Canonical -> Bool
122isMaybe =
123 is "Maybe" "Maybe"
125isArray :: Canonical -> Bool
126isArray =
127 is "Array" "Array"
130isTask :: Canonical -> Bool
131isTask =
132 is "Task" "Task"
135isList :: Canonical -> Bool
136isList v =
137 v == Canonical BuiltIn "List"
140isNative :: Canonical -> Bool
141isNative v =
142 case v of
143 Canonical (Module name) _ ->
144 ModuleName.canonicalIsNative name
146 _ ->
147 False
150isTuple :: Canonical -> Bool
151isTuple v =
152 case v of
153 Canonical BuiltIn name ->
154 Help.isTuple name
156 _ ->
157 False
160isPrimitive :: Canonical -> Bool
161isPrimitive v =
162 case v of
163 Canonical BuiltIn name ->
164 elem name ["Int","Float","String","Bool"]
166 _ ->
167 False
170isPrim :: Text -> Canonical -> Bool
171isPrim prim (Canonical home name) =
172 case home of
173 BuiltIn ->
174 name == prim
176 _ ->
177 False
180isLocal :: (Text -> Bool) -> Canonical -> Bool
181isLocal check (Canonical home name) =
182 case home of
183 Local ->
184 check name
186 _ ->
187 False
191-- VARIABLE TO STRING
194class ToString a where
195 toString :: a -> String
198instance ToString Raw where
199 toString (Raw name) =
200 Text.unpack name
203instance ToString Canonical where
204 toString (Canonical home name) =
205 case home of
206 BuiltIn ->
207 Text.unpack name
209 Module moduleName ->
210 ModuleName.canonicalToString moduleName ++ "." ++ Text.unpack name
212 TopLevel _ ->
213 Text.unpack name
215 Local ->
216 Text.unpack name
220-- LISTINGS
223-- | A listing of values. Something like (a,b,c) or (..) or (a,b,..)
224data Listing a =
225 Listing
226 { _explicits :: [a]
227 , _open :: Bool
228 }
229 deriving (Eq, Ord)
232openListing :: Listing a
233openListing =
234 Listing [] True
237closedListing :: Listing a
238closedListing =
239 Listing [] False
242listing :: [a] -> Listing a
243listing xs =
244 Listing xs False
247-- | A value that can be imported or exported
248data Value
249 = Value !Text
250 | Alias !Text
251 | Union !Text !(Listing Text)
252 deriving (Eq, Ord)
256-- CATEGORIZING VALUES
259getValues :: [Value] -> [Text]
260getValues values =
261 Maybe.mapMaybe getValue values
264getValue :: Value -> Maybe Text
265getValue value =
266 case value of
267 Value name -> Just name
268 Alias _ -> Nothing
269 Union _ _ -> Nothing
272getAliases :: [Value] -> [Text]
273getAliases values =
274 Maybe.mapMaybe getAlias values
277getAlias :: Value -> Maybe Text
278getAlias value =
279 case value of
280 Value _-> Nothing
281 Alias name -> Just name
282 Union _ _ -> Nothing
285getUnions :: [Value] -> [(Text, Listing Text)]
286getUnions values =
287 Maybe.mapMaybe getUnion values
290getUnion :: Value -> Maybe (Text, Listing Text)
291getUnion value =
292 case value of
293 Value _ -> Nothing
294 Alias _ -> Nothing
295 Union name ctors -> Just (name, ctors)
299-- BINARY SERIALIZATION
302instance Binary Canonical where
303 put (Canonical home name) =
304 case home of
305 BuiltIn ->
306 putWord8 0 >> put name
308 Module path ->
309 putWord8 1 >> put path >> put name
311 TopLevel path ->
312 putWord8 2 >> put path >> put name
314 Local ->
315 putWord8 3 >> put name
317 get =
318 do tag <- getWord8
319 case tag of
320 0 -> Canonical BuiltIn <$> get
321 1 -> Canonical . Module <$> get <*> get
322 2 -> Canonical . TopLevel <$> get <*> get
323 3 -> Canonical Local <$> get
324 _ -> error "Unexpected tag when deserializing canonical variable"
327instance Binary Value where
328 put portable =
329 case portable of
330 Value name ->
331 putWord8 0 >> put name
333 Alias name ->
334 putWord8 1 >> put name
336 Union name ctors ->
337 putWord8 2 >> put name >> put ctors
339 get =
340 do tag <- getWord8
341 case tag of
342 0 -> Value <$> get
343 1 -> Alias <$> get
344 2 -> Union <$> get <*> get
345 _ -> error "Error reading valid import/export information from serialized string"
348instance (Binary a) => Binary (Listing a) where
349 put (Listing explicits open) =
350 put explicits >> put open
352 get = Listing <$> get <*> get