aa7129a · elk · git.iko.soy

git.iko.soy/elk

on master help sign in

Add Decode.mapError to help define some decoders

aa7129aEvan Czaplicki9 years ago

src/Elm/Compiler/Module.hs−1

compare with master

unifiedsplit

@@ -14,7 +14,6 @@ module Elm.Compiler.Module

14 , dehyphenate

15 , encode

16 , decoder

17− , Error(..)

19 -- canonical names

18 -- canonical names

20 , ModuleName.Canonical(..)

19 , ModuleName.Canonical(..)

src/Elm/Docs.hs+15−4

@@ -107,10 +107,16 @@ encode (Module name comment unions aliases values binops) =

107 ]

108

109

110+data Error

111+ = BadAssociativity

112+ | BadName

113+ | BadType

114+

115+

110decoder :: D.Decoder Error Module

116decoder :: D.Decoder Error Module

111decoder =

117decoder =

112 Module

118 Module

113− <$> D.field "name" Module.decoder

119+ <$> D.field "name" nameDecoder

114 <*> D.field "comment" D.text

120 <*> D.field "comment" D.text

115 <*> D.field "unions" (dictDecoder union)

121 <*> D.field "unions" (dictDecoder union)

116 <*> D.field "aliases" (dictDecoder alias)

122 <*> D.field "aliases" (dictDecoder alias)

@@ -130,9 +136,14 @@ named entryDecoder =

130 <*> entryDecoder

136 <*> entryDecoder

131

137

132

138

133−data Error

139+nameDecoder :: D.Decoder Error N.Name

134− = BadAssociativity

140+nameDecoder =

135− | BadType

141+ D.mapError (const BadName) Module.decoder

142+

143+

144+typeDecoder :: D.Decoder Error Type.Type

145+typeDecoder =

146+ D.mapError (const BadType) Type.decoder

136

147

137

148

138

149

src/Json/Decode.hs+2−2

@@ -8,7 +8,7 @@ module Json.Decode

8 , Json.list, Json.dict, Json.maybe

9 , Json.field, Json.at

10 , Json.index

11− , Json.map, Json.map2

11+ , Json.map, Json.map2, Json.mapError

12 , Json.succeed, Json.fail

13 , Json.andThen, Json.oneOf

14 )

@@ -51,7 +51,7 @@ parse (Json.Decoder run) bytestring =

51 BadJson err

53 Right value ->

54− case run id value of

54+ case run value of

55 Left err ->

56 BadContent err

src/Json/Decode/Internals.hs+79−56

@@ -43,10 +43,12 @@ data Value

43-- DECODERS

46+-- TODO switch to CPS if possible

47+--

46newtype Decoder e a =

48newtype Decoder e a =

47− Decoder

49+ Decoder {

48− { _run :: (Error e -> Error e) -> Value -> Either (Error e) a

50+ _run :: Value -> Either (Error e) a

49− }

51+ }

52data Error e

54data Error e

@@ -67,6 +69,13 @@ data Type

67 | TArrayWith Int Int

69 | TArrayWith Int Int

