{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies #-}{-# LANGUAGE FlexibleContexts, FlexibleInstances, TypeSynonymInstances #-}{-# LANGUAGE DeriveFunctor, DeriveFoldable, DeriveTraversable #-}---------------------------------------------------------------------------------- See end of this file for licence information.---------------------------------------------------------------------------------- |-- Module : LookupMap-- Copyright : (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 Douglas Burke-- License : GPL V2---- Maintainer : Douglas Burke-- Stability : experimental-- Portability : A lot of LANGUAGE extensions...---- This module defines a lookup table format and associated functions-- used by the graph matching code.------------------------------------------------------------------------------------------------------------------------------------------------ Generic list-of-pairs lookup functions------------------------------------------------------------moduleSwish.Utils.LookupMap(LookupEntryClass(..),LookupMap(..),emptyLookupMap,makeLookupMap,listLookupMap,reverseLookupMap,keyOrder,mapFind,mapFindMaybe,mapContains,mapReplace,mapReplaceOrAdd,mapReplaceAll,mapReplaceMap,mapAdd,mapAddIfNew,mapDelete,mapDeleteAll,mapApplyToAll,mapTranslate,mapEq,mapKeys,mapVals,mapSelect,mapMerge,mapSortByKey,mapSortByVal,mapTranslateKeys,mapTranslateVals,mapTranslateEntries,mapTranslateEntriesM)whereimportqualifiedData.FoldableasFimportqualifiedData.TraversableasTimportqualifiedData.ListasLimportData.Ord(comparing)importSwish.Utils.ListHelpers(equiv)-------------------------------------------------------------- Class for lookup map entries-------------------------------------------------------------- |@LookupEntryClass@ defines essential functions of any datatype-- that can be used to make a 'LookupMap'.---- Minimal definition: @newEntry@ and @keyVal@--class(Eqk,Showk)=>LookupEntryClassakv|a->k,a->vwherenewEntry::(k,v)->akeyVal::a->(k,v)entryKey::a->kentryKeye=kwhere(k,_)=keyValeentryVal::a->ventryVale=vwhere(_,v)=keyValeentryEq::(Eqv)=>a->a->BoolentryEqe1e2=keyVale1==keyVale2entryShow::(Showv)=>a->StringentryShowe=showk++":"++showvwhere(k,v)=keyValekmap::(LookupEntryClassa2k2v)=>(k->k2)->a->a2kmapfe=newEntry(f$entryKeye,entryVale)vmap::(LookupEntryClassa2kv2)=>(v->v2)->a->a2vmapfe=newEntry(entryKeye,f$entryVale)-- |Predefine a pair of appropriate values as a valid lookup table entry-- (i.e. an instance of LookupEntryClass).--instance(Eqk,Showk)=>LookupEntryClass(k,v)kvwherenewEntry=idkeyVal=id-- |Define a lookup map based on a list of values.---- Note: the class constraint that a is an instance of 'LookupEntryClass'-- is not defined here, for good reasons (which I forget right now, but-- something to do with the method dictionary being superfluous on-- an algebraic data type).--dataLookupMapa=LookupMap[a]deriving(Functor,F.Foldable,T.Traversable)gLM::LookupMapa->[a]gLM(LookupMapes)=es-- |Define equality of 'LookupMap' values based on equality of entries.---- (This is possibly a poor definition, as it is dependent on ordering-- of list members. But it passes all current test cases, and is used-- only for testing.)---- See also 'mapEq'-- (why not just use that here? I don't know: it's probably historic.)--instance(Eqa)=>Eq(LookupMapa)whereLookupMapes1==LookupMapes2=es1==es2-- |Define Show instance for LookupMap based on Showing the-- list of entries.--instance(Showa)=>Show(LookupMapa)whereshow(LookupMapes)="LookupMap "++showes{-
TODO: should the LookupEntryClass constraint be removed from
emptyLookupMap and makeLookupMap?
I guess not since LookupMap is exported, so users can use
that if they do not need the constraint.
-}-- |Empty lookup map of arbitrary (i.e. polymorphic) type.--emptyLookupMap::(LookupEntryClassakv)=>LookupMapaemptyLookupMap=LookupMap[]-- |Function to create a `LookupMap` from a list of entries.---- Currently, this is trivial but future versions could be-- more substantial.--makeLookupMap::(LookupEntryClassakv)=>[a]->LookupMapamakeLookupMap=LookupMap-- |Return list of lookup map entries.---- Currently, this is trivial but future versions could be-- more substantial.--listLookupMap::(LookupEntryClassakv)=>LookupMapa->[a]listLookupMap=gLM-- |Given a lookup map entry, return a new entry that can be used-- in the reverse direction of lookup. This is used to construct-- a reverse LookupMap.--reverseEntry::(LookupEntryClassa1kv,LookupEntryClassa2vk)=>a1->a2reverseEntrye=newEntry(v,k)where(k,v)=keyVale-- |Given a lookup map, return a new map that can be used-- in the opposite direction of lookup.--reverseLookupMap::(LookupEntryClassa1bc,LookupEntryClassa2cb)=>LookupMapa1->LookupMapa2reverseLookupMap=fmapreverseEntry-- |Given a pair of lookup entry values, return the ordering of their-- key values.--keyOrder::(LookupEntryClassakv,Ordk)=>a->a->OrderingkeyOrdere1e2=comparek1k2where(k1,_)=keyVale1(k2,_)=keyVale2-- Local helper function to build a new LookupMap from-- a new entry and an exiting map.--mapCons::a->LookupMapa->LookupMapamapConse(LookupMapes)=LookupMap(e:es)-- |Find key in lookup map and return corresponding value,-- otherwise return default supplied.--mapFind::(LookupEntryClassakv)=>v->k->LookupMapa->vmapFinddefkey(LookupMapes)=foldrmatchdefeswherematchentalt|key==entryKeyent=entryValent|otherwise=alt-- |Find key in lookup map and return Just the corresponding value,-- otherwise return Nothing.--mapFindMaybe::(LookupEntryClassakv)=>k->LookupMapa->MaybevmapFindMaybekey(LookupMapes)=foldrmatchNothingeswherematchentalt|key==entryKeyent=Just(entryValent)|otherwise=alt-- |Test to see if key is present in the supplied map--mapContains::(LookupEntryClassakv)=>LookupMapa->k->BoolmapContains(LookupMapes)key=anymatcheswherematchent=key==entryKeyent-- |Replace an existing occurrence of a key a with a new key-value pair.-- -- The resulting lookup map has the same form as the original in all-- other respects. Assumes exactly one occurrence of the supplied key.--mapReplace::(LookupEntryClassakv)=>LookupMapa->a->LookupMapamapReplace(LookupMap(e:es))newe|entryKeye==entryKeynewe=LookupMap(newe:es)|otherwise=mapAddmoreewheremore=mapReplace(LookupMapes)newemapReplace_newe=error("mapReplace: Key value not found in lookup table: "++Prelude.show(entryKeynewe))-- |Replace an existing occurrence of a key a with a new key-value pair,-- or add a new key-value pair if the supplied key is not already present.--mapReplaceOrAdd::(LookupEntryClassakv)=>a->LookupMapa->LookupMapamapReplaceOrAddnewe(LookupMap(e:es))|entryKeye==entryKeynewe=LookupMap(newe:es)|otherwise=mapConsemorewheremore=mapReplaceOrAddnewe(LookupMapes)mapReplaceOrAddnewe(LookupMap[])=LookupMap[newe]-- |Replace any occurrence of a key a with a new key-value pair.---- The resulting lookup map has the same form as the original in all-- other respects.--mapReplaceAll::(LookupEntryClassakv)=>LookupMapa->a->LookupMapamapReplaceAll(LookupMap(e:es))newe=mapConse'morewheremore=mapReplaceAll(LookupMapes)newee'=ifentryKeye==entryKeynewethenneweelseemapReplaceAll(LookupMap[])_=LookupMap[]-- |Replace any occurrence of a key in the first argument with a-- corresponding key-value pair from the second argument, if present.---- This could be implemented by multiple applications of 'mapReplaceAll',-- but is arranged differently so that only one new @LookupMap@ value is-- created.---- Note: keys in the new map that are not present in the old map-- are not included in the result map--mapReplaceMap::(LookupEntryClassakv)=>LookupMapa->LookupMapa->LookupMapamapReplaceMap(LookupMap(e:es))newmap=mapConse'morewheremore=mapReplaceMap(LookupMapes)newmape'=newEntry(k,mapFindvknewmap)(k,v)=keyValemapReplaceMap(LookupMap[])_=LookupMap[]-- |Add supplied key-value pair to the lookup map.---- This is effectively an optimized case of 'mapReplaceOrAdd' or 'mapAddIfNew',-- where the caller guarantees to avoid duplicate key values.--mapAdd::LookupMapa->a->LookupMapamapAddemape=mapConseemap-- |Add supplied key-value pair to the lookup map,-- only if the key value is not already present.--mapAddIfNew::(LookupEntryClassakv)=>LookupMapa->a->LookupMapamapAddIfNewemape=ifmapContainsemap(entryKeye)thenemapelsemapConseemap-- |Delete supplied key value from the lookup map.---- This function assumes exactly one occurrence.--mapDelete::(LookupEntryClassakv)=>LookupMapa->k->LookupMapamapDelete(LookupMap(e:es))k|k==entryKeye=LookupMapes|otherwise=mapConsemorewheremore=mapDelete(LookupMapes)kmapDelete_k=error("mapDelete: Key value not found in lookup table: "++Prelude.showk)-- |Delete any occurrence of a supplied key value from the lookup map.--mapDeleteAll::(LookupEntryClassakv)=>LookupMapa->k->LookupMapamapDeleteAll(LookupMap(e:es))k=ifentryKeye==kthenmoreelsemapConsemorewheremore=mapDeleteAll(LookupMapes)kmapDeleteAll(LookupMap[])_=LookupMap[]-- |Return a list of values obtained by applying a function to each key-- in the map. Creates an alternative set of values that can be-- retrieved using mapTranslate.--mapApplyToAll::(LookupEntryClassakv)=>LookupMapa->(k->w)->[w]mapApplyToAllesf=gLM$fmap(f.entryKey)es-- |Find a node in a lookup map list, and returns the-- corresponding value from a supplied list. The appropriate ordering-- of the list is not specified here, but an appropriately ordered list-- may be obtained by 'mapApplyToAll'.--mapTranslate::(LookupEntryClassakv)=>LookupMapa->[w]->k->w->wmapTranslate(LookupMap(e:es))(w:ws)kdef|k==entryKeye=w|otherwise=mapTranslate(LookupMapes)wskdefmapTranslate___def=def-- |Compare two lookup maps for equality.---- Two maps are equal if they have the same set of keys, and if-- each key maps to an equivalent value.--mapEq::(LookupEntryClassakv,Eqv)=>LookupMapa->LookupMapa->BoolmapEqes1es2=ks1`equiv`ks2&&and[mapFindMaybekes1==mapFindMaybekes2|k<-ks1]whereks1=mapKeyses1ks2=mapKeyses2-- |Return the list of keys in a supplied LookupMap--mapKeys::(LookupEntryClassakv)=>LookupMapa->[k]mapKeys(LookupMapes)=L.nub$map(fst.keyVal)es-- |Return list of distinct values in a supplied LookupMap--mapVals::(Eqv,LookupEntryClassakv)=>LookupMapa->[v]mapVals(LookupMapes)=L.nub$map(snd.keyVal)es-- |Select portion of a lookup map that corresponds to-- a supplied list of keys--mapSelect::(LookupEntryClassakv)=>LookupMapa->[k]->LookupMapamapSelect(LookupMapes)ks=LookupMap$filter(keyInks)eswherekeyInikse=fst(keyVale)`elem`iks-- |Merge two lookup maps, ensuring that if the same key appears-- in both maps it is associated with the same value.--mapMerge::(LookupEntryClassakv,Eqa,Showa,Ordk)=>LookupMapa->LookupMapa->LookupMapamapMerge(LookupMaps1)(LookupMaps2)=LookupMap$merge(L.sortBykeyOrders1)(L.sortBykeyOrders2)wheremergees1[]=es1merge[]es2=es2mergees1@(e1:et1)es2@(e2:et2)=casekeyOrdere1e2ofLT->e1:mergeet1es2GT->e2:mergees1et2EQ->ife1/=e2thenerror("mapMerge key conflict: "++showe1++" with "++showe2)elsee1:mergeet1et2-- |Creates a new map that is the same as the supplied map, except-- that its entries are sorted by key value.---- (What's this used for? It should be redundant.)--mapSortByKey::(LookupEntryClassakv,Ordk)=>LookupMapa->LookupMapamapSortByKey(LookupMapes)=LookupMap$L.sortBy(comparingentryKey)es-- |Creates a new map that is the same as the supplied map, except-- that its entries are sorted by key value.---- (What's this used for? It should be redundant.)--mapSortByVal::(LookupEntryClassakv,Ordv)=>LookupMapa->LookupMapamapSortByVal(LookupMapes)=LookupMap$L.sortBy(comparingentryVal)es-- |An fmap-like function that returns a new lookup map that is a-- copy of the supplied map with entry keys replaced according to-- a supplied function.--mapTranslateKeys::(LookupEntryClassa1k1v,LookupEntryClassa2k2v)=>(k1->k2)->LookupMapa1->LookupMapa2mapTranslateKeysf=fmap(kmapf)-- |An fmap-like function that returns a new lookup map that is a-- copy of the supplied map with entry values replaced according to-- a supplied function.--mapTranslateVals::(LookupEntryClassa1kv1,LookupEntryClassa2kv2)=>(v1->v2)->LookupMapa1->LookupMapa2mapTranslateValsf=fmap(vmapf)-- |A function that returns a new lookup map that is a copy of the-- supplied map with complete entries replaced according to-- a supplied function.---- Since 'LookupMap' now has a 'Functor' instance this is just 'fmap'mapTranslateEntries::(a1->a2)->LookupMapa1->LookupMapa2mapTranslateEntries=fmap-- |A monadic form of `mapTranslateEntries`.---- Since `LookupMap` now has a `Data.Traversable.Traversable` instance-- this is just `T.mapM`.--mapTranslateEntriesM::(Monadm)=>(a1->ma2)->LookupMapa1->m(LookupMapa2)mapTranslateEntriesM=T.mapM{-
mapTranslateEntriesM f (LookupMap es) =
do { m2 <- mapM f es
; return $ LookupMap m2
}
-}------------------------------------------------------------------------------------ Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 Douglas Burke-- All rights reserved.---- This file is part of Swish.---- Swish is free software; you can redistribute it and/or modify-- it under the terms of the GNU General Public License as published by-- the Free Software Foundation; either version 2 of the License, or-- (at your option) any later version.---- Swish is distributed in the hope that it will be useful,-- but WITHOUT ANY WARRANTY; without even the implied warranty of-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the-- GNU General Public License for more details.---- You should have received a copy of the GNU General Public License-- along with Swish; if not, write to:-- The Free Software Foundation, Inc.,-- 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA----------------------------------------------------------------------------------