{-# LANGUAGE QuasiQuotes, TemplateHaskell,MultiParamTypeClasses, FunctionalDependencies #-}moduleScion.PersistentBrowser.TypeswhereimportData.List(find,intersperse)importqualifiedData.MapasMimportqualifiedData.TextasTimportDistribution.Packagehiding(Package)importqualifiedDistribution.PackageasPimportLanguage.Haskell.Exts.Annotated.SyntaximportDatabase.Persist.THdataDbDeclType=DbData|DbNewType|DbClass|DbInstance|DbSignature|DbTypederiving(Show,Read,Eq)derivePersistField"DbDeclType"-- |Documentation for an item.-- Now it is simply a Text element.dataDoc=NoDoc|DocT.TextderivingShowdocFromString::String->DocdocFromStrings=Doc(T.packs)-- |A documented item.typeDocumenteda=aDoc-- |A package.dataPackagel=PackagelPackageIdentifier(M.MapString(DocumentedModule))derivingShowinstanceP.Package(Packagel)wherepackageId(Package_i_)=i-- |A Database saves a list of packages. typeDatabase=M.MapPackageIdentifier(DocumentedPackage)-- |Gets the name inside a Name constructor.getNameString::Namel->StringgetNameString(Ident_s)=sgetNameString(Symbol_s)="("++s++")"-- |Gets the qualified name as a string.getQNameString::QNamel->StringgetQNameString(Qual_(ModuleName_"")ename)=getNameStringenamegetQNameString(Qual_(ModuleName_mname)ename)=mname++"."++getNameStringenamegetQNameString(UnQual_ename)=getNameStringenamegetQNameString(Special_(UnitCon_))="()"getQNameString(Special_(ListCon_))="[]"getQNameString(Special_(FunCon_))="(->)"getQNameString(Special_(TupleCon_boxn))=caseboxofBoxed->"("++replicate(n-1)','++")"Unboxed->"(#"++replicate(n-1)','++"#)"getQNameString(Special_(Cons_))="(:)"getQNameString(Special_(UnboxedSingleCon_))="(# #)"-- -------------------------------- Datatypes for traversing docs.-- ------------------------------classAnnotatede=>NamedewheregetName::Showl=>(el)->Stringclass(Namedparent,Namedchild)=>DocItemparentchild|parent->childwheregetChildren::Showl=>(parentl)->[childl]getChild::Showl=>(parentl)->String->Maybe(childl)getChildpname=find(\d->(getNamed)==name)(getChildrenp)instanceNamedModulewheregetName(Module_(Just(ModuleHead_(ModuleName_name)__))___)=namegetNamev=error$"This should not be possible: "++showvinstanceDocItemModuleDeclwheregetChildren(Module____decls)=declsgetChildren_=[]instanceNamedDeclwheregetName(TypeDecl_(DHead_name_)_)=getNameStringnamegetName(GDataDecl___(DHead_name_)___)=getNameStringnamegetName(ClassDecl__(DHead_name_)__)=getNameStringnamegetName(InstDecl__(IHead_name_)_)=getQNameStringnamegetName(TypeSig_name_)=concat$intersperse","$mapgetNameStringnamegetNamev=error$"This should not be possible: "++showvinstanceDocItemDeclGadtDeclwheregetChildren(GDataDecl_____cons_)=consgetChildren_=[]instanceNamedGadtDeclwheregetName(GadtDecl_name_)=getNameStringname