git.iko.soy/elk
on f5bf4e6 help sign in
elk/src/AST/Variable.hs
334 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
73inHtml :: ModuleName.Raw -> String -> Canonical
74inHtml home name =
75 Canonical (Module (ModuleName.inHtml home)) name
78cmd :: Canonical
79cmd =
80 inCore ["Platform","Cmd"] "Cmd"
83sub :: Canonical
84sub =
85 inCore ["Platform","Sub"] "Sub"
89-- VARIABLE RECOGNIZERS
92isLocalHome :: Home -> Bool
93isLocalHome home =
94 case home of
95 BuiltIn ->
96 False
98 Module _ ->
99 False
101 TopLevel _ ->
102 True
104 Local ->
105 True
108is :: ModuleName.Raw -> String -> Canonical -> Bool
109is home name var =
110 var == inCore home name
113isJson :: Canonical -> Bool
114isJson =
115 is ["Json", "Encode"] "Value"
118isMaybe :: Canonical -> Bool
119isMaybe =
120 is ["Maybe"] "Maybe"
122isArray :: Canonical -> Bool
123isArray =
124 is ["Array"] "Array"
127isTask :: Canonical -> Bool
128isTask =
129 is ["Task"] "Task"
132isList :: Canonical -> Bool
133isList v =
134 v == Canonical BuiltIn "List"
137isTuple :: Canonical -> Bool
138isTuple v =
139 case v of
140 Canonical BuiltIn name -> Help.isTuple name
141 _ -> False
144isPrimitive :: Canonical -> Bool
145isPrimitive v =
146 case v of
147 Canonical BuiltIn name ->
148 name `elem` ["Int","Float","String","Bool"]
149 _ ->
150 False
153isPrim :: String -> Canonical -> Bool
154isPrim prim (Canonical home name) =
155 case home of
156 BuiltIn ->
157 name == prim
159 _ ->
160 False
163isLocal :: (String -> Bool) -> Canonical -> Bool
164isLocal check (Canonical home name) =
165 case home of
166 Local ->
167 check name
169 _ ->
170 False
174-- VARIABLE TO STRING
177class ToString a where
178 toString :: a -> String
181instance ToString Raw where
182 toString (Raw name) =
183 name
186instance ToString Canonical where
187 toString (Canonical home name) =
188 case home of
189 BuiltIn ->
190 name
192 Module moduleName ->
193 ModuleName.canonicalToString moduleName ++ "." ++ name
195 TopLevel _ ->
196 name
198 Local ->
199 name
203-- LISTINGS
206-- | A listing of values. Something like (a,b,c) or (..) or (a,b,..)
207data Listing a = Listing
208 { _explicits :: [a]
209 , _open :: Bool
210 }
211 deriving (Eq, Ord)
214openListing :: Listing a
215openListing =
216 Listing [] True
219closedListing :: Listing a
220closedListing =
221 Listing [] False
224listing :: [a] -> Listing a
225listing xs =
226 Listing xs False
229-- | A value that can be imported or exported
230data Value
231 = Value !String
232 | Alias !String
233 | Union !String !(Listing String)
234 deriving (Eq, Ord)
238-- CATEGORIZING VALUES
241getValues :: [Value] -> [String]
242getValues values =
243 Maybe.mapMaybe getValue values
246getValue :: Value -> Maybe String
247getValue value =
248 case value of
249 Value name -> Just name
250 Alias _ -> Nothing
251 Union _ _ -> Nothing
254getAliases :: [Value] -> [String]
255getAliases values =
256 Maybe.mapMaybe getAlias values
259getAlias :: Value -> Maybe String
260getAlias value =
261 case value of
262 Value _-> Nothing
263 Alias name -> Just name
264 Union _ _ -> Nothing
267getUnions :: [Value] -> [(String, Listing String)]
268getUnions values =
269 Maybe.mapMaybe getUnion values
272getUnion :: Value -> Maybe (String, Listing String)
273getUnion value =
274 case value of
275 Value _ -> Nothing
276 Alias _ -> Nothing
277 Union name ctors -> Just (name, ctors)
281-- BINARY SERIALIZATION
284instance Binary Canonical where
285 put (Canonical home name) =
286 case home of
287 BuiltIn ->
288 putWord8 0 >> put name
290 Module path ->
291 putWord8 1 >> put path >> put name
293 TopLevel path ->
294 putWord8 2 >> put path >> put name
296 Local ->
297 putWord8 3 >> put name
299 get =
300 do tag <- getWord8
301 case tag of
302 0 -> Canonical BuiltIn <$> get
303 1 -> Canonical . Module <$> get <*> get
304 2 -> Canonical . TopLevel <$> get <*> get
305 3 -> Canonical Local <$> get
306 _ -> error "Unexpected tag when deserializing canonical variable"
309instance Binary Value where
310 put portable =
311 case portable of
312 Value name ->
313 putWord8 0 >> put name
315 Alias name ->
316 putWord8 1 >> put name
318 Union name ctors ->
319 putWord8 2 >> put name >> put ctors
321 get =
322 do tag <- getWord8
323 case tag of
324 0 -> Value <$> get
325 1 -> Alias <$> get
326 2 -> Union <$> get <*> get
327 _ -> error "Error reading valid import/export information from serialized string"
330instance (Binary a) => Binary (Listing a) where
331 put (Listing explicits open) =
332 put explicits >> put open
334 get = Listing <$> get <*> get