{-# LANGUAGE MultiParamTypeClasses #-}{-# LANGUAGE FlexibleInstances #-}{-# LANGUAGE FlexibleContexts #-}{-# LANGUAGE DeriveDataTypeable #-}{-# LANGUAGE ExistentialQuantification #-}{-# LANGUAGE TemplateHaskell #-}------------------------------------------------------------- Module : Data.Object.Base-- Copyright : Michael Snoyman-- License : BSD3---- Maintainer : Michael Snoyman <michael@snoyman.com>-- Stability : Stable-- Portability : portable---- These objects show up in different places, eg JSON, Yaml.-- By providing a representation in a separate repository,-- other libraries can share a single representation of-- these structures.------------------------------------------------------------- | The core of this package is the 'Object' data type, which is used for-- handling scalars, sequences and mappings in a nested manner. This-- is the same structure used in JSON or Yaml data.---- The 'Object' data type is polymorphic in its keys and values. Submodules-- within this package provide more concrete datatypes, such as a 'String'-- 'Object' and a specialized scalar type.---- Besides the 'Object' data type, there are utility functions and type classes-- for converting objects around. Care has been taken to avoid any overloaded-- instances for these type classes.moduleData.Object.Base(-- * Object data typeObject(..)-- * Basic mapping of keys and values,mapKeys,mapValues,mapKeysValues,mapKeysValuesA,mapKeysValuesM-- * Convert entires objects,convertObject,convertObjectM-- * Extracting underlying values,ObjectExtractError(..),fromScalar,fromSequence,fromMapping-- * Common object conversions,sTO,sFO,lTO,lFO,mTO,mFO,olTO,olFO,omTO,omFO-- * Automatic deriving of instances,deriveSuccessConvs-- * Helper functions,lookupObject,lookupScalar,lookupSequence,lookupMapping-- * Re-export,moduleData.Convertible.Text)whereimportControl.ArrowimportControl.ApplicativeimportControl.Monad(ap,(<=<))importPreludehiding(mapM,sequence)importData.Foldablehiding(concatMap,concat)importData.TraversableimportData.MonoidimportData.GenericsimportqualifiedSafe.FailureasAimportControl.Exception(Exception)importData.AttemptimportData.Convertible.TextimportLanguage.Haskell.TH-- | Can represent nested values as scalars, sequences and mappings. A-- sequence is synonymous with a list, while a mapping is synonymous with a-- list of pairs.---- Note that instances of standard library type classes for this data type-- leave the key untouched while altering the value. For example, the 'Functor'-- instance defines 'fmap' to be synonymous with 'mapValues'.dataObjectkeyval=Mapping[(key,Objectkeyval)]|Sequence[Objectkeyval]|Scalarvalderiving(Show,Eq,Data,Typeable)instanceFunctor(Objectkey)wherefmap=mapValuesinstanceFoldable(Objectkey)wherefoldMapf(Scalarv)=fvfoldMapf(Sequencevs)=mconcat$map(foldMapf)vsfoldMapf(Mappingpairs)=mconcat$map(foldMapf.snd)pairsinstanceTraversable(Objectkey)wheretraversef(Scalarv)=Scalar<$>fvtraversef(Sequencevs)=Sequence<$>traverse(traversef)vstraversef(Mappingpairs)=Mapping<$>traverse(traverse'(traversef))pairs-- It would be nice if there were an "instance Traversable ((,) a)", but I-- won't make an orphan instance simply for convenience. Instead:traverse'::Applicativef=>(a->fb)->(x,a)->f(x,b)traverse'f(x,a)=(,)x<$>fajoinObj::Objectkey(Objectkeyscalar)->ObjectkeyscalarjoinObj(Scalarx)=xjoinObj(Sequencexs)=Sequence(mapjoinObjxs)joinObj(Mappingxs)=Mapping(map(secondjoinObj)xs)instanceMonad(Objectkey)wherereturn=Scalarx>>=f=joinObj.fmapf$xinstanceApplicative(Objectkey)wherepure=Scalar(<*>)=ap-- | Apply some conversion to the keys of an 'Object', leaving the values-- unchanged.mapKeys::(keyIn->keyOut)->ObjectkeyInval->ObjectkeyOutvalmapKeys=flipmapKeysValuesid-- | Apply some conversion to the values of an 'Object', leaving the keys-- unchanged. This is equivalent to 'fmap'.mapValues::(valIn->valOut)->ObjectkeyvalIn->ObjectkeyvalOutmapValues=mapKeysValuesid-- | Apply a conversion to both the keys and values of an 'Object'.mapKeysValues::(keyIn->keyOut)->(valIn->valOut)->ObjectkeyInvalIn->ObjectkeyOutvalOutmapKeysValues_fv(Scalarv)=Scalar$fvvmapKeysValuesfkfv(Sequenceos)=Sequence$map(mapKeysValuesfkfv)osmapKeysValuesfkfv(Mappingpairs)=Mapping$map(fk***mapKeysValuesfkfv)pairs-- | Apply an 'Applicative' conversion to both the keys and values of an-- 'Object'.mapKeysValuesA::Applicativef=>(keyIn->fkeyOut)->(valIn->fvalOut)->ObjectkeyInvalIn->f(ObjectkeyOutvalOut)mapKeysValuesA_fv(Scalarv)=Scalar<$>fvvmapKeysValuesAfkfv(Sequenceos)=Sequence<$>traverse(mapKeysValuesAfkfv)osmapKeysValuesAfkfv(Mappingpairs)=Mapping<$>traverse(uncurry(liftA2(,)).(fk***mapKeysValuesAfkfv))pairs-- | The same as 'mapKeysValuesA', but using a 'Monad' since some people are-- more comfortable with 'Monad's and not all 'Monad's are 'Applicative'.mapKeysValuesM::Monadm=>(keyIn->mkeyOut)->(valIn->mvalOut)->ObjectkeyInvalIn->m(ObjectkeyOutvalOut)mapKeysValuesMfkfv=letfk'=WrapMonad.fkfv'=WrapMonad.fvinunwrapMonad.mapKeysValuesAfk'fv'convertObject::(ConvertSuccesskk',ConvertSuccessvv')=>Objectkv->Objectk'v'convertObject=mapKeysValuescscsconvertObjectM::(ConvertAttemptkk',ConvertAttemptvv')=>Objectkv->Attempt(Objectk'v')convertObjectM=mapKeysValuesMcaca-- | An error value returned when an unexpected node is encountered, eg you-- were expecting a 'Scalar' and found a 'Mapping'.dataObjectExtractError=ExpectedScalar|ExpectedSequence|ExpectedMappingderiving(Typeable,Show)instanceExceptionObjectExtractError-- | Extra a scalar from the input, failing if the input is a sequence or-- mapping.fromScalar::MonadFailureObjectExtractErrorm=>Objectkv->mvfromScalar(Scalars)=returnsfromScalar_=failureExpectedScalar-- | Extra a sequence from the input, failing if the input is a scalar or-- mapping.fromSequence::MonadFailureObjectExtractErrorm=>Objectkv->m[Objectkv]fromSequence(Sequences)=returnsfromSequence_=failureExpectedSequence-- | Extra a mapping from the input, failing if the input is a scalar or-- sequence.fromMapping::MonadFailureObjectExtractErrorm=>Objectkv->m[(k,Objectkv)]fromMapping(Mappingm)=returnmfromMapping_=failureExpectedMappingsTO::ConvertSuccessvv'=>v->Objectkv'sTO=Scalar.cssFO::ConvertAttemptv'v=>Objectkv'->AttemptvsFO=ca<=<fromScalarlTO::ConvertSuccessvv'=>[v]->Objectkv'lTO=Sequence.map(Scalar.cs)lFO::ConvertAttemptv'v=>Objectkv'->Attempt[v]lFO=mapM(ca<=<fromScalar)<=<fromSequencemTO::(ConvertSuccesskk',ConvertSuccessvv')=>[(k,v)]->Objectk'v'mTO=Mapping.map(cs***Scalar.cs)mFO::(ConvertAttemptk'k,ConvertAttemptv'v)=>Objectk'v'->Attempt[(k,v)]mFO=mapM(runKleisli(Kleislica***KleislisFO))<=<fromMappingolTO::ConvertSuccessx(Objectkv)=>[x]->ObjectkvolTO=Sequence.mapcsolFO::ConvertAttempt(Objectkv)x=>Objectkv->Attempt[x]olFO=mapMca<=<fromSequenceomTO::(ConvertSuccessk'k,ConvertSuccessx(Objectkv))=>[(k',x)]->ObjectkvomTO=Mapping.map(cs***cs)omFO::(ConvertAttemptkk',ConvertAttempt(Objectkv)x)=>Objectkv->Attempt[(k',x)]omFO=mapM(runKleisli(Kleislica***Kleislica))<=<fromMappingderiveSuccessConvs::Name-- ^ dest key->Name-- ^ dest value->[Name]-- ^ source keys->[Name]-- ^ source values->Q[Dec]deriveSuccessConvsdkdvskssvs=dosto<-[|sTO|]sfo<-[|sFO|]lto<-[|lTO|]lfo<-[|lFO|]mto<-[|mTO|]mfo<-[|mFO|]olto<-[|olTO|]olfo<-[|olFO|]omto<-[|omTO|]omfo<-[|omFO|]co<-[|convertObject|]coa<-[|convertObjectM|]letsks'=mapConTskssvs'=mapConTsvspairs=dosk<-sks'sv<-svs'return(sk,sv)letvalOnly=concatMap(helper1stosfoltolfo)svs'both=concatMap(helper2mtomfooltoolfococoaomtoomfo)pairskeyOnly=concatMap(helper3omtoomfo)sks'return$valOnly++both++keyOnlywheredk'=ConTdkdv'=ConTdvobjecttkv=ConT(mkName"Object")`AppT`k`AppT`vto'src=ConT(mkName"ConvertSuccess")`AppT`src`AppT`objecttdk'dv'fo'dst=ConT(mkName"ConvertAttempt")`AppT`objecttdk'dv'`AppT`dstcs'=mkName"convertSuccess"ca'=mkName"convertAttempt"tosrcf=InstanceD[](to'src)[FunDcs'[Clause[](NormalBf)[]]]fodstf=InstanceD[](fo'dst)[FunDca'[Clause[](NormalBf)[]]]tofotyxy=[totyx,fotyy]listt=AppTListTpairtkv=TupleT2`AppT`k`AppT`vhelper1stosfoltolfosv=concat[tofosvstosfo,tofo(listtsv)ltolfo]helper2mtomfooltoolfococoaomtoomfo(sk,sv)=concat[tofo(listt$pairtsksv)mtomfo,tofo(listt$objecttsksv)oltoolfo,ifsk==dk'&&sv==dv'-- avoid overlapping with identitythen[]elsetofo(objecttsksv)cocoa,ifsk==dk'&&sv==dv'-- avoid overlapping with helper3then[]elsetofo(listt$pairtsk$objecttsksv)omtoomfo]helper3omtoomfosk=concat[tofo(listt$pairtsk$objecttdk'dv')omtoomfo]-- | An equivalent of 'lookup' to deal specifically with maps of 'Object's. In-- particular, it will:---- 1. Automatically convert the lookup key as necesary. For example- assuming-- you have the appropriate 'ConvertSuccess' instances, you could lookup an 'Int' in-- a map that has 'String' keys.---- 2. Return the result in an 'Attempt', not 'Maybe'. This is especially useful-- when creating 'FromObject' instances.---- 3. Show a more useful error message. Since this function requires the key to-- be 'Show'able, the fail message states what key was not found.---- 4. Calls 'fromObject' automatically, so you get out the value type that you-- want, not just an 'Object'.lookupObject::(ConvertSuccessk'k,ConvertAttempt(Objectkv)o,Typeablek,Typeablev,Showk,Eqk)=>k'->[(k,Objectkv)]->AttemptolookupObjectkey=ca<=<A.lookup(convertSuccesskey)lookupScalar::(MonadFailureObjectExtractErrorm,Failure(A.LookupFailurek)m,Eqk)=>k->[(k,Objectkv)]->mvlookupScalarkey=fromScalar<=<A.lookupkeylookupSequence::(MonadFailureObjectExtractErrorm,Failure(A.LookupFailurek)m,Eqk)=>k->[(k,Objectkv)]->m[Objectkv]lookupSequencekey=fromSequence<=<A.lookupkeylookupMapping::(MonadFailureObjectExtractErrorm,Failure(A.LookupFailurek)m,Eqk)=>k->[(k,Objectkv)]->m[(k,Objectkv)]lookupMappingkey=fromMapping<=<A.lookupkey