git.iko.soy/elk
on fcf5cef help sign in
elk/src/AST/Variable.hs
330 lines 5.8 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
71cmd :: Canonical
72cmd =
73 inCore ["Platform","Cmd"] "Cmd"
76sub :: Canonical
77sub =
78 inCore ["Platform","Sub"] "Sub"
82-- VARIABLE RECOGNIZERS
85isLocalHome :: Home -> Bool
86isLocalHome home =
87 case home of
88 BuiltIn ->
89 False
91 Module _ ->
92 False
94 TopLevel _ ->
95 True
97 Local ->
98 True
101is :: ModuleName.Raw -> Text -> Canonical -> Bool
102is home name var =
103 var == inCore home name
106isJson :: Canonical -> Bool
107isJson =
108 is ["Json", "Encode"] "Value"
111isMaybe :: Canonical -> Bool
112isMaybe =
113 is ["Maybe"] "Maybe"
115isArray :: Canonical -> Bool
116isArray =
117 is ["Array"] "Array"
120isTask :: Canonical -> Bool
121isTask =
122 is ["Task"] "Task"
125isList :: Canonical -> Bool
126isList v =
127 v == Canonical BuiltIn "List"
130isTuple :: Canonical -> Bool
131isTuple v =
132 case v of
133 Canonical BuiltIn name ->
134 Help.isTuple name
136 _ ->
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 :: Text -> Canonical -> Bool
150isPrim prim (Canonical home name) =
151 case home of
152 BuiltIn ->
153 name == prim
155 _ ->
156 False
159isLocal :: (Text -> 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 Text.unpack name
182instance ToString Canonical where
183 toString (Canonical home name) =
184 case home of
185 BuiltIn ->
186 Text.unpack name
188 Module moduleName ->
189 ModuleName.canonicalToString moduleName ++ "." ++ Text.unpack name
191 TopLevel _ ->
192 Text.unpack name
194 Local ->
195 Text.unpack 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