git.iko.soy/elk
on 8a43c40 help sign in
elk/src/AST/Variable.hs
316 lines 6.0 kB history raw
1module AST.Variable where
3import Control.Applicative ((<$>), (<*>))
4import Data.Binary
5import qualified Data.List as List
6import qualified Data.Map as Map
7import qualified Data.Maybe as Maybe
8import Text.PrettyPrint as P
10import qualified AST.Helpers as Help
11import qualified Reporting.PrettyPrint as P
14-- VARIABLES
16newtype Raw = Raw String
17 deriving (Eq, Ord, Show)
20data TopLevelVar =
21 TopLevelVar
22 { topVarModule :: [String]
23 , topVarName :: String
24 } deriving (Eq, Ord, Show)
27data Home
28 = BuiltIn
29 | Module [String]
30 | TopLevel [String]
31 | Local
32 deriving (Eq, Ord, Show)
35data Canonical = Canonical
36 { home :: !Home
37 , name :: !String
38 }
39 deriving (Eq, Ord, Show)
42local :: String -> Canonical
43local x =
44 Canonical Local x
47topLevel :: [String] -> String -> Canonical
48topLevel names x =
49 Canonical (TopLevel names) x
52builtin :: String -> Canonical
53builtin x =
54 Canonical BuiltIn x
57fromModule :: [String] -> String -> Canonical
58fromModule home name =
59 Canonical (Module home) name
62-- VARIABLE RECOGNIZERS
64is :: [String] -> String -> Canonical -> Bool
65is home name var =
66 var == Canonical (Module home) name
69isJson :: Canonical -> Bool
70isJson =
71 is ["Json", "Encode"] "Value"
74isMaybe :: Canonical -> Bool
75isMaybe =
76 is ["Maybe"] "Maybe"
78isArray :: Canonical -> Bool
79isArray =
80 is ["Array"] "Array"
83isTask :: Canonical -> Bool
84isTask =
85 is ["Task"] "Task"
88isSignal :: Canonical -> Bool
89isSignal =
90 is ["Signal"] "Signal"
93isList :: Canonical -> Bool
94isList v =
95 v == Canonical BuiltIn "List"
98isTuple :: Canonical -> Bool
99isTuple v =
100 case v of
101 Canonical BuiltIn name -> Help.isTuple name
102 _ -> False
105isPrimitive :: Canonical -> Bool
106isPrimitive v =
107 case v of
108 Canonical BuiltIn name ->
109 name `elem` ["Int","Float","String","Bool"]
110 _ ->
111 False
114isPrim :: String -> Canonical -> Bool
115isPrim prim v =
116 case v of
117 Canonical BuiltIn name -> name == prim
118 _ -> False
121isText :: Canonical -> Bool
122isText =
123 is ["Text"] "Text"
126-- VARIABLE TO STRING
128class ToString a where
129 toString :: a -> String
132instance ToString Raw where
133 toString (Raw name) =
134 name
137instance ToString Canonical where
138 toString (Canonical home name) =
139 case home of
140 BuiltIn ->
141 name
143 Module path ->
144 List.intercalate "." (path ++ [name])
146 TopLevel _ ->
147 name
149 Local ->
150 name
153-- LISTINGS
155-- | A listing of values. Something like (a,b,c) or (..) or (a,b,..)
156data Listing a = Listing
157 { _explicits :: [a]
158 , _open :: Bool
159 }
160 deriving (Eq, Ord, Show)
163openListing :: Listing a
164openListing =
165 Listing [] True
168closedListing :: Listing a
169closedListing =
170 Listing [] False
173listing :: [a] -> Listing a
174listing xs =
175 Listing xs False
178-- | A value that can be imported or exported
179data Value
180 = Value !String
181 | Alias !String
182 | Union !String !(Listing String)
183 deriving (Eq, Ord, Show)
186-- CATEGORIZING VALUES
188getValues :: [Value] -> [String]
189getValues values =
190 Maybe.mapMaybe getValue values
193getValue :: Value -> Maybe String
194getValue value =
195 case value of
196 Value name -> Just name
197 Alias _ -> Nothing
198 Union _ _ -> Nothing
201getAliases :: [Value] -> [String]
202getAliases values =
203 Maybe.mapMaybe getAlias values
206getAlias :: Value -> Maybe String
207getAlias value =
208 case value of
209 Value _-> Nothing
210 Alias name -> Just name
211 Union _ _ -> Nothing
214getUnions :: [Value] -> [(String, Listing String)]
215getUnions values =
216 Maybe.mapMaybe getUnion values
219getUnion :: Value -> Maybe (String, Listing String)
220getUnion value =
221 case value of
222 Value _ -> Nothing
223 Alias _ -> Nothing
224 Union name ctors -> Just (name, ctors)
227-- PRETTY VARIABLES
229instance P.Pretty Raw where
230 pretty _ _ (Raw name) =
231 if Help.isOp name
232 then P.parens (P.text name)
233 else P.text name
236instance P.Pretty Canonical where
237 pretty dealiaser _ var =
238 let
239 name = toString var
240 in
241 P.text (maybe name id (Map.lookup name dealiaser))
244instance P.Pretty a => P.Pretty (Listing a) where
245 pretty dealiaser _ (Listing explicits open) =
246 let dots = [if open then P.text ".." else P.empty]
247 in
248 P.parens (P.commaCat (map (P.pretty dealiaser False) explicits ++ dots))
251instance P.Pretty Value where
252 pretty dealiaser _ portable =
253 case portable of
254 Value name ->
255 P.text name
257 Alias name ->
258 P.text name
260 Union name ctors ->
261 P.text name <> P.pretty dealiaser False ctors
264-- BINARY SERIALIZATION
266instance Binary Canonical where
267 put (Canonical home name) =
268 case home of
269 BuiltIn ->
270 putWord8 0 >> put name
272 Module path ->
273 putWord8 1 >> put path >> put name
275 TopLevel path ->
276 putWord8 2 >> put path >> put name
278 Local ->
279 putWord8 3 >> put name
281 get =
282 do tag <- getWord8
283 case tag of
284 0 -> Canonical BuiltIn <$> get
285 1 -> Canonical . Module <$> get <*> get
286 2 -> Canonical . TopLevel <$> get <*> get
287 3 -> Canonical Local <$> get
288 _ -> error "Unexpected tag when deserializing canonical variable"
291instance Binary Value where
292 put portable =
293 case portable of
294 Value name ->
295 putWord8 0 >> put name
297 Alias name ->
298 putWord8 1 >> put name
300 Union name ctors ->
301 putWord8 2 >> put name >> put ctors
303 get =
304 do tag <- getWord8
305 case tag of
306 0 -> Value <$> get
307 1 -> Alias <$> get
308 2 -> Union <$> get <*> get
309 _ -> error "Error reading valid import/export information from serialized string"
312instance (Binary a) => Binary (Listing a) where
313 put (Listing explicits open) =
314 put explicits >> put open
316 get = Listing <$> get <*> get