-- |Record combinators built on top of the record core that "Data.Record" provides.moduleData.Record.Combinators(-- * CatenationCat,cat,-- * Applicative functor operationsrepeat,(<<*>>),map,zipWith,-- * Modificationmodify,-- * Conversion-- FIXME: maybe don’t use the term “conversion” because of “record conversion”toList)where-- PreludeimportPreludehiding(repeat,map,zipWith)importqualifiedPrelude-- only for documentation-- DataimportData.KindasKindimportData.TypeFunasTypeFunimportData.RecordasRecord-- ControlimportControl.ApplicativeasApplicativehiding(Const)-- only for documentation-- * Catenation-- |Catenation of two record schemes.typefamilyCat(rec1::*->*)(rec2::*->*)::*->*typeinstanceCatrec1X=rec1typeinstanceCatrec1(rec2:&name2:::sort2)=Catrec1rec2:&name2:::sort2-- |Catenation of two records.cat::(TypeFunstyle,Record(Domainstyle)rec1,Record(Domainstyle)rec2)=>rec1style->rec2style->Catrec1rec2stylecat=letCatThingcat=foldcatNilAltcatExpanderincatnewtypeCatThingstylerec1rec2=CatThing(rec1style->rec2style->Catrec1rec2style)catNilAlt::(TypeFunstyle,Record(Domainstyle)rec1)=>CatThingstylerec1XcatNilAlt=CatThingnilCatwherenilCatrec1X=rec1catSnocAlt::(TypeFunstyle,Record(Domainstyle)rec1,Record(Domainstyle)rec2,Namename,Inhabitant(Domainstyle)sort)=>CatThingstylerec1rec2->CatThingstylerec1(rec2:&name:::sort)catSnocAlt(CatThingcat)=CatThingsnocCatwheresnocCatrec1(rec2:&field2)=catrec1rec2:&field2catExpander::(TypeFunstyle,Record(Domainstyle)rec1,Record(Domainstyle)rec2,Namename)=>All(Domainstyle)(Expander(CatThingstylerec1)rec2name)catExpander=closed(ExpandercatSnocAlt)-- * Record schemes as a kind of applicative functor{-|
Generates a record whose fields all contain the same value. In contrast to the
'Prelude.repeat' function from the Prelude, this function generates a finite data structure.
Thereby, the size of the generated record is determined by its type. @repeat@ is almost a
proper implementation of 'pure' from the 'Applicative' class. The only problem is that the
argument of @repeat@ uses the 'Universal' type.
-}repeat::(TypeFunstyle,Record(Domainstyle)rec)=>Universalstyle->recstylerepeat=letRepeatThingrepeat=foldrepeatNilAltrepeatExpanderinrepeatnewtypeRepeatThingstylerec=RepeatThing(Universalstyle->recstyle)repeatNilAlt::(TypeFunstyle)=>RepeatThingstyleXrepeatNilAlt=RepeatThingnilRepeatwherenilRepeat_=XrepeatSnocAlt::forallstylerecnamesort.(TypeFunstyle,Record(Domainstyle)rec,Namename,Inhabitant(Domainstyle)sort)=>RepeatThingstylerec->RepeatThingstyle(rec:&name:::sort)repeatSnocAlt(RepeatThingrepeat)=RepeatThingsnocRepeatwheresnocRepeat::Universalstyle->(rec:&name:::sort)stylesnocRepeatwrappedVal=repeatwrappedVal:&name:=unwrapApp(wrappedVal::WrappedAppstylesort)repeatExpander::(TypeFunstyle,Record(Domainstyle)rec,Namename)=>All(Domainstyle)(Expander(RepeatThingstyle)recname)repeatExpander=closed(ExpanderrepeatSnocAlt)zipWithApp::(TypeFunstyle,TypeFunstyle',Domainstyle~Domainstyle',Record(Domain(style->style'))rec)=>rec(style->style')->recstyle->recstyle'zipWithApp=letZipWithAppThingzipWithApp=foldzipWithAppNilAltzipWithAppExpanderinzipWithAppnewtypeZipWithAppThingstylestyle'rec=ZipWithAppThing(rec(style->style')->recstyle->recstyle')zipWithAppNilAlt::(TypeFunstyle,TypeFunstyle',Domainstyle~Domainstyle')=>ZipWithAppThingstylestyle'XzipWithAppNilAlt=ZipWithAppThingnilZipWithAppwherenilZipWithAppXX=XzipWithAppSnocAlt::(TypeFunstyle,TypeFunstyle',Domainstyle~Domainstyle',Record(Domain(style->style'))rec,Namename,Inhabitant(Domainstyle)sort)=>ZipWithAppThingstylestyle'rec->ZipWithAppThingstylestyle'(rec:&name:::sort)zipWithAppSnocAlt(ZipWithAppThingzipWithApp)=ZipWithAppThingsnocZipWithAppwheresnocZipWithApp(funRec:&name:=fun)(argRec:&_:=arg)=zipWithAppfunRecargRec:&name:=funargzipWithAppExpander::(TypeFunstyle,TypeFunstyle',Domainstyle~Domainstyle',Record(Domain(style->style'))rec,Namename)=>All(Domainstyle)(Expander(ZipWithAppThingstylestyle')recname)zipWithAppExpander=closed(ExpanderzipWithAppSnocAlt)infixl4<<*>>{-|
Merges a record of functions and a record of arguments by applying the functions to the
corresponding arguments. The @(\<\<*\>\>)@&#xA0;function would be a proper implementation
of&#xA0;@(\<*\>)@ from the 'Applicative' class.
-}(<<*>>)::(TypeFunstyle,TypeFunstyle',Domainstyle~Domainstyle',Record(Domain(style->style'))rec)=>rec(style->style')->recstyle->recstyle'(<<*>>)=zipWithApp-- ** Derived combinators-- |Transforms a record by applying a function to all its field values.map::(TypeFunstyle,TypeFunstyle',Domainstyle~Domainstyle',Record(Domain(style->style'))rec)=>Universal(style->style')->recstyle->recstyle'mapfunargRec=repeatfun<<*>>argRec-- |Merges two records by applying a function to each pair of corresponding field values.zipWith::(TypeFunstyle1,TypeFunstyle2,TypeFunstyle',Domainstyle1~Domainstyle2,Domainstyle2~Domainstyle',Record(Domain(style1->style2->style'))rec)=>Universal(style1->style2->style')->recstyle1->recstyle2->recstyle'zipWithfunargRec1argRec2=repeatfun<<*>>argRec1<<*>>argRec2-- * Modification{-|
Modifies a record by changing some of its field values. The first argument of @modify@ is
called the modification record, and the second argument is called the data record. The
result is formed by applying each field value of the modification record to the
corresponding field value of the data record and replacing the latter by the result of the
application. Data record fields that have no corresponding field in the modification record
are left unchanged.
-}modify::(TypeFunstyle,Record(Domainstyle)rec,Record(Domainstyle)modRec,ConvertiblerecmodRec)=>modRec(style->style)->recstyle->recstylemodifymodRec=foldr(.)id$toList(convertupdateFuns<<*>>modRec)typeUpdateFunStylerecstyle=(style->style)->Const(Domainstyle)(recstyle->recstyle)updateFuns::(TypeFunstyle,Record(Domainstyle)rec)=>rec(UpdateFunStylerecstyle)updateFuns=letUpdateFunsThingupdateFuns=foldupdateFunsNilAltupdateFunsExpanderinupdateFunsnewtypeUpdateFunsThingstylerec=UpdateFunsThing(rec(UpdateFunStylerecstyle))updateFunsNilAlt::(TypeFunstyle)=>UpdateFunsThingstyleXupdateFunsNilAlt=UpdateFunsThingnilUpdateFunswherenilUpdateFuns=XupdateFunsSnocAlt::(TypeFunstyle,Record(Domainstyle)rec,Namename,Inhabitant(Domainstyle)sort)=>UpdateFunsThingstylerec->UpdateFunsThingstyle(rec:&name:::sort)updateFunsSnocAlt(UpdateFunsThingupdateFuns)=UpdateFunsThingsnocUpdateFunswheresnocUpdateFuns=map(WrapApp(onInit.))updateFuns:&name:=updateFunupdateFunmod(rec:&name:=val)=rec:&name:=modvalupdateFunsExpander::(TypeFunstyle,Record(Domainstyle)rec,Namename)=>All(Domainstyle)(Expander(UpdateFunsThingstyle)recname)updateFunsExpander=closed(ExpanderupdateFunsSnocAlt)onInit::(recstyle->recstyle)->((rec:&name:::sort)style->(rec:&name:::sort)style)onInitfun(rec:&field)=funrec:&field-- * Conversion-- |Converts a record whose style is a constant function into the list of its field values.toList::(Kindkind,Recordkindrec)=>rec(Constkindval)->[val]toList=reverse.toRevListtoRevList::(Kindkind,Recordkindrec)=>rec(Constkindval)->[val]toRevList=letToRevListThingtoRevList=foldtoRevListNilAlttoRevListExpanderintoRevListnewtypeToRevListThingkindvalrec=ToRevListThing(rec(Constkindval)->[val])toRevListNilAlt::(Kindkind)=>ToRevListThingkindvalXtoRevListNilAlt=ToRevListThingnilToRevListwherenilToRevListX=[]toRevListSnocAlt::(Kindkind,Recordkindrec,Namename,Inhabitantkindsort)=>ToRevListThingkindvalrec->ToRevListThingkindval(rec:&name:::sort)toRevListSnocAlt(ToRevListThingtoRevList)=ToRevListThingsnocToRevListwheresnocToRevList(rec:&_:=val)=val:toRevListrectoRevListExpander::(Kindkind,Recordkindrec,Namename)=>Allkind(Expander(ToRevListThingkindval)recname)toRevListExpander=closed(ExpandertoRevListSnocAlt)