git.iko.soy/elk
on ed22dbd help sign in
elk/src/AST/Variable.hs
240 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 x) = x
107instance ToString Canonical where
108 toString (Canonical home name) =
109 case home of
110 BuiltIn -> name
111 Module path -> List.intercalate "." (path ++ [name])
112 Local -> name
115-- LISTINGS
117-- | A listing of values. Something like (a,b,c) or (..) or (a,b,..)
118data Listing a = Listing
119 { _explicits :: [a]
120 , _open :: Bool
121 } deriving (Eq,Ord,Show)
124openListing :: Listing a
125openListing =
126 Listing [] True
129-- | A value that can be imported or exported
130data Value
131 = Value !String
132 | Alias !String
133 | Union !String !(Listing String)
134 deriving (Eq,Ord,Show)
137-- CATEGORIZING VALUES
139getValues :: [Value] -> [String]
140getValues values =
141 Maybe.mapMaybe getValue values
144getValue :: Value -> Maybe String
145getValue value =
146 case value of
147 Value name -> Just name
148 Alias _ -> Nothing
149 Union _ _ -> Nothing
152getAliases :: [Value] -> [String]
153getAliases values =
154 Maybe.mapMaybe getAlias values
157getAlias :: Value -> Maybe String
158getAlias value =
159 case value of
160 Value _-> Nothing
161 Alias name -> Just name
162 Union _ _ -> Nothing
165getUnions :: [Value] -> [(String, Listing String)]
166getUnions values =
167 Maybe.mapMaybe getUnion values
170getUnion :: Value -> Maybe (String, Listing String)
171getUnion value =
172 case value of
173 Value _ -> Nothing
174 Alias _ -> Nothing
175 Union name ctors -> Just (name, ctors)
178-- PRETTY VARIABLES
180instance Pretty Raw where
181 pretty (Raw var) = variable var
184instance Pretty Canonical where
185 pretty var = P.text (toString var)
188instance Pretty a => Pretty (Listing a) where
189 pretty (Listing explicits open) =
190 P.parens (commaCat (map pretty explicits ++ dots))
191 where
192 dots = [if open then P.text ".." else P.empty]
195instance Pretty Value where
196 pretty portable =
197 case portable of
198 Value name -> P.text name
199 Alias name -> P.text name
200 Union name ctors ->
201 P.text name <> pretty (ctors { _explicits = map P.text (_explicits ctors) })
204-- BINARY SERIALIZATION
206instance Binary Canonical where
207 put (Canonical home name) =
208 case home of
209 BuiltIn -> putWord8 0 >> put name
210 Module path -> putWord8 1 >> put path >> put name
211 Local -> putWord8 2 >> put name
213 get = do tag <- getWord8
214 case tag of
215 0 -> Canonical BuiltIn <$> get
216 1 -> Canonical . Module <$> get <*> get
217 2 -> Canonical Local <$> get
218 _ -> error "Unexpected tag when deserializing canonical variable"
221instance Binary Value where
222 put portable =
223 case portable of
224 Value name -> putWord8 0 >> put name
225 Alias name -> putWord8 1 >> put name
226 Union name ctors -> putWord8 2 >> put name >> put ctors
228 get = do tag <- getWord8
229 case tag of
230 0 -> Value <$> get
231 1 -> Alias <$> get
232 2 -> Union <$> get <*> get
233 _ -> error "Error reading valid import/export information from serialized string"
236instance (Binary a) => Binary (Listing a) where
237 put (Listing explicits open) =
238 put explicits >> put open
240 get = Listing <$> get <*> get