{-# LANGUAGE PatternGuards, Rank2Types, ScopedTypeVariables, CPP #-}-- |-- Module: Data.Aeson.Generic-- Copyright: (c) 2011, 2012, 2013 Bryan O'Sullivan-- (c) 2011 MailRank, Inc.-- (c) 2008, 2009 Lennart Augustsson-- License: BSD3-- Maintainer: Bryan O'Sullivan <bos@serpentine.com>-- Stability: DEPRECATED-- Portability: portable---- JSON handling using 'Data.Generics'.---- This is based on the 'Text.JSON.Generic' package originally written-- by Lennart Augustsson.moduleData.Aeson.Generic{-# DEPRECATED "This module will be /REMOVED/ in version 0.7.0.0. Please switch to GHC generics or Data.Aeson.TH instead. These alternatives are less buggy, faster, and more configurable." #-}(-- * Decoding and encodingdecode,decode',encode-- * Lower-level conversion functions,fromJSON,toJSON)whereimportControl.Applicative((<$>))importControl.Arrow(first)importControl.Monad.State.StrictimportData.Aeson.Functionshiding(decode)importData.Aeson.Typeshiding(FromJSON(..),ToJSON(..),fromJSON)importData.Attoparsec.Number(Number)importData.GenericsimportData.Hashable(Hashable)importData.Int(Int8,Int16,Int32,Int64)importData.IntSet(IntSet)importData.Maybe(fromJust)importData.Text(Text,pack,unpack)importData.Text.Encoding(encodeUtf8)importData.Time.Clock(UTCTime)importData.Word(Word,Word8,Word16,Word32,Word64)importData.Aeson.Parser.Internal(decodeWith,json,json')importqualifiedData.Aeson.EncodeasEimportqualifiedData.Aeson.FunctionsasFimportqualifiedData.Aeson.TypesasTimportqualifiedData.ByteStringasBimportqualifiedData.ByteString.LazyasLimportqualifiedData.HashMap.StrictasHimportqualifiedData.MapasMapimportqualifiedData.SetasSetimportqualifiedData.TextasDTimportqualifiedData.Text.LazyasLTimportqualifiedData.TraversableasTimportqualifiedData.VectorasV-- | Efficiently serialize a JSON value as a lazy 'L.ByteString'.encode::(Dataa)=>a->L.ByteStringencode=E.encode.toJSON{-# INLINE encode #-}-- | Efficiently deserialize a JSON value from a lazy 'L.ByteString'.-- If this fails due to incomplete or invalid input, 'Nothing' is-- returned.---- This function parses immediately, but defers conversion. See-- 'json' for details.decode::(Dataa)=>L.ByteString->Maybeadecode=decodeWithjsonfromJSON{-# INLINE decode #-}-- | Efficiently deserialize a JSON value from a lazy 'L.ByteString'.-- If this fails due to incomplete or invalid input, 'Nothing' is-- returned.---- This function parses and performs conversion immediately. See-- 'json'' for details.decode'::(Dataa)=>L.ByteString->Maybeadecode'=decodeWithjson'fromJSON{-# INLINE decode' #-}typeTa=a->ValuetoJSON::(Dataa)=>a->ValuetoJSON=toJSON_generic`ext1Q`maybeNulltoJSON`ext1Q`list`ext1Q`vector`ext1Q`set`ext2Q'`mapAny`ext2Q'`hashMapAny-- Use the standard encoding for all base types.`extQ`(T.toJSON::TInteger)`extQ`(T.toJSON::TInt)`extQ`(T.toJSON::TInt8)`extQ`(T.toJSON::TInt16)`extQ`(T.toJSON::TInt32)`extQ`(T.toJSON::TInt64)`extQ`(T.toJSON::TWord)`extQ`(T.toJSON::TWord8)`extQ`(T.toJSON::TWord16)`extQ`(T.toJSON::TWord32)`extQ`(T.toJSON::TWord64)`extQ`(T.toJSON::TDouble)`extQ`(T.toJSON::TNumber)`extQ`(T.toJSON::TFloat)`extQ`(T.toJSON::TRational)`extQ`(T.toJSON::TChar)`extQ`(T.toJSON::TText)`extQ`(T.toJSON::TLT.Text)`extQ`(T.toJSON::TString)`extQ`(T.toJSON::TB.ByteString)`extQ`(T.toJSON::TL.ByteString)`extQ`(T.toJSON::TT.Value)`extQ`(T.toJSON::TDotNetTime)`extQ`(T.toJSON::TUTCTime)`extQ`(T.toJSON::TIntSet)`extQ`(T.toJSON::TBool)`extQ`(T.toJSON::T())--`extQ` (T.toJSON :: T Ordering)wherelistxs=Array.V.fromList.maptoJSON$xsvectorv=Array.V.maptoJSON$vsets=Array.V.fromList.maptoJSON.Set.toList$smapAnym|tyrep==typeOfDT.empty=remapid|tyrep==typeOfLT.empty=remapLT.toStrict|tyrep==typeOf""=remappack|tyrep==typeOfB.empty=remapF.decode|tyrep==typeOfL.empty=remapstrict|otherwise=modError"toJSON"$"cannot convert map keyed by type "++showtyrepwheretyrep=typeOf.head.Map.keys$mremapf=Object.mapHashKeyVal(f.fromJust.cast)toJSON$mhashMapAnym|tyrep==typeOfDT.empty=remapid|tyrep==typeOfLT.empty=remapLT.toStrict|tyrep==typeOf""=remappack|tyrep==typeOfB.empty=remapF.decode|tyrep==typeOfL.empty=remapstrict|otherwise=modError"toJSON"$"cannot convert map keyed by type "++showtyrepwheretyrep=typeOf.head.H.keys$mremapf=Object.mapKeyVal(f.fromJust.cast)toJSON$mtoJSON_generic::(Dataa)=>a->ValuetoJSON_generic=genericwhere-- Generic encoding of an algebraic data type.generica=casedataTypeRep(dataTypeOfa)of-- No constructor, so it must be an error value. Code-- it anyway as Null.AlgRep[]->Null-- Elide a single constructor and just code the arguments.AlgRep[c]->encodeArgsc(gmapQtoJSONa)-- For multiple constructors, make an object with a-- field name that is the constructor (except lower-- case) and the data is the arguments encoded.AlgRep_->encodeConstr(toConstra)(gmapQtoJSONa)rep->err(dataTypeOfa)repwhereerrdtr=modError"toJSON"$"not AlgRep "++showr++"("++showdt++")"-- Encode nullary constructor as a string.-- Encode non-nullary constructors as an object with the constructor-- name as the single field and the arguments as the value.-- Use an array if the are no field names, but elide singleton arrays,-- and use an object if there are field names.encodeConstrc[]=String.constrString$cencodeConstrcas=object[(constrStringc,encodeArgscas)]constrString=pack.showConstrencodeArgsc=encodeArgs'(constrFieldsc)encodeArgs'[][j]=jencodeArgs'[]js=Array.V.fromList$jsencodeArgs'nsjs=object$zip(mappackns)jsfromJSON::(Dataa)=>Value->ResultafromJSON=parseparseJSONtypeFa=ParseraparseJSON::(Dataa)=>Value->ParseraparseJSONj=parseJSON_genericj`ext1R`maybeP`ext1R`list`ext1R`vector`ext2R'`mapAny`ext2R'`hashMapAny-- Use the standard encoding for all base types.`extR`(value::FInteger)`extR`(value::FInt)`extR`(value::FInt8)`extR`(value::FInt16)`extR`(value::FInt32)`extR`(value::FInt64)`extR`(value::FWord)`extR`(value::FWord8)`extR`(value::FWord16)`extR`(value::FWord32)`extR`(value::FWord64)`extR`(value::FDouble)`extR`(value::FNumber)`extR`(value::FFloat)`extR`(value::FRational)`extR`(value::FChar)`extR`(value::FText)`extR`(value::FLT.Text)`extR`(value::FString)`extR`(value::FB.ByteString)`extR`(value::FL.ByteString)`extR`(value::FT.Value)`extR`(value::FDotNetTime)`extR`(value::FUTCTime)`extR`(value::FIntSet)`extR`(value::FBool)`extR`(value::F())wherevalue::(T.FromJSONa)=>Parseravalue=T.parseJSONjmaybeP::(Dataa)=>Parser(Maybea)maybeP=ifj==NullthenreturnNothingelseJust<$>parseJSONjlist::(Dataa)=>Parser[a]list=V.toList<$>parseJSONjvector::(Dataa)=>Parser(V.Vectora)vector=casejofArrayjs->V.mapMparseJSONjs_->myFailmapAny::forallef.(Datae,Dataf)=>Parser(Map.Mapfe)mapAny|tyrep==typeOfDT.empty=processid|tyrep==typeOfLT.empty=processLT.fromStrict|tyrep==typeOf""=processDT.unpack|tyrep==typeOfB.empty=processencodeUtf8|tyrep==typeOfL.empty=processlazy|otherwise=myFailwhereprocessf=maybemyFailreturn.cast=<<parseWithfparseWith::(Ordc)=>(Text->c)->Parser(Map.Mapce)parseWithf=casejofObjectjs->Map.fromList.map(firstf).H.toList<$>T.mapMparseJSONjs_->myFailtyrep=typeOf(undefined::f)hashMapAny::forallef.(Datae,Dataf)=>Parser(H.HashMapfe)hashMapAny|tyrep==typeOfDT.empty=processid|tyrep==typeOfLT.empty=processLT.fromStrict|tyrep==typeOf""=processDT.unpack|tyrep==typeOfB.empty=processencodeUtf8|tyrep==typeOfL.empty=processlazy|otherwise=myFailwhereprocessf=maybemyFailreturn.cast=<<parseWithfparseWith::(Eqc,Hashablec)=>(Text->c)->Parser(H.HashMapce)parseWithf=casejofObjectjs->mapKeyf<$>T.mapMparseJSONjs_->myFailtyrep=typeOf(undefined::f)myFail=modFail"parseJSON"$"bad data: "++showjparseJSON_generic::(Dataa)=>Value->ParseraparseJSON_genericj=genericwheretyp=dataTypeOf$resTypegenericgeneric=casedataTypeReptypofAlgRep[]->casejofNull->return(modError"parseJSON""empty type")_->modFail"parseJSON""no-constr bad data"AlgRep[_]->decodeArgs(indexConstrtyp1)jAlgRep_->do(c,j')<-getConstrtypj;decodeArgscj'rep->modFail"parseJSON"$showrep++"("++showtyp++")"getConstrt(Objecto)|[(s,j')]<-fromJSObjecto=doc<-readConstr'tsreturn(c,j')getConstrt(Stringjs)=doc<-readConstr't(unpackjs)return(c,Null)-- handle nullary ctorgetConstr__=modFail"parseJSON""bad constructor encoding"readConstr'ts=maybe(modFail"parseJSON"$"unknown constructor: "++s++" "++showt)return$readConstrtsdecodeArgsc0=go(numConstrArgs(resTypegeneric)c0)c0(constrFieldsc0)wherego0c_Null=constructc[]go1c[]jd=constructc[jd]-- unary constructorgo_c[](Arrayjs)=constructc(V.toListjs)-- no field names-- FIXME? We could allow reading an array into a constructor-- with field names.go_cfs@(_:_)(Objecto)=selectFieldsofs>>=constructc-- field namesgo_c_jd=modFail"parseJSON"$"bad decodeArgs data "++show(c,jd)fromJSObject=map(firstunpack).H.toList-- Build the value by stepping through the list of subparts.constructc=evalStateT$fromConstrMfcwheref::(Dataa)=>StateT[Value]Parseraf=dojs<-getcasejsof[]->lift$modFail"construct""empty list"(j':js')->doputjs';lift$parseJSONj'-- Select the named fields from a JSON object.selectFieldsfjs=mapM$\f->maybe(modFail"parseJSON"$"field does not exist "++f)return$H.lookup(packf)fjs-- Count how many arguments a constructor has. The value x is-- used to determine what type the constructor returns.numConstrArgs::(Dataa)=>a->Constr->IntnumConstrArgsxc=execState(fromConstrMfc`asTypeOf`returnx)0wheref=domodify(+1);returnundefinedresType::MonadPlusm=>ma->aresType_=modError"parseJSON""resType"modFail::(Monadm)=>String->String->mamodFailfuncerr=fail$"Data.Aeson.Generic."++func++": "++errmodError::String->String->amodErrorfuncerr=error$"Data.Aeson.Generic."++func++": "++err-- Type extension for binary type constructors.-- | Flexible type extension#if MIN_VERSION_base(4,7,0)ext2'::(Dataa,Typeablet)#elseext2'::(Dataa,Typeable2t)#endif=>ca->(foralld1d2.(Datad1,Datad2)=>c(td1d2))->caext2'defext=maybedefid(dataCast2ext)-- | Type extension of queries for type constructors#if MIN_VERSION_base(4,7,0)ext2Q'::(Datad,Typeablet)#elseext2Q'::(Datad,Typeable2t)#endif=>(d->q)->(foralld1d2.(Datad1,Datad2)=>td1d2->q)->d->qext2Q'defext=unQ((Qdef)`ext2'`(Qext))-- | Type extension of readers for type constructors#if MIN_VERSION_base(4,7,0)ext2R'::(Monadm,Datad,Typeablet)#elseext2R'::(Monadm,Datad,Typeable2t)#endif=>md->(foralld1d2.(Datad1,Datad2)=>m(td1d2))->mdext2R'defext=unR((Rdef)`ext2'`(Rext))-- | The type constructor for queriesnewtypeQqx=Q{unQ::x->q}-- | The type constructor for readersnewtypeRmx=R{unR::mx}