git.iko.soy/elk
on master help sign in
Fix checks for strings as a port type
c1aba2cEvan Czaplicki
src/Canonicalize/Effects.hs+26−15
compare with master
unifiedsplit
@@ -8,8 +8,6 @@ module Canonicalize.Effects
8
8
9import qualified Data.Foldable as F
9import qualified Data.Foldable as F
10import qualified Data.Map as Map
10import qualified Data.Map as Map
11−import qualified Data.Set as Set
12−import Data.Text (Text)
13
11
14import qualified AST.Canonical as Can
12import qualified AST.Canonical as Can
15import qualified AST.Valid as Valid
13import qualified AST.Valid as Valid
@@ -86,7 +84,7 @@ canonicalizePort env (Valid.Port (A.At region portName) tipe) =
86 Result.throw (Error.PortPayloadInvalid region portName badType err)
84 Result.throw (Error.PortPayloadInvalid region portName badType err)
87
85
88 Right () ->
86 Right () ->
89− Result.ok (portName, Can.Outgoing freeVars ctipe)
87+ Result.ok (portName, Can.Outgoing freeVars outgoingType ctipe)
90
88
91 Can.TLambda (Can.TLambda incomingType (Can.TVar msg1)) (Can.TType home name [Can.TVar msg2])
89 Can.TLambda (Can.TLambda incomingType (Can.TVar msg1)) (Can.TType home name [Can.TVar msg2])
92 | home == ModuleName.sub && name == "Sub" && msg1 == msg2 ->
90 | home == ModuleName.sub && name == "Sub" && msg1 == msg2 ->
@@ -95,7 +93,7 @@ canonicalizePort env (Valid.Port (A.At region portName) tipe) =
95 Result.throw (Error.PortPayloadInvalid region portName badType err)
93 Result.throw (Error.PortPayloadInvalid region portName badType err)
96
94
97 Right () ->
95 Right () ->
98− Result.ok (portName, Can.Incoming freeVars ctipe)
96+ Result.ok (portName, Can.Incoming freeVars incomingType ctipe)
99
97
100 _ ->
98 _ ->
101 Result.throw (Error.PortTypeInvalid region portName ctipe)
99 Result.throw (Error.PortTypeInvalid region portName ctipe)
@@ -141,8 +139,9 @@ checkPayload tipe =
141 Can.TType home name args ->
139 Can.TType home name args ->
142 case args of
140 case args of
143 []
141 []
144− | isPrim home name -> Right ()
145 | isJson home name -> Right ()
142 | isJson home name -> Right ()
143+ | isString home name -> Right ()
144+ | isIntFloatBool home name -> Right ()
146
145
147 [arg]
146 [arg]
148 | isList home name -> checkPayload arg
147 | isList home name -> checkPayload arg
@@ -178,31 +177,43 @@ checkPayload tipe =
178 F.traverse_ checkPayload fields
177 F.traverse_ checkPayload fields
179
178
180
179
181−isPrim :: ModuleName.Canonical -> N.Name -> Bool
180+isIntFloatBool :: ModuleName.Canonical -> N.Name -> Bool
182−isPrim home name =
181+isIntFloatBool home name =
183− home == ModuleName.basics && Set.member name primitives
182+ home == ModuleName.basics
183+ &&
184+ (name == N.int || name == N.float || name == N.bool)
184
185
185
186
186−primitives :: Set.Set Text
187+isString :: ModuleName.Canonical -> N.Name -> Bool
187−primitives =
188+isString home name =
188− Set.fromList [ N.int, N.float, N.string, N.bool ]
189+ home == ModuleName.string
190+ &&
191+ name == N.string
189
192
190
193
191isJson :: ModuleName.Canonical -> N.Name -> Bool
194isJson :: ModuleName.Canonical -> N.Name -> Bool
192isJson home name =
195isJson home name =
193− home == ModuleName.jsonEncode && name == N.value
196+ home == ModuleName.jsonEncode
197+ &&
198+ name == N.value
194
199
195
200
196isList :: ModuleName.Canonical -> N.Name -> Bool
201isList :: ModuleName.Canonical -> N.Name -> Bool
197isList home name =
202isList home name =
198− home == ModuleName.list && name == N.list
203+ home == ModuleName.list
204+ &&
205+ name == N.list
199
206
200
207
201isMaybe :: ModuleName.Canonical -> N.Name -> Bool
208isMaybe :: ModuleName.Canonical -> N.Name -> Bool
202isMaybe home name =
209isMaybe home name =
203− home == ModuleName.maybe && name == N.maybe
210+ home == ModuleName.maybe
211+ &&
212+ name == N.maybe
204
213
205
214
206isArray :: ModuleName.Canonical -> N.Name -> Bool
215isArray :: ModuleName.Canonical -> N.Name -> Bool
207isArray home name =
216isArray home name =
208− home == ModuleName.array && name == N.array
217+ home == ModuleName.array
218+ &&
219+ name == N.array