git.iko.soy/elk
on fe1d53a help sign in
elk/src/AST/Variable.hs
261 lines 4.2 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2{-# LANGUAGE FlexibleInstances #-}
3{-# LANGUAGE OverloadedStrings #-}
4module AST.Variable
5 ( Raw(..), Canonical(..), Home(..)
6 , local, topLevel, builtin, fromModule
7 , inCore, inHtml, cmd, sub
8 , isLocalHome, isCons
9 , is, isJson, isMaybe, isArray, isTask, isList
10 , isNative, isTuple, isPrimitive, isPrim, isLocal
11 , rawToText, toText
12 )
13 where
15import Data.Binary
16import Data.Monoid ((<>))
17import qualified Data.Set as Set
18import Data.Text (Text)
20import qualified AST.Helpers as Help
21import qualified AST.Module.Name as ModuleName
25-- RAW NAMES
28newtype Raw = Raw Text
29 deriving (Eq, Ord)
33-- CANONICAL NAMES
36data Home
37 = BuiltIn
38 | Module !ModuleName.Canonical
39 | TopLevel !ModuleName.Canonical
40 | Local
41 deriving (Eq, Ord)
44data Canonical =
45 Canonical
46 { _home :: !Home
47 , _name :: !Text
48 }
49 deriving (Eq, Ord)
53-- HELPERS
56local :: Text -> Canonical
57local x =
58 Canonical Local x
61topLevel :: ModuleName.Canonical -> Text -> Canonical
62topLevel home x =
63 Canonical (TopLevel home) x
66builtin :: Text -> Canonical
67builtin x =
68 Canonical BuiltIn x
71fromModule :: ModuleName.Canonical -> Text -> Canonical
72fromModule home name =
73 Canonical (Module home) name
76inCore :: ModuleName.Raw -> Text -> Canonical
77inCore home name =
78 Canonical (Module (ModuleName.inCore home)) name
81inHtml :: ModuleName.Raw -> Text -> Canonical
82inHtml home name =
83 Canonical (Module (ModuleName.inHtml home)) name
86cmd :: Canonical
87cmd =
88 inCore "Platform.Cmd" "Cmd"
91sub :: Canonical
92sub =
93 inCore "Platform.Sub" "Sub"
97-- VARIABLE RECOGNIZERS
100isLocalHome :: Home -> Bool
101isLocalHome home =
102 case home of
103 BuiltIn ->
104 False
106 Module _ ->
107 False
109 TopLevel _ ->
110 True
112 Local ->
113 True
116isCons :: Canonical -> Bool
117isCons var =
118 case var of
119 Canonical BuiltIn "::" ->
120 True
122 _ ->
123 False
126is :: ModuleName.Raw -> Text -> Canonical -> Bool
127is home name var =
128 var == inCore home name
131isJson :: Canonical -> Bool
132isJson =
133 is "Json.Encode" "Value"
136isMaybe :: Canonical -> Bool
137isMaybe =
138 is "Maybe" "Maybe"
140isArray :: Canonical -> Bool
141isArray =
142 is "Array" "Array"
145isTask :: Canonical -> Bool
146isTask =
147 is "Task" "Task"
150isList :: Canonical -> Bool
151isList v =
152 v == Canonical BuiltIn "List"
155isNative :: Canonical -> Bool
156isNative v =
157 case v of
158 Canonical (Module name) _ ->
159 ModuleName.canonicalIsNative name
161 _ ->
162 False
165isTuple :: Canonical -> Bool
166isTuple v =
167 case v of
168 Canonical BuiltIn name ->
169 Help.isTuple name
171 _ ->
172 False
175isPrimitive :: Canonical -> Bool
176isPrimitive v =
177 case v of
178 Canonical BuiltIn name ->
179 Set.member name primitiveSet
181 _ ->
182 False
185primitiveSet :: Set.Set Text
186primitiveSet =
187 Set.fromList ["Int","Float","String","Bool"]
190isPrim :: Text -> Canonical -> Bool
191isPrim prim (Canonical home name) =
192 case home of
193 BuiltIn ->
194 name == prim
196 _ ->
197 False
200isLocal :: (Text -> Bool) -> Canonical -> Bool
201isLocal check (Canonical home name) =
202 case home of
203 Local ->
204 check name
206 _ ->
207 False
211-- VARIABLE TO TEXT
214rawToText :: Raw -> Text
215rawToText (Raw name) =
216 name
219toText :: Canonical -> Text
220toText (Canonical home name) =
221 case home of
222 BuiltIn ->
223 name
225 Module moduleName ->
226 ModuleName.canonicalToText moduleName <> "." <> name
228 TopLevel _ ->
229 name
231 Local ->
232 name
236-- BINARY SERIALIZATION
239instance Binary Canonical where
240 put (Canonical home name) =
241 case home of
242 BuiltIn ->
243 putWord8 0 >> put name
245 Module path ->
246 putWord8 1 >> put path >> put name
248 TopLevel path ->
249 putWord8 2 >> put path >> put name
251 Local ->
252 putWord8 3 >> put name
254 get =
255 do tag <- getWord8
256 case tag of
257 0 -> Canonical BuiltIn <$> get
258 1 -> Canonical . Module <$> get <*> get
259 2 -> Canonical . TopLevel <$> get <*> get
260 3 -> Canonical Local <$> get
261 _ -> error "Unexpected tag when deserializing canonical variable"