git.iko.soy/elk
on 552becc help sign in
elk/src/AST/Variable.hs
278 lines 5.5 kB history raw
1module AST.Variable where
3import Control.Applicative ((<$>), (<*>))
4import Data.Binary
5import qualified Data.List as List
6import qualified Data.Maybe as Maybe
7import Text.PrettyPrint as P
8import qualified AST.Helpers as Help
9import AST.PrettyPrint
12-- VARIABLES
14newtype Raw = Raw String
15 deriving (Eq,Ord,Show)
18data Home
19 = BuiltIn
20 | Module [String]
21 | Local
22 deriving (Eq,Ord,Show)
25data Canonical = Canonical
26 { home :: !Home
27 , name :: !String
28 }
29 deriving (Eq,Ord,Show)
32local :: String -> Canonical
33local x = Canonical Local x
36builtin :: String -> Canonical
37builtin x = Canonical BuiltIn x
40fromModule :: [String] -> String -> Canonical
41fromModule home name =
42 Canonical (Module home) name
45-- VARIABLE RECOGNIZERS
47is :: [String] -> String -> Canonical -> Bool
48is home name var =
49 var == Canonical (Module home) name
52isJson :: Canonical -> Bool
53isJson =
54 is ["Json", "Encode"] "Value"
57isMaybe :: Canonical -> Bool
58isMaybe =
59 is ["Maybe"] "Maybe"
61isArray :: Canonical -> Bool
62isArray =
63 is ["Array"] "Array"
66isStream :: Canonical -> Bool
67isStream =
68 is ["Signal"] "Stream"
71isAddress :: Canonical -> Bool
72isAddress =
73 is ["Stream"] "Address"
76isVarying :: Canonical -> Bool
77isVarying =
78 is ["Signal"] "Varying"
81isPromise :: Canonical -> Bool
82isPromise =
83 is ["Promise"] "Promise"
86isResult :: Canonical -> Bool
87isResult =
88 is ["Result"] "Result"
91isList :: Canonical -> Bool
92isList v =
93 v == Canonical BuiltIn "List"
96isTuple :: Canonical -> Bool
97isTuple v =
98 case v of
99 Canonical BuiltIn name -> Help.isTuple name
100 _ -> False
103isPrimitive :: Canonical -> Bool
104isPrimitive v =
105 case v of
106 Canonical BuiltIn name -> name `elem` ["Int","Float","String","Bool"]
107 _ -> False
110isPrim :: String -> Canonical -> Bool
111isPrim prim v =
112 case v of
113 Canonical BuiltIn name -> name == prim
114 _ -> False
117isText :: Canonical -> Bool
118isText =
119 is ["Text"] "Text"
122-- VARIABLE TO STRING
124class ToString a where
125 toString :: a -> String
128instance ToString Raw where
129 toString (Raw name) =
130 name
133instance ToString Canonical where
134 toString (Canonical home name) =
135 case home of
136 BuiltIn -> name
137 Module path -> List.intercalate "." (path ++ [name])
138 Local -> name
141-- LISTINGS
143-- | A listing of values. Something like (a,b,c) or (..) or (a,b,..)
144data Listing a = Listing
145 { _explicits :: [a]
146 , _open :: Bool
147 } deriving (Eq,Ord,Show)
150openListing :: Listing a
151openListing =
152 Listing [] True
155closedListing :: Listing a
156closedListing =
157 Listing [] False
160listing :: [a] -> Listing a
161listing xs =
162 Listing xs False
165-- | A value that can be imported or exported
166data Value
167 = Value !String
168 | Alias !String
169 | Union !String !(Listing String)
170 deriving (Eq,Ord,Show)
173-- CATEGORIZING VALUES
175getValues :: [Value] -> [String]
176getValues values =
177 Maybe.mapMaybe getValue values
180getValue :: Value -> Maybe String
181getValue value =
182 case value of
183 Value name -> Just name
184 Alias _ -> Nothing
185 Union _ _ -> Nothing
188getAliases :: [Value] -> [String]
189getAliases values =
190 Maybe.mapMaybe getAlias values
193getAlias :: Value -> Maybe String
194getAlias value =
195 case value of
196 Value _-> Nothing
197 Alias name -> Just name
198 Union _ _ -> Nothing
201getUnions :: [Value] -> [(String, Listing String)]
202getUnions values =
203 Maybe.mapMaybe getUnion values
206getUnion :: Value -> Maybe (String, Listing String)
207getUnion value =
208 case value of
209 Value _ -> Nothing
210 Alias _ -> Nothing
211 Union name ctors -> Just (name, ctors)
214-- PRETTY VARIABLES
216instance Pretty Raw where
217 pretty (Raw name) =
218 variable name
221instance Pretty Canonical where
222 pretty var =
223 P.text (toString var)
226instance Pretty a => Pretty (Listing a) where
227 pretty (Listing explicits open) =
228 P.parens (commaCat (map pretty explicits ++ dots))
229 where
230 dots = [if open then P.text ".." else P.empty]
233instance Pretty Value where
234 pretty portable =
235 case portable of
236 Value name -> P.text name
237 Alias name -> P.text name
238 Union name ctors ->
239 P.text name <> pretty (ctors { _explicits = map P.text (_explicits ctors) })
242-- BINARY SERIALIZATION
244instance Binary Canonical where
245 put (Canonical home name) =
246 case home of
247 BuiltIn -> putWord8 0 >> put name
248 Module path -> putWord8 1 >> put path >> put name
249 Local -> putWord8 2 >> put name
251 get = do tag <- getWord8
252 case tag of
253 0 -> Canonical BuiltIn <$> get
254 1 -> Canonical . Module <$> get <*> get
255 2 -> Canonical Local <$> get
256 _ -> error "Unexpected tag when deserializing canonical variable"
259instance Binary Value where
260 put portable =
261 case portable of
262 Value name -> putWord8 0 >> put name
263 Alias name -> putWord8 1 >> put name
264 Union name ctors -> putWord8 2 >> put name >> put ctors
266 get = do tag <- getWord8
267 case tag of
268 0 -> Value <$> get
269 1 -> Alias <$> get
270 2 -> Union <$> get <*> get
271 _ -> error "Error reading valid import/export information from serialized string"
274instance (Binary a) => Binary (Listing a) where
275 put (Listing explicits open) =
276 put explicits >> put open
278 get = Listing <$> get <*> get