git.iko.soy/elk
on edfca84 help sign in
elk/src/AST/Variable.hs
268 lines 5.3 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"
71isVarying :: Canonical -> Bool
72isVarying =
73 is ["Signal"] "Varying"
76isPromise :: Canonical -> Bool
77isPromise =
78 is ["Promise"] "Promise"
81isList :: Canonical -> Bool
82isList v =
83 v == Canonical BuiltIn "List"
86isTuple :: Canonical -> Bool
87isTuple v =
88 case v of
89 Canonical BuiltIn name -> Help.isTuple name
90 _ -> False
93isPrimitive :: Canonical -> Bool
94isPrimitive v =
95 case v of
96 Canonical BuiltIn name -> name `elem` ["Int","Float","String","Bool"]
97 _ -> False
100isPrim :: String -> Canonical -> Bool
101isPrim prim v =
102 case v of
103 Canonical BuiltIn name -> name == prim
104 _ -> False
107isText :: Canonical -> Bool
108isText =
109 is ["Text"] "Text"
112-- VARIABLE TO STRING
114class ToString a where
115 toString :: a -> String
118instance ToString Raw where
119 toString (Raw name) =
120 name
123instance ToString Canonical where
124 toString (Canonical home name) =
125 case home of
126 BuiltIn -> name
127 Module path -> List.intercalate "." (path ++ [name])
128 Local -> name
131-- LISTINGS
133-- | A listing of values. Something like (a,b,c) or (..) or (a,b,..)
134data Listing a = Listing
135 { _explicits :: [a]
136 , _open :: Bool
137 } deriving (Eq,Ord,Show)
140openListing :: Listing a
141openListing =
142 Listing [] True
145closedListing :: Listing a
146closedListing =
147 Listing [] False
150listing :: [a] -> Listing a
151listing xs =
152 Listing xs False
155-- | A value that can be imported or exported
156data Value
157 = Value !String
158 | Alias !String
159 | Union !String !(Listing String)
160 deriving (Eq,Ord,Show)
163-- CATEGORIZING VALUES
165getValues :: [Value] -> [String]
166getValues values =
167 Maybe.mapMaybe getValue values
170getValue :: Value -> Maybe String
171getValue value =
172 case value of
173 Value name -> Just name
174 Alias _ -> Nothing
175 Union _ _ -> Nothing
178getAliases :: [Value] -> [String]
179getAliases values =
180 Maybe.mapMaybe getAlias values
183getAlias :: Value -> Maybe String
184getAlias value =
185 case value of
186 Value _-> Nothing
187 Alias name -> Just name
188 Union _ _ -> Nothing
191getUnions :: [Value] -> [(String, Listing String)]
192getUnions values =
193 Maybe.mapMaybe getUnion values
196getUnion :: Value -> Maybe (String, Listing String)
197getUnion value =
198 case value of
199 Value _ -> Nothing
200 Alias _ -> Nothing
201 Union name ctors -> Just (name, ctors)
204-- PRETTY VARIABLES
206instance Pretty Raw where
207 pretty (Raw name) =
208 variable name
211instance Pretty Canonical where
212 pretty var =
213 P.text (toString var)
216instance Pretty a => Pretty (Listing a) where
217 pretty (Listing explicits open) =
218 P.parens (commaCat (map pretty explicits ++ dots))
219 where
220 dots = [if open then P.text ".." else P.empty]
223instance Pretty Value where
224 pretty portable =
225 case portable of
226 Value name -> P.text name
227 Alias name -> P.text name
228 Union name ctors ->
229 P.text name <> pretty (ctors { _explicits = map P.text (_explicits ctors) })
232-- BINARY SERIALIZATION
234instance Binary Canonical where
235 put (Canonical home name) =
236 case home of
237 BuiltIn -> putWord8 0 >> put name
238 Module path -> putWord8 1 >> put path >> put name
239 Local -> putWord8 2 >> put name
241 get = do tag <- getWord8
242 case tag of
243 0 -> Canonical BuiltIn <$> get
244 1 -> Canonical . Module <$> get <*> get
245 2 -> Canonical Local <$> get
246 _ -> error "Unexpected tag when deserializing canonical variable"
249instance Binary Value where
250 put portable =
251 case portable of
252 Value name -> putWord8 0 >> put name
253 Alias name -> putWord8 1 >> put name
254 Union name ctors -> putWord8 2 >> put name >> put ctors
256 get = do tag <- getWord8
257 case tag of
258 0 -> Value <$> get
259 1 -> Alias <$> get
260 2 -> Union <$> get <*> get
261 _ -> error "Error reading valid import/export information from serialized string"
264instance (Binary a) => Binary (Listing a) where
265 put (Listing explicits open) =
266 put explicits >> put open
268 get = Listing <$> get <*> get