72+mapLeft :: (e -> e') -> Either e a -> Either e' a

73+mapLeft func eith =

74+ case eith of

75+ Right a -> Right a

76+ Left e -> Left (func e)

77+

78+

71-- PRIMITIVES

80-- PRIMITIVES

@@ -78,18 +87,18 @@ string =

79text :: Decoder e Text

88text :: Decoder e Text

80text =

89text =

81− Decoder $ \mkError value ->

90+ Decoder $ \value ->

82 case value of

91 case value of

83 String txt ->

92 String txt ->

84 Right txt

93 Right txt

86 _ ->

95 _ ->

87− Left (mkError (Expecting value TString))

96+ Left (Expecting value TString)

90bool :: Decoder e Bool

99bool :: Decoder e Bool

91bool =

100bool =

92− Decoder $ \mkError value ->

101+ Decoder $ \value ->

93 case value of

102 case value of

94 TRUE ->

103 TRUE ->

95 Right True

104 Right True

@@ -98,18 +107,18 @@ bool =

98 Right False

107 Right False

108

100 _ ->

109 _ ->

101− Left (mkError (Expecting value TBool))

110+ Left (Expecting value TBool)

102

111

103

112

104int :: Decoder e Int

113int :: Decoder e Int

105int =

114int =

106− Decoder $ \mkError value ->

115+ Decoder $ \value ->

107 case value of

116 case value of

108 Integer integer ->

117 Integer integer ->

109 Right integer

118 Right integer

110

119

111 _ ->

120 _ ->

112− Left (mkError (Expecting value TInt))

121+ Left (Expecting value TInt)

113

122

114

123

115

124

@@ -118,67 +127,80 @@ int =

118

127

119list :: Decoder e a -> Decoder e [a]

128list :: Decoder e a -> Decoder e [a]

120list (Decoder run) =

129list (Decoder run) =

121− Decoder $ \mkError value ->

130+ Decoder $ \value ->

122 case value of

131 case value of

123 Array vector ->

132 Array vector ->

133+ let

134+ runHelp i v =

135+ mapLeft (Index i) (run v)

136+ in

124− Vector.toList <$>

137+ Vector.toList <$> Vector.imapM runHelp vector

125− Vector.imapM (\i v -> run (mkError . Index i) v) vector

126

138

127 _ ->

139 _ ->

128− Left (mkError (Expecting value TArray))

140+ Left (Expecting value TArray)

129

141

130

142

131dict :: Decoder e a -> Decoder e (HashMap.HashMap Text a)

143dict :: Decoder e a -> Decoder e (HashMap.HashMap Text a)

132dict (Decoder run) =

144dict (Decoder run) =

133− Decoder $ \mkError value ->

145+ Decoder $ \value ->

134 case value of

146 case value of

135 Object _ hashMap ->

147 Object _ hashMap ->

148+ let

149+ runHelp k v =

150+ mapLeft (Field k) (run v)

151+ in

136− HashMap.traverseWithKey (\k v -> run (mkError . Field k) v) hashMap

152+ HashMap.traverseWithKey runHelp hashMap

137

153

138 _ ->

154 _ ->

139− Left (mkError (Expecting value TObject))

155+ Left (Expecting value TObject)

140

156

141

157

142pairs :: Decoder e a -> Decoder e [(Text, a)]

158pairs :: Decoder e a -> Decoder e [(Text, a)]

143pairs (Decoder run) =

159pairs (Decoder run) =

144− Decoder $ \mkError value ->

160+ Decoder $ \value ->

145 case value of

161 case value of

146 Object kvs _ ->

162 Object kvs _ ->

147− traverse (\(k,v) -> (,) k <$> run (mkError . Field k) v) kvs

163+ let

164+ runHelp (k,v) =

165+ case run v of

166+ Right a -> Right (k, a)

167+ Left e -> Left (Field k e)

168+ in

169+ traverse runHelp kvs

148

170

149 _ ->

171 _ ->

150− Left (mkError (Expecting value TObject))

172+ Left (Expecting value TObject)

151

173

152

174

153maybe :: Decoder e a -> Decoder e (Maybe a)

175maybe :: Decoder e a -> Decoder e (Maybe a)

154maybe (Decoder run) =

176maybe (Decoder run) =

155− Decoder $ \mkError value ->

177+ Decoder $ \value ->

156− case run mkError value of

178+ case run value of

157− Left _ ->

158− Right Nothing

159−

160 Right a ->

179 Right a ->

161 Right (Just a)

180 Right (Just a)

162

181

182+ Left _ ->

183+ Right Nothing

184+

163

185

164

186

165-- OBJECT PRIMITIVES

187-- OBJECT PRIMITIVES

166

188

167

189

168field :: Text -> Decoder e a -> Decoder e a

190field :: Text -> Decoder e a -> Decoder e a

169−field name (Decoder run) =

191+field k (Decoder run) =

170− Decoder $ \mkError value ->

192+ Decoder $ \value ->

171 case value of

193 case value of

172 Object _ hashMap ->

194 Object _ hashMap ->

173− case HashMap.lookup name hashMap of

195+ case HashMap.lookup k hashMap of

174 Just v ->

196 Just v ->

175− run (mkError . Field name) v

197+ mapLeft (Field k) (run v)

176

198

177 Nothing ->

199 Nothing ->

178− Left $ mkError $ Expecting value (ObjectWith name)

200+ Left (Expecting value (TObjectWith k))

179

201

180 _ ->

202 _ ->

181− Left (mkError (Expecting value TObject))

203+ Left (Expecting value TObject)

182

204

183

205

184at :: [Text] -> Decoder e a -> Decoder e a

206at :: [Text] -> Decoder e a -> Decoder e a

@@ -192,18 +214,18 @@ at names decoder =

192

214

193index :: Int -> Decoder e a -> Decoder e a

215index :: Int -> Decoder e a -> Decoder e a

194index i (Decoder run) =

216index i (Decoder run) =

195− Decoder $ \mkError value ->

217+ Decoder $ \value ->

196 case value of

218 case value of

197 Array vector ->

219 Array vector ->

198 case vector !? i of

220 case vector !? i of

199 Just v ->

221 Just v ->

200− run (mkError . Index i) v

222+ mapLeft (Index i) (run v)

201

223

202 Nothing ->

224 Nothing ->

203− Left $ mkError $ Expecting value $ ArrayWith i (Vector.length vector)

225+ Left (Expecting value (TArrayWith i (Vector.length vector)))

204

226

205 _ ->

227 _ ->

206− Left (mkError (Expecting value TArray))

228+ Left (Expecting value TArray)

207

229

208

230

209

231

@@ -212,22 +234,23 @@ index i (Decoder run) =

212

234

213map :: (a -> value) -> Decoder e a -> Decoder e value

235map :: (a -> value) -> Decoder e a -> Decoder e value

214map func (Decoder run) =

236map func (Decoder run) =

215− Decoder $ \mkError value ->

237+ Decoder $ \value ->

216− func <$> run mkError value

238+ func <$> run value

239+

217

240

218

241

219map2 :: (a -> b -> value) -> Decoder e a -> Decoder e b -> Decoder e value

242map2 :: (a -> b -> value) -> Decoder e a -> Decoder e b -> Decoder e value

220map2 func (Decoder runA) (Decoder runB) =

243map2 func (Decoder runA) (Decoder runB) =

221− Decoder $ \mkError value ->

244+ Decoder $ \value ->

222 func

245 func

223− <$> runA mkError value

246+ <$> runA value

224− <*> runB mkError value

247+ <*> runB value

225

248

226

249

227mapError :: (e -> e') -> Decoder e a -> Decoder e' a

250mapError :: (e -> e') -> Decoder e a -> Decoder e' a

228mapError func (Decoder run) =

251mapError func (Decoder run) =

229− Decoder $ \mkError value ->

252+ Decoder $ \value ->

230− run (mapErrorHelp func . mkError) value

253+ mapLeft (mapErrorHelp func) (run value)

231

254

232

255

233mapErrorHelp :: (e -> e') -> Error e -> Error e'

256mapErrorHelp :: (e -> e') -> Error e -> Error e'

@@ -235,16 +258,16 @@ mapErrorHelp func err =

235 case err of

258 case err of

236 Field f subErr -> Field f (mapErrorHelp func subErr)

259 Field f subErr -> Field f (mapErrorHelp func subErr)

237 Index i subErr -> Index i (mapErrorHelp func subErr)

260 Index i subErr -> Index i (mapErrorHelp func subErr)

238− OneOf errors -> OneOf (map (mapErrorHelp func) errors)

261+ OneOf errors -> OneOf (fmap (mapErrorHelp func) errors)

239 Failure v e -> Failure v (func e)

262 Failure v e -> Failure v (func e)

240 Expecting v e -> Expecting v e

263 Expecting v e -> Expecting v e

241

264

242

265

243apply :: Decoder e (a -> b) -> Decoder e a -> Decoder e b

266apply :: Decoder e (a -> b) -> Decoder e a -> Decoder e b

244apply (Decoder runFunc) (Decoder runArg) =

267apply (Decoder runFunc) (Decoder runArg) =

245− Decoder $ \mkError value ->

268+ Decoder $ \value ->

246− do func <- runFunc mkError value

269+ do func <- runFunc value

247− arg <- runArg mkError value

270+ arg <- runArg value

248 return (func arg)

271 return (func arg)

249

272

250

273

@@ -275,21 +298,21 @@ instance Monad (Decoder e) where

275

298

276succeed :: a -> Decoder e a

299succeed :: a -> Decoder e a

277succeed a =

300succeed a =

278− Decoder $ \_ _ -> Right a

301+ Decoder $ \_ -> Right a

279

302

280

303

281fail :: e -> Decoder e a

304fail :: e -> Decoder e a

282fail err =

305fail err =

283− Decoder $ \mkError value ->

306+ Decoder $ \value ->

284− Left (mkError (Failure value err))

307+ Left (Failure value err)

285

308

286

309

287andThen :: (a -> Decoder e b) -> Decoder e a -> Decoder e b

310andThen :: (a -> Decoder e b) -> Decoder e a -> Decoder e b

288andThen callback (Decoder runA) =

311andThen callback (Decoder runA) =

289− Decoder $ \mkError value ->

312+ Decoder $ \value ->

290− do a <- runA mkError value

313+ do a <- runA value

291 let (Decoder runB) = callback a

314 let (Decoder runB) = callback a

292− runB mkError value

315+ runB value

293

316

294

317

295

318

@@ -301,16 +324,16 @@ oneOf decoders =

301 Decoder (oneOfHelp decoders [])

324 Decoder (oneOfHelp decoders [])

302

325

303

326

304−oneOfHelp :: [Decoder e a] -> [Error e] -> (Error e -> Error e) -> Value -> Either (Error e) a

327+oneOfHelp :: [Decoder e a] -> [Error e] -> Value -> Either (Error e) a

305−oneOfHelp decoders errors mkError value =

328+oneOfHelp decoders errors value =

306 case decoders of

329 case decoders of

307 [] ->

330 [] ->

308− Left (mkError (OneOf (reverse errors)))

331+ Left (OneOf (reverse errors))

309

332

310 Decoder run : otherDecoders ->

333 Decoder run : otherDecoders ->

311− case run mkError value of

334+ case run value of

312 Right a ->

335 Right a ->

313 Right a

336 Right a

314

337

315 Left err ->

338 Left err ->

316− oneOfHelp otherDecoders (err:errors) mkError value

339+ oneOfHelp otherDecoders (err:errors) value