git.iko.soy/elk
on master help sign in
Make Elm.Name an opaque type
a3ad7d2Evan Czaplicki
src/Canonicalize/Expression.hs+1−2
compare with master
unifiedsplit
@@ -15,7 +15,6 @@ import qualified Data.Graph as Graph
15import qualified Data.List as List
15import qualified Data.List as List
16import qualified Data.Map.Strict as Map
16import qualified Data.Map.Strict as Map
17import qualified Data.Map.Strict.Internal as I
17import qualified Data.Map.Strict.Internal as I
18−import qualified Data.Text as Text
19
18
20import qualified AST.Canonical as Can
19import qualified AST.Canonical as Can
21import qualified AST.Source as Src
20import qualified AST.Source as Src
@@ -436,7 +435,7 @@ addDefNodes env nodes def =
436 (\freeLocals warnings cbody ->
435 (\freeLocals warnings cbody ->
437 let
436 let
438 names = getPatternNames [] pattern
437 names = getPatternNames [] pattern
439− name = Text.cons '$' (Text.intercalate "$" (map A.toValue names))
438+ name = N.toCompositeName (map A.toValue names)
440 node = ( Destruct cpattern cbody, name, Map.keys freeLocals )
439 node = ( Destruct cpattern cbody, name, Map.keys freeLocals )
441 in
440 in
442 good
441 good
src/Elm/Compiler/Module.hs+23−44
@@ -7,11 +7,9 @@ module Elm.Compiler.Module
7
7
8 -- module names
8 -- module names
9 , Raw
9 , Raw
10− , nameToPath
11 , nameToString
10 , nameToString
12− , nameFromText
11+ , nameToSlashPath
13− , hyphenate
12+ , nameToHyphenPath
14− , dehyphenate
15 , encode
13 , encode
16 , decoder
14 , decoder
17
15
@@ -40,38 +38,37 @@ import qualified Json.Encode as Encode
40type Raw = N.Name
38type Raw = N.Name
41
39
42
40
43−nameToPath :: Raw -> FilePath
41+nameToString :: Raw -> String
44−nameToPath name =
42+nameToString =
45− List.foldl1 (</>) (map Text.unpack (Text.splitOn "." name))
43+ N.toString
46
44
47
45
48−nameToString :: Raw -> String
46+nameToSlashPath :: Raw -> FilePath
49−nameToString name =
47+nameToSlashPath name =
50− Text.unpack name
48+ List.foldl1 (</>) (map Text.unpack (Text.splitOn "." (N.toText name)))
51
49
52
50
53−nameFromText :: Text.Text -> Maybe Raw
51+nameToHyphenPath :: Raw -> FilePath
54−nameFromText =
52+nameToHyphenPath name =
55− fromText '.'
53+ Text.unpack (Text.replace "." "-" (N.toText name))
56
54
57
55
58−hyphenate :: Raw -> Text.Text
59−hyphenate name =
60− Text.replace "." "-" name
61
56
57+-- JSON
62
58
63−dehyphenate :: Text.Text -> Maybe Raw
64−dehyphenate =
65− fromText '-'
66
59
60+encode :: Raw -> Encode.Value
61+encode =
62+ Encode.name
67
63
68−fromText :: Char -> Text.Text -> Maybe Raw
64+
69−fromText sep name =
65+decoder :: Decode.Decoder Text.Text Raw
70− let
66+decoder =
67+ do txt <- Decode.text
71− chunks =
68+ let chunks = Text.splitOn "." txt
72− Text.splitOn (Text.singleton sep) name
73− in
74− if all isGoodChunk chunks then Just name else Nothing
69+ if all isGoodChunk chunks
70+ then Decode.succeed (N.fromText txt)
71+ else Decode.fail txt
75
72
76
73
77isGoodChunk :: Text.Text -> Bool
74isGoodChunk :: Text.Text -> Bool
@@ -89,21 +86,3 @@ isGoodChar char =
89 Char.isAlphaNum char || char == '_'
86 Char.isAlphaNum char || char == '_'
90
87
91
88
92−
93−-- JSON
94−
95−
96−encode :: Raw -> Encode.Value
97−encode =
98− Encode.text
99−
100−
101−decoder :: Decode.Decoder Text.Text Raw
102−decoder =
103− do txt <- Decode.text
104− case nameFromText txt of
105− Just name ->
106− Decode.succeed name
107−
108− Nothing ->
109− Decode.fail txt
src/Elm/Compiler/Type.hs+12−13
@@ -14,7 +14,6 @@ module Elm.Compiler.Type
14 where
14 where
15
15
16
16
17−import Data.Text (Text)
18import qualified Data.Text as Text
17import qualified Data.Text as Text
19import qualified Data.Text.Encoding as Text
18import qualified Data.Text.Encoding as Text
20import qualified Text.PrettyPrint as P
19import qualified Text.PrettyPrint as P
@@ -93,7 +92,7 @@ toDoc context tipe =
93 _ -> P.parens lambda
92 _ -> P.parens lambda
94
93
95 Var name ->
94 Var name ->
96− P.text (Text.unpack name)
95+ P.text (N.toString name)
97
96
98 Unit ->
97 Unit ->
99 "()"
98 "()"
@@ -111,13 +110,13 @@ toDoc context tipe =
111 Type name args ->
110 Type name args ->
112 case args of
111 case args of
113 [] ->
112 [] ->
114− P.text (Text.unpack name)
113+ P.text (N.toString name)
115
114
116 _ ->
115 _ ->
117 let
116 let
118 application =
117 application =
119 P.hang
118 P.hang
120− (P.text (Text.unpack name))
119+ (P.text (N.toString name))
121 2
120 2
122 (P.sep $ map (toDoc InType) args)
121 (P.sep $ map (toDoc InType) args)
123 in
122 in
@@ -141,7 +140,7 @@ toDoc context tipe =
141
140
142 (fields, Just x) ->
141 (fields, Just x) ->
143 P.hang
142 P.hang
144− ("{" <+> P.text (Text.unpack x) <+> "|")
143+ ("{" <+> P.text (N.toString x) <+> "|")
145 4
144 4
146 (P.sep
145 (P.sep
147 [ P.sep (P.punctuate "," (map prettyField fields))
146 [ P.sep (P.punctuate "," (map prettyField fields))
@@ -150,7 +149,7 @@ toDoc context tipe =
150 )
149 )
151 where
150 where
152 prettyField (field, fieldType) =
151 prettyField (field, fieldType) =
153− P.text (Text.unpack field) <+> ":" <+> toDoc None fieldType
152+ P.text (N.toString field) <+> ":" <+> toDoc None fieldType
154
153
155
154
156collectLambdas :: Type -> [Type]
155collectLambdas :: Type -> [Type]
@@ -160,7 +159,7 @@ collectLambdas tipe =
160 _ -> [tipe]
159 _ -> [tipe]
161
160
162
161
163−flattenRecord :: Type -> ( [(Text, Type)], Maybe Text )
162+flattenRecord :: Type -> ( [(N.Name, Type)], Maybe N.Name )
164flattenRecord tipe =
163flattenRecord tipe =
165 case tipe of
164 case tipe of
166 Var x ->
165 Var x ->
@@ -244,22 +243,22 @@ encodeMetadata (DebugMetadata msg aliases unions) =
244
243
245toAliasField :: Alias -> ( Text.Text, Encode.Value )
244toAliasField :: Alias -> ( Text.Text, Encode.Value )
246toAliasField (Alias name args tipe) =
245toAliasField (Alias name args tipe) =
247− name ==>
246+ N.toText name ==>
248 Encode.object
247 Encode.object
249− [ "args" ==> Encode.list Encode.text args
248+ [ "args" ==> Encode.list Encode.name args
250 , "type" ==> encode tipe
249 , "type" ==> encode tipe
251 ]
250 ]
252
251
253
252
254toUnionField :: Union -> ( Text.Text, Encode.Value )
253toUnionField :: Union -> ( Text.Text, Encode.Value )
255toUnionField (Union name args constructors) =
254toUnionField (Union name args constructors) =
256− name ==>
255+ N.toText name ==>
257 Encode.object
256 Encode.object
258− [ "args" ==> Encode.list Encode.text args
257+ [ "args" ==> Encode.list Encode.name args
259 , "tags" ==> Encode.object (map toCtorObject constructors)
258 , "tags" ==> Encode.object (map toCtorObject constructors)
260 ]
259 ]
261
260
262
261
263−toCtorObject :: (Text, [Type]) -> ( Text.Text, Encode.Value )
262+toCtorObject :: (N.Name, [Type]) -> ( Text.Text, Encode.Value )
264toCtorObject (name, args) =
263toCtorObject (name, args) =
265− name ==> Encode.list encode args
264+ N.toText name ==> Encode.list encode args
src/Elm/Compiler/Type/Extract.hs+1−2
@@ -12,7 +12,6 @@ module Elm.Compiler.Type.Extract
12import Data.Map ((!))
12import Data.Map ((!))
13import qualified Data.Map as Map
13import qualified Data.Map as Map
14import qualified Data.Maybe as Maybe
14import qualified Data.Maybe as Maybe
15−import Data.Monoid ((<>))
16import qualified Data.Set as Set
15import qualified Data.Set as Set
17
16
18import qualified AST.Canonical as Can
17import qualified AST.Canonical as Can
@@ -76,7 +75,7 @@ extract astType =
76
75
77toPublicName :: ModuleName.Canonical -> N.Name -> N.Name
76toPublicName :: ModuleName.Canonical -> N.Name -> N.Name
78toPublicName (ModuleName.Canonical _ home) name =
77toPublicName (ModuleName.Canonical _ home) name =
79− home <> "." <> name
78+ N.sepBy 0x2E {- . -} home name
80
79
81
80
82
81
src/Elm/Docs.hs+11−11
@@ -132,7 +132,7 @@ dictDecoder entryDecoder =
132named :: D.Decoder Error a -> D.Decoder Error (N.Name, a)
132named :: D.Decoder Error a -> D.Decoder Error (N.Name, a)
133named entryDecoder =
133named entryDecoder =
134 (,)
134 (,)
135− <$> D.field "name" D.text
135+ <$> D.field "name" D.name
136 <*> entryDecoder
136 <*> entryDecoder
137
137
138
138
@@ -153,9 +153,9 @@ typeDecoder =
153encodeUnion :: (N.Name, Union) -> E.Value
153encodeUnion :: (N.Name, Union) -> E.Value
154encodeUnion (name, Union comment args cases) =
154encodeUnion (name, Union comment args cases) =
155 E.object
155 E.object
156− [ "name" ==> E.text name
156+ [ "name" ==> E.name name
157 , "comment" ==> E.text comment
157 , "comment" ==> E.text comment
158− , "args" ==> E.list E.text args
158+ , "args" ==> E.list E.name args
159 , "cases" ==> E.list encodeCase cases
159 , "cases" ==> E.list encodeCase cases
160 ]
160 ]
161
161
@@ -164,19 +164,19 @@ union :: D.Decoder Error Union
164union =
164union =
165 Union
165 Union
166 <$> D.field "comment" D.text
166 <$> D.field "comment" D.text
167− <*> D.field "args" (D.list D.text)
167+ <*> D.field "args" (D.list D.name)
168 <*> D.field "cases" (D.list caseDecoder)
168 <*> D.field "cases" (D.list caseDecoder)
169
169
170
170
171encodeCase :: ( N.Name, [Type.Type] ) -> E.Value
171encodeCase :: ( N.Name, [Type.Type] ) -> E.Value
172encodeCase ( tag, args ) =
172encodeCase ( tag, args ) =
173− E.list id [ E.text tag, E.list Type.encode args ]
173+ E.list id [ E.name tag, E.list Type.encode args ]
174
174
175
175
176caseDecoder :: D.Decoder Error ( N.Name, [Type.Type] )
176caseDecoder :: D.Decoder Error ( N.Name, [Type.Type] )
177caseDecoder =
177caseDecoder =
178 (,)
178 (,)
179− <$> D.index 0 D.text
179+ <$> D.index 0 D.name
180 <*> D.index 1 (D.list typeDecoder)
180 <*> D.index 1 (D.list typeDecoder)
181
181
182
182
@@ -187,9 +187,9 @@ caseDecoder =
187encodeAlias :: (N.Name, Alias) -> E.Value
187encodeAlias :: (N.Name, Alias) -> E.Value
188encodeAlias ( name, Alias comment args tipe) =
188encodeAlias ( name, Alias comment args tipe) =
189 E.object
189 E.object
190− [ "name" ==> E.text name
190+ [ "name" ==> E.name name
191 , "comment" ==> E.text comment
191 , "comment" ==> E.text comment
192− , "args" ==> E.list E.text args
192+ , "args" ==> E.list E.name args
193 , "type" ==> Type.encode tipe
193 , "type" ==> Type.encode tipe
194 ]
194 ]
195
195
@@ -198,7 +198,7 @@ alias :: D.Decoder Error Alias
198alias =
198alias =
199 Alias
199 Alias
200 <$> D.field "comment" D.text
200 <$> D.field "comment" D.text
201− <*> D.field "args" (D.list D.text)
201+ <*> D.field "args" (D.list D.name)
202 <*> D.field "type" typeDecoder
202 <*> D.field "type" typeDecoder
203
203
204
204
@@ -209,7 +209,7 @@ alias =
209encodeValue :: (N.Name, Value) -> E.Value
209encodeValue :: (N.Name, Value) -> E.Value
210encodeValue (name, Value comment tipe) =
210encodeValue (name, Value comment tipe) =
211 E.object
211 E.object
212− [ "name" ==> E.text name
212+ [ "name" ==> E.name name
213 , "comment" ==> E.text comment
213 , "comment" ==> E.text comment
214 , "type" ==> Type.encode tipe
214 , "type" ==> Type.encode tipe
215 ]
215 ]
@@ -229,7 +229,7 @@ value =
229encodeBinop :: (N.Name, Binop) -> E.Value
229encodeBinop :: (N.Name, Binop) -> E.Value
230encodeBinop (name, Binop comment tipe assoc prec) =
230encodeBinop (name, Binop comment tipe assoc prec) =
231 E.object
231 E.object
232− [ "name" ==> E.text name
232+ [ "name" ==> E.name name
233 , "comment" ==> E.text comment
233 , "comment" ==> E.text comment
234 , "type" ==> Type.encode tipe
234 , "type" ==> Type.encode tipe
235 , "associativity" ==> encodeAssoc assoc
235 , "associativity" ==> encodeAssoc assoc
src/Elm/Kernel.hs+10−12
@@ -10,9 +10,7 @@ module Elm.Kernel
10import qualified Data.ByteString as B
10import qualified Data.ByteString as B
11import qualified Data.List as List
11import qualified Data.List as List
12import qualified Data.Map as Map
12import qualified Data.Map as Map
13−import Data.Monoid ((<>))
14import qualified Data.Set as Set
13import qualified Data.Set as Set
15−import qualified Data.Text as Text
16import Data.Word (Word8)
14import Data.Word (Word8)
17
15
18
16
@@ -66,7 +64,7 @@ parser importDict =
66
64
67
65
68type VarTable =
66type VarTable =
69− Map.Map Text.Text Opt.KChunk
67+ Map.Map N.Name Opt.KChunk
70
68
71
69
72data State =
70data State =
@@ -83,7 +81,7 @@ addImport importDict state (Src.Import (A.At _ home) maybeAlias exposing) =
83 if ModuleName.isKernel home then
81 if ModuleName.isKernel home then
84 case maybeAlias of
82 case maybeAlias of
85 Just _ ->
83 Just _ ->
86− error ("Cannot use aliases on kernel import of: " ++ show home)
84+ error ("Cannot use aliases on kernel import of: " ++ N.toString home)
87
85
88 Nothing ->
86 Nothing ->
89 addKernelImport (ModuleName.getKernel home) exposing state
87 addKernelImport (ModuleName.getKernel home) exposing state
@@ -98,7 +96,7 @@ addImport importDict state (Src.Import (A.At _ home) maybeAlias exposing) =
98 addNormalImport canonicalHome prefix exposing state
96 addNormalImport canonicalHome prefix exposing state
99
97
100 _ ->
98 _ ->
101− error ("Cannot find kernel import of: " ++ show home)
99+ error ("Cannot find kernel import of: " ++ N.toString home)
102
100
103
101
104-- INVARIANT: the `home` is the * in `Elm.Kernel.*`
102-- INVARIANT: the `home` is the * in `Elm.Kernel.*`
@@ -107,7 +105,7 @@ addKernelImport :: N.Name -> Src.Exposing -> State -> State
107addKernelImport home exposing (State vtable deps) =
105addKernelImport home exposing (State vtable deps) =
108 let
106 let
109 addVar table name =
107 addVar table name =
110− Map.insert (home <> "_" <> name) (Opt.JsVar home name) table
108+ Map.insert (N.sepBy 0x5F {- _ -} home name) (Opt.JsVar home name) table
111 in
109 in
112 State
110 State
113 (List.foldl' addVar vtable (toNames exposing))
111 (List.foldl' addVar vtable (toNames exposing))
@@ -119,7 +117,7 @@ addNormalImport home prefix exposing state =
119 let
117 let
120 addVar (State vtable deps) name =
118 addVar (State vtable deps) name =
121 State
119 State
122− (Map.insert (prefix <> "_" <> name) (Opt.ElmVar home name) vtable)
120+ (Map.insert (N.sepBy 0x5F {- _ -} prefix name) (Opt.ElmVar home name) vtable)
123 (Set.insert (Opt.Global home name) deps)
121 (Set.insert (Opt.Global home name) deps)
124 in
122 in
125 List.foldl' addVar state (toNames exposing)
123 List.foldl' addVar state (toNames exposing)
@@ -132,8 +130,8 @@ toPrefix home maybeAlias =
132 alias
130 alias
133
131
134 Nothing ->
132 Nothing ->
135− if Text.isInfixOf "." home then
133+ if N.contains 0x2E {- . -} home then
136− error ("kernel imports with dots need an alias: " ++ show home)
134+ error ("kernel imports with dots need an alias: " ++ show (N.toString home))
137 else
135 else
138 home
136 home
139
137
@@ -187,7 +185,7 @@ chompChunks vtable enums fields chunks =
187 K.Import var ->
185 K.Import var ->
188 case Map.lookup var vtable of
186 case Map.lookup var vtable of
189 Nothing ->
187 Nothing ->
190− error ("Bad kernel symbol: " ++ Text.unpack var)
188+ error ("Bad kernel symbol: " ++ N.toString var)
191
189
192 Just chunk ->
190 Just chunk ->
193 chompChunks vtable enums fields $
191 chompChunks vtable enums fields $
@@ -213,10 +211,10 @@ chompChunks vtable enums fields chunks =
213
211
214
212
215type Fields =
213type Fields =
216− Map.Map Text.Text Int
214+ Map.Map N.Name Int
217
215
218
216
219−lookupField :: Text.Text -> Fields -> (Int, Fields)
217+lookupField :: N.Name -> Fields -> (Int, Fields)
220lookupField name fields =
218lookupField name fields =
221 case Map.lookup name fields of
219 case Map.lookup name fields of
222 Just n ->
220 Just n ->
src/Elm/Name.hs+88−20
@@ -2,16 +2,28 @@
2{-# LANGUAGE OverloadedStrings #-}
2{-# LANGUAGE OverloadedStrings #-}
3module Elm.Name
3module Elm.Name
4 ( Name
4 ( Name
5+ -- utilities
5 , length
6 , length
7+ , contains
6 , startsWith
8 , startsWith
7 , drop
9 , drop
10+ -- conversions
11+ , toText
8 , toString
12 , toString
9 , toBuilder
13 , toBuilder
14+ , toDotlessBuilder
10 , toShort
15 , toShort
16+ -- helpers
11 , addIndex
17 , addIndex
12 , addSafeIndex
18 , addSafeIndex
13 , toCompositeName
19 , toCompositeName
20+ , sepBy
21+ -- create
14 , fromForeignPtr
22 , fromForeignPtr
23+ , fromString
24+ , fromLetter
25+ , fromText
26+ -- interned
15 , int, float, bool, char, string
27 , int, float, bool, char, string
16 , maybe, list, array, tuple, jsArray
28 , maybe, list, array, tuple, jsArray
17 , task, router, cmd, sub, platform, browser
29 , task, router, cmd, sub, platform, browser
@@ -23,11 +35,12 @@ module Elm.Name
23
35
24
36
25import Prelude hiding (drop, length, maybe, negate)
37import Prelude hiding (drop, length, maybe, negate)
38+import Data.Binary
26import qualified Data.ByteString.Builder as B
39import qualified Data.ByteString.Builder as B
27import qualified Data.ByteString.Internal as B
40import qualified Data.ByteString.Internal as B
28import qualified Data.ByteString.Short as S
41import qualified Data.ByteString.Short as S
29import qualified Data.Char as Char
42import qualified Data.Char as Char
30−import qualified Data.Set as Set
43+import qualified Data.String as String
31import qualified Data.Text as Text
44import qualified Data.Text as Text
32import qualified Data.Text.Encoding as Text
45import qualified Data.Text.Encoding as Text
33import Data.Word (Word8)
46import Data.Word (Word8)
@@ -38,32 +51,52 @@ import Foreign.ForeignPtr (ForeignPtr)
38-- NAME
51-- NAME
39
52
40
53
41−type Name = Text.Text
54+newtype Name = Name { _name :: Text.Text }
55+ deriving (Eq, Ord)
42
56
43
57
44length :: Name -> Int
58length :: Name -> Int
45−length =
59+length (Name name) =
46− Text.length
60+ Text.length name
61+
62+
63+contains :: Word8 -> Name -> Bool
64+contains word (Name name) =
65+ Text.isInfixOf (Text.singleton (Char.chr (fromIntegral word))) name
47
66
48
67
49startsWith :: Name -> Name -> Bool
68startsWith :: Name -> Name -> Bool
50−startsWith =
69+startsWith (Name prefix) (Name name) =
51− Text.isPrefixOf
70+ Text.isPrefixOf prefix name
52
71
53
72
54drop :: Int -> Name -> Name
73drop :: Int -> Name -> Name
55−drop =
74+drop numBytes (Name name) =
56− Text.drop
75+ Name (Text.drop numBytes name)
76+
77+
78+
79+-- CONVERSIONS
80+
81+
82+toText :: Name -> Text.Text
83+toText (Name name) =
84+ name
57
85
58
86
59toString :: Name -> String
87toString :: Name -> String
60−toString =
88+toString (Name name) =
61− Text.unpack
89+ Text.unpack name
62
90
63
91
64toBuilder :: Name -> B.Builder
92toBuilder :: Name -> B.Builder
65−toBuilder =
93+toBuilder (Name name) =
66− Text.encodeUtf8Builder
94+ Text.encodeUtf8Builder name
95+
96+
97+toDotlessBuilder :: Name -> B.Builder
98+toDotlessBuilder (Name name) =
99+ Text.encodeUtf8Builder (Text.replace "." "$" name)
67
100
68
101
69toShort :: Name -> S.ShortByteString
102toShort :: Name -> S.ShortByteString
@@ -72,31 +105,66 @@ toShort name =
72
105
73
106
74addIndex :: Name -> Int -> Name
107addIndex :: Name -> Int -> Name
75−addIndex name index =
108+addIndex (Name name) index =
76− Text.append name (Text.pack (show index))
109+ Name (Text.append name (Text.pack (show index)))
77
110
78
111
79addSafeIndex :: Name -> Int -> Name
112addSafeIndex :: Name -> Int -> Name
80−addSafeIndex name index =
113+addSafeIndex (Name name) index =
81− Text.append name $ Text.pack $
114+ Name $ Text.append name $ Text.pack $
82 if Char.isDigit (Text.last name) then
115 if Char.isDigit (Text.last name) then
83 '_' : show index
116 '_' : show index
84 else
117 else
85 show index
118 show index
86
119
87
120
88−toCompositeName :: Set.Set Name -> Name
121+toCompositeName :: [Name] -> Name
89toCompositeName names =
122toCompositeName names =
90− Text.cons '$' (Text.intercalate "$" (Set.toList names))
123+ Name (Text.cons '$' (Text.intercalate "$" (map _name names)))
91
124
92
125
126+sepBy :: Word8 -> Name -> Name -> Name
127+sepBy sep (Name home) (Name name) =
128+ Name (Text.concat [ home, Text.singleton (Char.chr (fromIntegral sep)), name ])
93
129
94−-- FROM PARSER
130+
131+
132+-- CREATE NAMES
95
133
96
134
97fromForeignPtr :: ForeignPtr Word8 -> Int -> Int -> Name
135fromForeignPtr :: ForeignPtr Word8 -> Int -> Int -> Name
98fromForeignPtr fptr offset len =
136fromForeignPtr fptr offset len =
99− Text.decodeUtf8 (B.PS fptr offset len)
137+ Name (Text.decodeUtf8 (B.PS fptr offset len))
138+
139+
140+fromString :: String -> Name
141+fromString str =
142+ Name (Text.pack str)
143+
144+
145+{- Takes a letter from 0 to 25 -}
146+fromLetter :: Int -> Name
147+fromLetter letter =
148+ Name (Text.singleton (Char.chr (97 + letter)))
149+
150+
151+fromText :: Text.Text -> Name
152+fromText =
153+ Name
154+
155+
156+
157+-- INSTANCES
158+
159+
160+instance String.IsString Name where
161+ fromString str =
162+ Name (Text.pack str)
163+
164+
165+instance Binary Name where
166+ put (Name name) = put name
167+ get = Name <$> get
100
168
101
169
102
170
src/Generate/JavaScript.hs+7−6
@@ -16,6 +16,7 @@ import Data.Map ((!))
16import qualified Data.Map as Map
16import qualified Data.Map as Map
17import qualified Data.Set as Set
17import qualified Data.Set as Set
18import qualified Data.Text as Text
18import qualified Data.Text as Text
19+import qualified Data.Text.Encoding as Text
19
20
20import qualified AST.Optimized as Opt
21import qualified AST.Optimized as Opt
21import qualified AST.Module.Name as ModuleName
22import qualified AST.Module.Name as ModuleName
@@ -434,7 +435,7 @@ generateExports mode interfaces (Trie maybeMain subs) =
434 "{}"
435 "{}"
435
436
436 (name, subTrie) : otherSubTries ->
437 (name, subTrie) : otherSubTries ->
437− "{'" <> N.toBuilder name <> "':"
438+ "{'" <> Text.encodeUtf8Builder name <> "':"
438 <> generateExports mode interfaces subTrie
439 <> generateExports mode interfaces subTrie
439 <> List.foldl' (addSubTrie mode interfaces) "}" otherSubTries
440 <> List.foldl' (addSubTrie mode interfaces) "}" otherSubTries
440 in
441 in
@@ -447,9 +448,9 @@ generateExports mode interfaces (Trie maybeMain subs) =
447 JS.exprToBuilder initialize <> "(" <> object <> ")"
448 JS.exprToBuilder initialize <> "(" <> object <> ")"
448
449
449
450
450−addSubTrie :: Name.Mode -> I.Interfaces -> B.Builder -> (N.Name, Trie) -> B.Builder
451+addSubTrie :: Name.Mode -> I.Interfaces -> B.Builder -> (Text.Text, Trie) -> B.Builder
451addSubTrie mode interfaces end (name, trie) =
452addSubTrie mode interfaces end (name, trie) =
452− ",'" <> N.toBuilder name <> "':"
453+ ",'" <> Text.encodeUtf8Builder name <> "':"
453 <> generateExports mode interfaces trie
454 <> generateExports mode interfaces trie
454 <> end
455 <> end
455
456
@@ -461,7 +462,7 @@ addSubTrie mode interfaces end (name, trie) =
461data Trie =
462data Trie =
462 Trie
463 Trie
463 { _main :: Maybe (ModuleName.Canonical, Opt.Main)
464 { _main :: Maybe (ModuleName.Canonical, Opt.Main)
464− , _subs :: Map.Map N.Name Trie
465+ , _subs :: Map.Map Text.Text Trie
465 }
466 }
466
467
467
468
@@ -472,10 +473,10 @@ emptyTrie =
472
473
473addToTrie :: ModuleName.Canonical -> Opt.Main -> Trie -> Trie
474addToTrie :: ModuleName.Canonical -> Opt.Main -> Trie -> Trie
474addToTrie home@(ModuleName.Canonical _ moduleName) main trie =
475addToTrie home@(ModuleName.Canonical _ moduleName) main trie =
475− merge trie $ segmentsToTrie home (Text.splitOn "." moduleName) main
476+ merge trie $ segmentsToTrie home (Text.splitOn "." (N.toText moduleName)) main
476
477
477
478
478−segmentsToTrie :: ModuleName.Canonical -> [N.Name] -> Opt.Main -> Trie
479+segmentsToTrie :: ModuleName.Canonical -> [Text.Text] -> Opt.Main -> Trie
479segmentsToTrie home segments main =
480segmentsToTrie home segments main =
480 case segments of
481 case segments of
481 [] ->
482 [] ->
src/Generate/JavaScript/Name.hs+1−1
@@ -103,7 +103,7 @@ fromGlobal (ModuleName.Canonical (Pkg.Name user project) home) name =
103 Name $
103 Name $
104 Text.encodeUtf8Builder (Text.replace "-" "_" user)
104 Text.encodeUtf8Builder (Text.replace "-" "_" user)
105 <> "$" <> Text.encodeUtf8Builder (Text.replace "-" "_" project) -- TODO store this in a better way
105 <> "$" <> Text.encodeUtf8Builder (Text.replace "-" "_" project) -- TODO store this in a better way
106− <> "$" <> N.toBuilder (Text.replace "." "$" home)
106+ <> "$" <> N.toDotlessBuilder home
107 <> "$" <> N.toBuilder name
107 <> "$" <> N.toBuilder name
108
108
109
109
src/Json/Decode.hs+1−1
@@ -5,7 +5,7 @@ module Json.Decode
5 , Failure(..)
5 , Failure(..)
6 -- re-export from Json.Decode.Internals
6 -- re-export from Json.Decode.Internals
7 , Json.Decoder, Json.Error(..), Json.Type(..)
7 , Json.Decoder, Json.Error(..), Json.Type(..)
8− , Json.string, Json.text, Json.bool, Json.int
8+ , Json.string, Json.text, Json.name, Json.bool, Json.int
9 , Json.list, Json.dict, Json.pairs, Json.maybe
9 , Json.list, Json.dict, Json.pairs, Json.maybe
10 , Json.field, Json.at
10 , Json.field, Json.at
11 , Json.index
11 , Json.index
src/Json/Decode/Internals.hs+7−2
@@ -5,7 +5,7 @@ module Json.Decode.Internals
5 , Decoder(..)
5 , Decoder(..)
6 , Error(..)
6 , Error(..)
7 , Type(..)
7 , Type(..)
8− , string, text, bool, int
8+ , string, text, name, bool, int
9 , list, dict, pairs
9 , list, dict, pairs
10 , maybe
10 , maybe
11 , field, at
11 , field, at
@@ -25,10 +25,10 @@ import qualified Data.Scientific as Sci
25import qualified Data.Text as Text
25import qualified Data.Text as Text
26import qualified Data.Vector as Vector
26import qualified Data.Vector as Vector
27import Data.Vector ((!?))
27import Data.Vector ((!?))
28+import qualified Elm.Name as N
28import qualified Json.Encode as E
29import qualified Json.Encode as E
29
30
30
31
31−
32-- VALUE
32-- VALUE
33
33
34
34
@@ -93,6 +93,11 @@ text =
93 Left (expecting value TString)
93 Left (expecting value TString)
94
94
95
95
96+name :: Decoder e N.Name
97+name =
98+ N.fromText <$> text
99+
100+
96bool :: Decoder e Bool
101bool :: Decoder e Bool
97bool =
102bool =
98 Decoder $ \value ->
103 Decoder $ \value ->
src/Json/Encode.hs+20−12
@@ -9,6 +9,7 @@ module Json.Encode
9 , array
9 , array
10 , object
10 , object
11 , text
11 , text
12+ , name
12 , bool
13 , bool
13 , int
14 , int
14 , number
15 , number
@@ -34,6 +35,8 @@ import qualified Data.Text.Encoding as Text
34import qualified Data.Word as W
35import qualified Data.Word as W
35import System.IO (IOMode(WriteMode), withBinaryFile)
36import System.IO (IOMode(WriteMode), withBinaryFile)
36
37
38+import qualified Elm.Name as N
39+
37
40
38
41
39-- VALUES
42-- VALUES
@@ -42,7 +45,7 @@ import System.IO (IOMode(WriteMode), withBinaryFile)
42data Value
45data Value
43 = Array [Value]
46 = Array [Value]
44 | Object [(Text.Text, Value)]
47 | Object [(Text.Text, Value)]
45− | String Text.Text
48+ | String B.Builder
46 | Boolean Bool
49 | Boolean Bool
47 | Integer Int
50 | Integer Int
48 | Number Sci.Scientific
51 | Number Sci.Scientific
@@ -60,8 +63,13 @@ object =
60
63
61
64
62text :: Text.Text -> Value
65text :: Text.Text -> Value
63−text =
66+text txt =
64− String
67+ String (encodeText txt)
68+
69+
70+name :: N.Name -> Value
71+name nm =
72+ String ("\"" <> N.toBuilder nm <> "\"")
65
73
66
74
67bool :: Bool -> Value
75bool :: Bool -> Value
@@ -142,12 +150,12 @@ encodeUgly value =
142 Object (first : rest) ->
150 Object (first : rest) ->
143 let
151 let
144 encodeEntry char (key, entry) =
152 encodeEntry char (key, entry) =
145− B.char7 char <> encodeString key <> B.char7 ':' <> encodeUgly entry
153+ B.char7 char <> encodeText key <> B.char7 ':' <> encodeUgly entry
146 in
154 in
147 encodeEntry '{' first <> mconcat (map (encodeEntry ',') rest) <> B.char7 '}'
155 encodeEntry '{' first <> mconcat (map (encodeEntry ',') rest) <> B.char7 '}'
148
156
149− String txt ->
157+ String builder ->
150− encodeString txt
158+ builder
151
159
152 Boolean boolean ->
160 Boolean boolean ->
153 B.string7 (if boolean then "true" else "false")
161 B.string7 (if boolean then "true" else "false")
@@ -186,8 +194,8 @@ encodeHelp indent value =
186 Object (first : rest) ->
194 Object (first : rest) ->
187 encodeObject indent first rest
195 encodeObject indent first rest
188
196
189− String txt ->
197+ String builder ->
190− encodeString txt
198+ builder
191
199
192 Boolean boolean ->
200 Boolean boolean ->
193 B.string7 (if boolean then "true" else "false")
201 B.string7 (if boolean then "true" else "false")
@@ -242,7 +250,7 @@ objectClose =
242
250
243encodeField :: BSC.ByteString -> (Text.Text, Value) -> B.Builder
251encodeField :: BSC.ByteString -> (Text.Text, Value) -> B.Builder
244encodeField indent (key, value) =
252encodeField indent (key, value) =
245− encodeString key <> B.string7 ": " <> encodeHelp indent value
253+ encodeText key <> B.string7 ": " <> encodeHelp indent value
246
254
247
255
248
256
@@ -284,11 +292,11 @@ newline =
284
292
285
293
286
294
287−-- ENCODE STRING
295+-- ENCODE TEXT
288
296
289
297
290−encodeString :: Text.Text -> B.Builder
298+encodeText :: Text.Text -> B.Builder
291−encodeString txt =
299+encodeText txt =
292 B.char7 '"' <> Text.encodeUtf8BuilderEscaped escapeAscii txt <> B.char7 '"'
300 B.char7 '"' <> Text.encodeUtf8BuilderEscaped escapeAscii txt <> B.char7 '"'
293
301
294
302
src/Optimize/Module.hs+1−1
@@ -307,7 +307,7 @@ addRecDefs :: ModuleName.Canonical -> [Can.Def] -> Opt.Graph -> Opt.Graph
307addRecDefs home defs graph =
307addRecDefs home defs graph =
308 let
308 let
309 cycleValues = foldr addValueName Set.empty defs
309 cycleValues = foldr addValueName Set.empty defs
310− dummyName = Opt.Global home (N.toCompositeName cycleValues)
310+ dummyName = Opt.Global home (N.toCompositeName (Set.toList cycleValues))
311
311
312 (deps, fields, State cyclicValuePairs newGraph) =
312 (deps, fields, State cyclicValuePairs newGraph) =
313 Names.run $
313 Names.run $
src/Optimize/Names.hs+1−3
@@ -15,10 +15,8 @@ module Optimize.Names
15 where
15 where
16
16
17
17
18−import Data.Monoid ((<>))
19import qualified Data.Map as Map
18import qualified Data.Map as Map
20import qualified Data.Set as Set
19import qualified Data.Set as Set
21−import qualified Data.Text as Text
22
20
23import qualified AST.Canonical as Can
21import qualified AST.Canonical as Can
24import qualified AST.Optimized as Opt
22import qualified AST.Optimized as Opt
@@ -52,7 +50,7 @@ run (Tracker k) =
52generate :: Tracker N.Name
50generate :: Tracker N.Name
53generate =
51generate =
54 Tracker $ \uid deps fields ok ->
52 Tracker $ \uid deps fields ok ->
55− ok (uid + 1) deps fields ("_n" <> Text.pack (show uid))
53+ ok (uid + 1) deps fields (N.addIndex "_n" uid)
56
54
57
55
58registerKernel :: N.Name -> a -> Tracker a
56registerKernel :: N.Name -> a -> Tracker a
src/Optimize/Port.hs+2−2
@@ -68,7 +68,7 @@ toEncoder tipe =
68 encodeField (name, fieldType) =
68 encodeField (name, fieldType) =
69 do encoder <- toEncoder fieldType
69 do encoder <- toEncoder fieldType
70 let value = Opt.Call encoder [Opt.Access (Opt.VarLocal N.dollar) name]
70 let value = Opt.Call encoder [Opt.Access (Opt.VarLocal N.dollar) name]
71− return $ Opt.Tuple (Opt.Str name) value Nothing
71+ return $ Opt.Tuple (Opt.Str (N.toText name)) value Nothing
72 in
72 in
73 do object <- encode "object"
73 do object <- encode "object"
74 keyValuePairs <- traverse encodeField (Map.toList fields)
74 keyValuePairs <- traverse encodeField (Map.toList fields)
@@ -305,7 +305,7 @@ fieldAndThen decoder (key, tipe) =
305 return $
305 return $
306 Opt.Call andThen
306 Opt.Call andThen
307 [ Opt.Function [key] decoder
307 [ Opt.Function [key] decoder
308− , Opt.Call field [ Opt.Str key, typeDecoder ]
308+ , Opt.Call field [ Opt.Str (N.toText key), typeDecoder ]
309 ]
309 ]
310
310
311
311
src/Parse/Declaration.hs+5−5
@@ -7,11 +7,11 @@ module Parse.Declaration
7 where
7 where
8
8
9
9
10−import Data.Text (Text)
11import qualified Data.Text.Encoding as Text
10import qualified Data.Text.Encoding as Text
12
11
13import qualified AST.Source as Src
12import qualified AST.Source as Src
14import qualified AST.Utils.Binop as Binop
13import qualified AST.Utils.Binop as Binop
14+import qualified Elm.Name as N
15import qualified Parse.Expression as Expr
15import qualified Parse.Expression as Expr
16import qualified Parse.Pattern as Pattern
16import qualified Parse.Pattern as Pattern
17import Parse.Primitives
17import Parse.Primitives
@@ -77,7 +77,7 @@ def_ start =
77 ]
77 ]
78
78
79
79
80−definitionHelp :: R.Position -> A.Located Text -> [Src.Pattern] -> SParser Src.Decl
80+definitionHelp :: R.Position -> A.Located N.Name -> [Src.Pattern] -> SParser Src.Decl
81definitionHelp start name revArgs =
81definitionHelp start name revArgs =
82 oneOf
82 oneOf
83 [ do arg <- hint E.Arg Pattern.term
83 [ do arg <- hint E.Arg Pattern.term
@@ -115,14 +115,14 @@ type_ start =
115 ]
115 ]
116
116
117
117
118−nameArgsEquals :: Parser (A.Located Text, [A.Located Text])
118+nameArgsEquals :: Parser (A.Located N.Name, [A.Located N.Name])
119nameArgsEquals =
119nameArgsEquals =
120 do name <- addLocation Var.upper
120 do name <- addLocation Var.upper
121 spaces
121 spaces
122 nameArgsEqualsHelp name []
122 nameArgsEqualsHelp name []
123
123
124
124
125−nameArgsEqualsHelp :: A.Located Text -> [A.Located Text] -> Parser (A.Located Text, [A.Located Text])
125+nameArgsEqualsHelp :: A.Located N.Name -> [A.Located N.Name] -> Parser (A.Located N.Name, [A.Located N.Name])
126nameArgsEqualsHelp name args =
126nameArgsEqualsHelp name args =
127 oneOf
127 oneOf
128 [ do arg <- addLocation Var.lower
128 [ do arg <- addLocation Var.lower
@@ -134,7 +134,7 @@ nameArgsEqualsHelp name args =
134 ]
134 ]
135
135
136
136
137−chompConstructors :: [(A.Located Text, [Src.Type])] -> R.Position -> SPos -> SParser [(A.Located Text, [Src.Type])]
137+chompConstructors :: [(A.Located N.Name, [Src.Type])] -> R.Position -> SPos -> SParser [(A.Located N.Name, [Src.Type])]
138chompConstructors ctors end pos =
138chompConstructors ctors end pos =
139 oneOf
139 oneOf
140 [ do checkSpace pos
140 [ do checkSpace pos
src/Parse/Module.hs+4−5
@@ -9,7 +9,6 @@ module Parse.Module
9
9
10
10
11import qualified Data.ByteString as B
11import qualified Data.ByteString as B
12−import Data.Text (Text)
13
12
14import qualified AST.Source as Src
13import qualified AST.Source as Src
15import qualified Elm.Compiler.Imports as Imports
14import qualified Elm.Compiler.Imports as Imports
@@ -137,7 +136,7 @@ chompManager =
137 ]
136 ]
138
137
139
138
140−chompCommand :: Parser (A.Located Text)
139+chompCommand :: Parser (A.Located N.Name)
141chompCommand =
140chompCommand =
142 do Keyword.command_
141 do Keyword.command_
143 P.spaces
142 P.spaces
@@ -146,7 +145,7 @@ chompCommand =
146 P.addLocation Var.upper
145 P.addLocation Var.upper
147
146
148
147
149−chompSubscription :: Parser (A.Located Text)
148+chompSubscription :: Parser (A.Located N.Name)
150chompSubscription =
149chompSubscription =
151 do Keyword.subscription_
150 do Keyword.subscription_
152 P.spaces
151 P.spaces
@@ -200,7 +199,7 @@ chompImports imports =
200 ]
199 ]
201
200
202
201
203−chompAs :: A.Located Text -> [Src.Import] -> Parser [Src.Import]
202+chompAs :: A.Located N.Name -> [Src.Import] -> Parser [Src.Import]
204chompAs name imports =
203chompAs name imports =
205 do Keyword.as_
204 do Keyword.as_
206 P.spaces
205 P.spaces
@@ -216,7 +215,7 @@ chompAs name imports =
216 ]
215 ]
217
216
218
217
219−chompExposing :: A.Located Text -> Maybe Text -> [Src.Import] -> Parser [Src.Import]
218+chompExposing :: A.Located N.Name -> Maybe N.Name -> [Src.Import] -> Parser [Src.Import]
220chompExposing name maybeAlias imports =
219chompExposing name maybeAlias imports =
221 do Keyword.exposing_
220 do Keyword.exposing_
222 P.spaces
221 P.spaces
src/Parse/Primitives/Kernel.hs+3−4
@@ -9,7 +9,6 @@ module Parse.Primitives.Kernel
9
9
10import Prelude hiding (length)
10import Prelude hiding (length)
11import qualified Data.ByteString.Internal as B
11import qualified Data.ByteString.Internal as B
12−import Data.Text (Text)
13import Data.Word (Word8)
12import Data.Word (Word8)
14import Foreign.ForeignPtr (ForeignPtr)
13import Foreign.ForeignPtr (ForeignPtr)
15
14
@@ -24,11 +23,11 @@ import qualified Parse.Primitives.Variable as Var
24
23
25
24
26data Special
25data Special
27− = Enum Word8 Text
26+ = Enum Word8 N.Name
28 | Prod
27 | Prod
29 | Debug
28 | Debug
30− | Import Text
29+ | Import N.Name
31− | JsField Text
30+ | JsField N.Name
32 | ElmField N.Name
31 | ElmField N.Name
33
32
34
33
src/Parse/Primitives/Shader.hs+3−2
@@ -7,11 +7,12 @@ module Parse.Primitives.Shader
7 where
7 where
8
8
9
9
10+import qualified Data.ByteString.Internal as B
10import qualified Data.Text as Text
11import qualified Data.Text as Text
12+import qualified Data.Text.Encoding as Text
11import Foreign.ForeignPtr (ForeignPtr)
13import Foreign.ForeignPtr (ForeignPtr)
12import GHC.Word (Word8)
14import GHC.Word (Word8)
13
15
14−import qualified Elm.Name as N
15import Parse.Primitives.Internals (Parser(..), State(..), noError)
16import Parse.Primitives.Internals (Parser(..), State(..), noError)
16import qualified Parse.Primitives.Internals as I
17import qualified Parse.Primitives.Internals as I
17import qualified Parse.Primitives.Symbol as Symbol
18import qualified Parse.Primitives.Symbol as Symbol
@@ -39,7 +40,7 @@ block =
39 Ok newOffset newRow newCol ->
40 Ok newOffset newRow newCol ->
40 let
41 let
41 !size = newOffset - offset
42 !size = newOffset - offset
42− !shader = N.fromForeignPtr fp offset size
43+ !shader = Text.decodeUtf8 (B.PS fp offset size)
43 !newState = State fp (newOffset + 2) terminal indent newRow newCol ctx
44 !newState = State fp (newOffset + 2) terminal indent newRow newCol ctx
44 in
45 in
45 cok shader newState noError
46 cok shader newState noError
src/Parse/Primitives/Symbol.hs+1−2
@@ -17,7 +17,6 @@ import qualified Data.ByteString.Char8 as Char8
17import qualified Data.Char as Char
17import qualified Data.Char as Char
18import qualified Data.IntSet as IntSet
18import qualified Data.IntSet as IntSet
19import qualified Data.Vector as Vector
19import qualified Data.Vector as Vector
20−import Data.Text (Text)
21import Foreign.ForeignPtr (ForeignPtr)
20import Foreign.ForeignPtr (ForeignPtr)
22import GHC.Word (Word8)
21import GHC.Word (Word8)
23
22
@@ -55,7 +54,7 @@ underscore =
55-- BINOP
54-- BINOP
56
55
57
56
58−binop :: Parser Text
57+binop :: Parser N.Name
59binop =
58binop =
60 Parser $ \(State fp offset terminal indent row col ctx) cok cerr _ eerr ->
59 Parser $ \(State fp offset terminal indent row col ctx) cok cerr _ eerr ->
61 let !newOffset = chompOps fp offset terminal in
60 let !newOffset = chompOps fp offset terminal in
src/Parse/Primitives/Variable.hs+4−5
@@ -18,7 +18,6 @@ import Control.Exception (assert)
18import Data.Bits ((.&.), (.|.), shiftL)
18import Data.Bits ((.&.), (.|.), shiftL)
19import qualified Data.Char as Char
19import qualified Data.Char as Char
20import qualified Data.Set as Set
20import qualified Data.Set as Set
21−import Data.Text (Text)
22import Foreign.ForeignPtr (ForeignPtr)
21import Foreign.ForeignPtr (ForeignPtr)
23import GHC.Word (Word8)
22import GHC.Word (Word8)
24
23
@@ -32,7 +31,7 @@ import qualified Reporting.Error.Syntax as E
32-- LOCAL UPPER
31-- LOCAL UPPER
33
32
34
33
35−upper :: Parser Text
34+upper :: Parser N.Name
36upper =
35upper =
37 Parser $ \(State fp offset terminal indent row col ctx) cok _ _ eerr ->
36 Parser $ \(State fp offset terminal indent row col ctx) cok _ _ eerr ->
38 let (# newOffset, newCol #) = chompUpper fp offset terminal col in
37 let (# newOffset, newCol #) = chompUpper fp offset terminal col in
@@ -47,7 +46,7 @@ upper =
47-- LOCAL LOWER
46-- LOCAL LOWER
48
47
49
48
50−lower :: Parser Text
49+lower :: Parser N.Name
51lower =
50lower =
52 Parser $ \(State fp offset terminal indent row col ctx) cok _ _ eerr ->
51 Parser $ \(State fp offset terminal indent row col ctx) cok _ _ eerr ->
53 let (# newOffset, newCol #) = chompLower fp offset terminal col in
52 let (# newOffset, newCol #) = chompLower fp offset terminal col in
@@ -62,7 +61,7 @@ lower =
62
61
63
62
64{-# NOINLINE reservedWords #-}
63{-# NOINLINE reservedWords #-}
65−reservedWords :: Set.Set Text
64+reservedWords :: Set.Set N.Name
66reservedWords =
65reservedWords =
67 Set.fromList
66 Set.fromList
68 [ "if", "then", "else"
67 [ "if", "then", "else"
@@ -80,7 +79,7 @@ reservedWords =
80-- MODULE NAME
79-- MODULE NAME
81
80
82
81
83−moduleName :: Parser Text
82+moduleName :: Parser N.Name
84moduleName =
83moduleName =
85 Parser $ \(State fp offset terminal indent row col ctx) cok _ _ eerr ->
84 Parser $ \(State fp offset terminal indent row col ctx) cok _ _ eerr ->
86 let (# newOffset, newCol #) = chompUpper fp offset terminal col in
85 let (# newOffset, newCol #) = chompUpper fp offset terminal col in
src/Parse/Shader.hs+15−20
@@ -15,6 +15,7 @@ import qualified Text.Parsec.Error as Parsec
15
15
16import qualified AST.Source as Src
16import qualified AST.Source as Src
17import qualified AST.Utils.Shader as Shader
17import qualified AST.Utils.Shader as Shader
18+import qualified Elm.Name as N
18import qualified Reporting.Annotation as A
19import qualified Reporting.Annotation as A
19import qualified Reporting.Region as R
20import qualified Reporting.Region as R
20import Parse.Primitives (Parser, getPosition)
21import Parse.Primitives (Parser, getPosition)
@@ -65,22 +66,16 @@ emptyShader =
65 Shader.Shader Map.empty Map.empty Map.empty
66 Shader.Shader Map.empty Map.empty Map.empty
66
67
67
68
68−addInput :: (GLS.StorageQualifier, Shader.Type, Text.Text) -> Shader.Shader -> Shader.Shader
69+addInput :: (GLS.StorageQualifier, Shader.Type, String) -> Shader.Shader -> Shader.Shader
69−addInput ( qual, tipe, name ) glDecls =
70+addInput (qual, tipe, name) glDecls =
70 case qual of
71 case qual of
71− GLS.Attribute ->
72− glDecls { Shader._attribute = Map.insert name tipe (Shader._attribute glDecls) }
72+ GLS.Attribute -> glDecls { Shader._attribute = Map.insert (N.fromString name) tipe (Shader._attribute glDecls) }
73+ GLS.Uniform -> glDecls { Shader._uniform = Map.insert (N.fromString name) tipe (Shader._uniform glDecls) }
74+ GLS.Varying -> glDecls { Shader._varying = Map.insert (N.fromString name) tipe (Shader._varying glDecls) }
75+ _ -> error "Should never happen due to `extractInputs` function"
73
76
74− GLS.Uniform ->
75− glDecls { Shader._uniform = Map.insert name tipe (Shader._uniform glDecls) }
76
77
77− GLS.Varying ->
78− glDecls { Shader._varying = Map.insert name tipe (Shader._varying glDecls) }
79−
80− _ -> error "Should never happen due to below filter"
81−
82−
83−extractInputs :: GLS.ExternalDeclaration -> [(GLS.StorageQualifier, Shader.Type, Text.Text)]
78+extractInputs :: GLS.ExternalDeclaration -> [(GLS.StorageQualifier, Shader.Type, String)]
84extractInputs decl =
79extractInputs decl =
85 case decl of
80 case decl of
86 GLS.Declaration
81 GLS.Declaration
@@ -95,12 +90,12 @@ extractInputs decl =
95 False -> []
90 False -> []
96 True ->
91 True ->
97 case tipe of
92 case tipe of
98− GLS.Vec2 -> [(qual, Shader.V2, Text.pack name)]
93+ GLS.Vec2 -> [(qual, Shader.V2, name)]
99− GLS.Vec3 -> [(qual, Shader.V3, Text.pack name)]
94+ GLS.Vec3 -> [(qual, Shader.V3, name)]
100− GLS.Vec4 -> [(qual, Shader.V4, Text.pack name)]
95+ GLS.Vec4 -> [(qual, Shader.V4, name)]
101− GLS.Mat4 -> [(qual, Shader.M4, Text.pack name)]
96+ GLS.Mat4 -> [(qual, Shader.M4, name)]
102− GLS.Int -> [(qual, Shader.Int, Text.pack name)]
97+ GLS.Int -> [(qual, Shader.Int, name)]
103− GLS.Float -> [(qual, Shader.Float, Text.pack name)]
98+ GLS.Float -> [(qual, Shader.Float, name)]
104− GLS.Sampler2D -> [(qual, Shader.Texture, Text.pack name)]
99+ GLS.Sampler2D -> [(qual, Shader.Texture, name)]
105 _ -> []
100 _ -> []
106 _ -> []
101 _ -> []
src/Parse/Type.hs+3−5
@@ -7,15 +7,13 @@ module Parse.Type
7 where
7 where
8
8
9
9
10−import Data.Text (Text)
11−
12import qualified AST.Source as Src
10import qualified AST.Source as Src
11+import qualified Elm.Name as N
13import Parse.Primitives (Parser, SParser, addLocation, checkSpace, getPosition, hint, spaces, oneOf)
12import Parse.Primitives (Parser, SParser, addLocation, checkSpace, getPosition, hint, spaces, oneOf)
14import qualified Parse.Primitives as P
13import qualified Parse.Primitives as P
15import qualified Parse.Primitives.Symbol as Symbol
14import qualified Parse.Primitives.Symbol as Symbol
16import qualified Parse.Primitives.Variable as Var
15import qualified Parse.Primitives.Variable as Var
17import Parse.Primitives.Whitespace (SPos, whitespace)
16import Parse.Primitives.Whitespace (SPos, whitespace)
18−
19import qualified Reporting.Annotation as A
17import qualified Reporting.Annotation as A
20import qualified Reporting.Error.Syntax as E
18import qualified Reporting.Error.Syntax as E
21import qualified Reporting.Region as R
19import qualified Reporting.Region as R
@@ -110,7 +108,7 @@ app start =
110 return ( A.at start end tipe, end, pos )
108 return ( A.at start end tipe, end, pos )
111
109
112
110
113−unionConstructor :: SParser (A.Located Text, [Src.Type])
111+unionConstructor :: SParser (A.Located N.Name, [Src.Type])
114unionConstructor =
112unionConstructor =
115 do start <- getPosition
113 do start <- getPosition
116 name <- Var.upper
114 name <- Var.upper
@@ -204,7 +202,7 @@ record start =
204 ]
202 ]
205
203
206
204
207−type Field = ( A.Located Text, Src.Type )
205+type Field = ( A.Located N.Name, Src.Type )
208
206
209
207
210chompFields :: [Field] -> Parser [Field]
208chompFields :: [Field] -> Parser [Field]
src/Type/Type.hs+2−7
@@ -29,10 +29,8 @@ module Type.Type
29
29
30import Control.Monad.State.Strict (StateT, liftIO)
30import Control.Monad.State.Strict (StateT, liftIO)
31import qualified Control.Monad.State.Strict as State
31import qualified Control.Monad.State.Strict as State
32−import qualified Data.Char as Char
33import Data.Foldable (foldrM)
32import Data.Foldable (foldrM)
34import qualified Data.Map.Strict as Map
33import qualified Data.Map.Strict as Map
35−import qualified Data.Text as Text
36import Data.Word (Word32)
34import Data.Word (Word32)
37
35
38import qualified AST.Canonical as Can
36import qualified AST.Canonical as Can
@@ -469,11 +467,8 @@ getFreshNormal index taken =
469 (postfix, letter) =
467 (postfix, letter) =
470 quotRem index 26
468 quotRem index 26
471
469
472− character =
470+ chr = N.fromLetter letter
473− Char.chr (97 + letter)
474−
475− name =
476− Text.pack (if postfix <= 0 then [character] else character : show postfix)
471+ name = if postfix <= 0 then chr else N.addIndex chr postfix
477 in
472 in
478 if Map.member name taken then
473 if Map.member name taken then
479 getFreshNormal (index + 1) taken
474 getFreshNormal (index + 1) taken
src/Validate.hs+1−1
@@ -289,7 +289,7 @@ definitions sourceDefs =
289 Result.throw (Error.TypeWithoutDefinition annRegion annotationName)
289 Result.throw (Error.TypeWithoutDefinition annRegion annotationName)
290
290
291
291
292−validateDefinition :: R.Region -> A.Located Text -> [Src.Pattern] -> Src.Expr -> Maybe Src.Type -> Result i w Valid.Def
292+validateDefinition :: R.Region -> A.Located N.Name -> [Src.Pattern] -> Src.Expr -> Maybe Src.Type -> Result i w Valid.Def
293validateDefinition region name args expr maybeType =
293validateDefinition region name args expr maybeType =
294 do validExpr <- expression expr
294 do validExpr <- expression expr
295 return $ Valid.Define region name args validExpr maybeType
295 return $ Valid.Define region name args validExpr maybeType