git.iko.soy/elk
on 68fdeff help sign in
elk/src/AST/Variable.hs
243 lines 4.9 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
40-- VARIABLE RECOGNIZERS
42is :: [String] -> String -> Canonical -> Bool
43is home name var =
44 var == Canonical (Module home) name
47isJson :: Canonical -> Bool
48isJson =
49 is ["Json", "Encode"] "Value"
52isMaybe :: Canonical -> Bool
53isMaybe =
54 is ["Maybe"] "Maybe"
56isArray :: Canonical -> Bool
57isArray =
58 is ["Array"] "Array"
61isSignal :: Canonical -> Bool
62isSignal =
63 is ["Signal"] "Signal"
66isList :: Canonical -> Bool
67isList v =
68 v == Canonical BuiltIn "List"
71isTuple :: Canonical -> Bool
72isTuple v =
73 case v of
74 Canonical BuiltIn name -> Help.isTuple name
75 _ -> False
78isPrimitive :: Canonical -> Bool
79isPrimitive v =
80 case v of
81 Canonical BuiltIn name -> name `elem` ["Int","Float","String","Bool"]
82 _ -> False
85isPrim :: String -> Canonical -> Bool
86isPrim prim v =
87 case v of
88 Canonical BuiltIn name -> name == prim
89 _ -> False
92isText :: Canonical -> Bool
93isText =
94 is ["Text"] "Text"
97-- VARIABLE TO STRING
99class ToString a where
100 toString :: a -> String
103instance ToString Raw where
104 toString (Raw name) =
105 name
108instance ToString Canonical where
109 toString (Canonical home name) =
110 case home of
111 BuiltIn -> name
112 Module path -> List.intercalate "." (path ++ [name])
113 Local -> name
116-- LISTINGS
118-- | A listing of values. Something like (a,b,c) or (..) or (a,b,..)
119data Listing a = Listing
120 { _explicits :: [a]
121 , _open :: Bool
122 } deriving (Eq,Ord,Show)
125openListing :: Listing a
126openListing =
127 Listing [] True
130-- | A value that can be imported or exported
131data Value
132 = Value !String
133 | Alias !String
134 | Union !String !(Listing String)
135 deriving (Eq,Ord,Show)
138-- CATEGORIZING VALUES
140getValues :: [Value] -> [String]
141getValues values =
142 Maybe.mapMaybe getValue values
145getValue :: Value -> Maybe String
146getValue value =
147 case value of
148 Value name -> Just name
149 Alias _ -> Nothing
150 Union _ _ -> Nothing
153getAliases :: [Value] -> [String]
154getAliases values =
155 Maybe.mapMaybe getAlias values
158getAlias :: Value -> Maybe String
159getAlias value =
160 case value of
161 Value _-> Nothing
162 Alias name -> Just name
163 Union _ _ -> Nothing
166getUnions :: [Value] -> [(String, Listing String)]
167getUnions values =
168 Maybe.mapMaybe getUnion values
171getUnion :: Value -> Maybe (String, Listing String)
172getUnion value =
173 case value of
174 Value _ -> Nothing
175 Alias _ -> Nothing
176 Union name ctors -> Just (name, ctors)
179-- PRETTY VARIABLES
181instance Pretty Raw where
182 pretty (Raw name) =
183 variable name
186instance Pretty Canonical where
187 pretty var =
188 P.text (toString var)
191instance Pretty a => Pretty (Listing a) where
192 pretty (Listing explicits open) =
193 P.parens (commaCat (map pretty explicits ++ dots))
194 where
195 dots = [if open then P.text ".." else P.empty]
198instance Pretty Value where
199 pretty portable =
200 case portable of
201 Value name -> P.text name
202 Alias name -> P.text name
203 Union name ctors ->
204 P.text name <> pretty (ctors { _explicits = map P.text (_explicits ctors) })
207-- BINARY SERIALIZATION
209instance Binary Canonical where
210 put (Canonical home name) =
211 case home of
212 BuiltIn -> putWord8 0 >> put name
213 Module path -> putWord8 1 >> put path >> put name
214 Local -> putWord8 2 >> put name
216 get = do tag <- getWord8
217 case tag of
218 0 -> Canonical BuiltIn <$> get
219 1 -> Canonical . Module <$> get <*> get
220 2 -> Canonical Local <$> get
221 _ -> error "Unexpected tag when deserializing canonical variable"
224instance Binary Value where
225 put portable =
226 case portable of
227 Value name -> putWord8 0 >> put name
228 Alias name -> putWord8 1 >> put name
229 Union name ctors -> putWord8 2 >> put name >> put ctors
231 get = do tag <- getWord8
232 case tag of
233 0 -> Value <$> get
234 1 -> Alias <$> get
235 2 -> Union <$> get <*> get
236 _ -> error "Error reading valid import/export information from serialized string"
239instance (Binary a) => Binary (Listing a) where
240 put (Listing explicits open) =
241 put explicits >> put open
243 get = Listing <$> get <*> get