b9fd688 · elk · git.iko.soy

git.iko.soy/elk

Export a few more things from Json.Decode for better error handling

commitb9fd688c22f8d99fd80a2b48a05071367b2f483c authorEvan Czaplicki <evancz@users.noreply.github.com> dateMon 22 Jan 2018, 17:09 (9 years ago) parent780b9a3

2 files changed+88−65

compare with master

unifiedsplit

src/Json/Decode.hs+13−10 src/Json/Decode/Internals.hs+75−55

src/Json/Decode.hs+13−10

@@ -2,10 +2,11 @@

22{-# LANGUAGE BangPatterns, MagicHash, OverloadedStrings, UnboxedTuples #-}

33module Json.Decode

44 ( parse

5+ , Failure(..)

56 -- re-export from Json.Decode.Internals

6− , Json.Decoder, Json.Error(..)

7+ , Json.Decoder, Json.Error(..), Json.Type(..)

78 , Json.string, Json.text, Json.bool, Json.int

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

9+ , Json.list, Json.dict, Json.pairs, Json.maybe

910 , Json.field, Json.at

1011 , Json.index

1112 , Json.map, Json.map2, Json.mapError

@@ -38,25 +39,24 @@ import qualified Reporting.Region as R

3839-- PARSE

3940

4041

41−data Result e a

42+data Failure e

4243 = BadJson E.Error

4344 | BadContent (Json.Error e)

44− | Success a

4545

4646

47−parse :: Json.Decoder e a -> B.ByteString -> Result e a

47+parse :: Json.Decoder e a -> B.ByteString -> Either (Failure e) a

4848parse (Json.Decoder run) bytestring =

4949 case P.run jsonFile bytestring of

5050 Left err ->

51− BadJson err

51+ Left (BadJson err)

5252

5353 Right value ->

5454 case run value of

5555 Left err ->

56− BadContent err

56+ Left (BadContent err)

5757

5858 Right answer ->

59− Success answer

59+ Right answer

6060

6161

6262

@@ -181,14 +181,17 @@ string =

181181 Parser $ \(State fp offset terminal indent row col ctx) cok cerr _ eerr ->

182182 if offset < terminal && I.unsafeIndex fp offset == 0x22 {- " -} then

183183

184− case stringHelp fp (offset + 1) terminal row (col + 1) of

184+ let

185+ !offset1 = offset + 1

186+ in

187+ case stringHelp fp offset1 terminal row (col + 1) of

185188 Err err ->

186189 cerr err

187190

188191 Ok newOffset newRow newCol ->

189192 let

190193 !newState = State fp newOffset terminal indent newRow newCol ctx

191− !content = Text.decodeUtf8 (B.PS fp offset (newOffset - offset))

194+ !content = Text.decodeUtf8 (B.PS fp offset1 (newOffset - offset1 - 1))

192195 in

193196 cok content newState noError

194197

src/Json/Decode/Internals.hs+75−55

@@ -4,6 +4,7 @@ module Json.Decode.Internals

44 ( Value(..)

55 , Decoder(..)

66 , Error(..)

7+ , Type(..)

78 , string, text, bool, int

89 , list, dict, pairs

910 , maybe

@@ -23,6 +24,7 @@ import qualified Data.HashMap.Strict as HashMap

2324import qualified Data.Text as Text

2425import qualified Data.Vector as Vector

2526import Data.Vector ((!?))

27+import qualified Json.Encode as E

2628

2729

2830

@@ -55,8 +57,8 @@ data Error e

5557 = Field Text (Error e)

5658 | Index Int (Error e)

5759 | OneOf [Error e]

58− | Failure Value e

59− | Expecting Value Type

60+ | Failure E.Value e

61+ | Expecting E.Value Type

6062

6163

6264data Type

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

6971 | TArrayWith Int Int

7072

7173

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−

7974

8075-- PRIMITIVES

8176

@@ -93,7 +88,7 @@ text =

9388 Right txt

9489

9590 _ ->

96− Left (Expecting value TString)

91+ Left (expecting value TString)

9792

9893

9994bool :: Decoder e Bool

@@ -107,7 +102,7 @@ bool =

107102 Right False

108103

109104 _ ->

110− Left (Expecting value TBool)

105+ Left (expecting value TBool)

111106

112107

113108int :: Decoder e Int

@@ -118,7 +113,7 @@ int =

118113 Right integer

119114

120115 _ ->

121− Left (Expecting value TInt)

116+ Left (expecting value TInt)

122117

123118

124119

@@ -137,7 +132,7 @@ list (Decoder run) =

137132 Vector.toList <$> Vector.imapM runHelp vector

138133

139134 _ ->

140− Left (Expecting value TArray)

135+ Left (expecting value TArray)

141136

142137

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

@@ -152,7 +147,7 @@ dict (Decoder run) =

152147 HashMap.traverseWithKey runHelp hashMap

153148

154149 _ ->

155− Left (Expecting value TObject)

150+ Left (expecting value TObject)

156151

157152

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

@@ -169,7 +164,7 @@ pairs (Decoder run) =

169164 traverse runHelp kvs

170165

171166 _ ->

172− Left (Expecting value TObject)

167+ Left (expecting value TObject)

173168

174169

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

@@ -197,10 +192,10 @@ field k (Decoder run) =

197192 mapLeft (Field k) (run v)

198193

199194 Nothing ->

200− Left (Expecting value (TObjectWith k))

195+ Left (expecting value (TObjectWith k))

201196

202197 _ ->

203− Left (Expecting value TObject)

198+ Left (expecting value TObject)

204199

205200

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

@@ -222,29 +217,14 @@ index i (Decoder run) =

222217 mapLeft (Index i) (run v)

223218

224219 Nothing ->

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

220+ Left (expecting value (TArrayWith i (Vector.length vector)))

226221

227222 _ ->

228− Left (Expecting value TArray)

229−

223+ Left (expecting value TArray)

230224

231225

232−-- MAPPING

233−

234226

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

236−map func (Decoder run) =

237− Decoder $ \value ->

238− func <$> run value

239−

240−

241−

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

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

244− Decoder $ \value ->

245− func

246− <$> runA value

247− <*> runB value

227+-- ERRORS

248228

249229

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

@@ -263,33 +243,54 @@ mapErrorHelp func err =

263243 Expecting v e -> Expecting v e

264244

265245

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

267−apply (Decoder runFunc) (Decoder runArg) =

268− Decoder $ \value ->

269− do func <- runFunc value

270− arg <- runArg value

271− return (func arg)

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

247+mapLeft func eith =

248+ case eith of

249+ Right a -> Right a

250+ Left e -> Left (func e)

272251

273252

274−instance Functor (Decoder e) where

275− fmap =

276− map

253+expecting :: Value -> Type -> Error e

254+expecting value tipe =

255+ Expecting (toEncodeValue value) tipe

277256

278257

279−instance Applicative (Decoder e) where

280− pure =

281− succeed

258+toEncodeValue :: Value -> E.Value

259+toEncodeValue value =

260+ case value of

261+ Array vector -> E.array (Vector.toList (Vector.map toEncodeValue vector))

262+ Object fields _ -> E.object (fmap (\(k,v) -> (Text.unpack k, toEncodeValue v)) fields)

263+ String txt -> E.text txt

264+ TRUE -> E.bool True

265+ FALSE -> E.bool False

266+ Integer n -> E.int n

267+ NULL -> E.null

282268

283− (<*>) =

284− apply

285269

286270

287−instance Monad (Decoder e) where

288− return =

289− succeed

271+-- MAPPING

290272

291− (>>=) decoder callback =

292− andThen callback decoder

273+

274+map :: (a -> value) -> Decoder e a -> Decoder e value

275+map func (Decoder run) =

276+ Decoder $ \value ->

277+ func <$> run value

278+

279+

280+map2 :: (a -> b -> value) -> Decoder e a -> Decoder e b -> Decoder e value

281+map2 func (Decoder runA) (Decoder runB) =

282+ Decoder $ \value ->

283+ func

284+ <$> runA value

285+ <*> runB value

286+

287+

288+apply :: Decoder e (a -> b) -> Decoder e a -> Decoder e b

289+apply (Decoder runFunc) (Decoder runArg) =

290+ Decoder $ \value ->

291+ do func <- runFunc value

292+ arg <- runArg value

293+ return (func arg)

293294

294295

295296

@@ -304,7 +305,7 @@ succeed a =

304305fail :: e -> Decoder e a

305306fail err =

306307 Decoder $ \value ->

307− Left (Failure value err)

308+ Left (Failure (toEncodeValue value) err)

308309

309310

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

@@ -337,3 +338,22 @@ oneOfHelp decoders errors value =

337338

338339 Left err ->

339340 oneOfHelp otherDecoders (err:errors) value

341+

342+

343+

344+-- INSTANCES

345+

346+

347+instance Functor (Decoder e) where

348+ fmap = map

349+

350+

351+instance Applicative (Decoder e) where

352+ pure = succeed

353+ (<*>) = apply

354+

355+

356+instance Monad (Decoder e) where

357+ return = succeed

358+ (>>=) decoder callback =

359+ andThen callback decoder