git.iko.soy/elk
on e00a3f3 help sign in
elk/src/AST/Variable.hs
278 lines 4.4 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2{-# LANGUAGE OverloadedStrings #-}
3module AST.Variable
4 ( Raw(..)
5 , Canonical(..), Home(..)
6 , Global(..)
7 , local, topLevel, builtin, fromModule
8 , inCore, inHtml, cmd, sub
9 , isLocalHome, isCons
10 , is, isJson, isMaybe, isArray, isTask, isList
11 , isKernel, isTuple, isPrimitive, isPrim, isLocal
12 , rawToText, toText
13 )
14 where
16import Data.Binary
17import Data.Monoid ((<>))
18import qualified Data.Set as Set
19import Data.Text (Text)
21import qualified AST.Helpers as Help
22import qualified AST.Module.Name as ModuleName
26-- RAW NAMES
29newtype Raw = Raw Text
30 deriving (Eq, Ord)
34-- CANONICAL NAMES
37data Home
38 = BuiltIn
39 | Module !ModuleName.Canonical
40 | TopLevel !ModuleName.Canonical
41 | Local
42 deriving (Eq, Ord)
45data Canonical =
46 Canonical
47 { _home :: !Home
48 , _name :: !Text
49 }
50 deriving (Eq, Ord)
54-- GLOBAL NAMES
57data Global = Global !ModuleName.Canonical !Text
58 deriving (Eq, Ord)
62-- HELPERS
65local :: Text -> Canonical
66local x =
67 Canonical Local x
70topLevel :: ModuleName.Canonical -> Text -> Canonical
71topLevel home x =
72 Canonical (TopLevel home) x
75builtin :: Text -> Canonical
76builtin x =
77 Canonical BuiltIn x
80fromModule :: ModuleName.Canonical -> Text -> Canonical
81fromModule home name =
82 Canonical (Module home) name
85inCore :: ModuleName.Raw -> Text -> Canonical
86inCore home name =
87 Canonical (Module (ModuleName.inCore home)) name
90inHtml :: ModuleName.Raw -> Text -> Canonical
91inHtml home name =
92 Canonical (Module (ModuleName.inHtml home)) name
95cmd :: Canonical
96cmd =
97 inCore "Platform.Cmd" "Cmd"
100sub :: Canonical
101sub =
102 inCore "Platform.Sub" "Sub"
106-- VARIABLE RECOGNIZERS
109isLocalHome :: Home -> Bool
110isLocalHome home =
111 case home of
112 BuiltIn ->
113 False
115 Module _ ->
116 False
118 TopLevel _ ->
119 True
121 Local ->
122 True
125isCons :: Canonical -> Bool
126isCons var =
127 case var of
128 Canonical BuiltIn "::" ->
129 True
131 _ ->
132 False
135is :: ModuleName.Raw -> Text -> Canonical -> Bool
136is home name var =
137 var == inCore home name
140isJson :: Canonical -> Bool
141isJson =
142 is "Json.Encode" "Value"
145isMaybe :: Canonical -> Bool
146isMaybe =
147 is "Maybe" "Maybe"
149isArray :: Canonical -> Bool
150isArray =
151 is "Array" "Array"
154isTask :: Canonical -> Bool
155isTask =
156 is "Task" "Task"
159isList :: Canonical -> Bool
160isList var =
161 var == Canonical BuiltIn "List"
164isKernel :: Canonical -> Bool
165isKernel var =
166 case var of
167 Canonical (Module name) _ ->
168 ModuleName.canonicalIsKernel name
170 _ ->
171 False
174isTuple :: Canonical -> Bool
175isTuple var =
176 case var of
177 Canonical BuiltIn name ->
178 Help.isTuple name
180 _ ->
181 False
184isPrimitive :: Canonical -> Bool
185isPrimitive var =
186 case var of
187 Canonical BuiltIn name ->
188 Set.member name primitiveSet
190 _ ->
191 False
194primitiveSet :: Set.Set Text
195primitiveSet =
196 Set.fromList ["Int","Float","String","Bool"]
199isPrim :: Text -> Canonical -> Bool
200isPrim prim (Canonical home name) =
201 case home of
202 BuiltIn ->
203 name == prim
205 _ ->
206 False
209isLocal :: (Text -> Bool) -> Canonical -> Bool
210isLocal check (Canonical home name) =
211 case home of
212 Local ->
213 check name
215 _ ->
216 False
220-- VARIABLE TO TEXT
223rawToText :: Raw -> Text
224rawToText (Raw name) =
225 name
228toText :: Canonical -> Text
229toText (Canonical home name) =
230 case home of
231 BuiltIn ->
232 name
234 Module moduleName ->
235 ModuleName.canonicalToText moduleName <> "." <> name
237 TopLevel _ ->
238 name
240 Local ->
241 name
245-- BINARY SERIALIZATION
248instance Binary Global where
249 put (Global home name) =
250 put home >> put name
252 get =
253 Global <$> get <*> get
256instance Binary Canonical where
257 put (Canonical home name) =
258 case home of
259 BuiltIn ->
260 putWord8 0 >> put name
262 Module path ->
263 putWord8 1 >> put path >> put name
265 TopLevel path ->
266 putWord8 2 >> put path >> put name
268 Local ->
269 putWord8 3 >> put name
271 get =
272 do tag <- getWord8
273 case tag of
274 0 -> Canonical BuiltIn <$> get
275 1 -> Canonical . Module <$> get <*> get
276 2 -> Canonical . TopLevel <$> get <*> get
277 3 -> Canonical Local <$> get
278 _ -> error "Unexpected tag when deserializing canonical variable"