git.iko.soy/elk
on bc3312c help sign in
elk/src/AST/Variable.hs
260 lines 4.1 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2{-# LANGUAGE OverloadedStrings #-}
3module AST.Variable
4 ( Raw(..), Canonical(..), Home(..)
5 , local, topLevel, builtin, fromModule
6 , inCore, inHtml, cmd, sub
7 , isLocalHome, isCons
8 , is, isJson, isMaybe, isArray, isTask, isList
9 , isNative, isTuple, isPrimitive, isPrim, isLocal
10 , rawToText, toText
11 )
12 where
14import Data.Binary
15import Data.Monoid ((<>))
16import qualified Data.Set as Set
17import Data.Text (Text)
19import qualified AST.Helpers as Help
20import qualified AST.Module.Name as ModuleName
24-- RAW NAMES
27newtype Raw = Raw Text
28 deriving (Eq, Ord)
32-- CANONICAL NAMES
35data Home
36 = BuiltIn
37 | Module !ModuleName.Canonical
38 | TopLevel !ModuleName.Canonical
39 | Local
40 deriving (Eq, Ord)
43data Canonical =
44 Canonical
45 { _home :: !Home
46 , _name :: !Text
47 }
48 deriving (Eq, Ord)
52-- HELPERS
55local :: Text -> Canonical
56local x =
57 Canonical Local x
60topLevel :: ModuleName.Canonical -> Text -> Canonical
61topLevel home x =
62 Canonical (TopLevel home) x
65builtin :: Text -> Canonical
66builtin x =
67 Canonical BuiltIn x
70fromModule :: ModuleName.Canonical -> Text -> Canonical
71fromModule home name =
72 Canonical (Module home) name
75inCore :: ModuleName.Raw -> Text -> Canonical
76inCore home name =
77 Canonical (Module (ModuleName.inCore home)) name
80inHtml :: ModuleName.Raw -> Text -> Canonical
81inHtml home name =
82 Canonical (Module (ModuleName.inHtml home)) name
85cmd :: Canonical
86cmd =
87 inCore "Platform.Cmd" "Cmd"
90sub :: Canonical
91sub =
92 inCore "Platform.Sub" "Sub"
96-- VARIABLE RECOGNIZERS
99isLocalHome :: Home -> Bool
100isLocalHome home =
101 case home of
102 BuiltIn ->
103 False
105 Module _ ->
106 False
108 TopLevel _ ->
109 True
111 Local ->
112 True
115isCons :: Canonical -> Bool
116isCons var =
117 case var of
118 Canonical BuiltIn "::" ->
119 True
121 _ ->
122 False
125is :: ModuleName.Raw -> Text -> Canonical -> Bool
126is home name var =
127 var == inCore home name
130isJson :: Canonical -> Bool
131isJson =
132 is "Json.Encode" "Value"
135isMaybe :: Canonical -> Bool
136isMaybe =
137 is "Maybe" "Maybe"
139isArray :: Canonical -> Bool
140isArray =
141 is "Array" "Array"
144isTask :: Canonical -> Bool
145isTask =
146 is "Task" "Task"
149isList :: Canonical -> Bool
150isList v =
151 v == Canonical BuiltIn "List"
154isNative :: Canonical -> Bool
155isNative v =
156 case v of
157 Canonical (Module name) _ ->
158 ModuleName.canonicalIsNative name
160 _ ->
161 False
164isTuple :: Canonical -> Bool
165isTuple v =
166 case v of
167 Canonical BuiltIn name ->
168 Help.isTuple name
170 _ ->
171 False
174isPrimitive :: Canonical -> Bool
175isPrimitive v =
176 case v of
177 Canonical BuiltIn name ->
178 Set.member name primitiveSet
180 _ ->
181 False
184primitiveSet :: Set.Set Text
185primitiveSet =
186 Set.fromList ["Int","Float","String","Bool"]
189isPrim :: Text -> Canonical -> Bool
190isPrim prim (Canonical home name) =
191 case home of
192 BuiltIn ->
193 name == prim
195 _ ->
196 False
199isLocal :: (Text -> Bool) -> Canonical -> Bool
200isLocal check (Canonical home name) =
201 case home of
202 Local ->
203 check name
205 _ ->
206 False
210-- VARIABLE TO TEXT
213rawToText :: Raw -> Text
214rawToText (Raw name) =
215 name
218toText :: Canonical -> Text
219toText (Canonical home name) =
220 case home of
221 BuiltIn ->
222 name
224 Module moduleName ->
225 ModuleName.canonicalToText moduleName <> "." <> name
227 TopLevel _ ->
228 name
230 Local ->
231 name
235-- BINARY SERIALIZATION
238instance Binary Canonical where
239 put (Canonical home name) =
240 case home of
241 BuiltIn ->
242 putWord8 0 >> put name
244 Module path ->
245 putWord8 1 >> put path >> put name
247 TopLevel path ->
248 putWord8 2 >> put path >> put name
250 Local ->
251 putWord8 3 >> put name
253 get =
254 do tag <- getWord8
255 case tag of
256 0 -> Canonical BuiltIn <$> get
257 1 -> Canonical . Module <$> get <*> get
258 2 -> Canonical . TopLevel <$> get <*> get
259 3 -> Canonical Local <$> get
260 _ -> error "Unexpected tag when deserializing canonical variable"