git.iko.soy/elk
on eb97f2a help sign in
elk/src/AST/Variable.hs
323 lines 5.6 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-- CANONICAL NAMES
22data Home
23 = BuiltIn
24 | Module ModuleName.Canonical
25 | TopLevel ModuleName.Canonical
26 | Local
27 deriving (Eq, Ord)
30data Canonical = Canonical
31 { home :: !Home
32 , name :: !String
33 }
34 deriving (Eq, Ord)
37local :: String -> Canonical
38local x =
39 Canonical Local x
42topLevel :: ModuleName.Canonical -> String -> Canonical
43topLevel home x =
44 Canonical (TopLevel home) x
47builtin :: String -> Canonical
48builtin x =
49 Canonical BuiltIn x
52fromModule :: ModuleName.Canonical -> String -> Canonical
53fromModule home name =
54 Canonical (Module home) name
57inCore :: ModuleName.Raw -> String -> Canonical
58inCore home name =
59 Canonical (Module (ModuleName.inCore home)) name
62inHtml :: ModuleName.Raw -> String -> Canonical
63inHtml home name =
64 Canonical (Module (ModuleName.inHtml home)) name
67cmd :: Canonical
68cmd =
69 inCore ["Platform","Cmd"] "Cmd"
72sub :: Canonical
73sub =
74 inCore ["Platform","Sub"] "Sub"
78-- VARIABLE RECOGNIZERS
81isLocalHome :: Home -> Bool
82isLocalHome home =
83 case home of
84 BuiltIn ->
85 False
87 Module _ ->
88 False
90 TopLevel _ ->
91 True
93 Local ->
94 True
97is :: ModuleName.Raw -> String -> Canonical -> Bool
98is home name var =
99 var == inCore home name
102isJson :: Canonical -> Bool
103isJson =
104 is ["Json", "Encode"] "Value"
107isMaybe :: Canonical -> Bool
108isMaybe =
109 is ["Maybe"] "Maybe"
111isArray :: Canonical -> Bool
112isArray =
113 is ["Array"] "Array"
116isTask :: Canonical -> Bool
117isTask =
118 is ["Task"] "Task"
121isList :: Canonical -> Bool
122isList v =
123 v == Canonical BuiltIn "List"
126isTuple :: Canonical -> Bool
127isTuple v =
128 case v of
129 Canonical BuiltIn name -> Help.isTuple name
130 _ -> False
133isPrimitive :: Canonical -> Bool
134isPrimitive v =
135 case v of
136 Canonical BuiltIn name ->
137 name `elem` ["Int","Float","String","Bool"]
138 _ ->
139 False
142isPrim :: String -> Canonical -> Bool
143isPrim prim (Canonical home name) =
144 case home of
145 BuiltIn ->
146 name == prim
148 _ ->
149 False
152isLocal :: (String -> Bool) -> Canonical -> Bool
153isLocal check (Canonical home name) =
154 case home of
155 Local ->
156 check name
158 _ ->
159 False
163-- VARIABLE TO STRING
166class ToString a where
167 toString :: a -> String
170instance ToString Raw where
171 toString (Raw name) =
172 name
175instance ToString Canonical where
176 toString (Canonical home name) =
177 case home of
178 BuiltIn ->
179 name
181 Module moduleName ->
182 ModuleName.canonicalToString moduleName ++ "." ++ name
184 TopLevel _ ->
185 name
187 Local ->
188 name
192-- LISTINGS
195-- | A listing of values. Something like (a,b,c) or (..) or (a,b,..)
196data Listing a = Listing
197 { _explicits :: [a]
198 , _open :: Bool
199 }
200 deriving (Eq, Ord)
203openListing :: Listing a
204openListing =
205 Listing [] True
208closedListing :: Listing a
209closedListing =
210 Listing [] False
213listing :: [a] -> Listing a
214listing xs =
215 Listing xs False
218-- | A value that can be imported or exported
219data Value
220 = Value !String
221 | Alias !String
222 | Union !String !(Listing String)
223 deriving (Eq, Ord)
227-- CATEGORIZING VALUES
230getValues :: [Value] -> [String]
231getValues values =
232 Maybe.mapMaybe getValue values
235getValue :: Value -> Maybe String
236getValue value =
237 case value of
238 Value name -> Just name
239 Alias _ -> Nothing
240 Union _ _ -> Nothing
243getAliases :: [Value] -> [String]
244getAliases values =
245 Maybe.mapMaybe getAlias values
248getAlias :: Value -> Maybe String
249getAlias value =
250 case value of
251 Value _-> Nothing
252 Alias name -> Just name
253 Union _ _ -> Nothing
256getUnions :: [Value] -> [(String, Listing String)]
257getUnions values =
258 Maybe.mapMaybe getUnion values
261getUnion :: Value -> Maybe (String, Listing String)
262getUnion value =
263 case value of
264 Value _ -> Nothing
265 Alias _ -> Nothing
266 Union name ctors -> Just (name, ctors)
270-- BINARY SERIALIZATION
273instance Binary Canonical where
274 put (Canonical home name) =
275 case home of
276 BuiltIn ->
277 putWord8 0 >> put name
279 Module path ->
280 putWord8 1 >> put path >> put name
282 TopLevel path ->
283 putWord8 2 >> put path >> put name
285 Local ->
286 putWord8 3 >> put name
288 get =
289 do tag <- getWord8
290 case tag of
291 0 -> Canonical BuiltIn <$> get
292 1 -> Canonical . Module <$> get <*> get
293 2 -> Canonical . TopLevel <$> get <*> get
294 3 -> Canonical Local <$> get
295 _ -> error "Unexpected tag when deserializing canonical variable"
298instance Binary Value where
299 put portable =
300 case portable of
301 Value name ->
302 putWord8 0 >> put name
304 Alias name ->
305 putWord8 1 >> put name
307 Union name ctors ->
308 putWord8 2 >> put name >> put ctors
310 get =
311 do tag <- getWord8
312 case tag of
313 0 -> Value <$> get
314 1 -> Alias <$> get
315 2 -> Union <$> get <*> get
316 _ -> error "Error reading valid import/export information from serialized string"
319instance (Binary a) => Binary (Listing a) where
320 put (Listing explicits open) =
321 put explicits >> put open
323 get = Listing <$> get <*> get