git.iko.soy/elk
on 74db13f help sign in
elk/src/AST/Variable.hs
330 lines 5.7 kB history raw
1module AST.Variable where
3import Data.Binary
4import qualified Data.Map as Map
5import qualified Data.Maybe as Maybe
7import qualified AST.Helpers as Help
8import qualified AST.Module.Name as ModuleName
12-- RAW NAMES
15newtype Raw = Raw String
16 deriving (Eq, Ord)
20-- TOP LEVEL NAMES
23data TopLevel = TopLevelVar
24 { topHome :: ModuleName.Canonical
25 , topName :: String
26 }
27 deriving (Eq, Ord)
31-- CANONICAL NAMES
34data Home
35 = BuiltIn
36 | Module ModuleName.Canonical
37 | TopLevel ModuleName.Canonical
38 | Local
39 deriving (Eq, Ord)
42data Canonical = Canonical
43 { home :: !Home
44 , name :: !String
45 }
46 deriving (Eq, Ord)
49local :: String -> Canonical
50local x =
51 Canonical Local x
54topLevel :: ModuleName.Canonical -> String -> Canonical
55topLevel home x =
56 Canonical (TopLevel home) x
59builtin :: String -> Canonical
60builtin x =
61 Canonical BuiltIn x
64fromModule :: ModuleName.Canonical -> String -> Canonical
65fromModule home name =
66 Canonical (Module home) name
69inCore :: ModuleName.Raw -> String -> Canonical
70inCore home name =
71 Canonical (Module (ModuleName.inCore home)) name
75-- VARIABLE RECOGNIZERS
78isLocalHome :: Home -> Bool
79isLocalHome home =
80 case home of
81 BuiltIn ->
82 False
84 Module _ ->
85 False
87 TopLevel _ ->
88 True
90 Local ->
91 True
94is :: ModuleName.Raw -> String -> Canonical -> Bool
95is home name var =
96 var == inCore home name
99isJson :: Canonical -> Bool
100isJson =
101 is ["Json", "Encode"] "Value"
104isMaybe :: Canonical -> Bool
105isMaybe =
106 is ["Maybe"] "Maybe"
108isArray :: Canonical -> Bool
109isArray =
110 is ["Array"] "Array"
113isTask :: Canonical -> Bool
114isTask =
115 is ["Task"] "Task"
118isSignal :: Canonical -> Bool
119isSignal =
120 is ["Signal"] "Signal"
123isText :: Canonical -> Bool
124isText =
125 is ["Text"] "Text"
128isList :: Canonical -> Bool
129isList v =
130 v == Canonical BuiltIn "List"
133isTuple :: Canonical -> Bool
134isTuple v =
135 case v of
136 Canonical BuiltIn name -> Help.isTuple name
137 _ -> False
140isPrimitive :: Canonical -> Bool
141isPrimitive v =
142 case v of
143 Canonical BuiltIn name ->
144 name `elem` ["Int","Float","String","Bool"]
145 _ ->
146 False
149isPrim :: String -> Canonical -> Bool
150isPrim prim (Canonical home name) =
151 case home of
152 BuiltIn ->
153 name == prim
155 _ ->
156 False
159isLocal :: (String -> Bool) -> Canonical -> Bool
160isLocal check (Canonical home name) =
161 case home of
162 Local ->
163 check name
165 _ ->
166 False
170-- VARIABLE TO STRING
173class ToString a where
174 toString :: a -> String
177instance ToString Raw where
178 toString (Raw name) =
179 name
182instance ToString Canonical where
183 toString (Canonical home name) =
184 case home of
185 BuiltIn ->
186 name
188 Module moduleName ->
189 ModuleName.canonicalToString moduleName ++ "." ++ name
191 TopLevel _ ->
192 name
194 Local ->
195 name
199-- LISTINGS
202-- | A listing of values. Something like (a,b,c) or (..) or (a,b,..)
203data Listing a = Listing
204 { _explicits :: [a]
205 , _open :: Bool
206 }
207 deriving (Eq, Ord)
210openListing :: Listing a
211openListing =
212 Listing [] True
215closedListing :: Listing a
216closedListing =
217 Listing [] False
220listing :: [a] -> Listing a
221listing xs =
222 Listing xs False
225-- | A value that can be imported or exported
226data Value
227 = Value !String
228 | Alias !String
229 | Union !String !(Listing String)
230 deriving (Eq, Ord)
234-- CATEGORIZING VALUES
237getValues :: [Value] -> [String]
238getValues values =
239 Maybe.mapMaybe getValue values
242getValue :: Value -> Maybe String
243getValue value =
244 case value of
245 Value name -> Just name
246 Alias _ -> Nothing
247 Union _ _ -> Nothing
250getAliases :: [Value] -> [String]
251getAliases values =
252 Maybe.mapMaybe getAlias values
255getAlias :: Value -> Maybe String
256getAlias value =
257 case value of
258 Value _-> Nothing
259 Alias name -> Just name
260 Union _ _ -> Nothing
263getUnions :: [Value] -> [(String, Listing String)]
264getUnions values =
265 Maybe.mapMaybe getUnion values
268getUnion :: Value -> Maybe (String, Listing String)
269getUnion value =
270 case value of
271 Value _ -> Nothing
272 Alias _ -> Nothing
273 Union name ctors -> Just (name, ctors)
277-- BINARY SERIALIZATION
280instance Binary Canonical where
281 put (Canonical home name) =
282 case home of
283 BuiltIn ->
284 putWord8 0 >> put name
286 Module path ->
287 putWord8 1 >> put path >> put name
289 TopLevel path ->
290 putWord8 2 >> put path >> put name
292 Local ->
293 putWord8 3 >> put name
295 get =
296 do tag <- getWord8
297 case tag of
298 0 -> Canonical BuiltIn <$> get
299 1 -> Canonical . Module <$> get <*> get
300 2 -> Canonical . TopLevel <$> get <*> get
301 3 -> Canonical Local <$> get
302 _ -> error "Unexpected tag when deserializing canonical variable"
305instance Binary Value where
306 put portable =
307 case portable of
308 Value name ->
309 putWord8 0 >> put name
311 Alias name ->
312 putWord8 1 >> put name
314 Union name ctors ->
315 putWord8 2 >> put name >> put ctors
317 get =
318 do tag <- getWord8
319 case tag of
320 0 -> Value <$> get
321 1 -> Alias <$> get
322 2 -> Union <$> get <*> get
323 _ -> error "Error reading valid import/export information from serialized string"
326instance (Binary a) => Binary (Listing a) where
327 put (Listing explicits open) =
328 put explicits >> put open
330 get = Listing <$> get <*> get