git.iko.soy/elk
on 396fd33 help sign in
elk/src/AST/Variable.hs
198 lines 4.1 kB history raw
1module AST.Variable where
3import Control.Applicative ((<$>), (<*>))
4import Data.Binary
5import qualified Data.List as List
6import Text.PrettyPrint as P
7import qualified AST.Helpers as Help
8import AST.PrettyPrint
11-- VARIABLES
13newtype Raw = Raw String
14 deriving (Eq,Ord,Show)
17data Home
18 = BuiltIn
19 | Module [String]
20 | Local
21 deriving (Eq,Ord,Show)
24data Canonical = Canonical
25 { home :: !Home
26 , name :: !String
27 }
28 deriving (Eq,Ord,Show)
31local :: String -> Canonical
32local x = Canonical Local x
35builtin :: String -> Canonical
36builtin x = Canonical BuiltIn x
39-- VARIABLE RECOGNIZERS
41is :: [String] -> String -> Canonical -> Bool
42is home name var =
43 var == Canonical (Module home) name
46isJson :: Canonical -> Bool
47isJson =
48 is ["Json", "Encode"] "Value"
51isMaybe :: Canonical -> Bool
52isMaybe =
53 is ["Maybe"] "Maybe"
55isArray :: Canonical -> Bool
56isArray =
57 is ["Array"] "Array"
60isSignal :: Canonical -> Bool
61isSignal =
62 is ["Signal"] "Signal"
65isList :: Canonical -> Bool
66isList v =
67 v == Canonical BuiltIn "List"
70isTuple :: Canonical -> Bool
71isTuple v =
72 case v of
73 Canonical BuiltIn name -> Help.isTuple name
74 _ -> False
77isPrimitive :: Canonical -> Bool
78isPrimitive v =
79 case v of
80 Canonical BuiltIn name -> name `elem` ["Int","Float","String","Bool"]
81 _ -> False
84isPrim :: String -> Canonical -> Bool
85isPrim prim v =
86 case v of
87 Canonical BuiltIn name -> name == prim
88 _ -> False
91isText :: Canonical -> Bool
92isText =
93 is ["Text"] "Text"
96-- VARIABLE TO STRING
98class ToString a where
99 toString :: a -> String
102instance ToString Raw where
103 toString (Raw x) = x
106instance ToString Canonical where
107 toString (Canonical home name) =
108 case home of
109 BuiltIn -> name
110 Module path -> List.intercalate "." (path ++ [name])
111 Local -> name
114-- LISTINGS
116-- | A listing of values. Something like (a,b,c) or (..) or (a,b,..)
117data Listing a = Listing
118 { _explicits :: [a]
119 , _open :: Bool
120 } deriving (Eq,Ord,Show)
123openListing :: Listing a
124openListing =
125 Listing [] True
128-- | A value that can be imported or exported
129data Value
130 = Value !String
131 | Alias !String
132 | ADT !String !(Listing String)
133 deriving (Eq,Ord,Show)
136-- PRETTY VARIABLES
138instance Pretty Raw where
139 pretty (Raw var) = variable var
142instance Pretty Canonical where
143 pretty var = P.text (toString var)
146instance Pretty a => Pretty (Listing a) where
147 pretty (Listing explicits open) =
148 P.parens (commaCat (map pretty explicits ++ dots))
149 where
150 dots = [if open then P.text ".." else P.empty]
153instance Pretty Value where
154 pretty portable =
155 case portable of
156 Value name -> P.text name
157 Alias name -> P.text name
158 ADT name ctors ->
159 P.text name <> pretty (ctors { _explicits = map P.text (_explicits ctors) })
162-- BINARY SERIALIZATION
164instance Binary Canonical where
165 put (Canonical home name) =
166 case home of
167 BuiltIn -> putWord8 0 >> put name
168 Module path -> putWord8 1 >> put path >> put name
169 Local -> putWord8 2 >> put name
171 get = do tag <- getWord8
172 case tag of
173 0 -> Canonical BuiltIn <$> get
174 1 -> Canonical . Module <$> get <*> get
175 2 -> Canonical Local <$> get
176 _ -> error "Unexpected tag when deserializing canonical variable"
179instance Binary Value where
180 put portable =
181 case portable of
182 Value name -> putWord8 0 >> put name
183 Alias name -> putWord8 1 >> put name
184 ADT name ctors -> putWord8 2 >> put name >> put ctors
186 get = do tag <- getWord8
187 case tag of
188 0 -> Value <$> get
189 1 -> Alias <$> get
190 2 -> ADT <$> get <*> get
191 _ -> error "Error reading valid import/export information from serialized string"
194instance (Binary a) => Binary (Listing a) where
195 put (Listing explicits open) =
196 put explicits >> put open
198 get = Listing <$> get <*> get