git.iko.soy/elk
on 54dfb21 help sign in
elk/src/AST/Variable.hs
356 lines 6.6 kB history raw
1module AST.Variable where
3import Data.Binary
4import qualified Data.Map as Map
5import qualified Data.Maybe as Maybe
6import Text.PrettyPrint as P
8import qualified AST.Helpers as Help
9import qualified AST.Module.Name as ModuleName
10import qualified Reporting.PrettyPrint as P
13-- RAW NAMES
15newtype Raw = Raw String
16 deriving (Eq, Ord, Show)
19-- TOP LEVEL NAMES
21data TopLevel = TopLevelVar
22 { topHome :: ModuleName.Canonical
23 , topName :: String
24 }
25 deriving (Eq, Ord, Show)
29-- CANONICAL NAMES
31data Home
32 = BuiltIn
33 | Module ModuleName.Canonical
34 | TopLevel ModuleName.Canonical
35 | Local
36 deriving (Eq, Ord, Show)
39data Canonical = Canonical
40 { home :: !Home
41 , name :: !String
42 }
43 deriving (Eq, Ord, Show)
46local :: String -> Canonical
47local x =
48 Canonical Local x
51topLevel :: ModuleName.Canonical -> String -> Canonical
52topLevel home x =
53 Canonical (TopLevel home) x
56builtin :: String -> Canonical
57builtin x =
58 Canonical BuiltIn x
61fromModule :: ModuleName.Canonical -> String -> Canonical
62fromModule home name =
63 Canonical (Module home) name
66inCore :: ModuleName.Raw -> String -> Canonical
67inCore home name =
68 Canonical (Module (ModuleName.inCore home)) name
71-- VARIABLE RECOGNIZERS
73isLocalHome :: Home -> Bool
74isLocalHome home =
75 case home of
76 BuiltIn ->
77 False
79 Module _ ->
80 False
82 TopLevel _ ->
83 True
85 Local ->
86 True
89is :: ModuleName.Raw -> String -> Canonical -> Bool
90is home name var =
91 var == inCore home name
94isJson :: Canonical -> Bool
95isJson =
96 is ["Json", "Encode"] "Value"
99isMaybe :: Canonical -> Bool
100isMaybe =
101 is ["Maybe"] "Maybe"
103isArray :: Canonical -> Bool
104isArray =
105 is ["Array"] "Array"
108isTask :: Canonical -> Bool
109isTask =
110 is ["Task"] "Task"
113isSignal :: Canonical -> Bool
114isSignal =
115 is ["Signal"] "Signal"
118isText :: Canonical -> Bool
119isText =
120 is ["Text"] "Text"
123isList :: Canonical -> Bool
124isList v =
125 v == Canonical BuiltIn "List"
128isTuple :: Canonical -> Bool
129isTuple v =
130 case v of
131 Canonical BuiltIn name -> Help.isTuple name
132 _ -> False
135isPrimitive :: Canonical -> Bool
136isPrimitive v =
137 case v of
138 Canonical BuiltIn name ->
139 name `elem` ["Int","Float","String","Bool"]
140 _ ->
141 False
144isPrim :: String -> Canonical -> Bool
145isPrim prim (Canonical home name) =
146 case home of
147 BuiltIn ->
148 name == prim
150 _ ->
151 False
154isLocal :: (String -> Bool) -> Canonical -> Bool
155isLocal check (Canonical home name) =
156 case home of
157 Local ->
158 check name
160 _ ->
161 False
165-- VARIABLE TO STRING
168class ToString a where
169 toString :: a -> String
172instance ToString Raw where
173 toString (Raw name) =
174 name
177instance ToString Canonical where
178 toString (Canonical home name) =
179 case home of
180 BuiltIn ->
181 name
183 Module moduleName ->
184 ModuleName.canonicalToString moduleName ++ "." ++ name
186 TopLevel _ ->
187 name
189 Local ->
190 name
193-- 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, Show)
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, Show)
226-- CATEGORIZING VALUES
228getValues :: [Value] -> [String]
229getValues values =
230 Maybe.mapMaybe getValue values
233getValue :: Value -> Maybe String
234getValue value =
235 case value of
236 Value name -> Just name
237 Alias _ -> Nothing
238 Union _ _ -> Nothing
241getAliases :: [Value] -> [String]
242getAliases values =
243 Maybe.mapMaybe getAlias values
246getAlias :: Value -> Maybe String
247getAlias value =
248 case value of
249 Value _-> Nothing
250 Alias name -> Just name
251 Union _ _ -> Nothing
254getUnions :: [Value] -> [(String, Listing String)]
255getUnions values =
256 Maybe.mapMaybe getUnion values
259getUnion :: Value -> Maybe (String, Listing String)
260getUnion value =
261 case value of
262 Value _ -> Nothing
263 Alias _ -> Nothing
264 Union name ctors -> Just (name, ctors)
267-- PRETTY VARIABLES
269instance P.Pretty Raw where
270 pretty _ _ (Raw name) =
271 if Help.isOp name
272 then P.parens (P.text name)
273 else P.text name
276instance P.Pretty Canonical where
277 pretty dealiaser _ var =
278 let
279 name = toString var
280 in
281 P.text (maybe name id (Map.lookup name dealiaser))
284instance P.Pretty a => P.Pretty (Listing a) where
285 pretty dealiaser _ (Listing explicits open) =
286 let dots = [if open then P.text ".." else P.empty]
287 in
288 P.parens (P.commaCat (map (P.pretty dealiaser False) explicits ++ dots))
291instance P.Pretty Value where
292 pretty dealiaser _ portable =
293 case portable of
294 Value name ->
295 P.text name
297 Alias name ->
298 P.text name
300 Union name ctors ->
301 P.text name <> P.pretty dealiaser False ctors
304-- BINARY SERIALIZATION
306instance Binary Canonical where
307 put (Canonical home name) =
308 case home of
309 BuiltIn ->
310 putWord8 0 >> put name
312 Module path ->
313 putWord8 1 >> put path >> put name
315 TopLevel path ->
316 putWord8 2 >> put path >> put name
318 Local ->
319 putWord8 3 >> put name
321 get =
322 do tag <- getWord8
323 case tag of
324 0 -> Canonical BuiltIn <$> get
325 1 -> Canonical . Module <$> get <*> get
326 2 -> Canonical . TopLevel <$> get <*> get
327 3 -> Canonical Local <$> get
328 _ -> error "Unexpected tag when deserializing canonical variable"
331instance Binary Value where
332 put portable =
333 case portable of
334 Value name ->
335 putWord8 0 >> put name
337 Alias name ->
338 putWord8 1 >> put name
340 Union name ctors ->
341 putWord8 2 >> put name >> put ctors
343 get =
344 do tag <- getWord8
345 case tag of
346 0 -> Value <$> get
347 1 -> Alias <$> get
348 2 -> Union <$> get <*> get
349 _ -> error "Error reading valid import/export information from serialized string"
352instance (Binary a) => Binary (Listing a) where
353 put (Listing explicits open) =
354 put explicits >> put open
356 get = Listing <$> get <*> get