{-# LANGUAGE TypeSynonymInstances
, FlexibleInstances
, TypeFamilies
, GeneralizedNewtypeDeriving
, MultiParamTypeClasses
, OverlappingInstances
#-}------------------------------------------------------------------------------- |-- Module : Graphics.Rendering.Diagrams.Names-- Copyright : (c) 2011 diagrams-core team (see LICENSE)-- License : BSD-style (see LICENSE)-- Maintainer : diagrams-discuss@googlegroups.com---- This module defines a type of names which can be used for referring-- to locations within diagrams, and related types.-------------------------------------------------------------------------------moduleGraphics.Rendering.Diagrams.Names(-- * NamesAName(..),Name(..),IsName(..),Qualifiable(..),(||>)-- * Name maps,NameMap(..)-- ** Constructing name maps,fromNames,rememberAs-- ** Searching within name maps,lookupN)whereimportGraphics.Rendering.Diagrams.VimportGraphics.Rendering.Diagrams.MonoidsimportGraphics.Rendering.Diagrams.HasOriginimportGraphics.Rendering.Diagrams.PointsimportData.VectorSpaceimportData.List(intercalate,isSuffixOf)importqualifiedData.MapasMimportData.MonoidimportControl.Arrow((***))importControl.Monad(mplus)-------------------------------------------------------------- Names --------------------------------------------------------------------------------------------------------------- | An atomic name is either a number or a string. Numeric names are-- provided for convenience in naming lists of things, such as a row-- of ten squares, or the vertices of a path.dataAName=INameInteger|SNameStringderivingOrd-- | Note that equality on names does not distinguish between integers-- and their @String@ representations.instanceEqANamewhereINamei1==INamei2=i1==i2SNames1==SNames2=s1==s2INamei==SNames=showi==sSNames==INamei=s==showiinstanceShowANamewhereshow(INamei)=showishow(SNames)=s-- | A (qualified) name is a (possibly empty) sequence of atomic names.-- Atomic names can be either numbers or arbitrary strings. Numeric-- names are provided for convenience in naming lists of things,-- such as a row of ten squares, or the vertices of a path.newtypeName=Name[AName]deriving(Eq,Ord,Monoid)instanceShowNamewhereshow(Namens)=intercalate"."$mapshowns-- | Instaces of 'IsName' are things which can be converted to names.classIsNamenwheretoName::n->NameinstanceIsNameStringwheretoName=Name.(:[]).SNameinstanceIsNameIntwheretoName=Name.(:[]).IName.fromIntegralinstanceIsNameIntegerwheretoName=Name.(:[]).INameinstanceIsNameNamewheretoName=id-- | Instances of 'Qualifiable' are things which can be qualified by-- prefixing them with a name.classQualifiableawhere-- | Qualify with the given name.(|>)::IsNamen=>n->a->a-- | Names can be qualified by prefixing them with other names.instanceQualifiableNamewheren1|>n2=toNamen1`mappend`n2-- | Convenient operator for writing complete names in the form @a1 |>-- a2 |> a3 ||> a4@. In particular, @n1 ||> n2@ is equivalent to-- @n1 |> toName n2@.(||>)::(IsNamen,IsNamem)=>n->m->Namen1||>n2=n1|>toNamen2infixr2|>infixr2||>-------------------------------------------------------------- Name maps ----------------------------------------------------------------------------------------------------------- | A 'NameMap' is a map from names to points, possibly with-- multiple points associated with each name.newtypeNameMapv=NameMap(M.MapName[Pointv])-- Note, in some sense it would be nicer to use Sets of points instead-- of a list, but then we would have to put Ord constraints on v-- everywhere. =PtypeinstanceV(NameMapv)=v-- | 'NameMap's form a monoid with the empty map as the identity, and-- map union as the binary operation. No information is ever lost:-- if two maps have the same name in their domain, the resulting map-- will associate that name to the union of the two sets of points-- associated with that name.instanceMonoid(NameMapv)wheremempty=NameMapM.empty(NameMaps1)`mappend`(NameMaps2)=NameMap$M.unionWith(++)s1s2instanceVectorSpacev=>HasOrigin(NameMapv)wheremoveOriginTop(NameMapm)=NameMap$M.map(map(moveOriginTop))m-- | 'NameMap's are qualifiable: if @ns@ is a 'NameMap', then @n |>-- ns@ is the same 'NameMap' except with every name qualified by-- @n@.instanceQualifiable(NameMapv)wheren|>(NameMapnames)=NameMap$M.mapKeys(n|>)names-- | Construct a 'NameMap' from a list of (name, point) pairs.fromNames::IsNamen=>[(n,Pointv)]->NameMapvfromNames=NameMap.M.fromList.map(toName***(:[]))-- | Give a name to a point.rememberAs::Name->Pointv->NameMapv->NameMapvrememberAsnp(NameMapnames)=NameMap$M.insertWith(++)n[p]names-- | A name acts on a name map by qualifying every name in it.instanceActionName(NameMapv)whereact=(|>)-- | Names don't act on anything else.instanceActionNamea-- Searching in name maps.-- | Look for the given name in a name map, returning a list of points-- associated with that name. If no names match the given name-- exactly, return all the points associated with names of which the-- given name is a suffix.lookupN::IsNamen=>n->NameMapv->Maybe[Pointv]lookupNn(NameMapm)=M.lookupn'm`mplus`(flatten.filter((n'`nameSuffixOf`).fst).M.assocs$m)wheren'=toNamen(Namen1)`nameSuffixOf`(Namen2)=n1`isSuffixOf`n2flatten[]=Nothingflattenxs=Just.concatMapsnd$xs