module Data.GMap.InjectKeys
(
InjectKeys
,Injection
,inject
,outject
) where
import Prelude hiding (foldr,map,filter,lookup)
import Data.GMap
import Data.Typeable
import qualified Data.Foldable as F
import qualified Data.Monoid as M
import Data.Maybe hiding (mapMaybe)
import GHC.Base hiding (map)
import qualified Text.Read as R (Read(..),Lexeme(..),parens,prec,lexP,readListPrecDefault)
import qualified Data.List as L
data InjectKeys t k1 k2 map a = InjectKeys !(map a)
class Injection t k1 k2 | t -> k1, t -> k2 where
inject :: t -> k1 -> k2
outject :: t -> k2 -> k1
transformOf :: InjectKeys t k1 k2 map a -> t
transformOf = undefined
injectFor :: Injection t k1 k2 => InjectKeys t k1 k2 map a -> k1 -> k2
injectFor mp k1 = inject (transformOf mp) k1
outjectFor :: Injection t k1 k2 => InjectKeys t k1 k2 map a -> k2 -> k1
outjectFor mp k2 = outject (transformOf mp) k2
instance (Eq k1, Injection t k1 k2, Map map k2) => Map (InjectKeys t k1 k2 map) k1 where
empty = emptyInjectKeys
singleton = singletonInjectKeys
pair = pairInjectKeys
nonEmpty = nonEmptyInjectKeys
status = statusInjectKeys
addSize = addSizeInjectKeys
lookup = lookupInjectKeys
lookupCont = lookupContInjectKeys
alter = alterInjectKeys
insertWith = insertWithInjectKeys
insertWith' = insertWithInjectKeys'
insertMaybe = insertMaybeInjectKeys
delete = deleteInjectKeys
adjustWith = adjustWithInjectKeys
adjustWith' = adjustWithInjectKeys'
adjustMaybe = adjustMaybeInjectKeys
venn = vennInjectKeys
venn' = vennInjectKeys'
vennMaybe = vennMaybeInjectKeys
disjointUnion = disjointUnionInjectKeys
union = unionInjectKeys
union' = unionInjectKeys'
unionMaybe = unionMaybeInjectKeys
intersection = intersectionInjectKeys
intersection' = intersectionInjectKeys'
intersectionMaybe = intersectionMaybeInjectKeys
difference = differenceInjectKeys
differenceMaybe = differenceMaybeInjectKeys
isSubsetOf = isSubsetOfInjectKeys
isSubmapOf = isSubmapOfInjectKeys
map = mapInjectKeys
map' = mapInjectKeys'
mapMaybe = mapMaybeInjectKeys
mapWithKey = mapWithInjectionKeys
mapWithKey' = mapWithInjectionKeys'
filter = filterInjectKeys
foldKeys = foldKeysInjectKeys
foldElems = foldElemsInjectKeys
foldAssocs = foldAssocsInjectKeys
foldKeys' = foldKeysInjectKeys'
foldElems' = foldElemsInjectKeys'
foldAssocs' = foldAssocsInjectKeys'
foldElemsUInt = foldElemsUIntInjectKeys
valid = validInjectKeys
instance (Eq k1, Injection t k1 k2, OrderedMap map k2) => OrderedMap (InjectKeys t k1 k2 map) k1 where
compareKey = compareInjectionKeys
fromAssocsAscWith = fromAssocsAscWithInjectKeys
fromAssocsDescWith = fromAssocsDescWithInjectKeys
fromAssocsAscMaybe = fromAssocsAscMaybeInjectKeys
fromAssocsDescMaybe = fromAssocsDescMaybeInjectKeys
foldElemsAsc = foldElemsAscInjectKeys
foldElemsDesc = foldElemsDescInjectKeys
foldKeysAsc = foldKeysAscInjectKeys
foldKeysDesc = foldKeysDescInjectKeys
foldAssocsAsc = foldAssocsAscInjectKeys
foldAssocsDesc = foldAssocsDescInjectKeys
foldElemsAsc' = foldElemsAscInjectKeys'
foldElemsDesc' = foldElemsDescInjectKeys'
foldKeysAsc' = foldKeysAscInjectKeys'
foldKeysDesc' = foldKeysDescInjectKeys'
foldAssocsAsc' = foldAssocsAscInjectKeys'
foldAssocsDesc' = foldAssocsDescInjectKeys'
emptyInjectKeys = InjectKeys empty
singletonInjectKeys k a = let tk = InjectKeys (singleton (injectFor tk k) a) in tk
fromAssocsAscWithInjectKeys f kas = let tk = InjectKeys (fromAssocsAscWith f [(injectFor tk k,a) | (k,a) <- kas]) in tk
fromAssocsDescWithInjectKeys f kas = let tk = InjectKeys (fromAssocsDescWith f [(injectFor tk k,a) | (k,a) <- kas]) in tk
fromAssocsAscMaybeInjectKeys f kas = let tk = InjectKeys (fromAssocsAscMaybe f [(injectFor tk k,a) | (k,a) <- kas]) in tk
fromAssocsDescMaybeInjectKeys f kas = let tk = InjectKeys (fromAssocsDescMaybe f [(injectFor tk k,a) | (k,a) <- kas]) in tk
pairInjectKeys k1 k2 =
let tk = (fromJust pairf) undefined undefined
pairf =
case pair (injectFor tk k1) (injectFor tk k2) of
Nothing -> Nothing
Just f -> Just (\a1 a2 -> InjectKeys (f a1 a2))
in pairf
nonEmptyInjectKeys (InjectKeys mp) = fmap InjectKeys (nonEmpty mp)
statusInjectKeys tk@(InjectKeys mp) =
case status mp of
None -> None
One k a -> One (outjectFor tk k) a
Many -> Many
addSizeInjectKeys (InjectKeys mp) = addSize mp
lookupInjectKeys k tk@(InjectKeys mp) = lookup (injectFor tk k) mp
lookupContInjectKeys f k tk@(InjectKeys mp) = lookupCont f (injectFor tk k) mp
alterInjectKeys f k tk@(InjectKeys mp) = InjectKeys (alter f (injectFor tk k) mp)
insertWithInjectKeys f k a tk@(InjectKeys mp) = InjectKeys (insertWith f (injectFor tk k) a mp)
insertWithInjectKeys' f k a tk@(InjectKeys mp) = InjectKeys (insertWith' f (injectFor tk k) a mp)
insertMaybeInjectKeys f k a tk@(InjectKeys mp) = InjectKeys (insertMaybe f (injectFor tk k) a mp)
deleteInjectKeys k tk@(InjectKeys mp) = InjectKeys (delete (injectFor tk k) mp)
adjustWithInjectKeys f k tk@(InjectKeys mp) = InjectKeys (adjustWith f (injectFor tk k) mp)
adjustWithInjectKeys' f k tk@(InjectKeys mp) = InjectKeys (adjustWith' f (injectFor tk k) mp)
adjustMaybeInjectKeys f k tk@(InjectKeys mp) = InjectKeys (adjustMaybe f (injectFor tk k) mp)
vennInjectKeys f (InjectKeys mp1) (InjectKeys mp2) = (InjectKeys leftDiff, InjectKeys inter, InjectKeys rightDiff)
where (leftDiff, inter, rightDiff) = venn f mp1 mp2
vennInjectKeys' f (InjectKeys mp1) (InjectKeys mp2) = (InjectKeys leftDiff, InjectKeys inter, InjectKeys rightDiff)
where (leftDiff, inter, rightDiff) = venn' f mp1 mp2
vennMaybeInjectKeys f (InjectKeys mp1) (InjectKeys mp2) = (InjectKeys leftDiff, InjectKeys inter, InjectKeys rightDiff)
where (leftDiff, inter, rightDiff) = vennMaybe f mp1 mp2
disjointUnionInjectKeys (InjectKeys mp1) (InjectKeys mp2) = InjectKeys (disjointUnion mp1 mp2)
unionInjectKeys f (InjectKeys mp1) (InjectKeys mp2) = InjectKeys (union f mp1 mp2)
unionInjectKeys' f (InjectKeys mp1) (InjectKeys mp2) = InjectKeys (union' f mp1 mp2)
unionMaybeInjectKeys f (InjectKeys mp1) (InjectKeys mp2) = InjectKeys (unionMaybe f mp1 mp2)
intersectionInjectKeys f (InjectKeys mp1) (InjectKeys mp2) = InjectKeys (intersection f mp1 mp2)
intersectionInjectKeys' f (InjectKeys mp1) (InjectKeys mp2) = InjectKeys (intersection' f mp1 mp2)
intersectionMaybeInjectKeys f (InjectKeys mp1) (InjectKeys mp2) = InjectKeys (intersectionMaybe f mp1 mp2)
differenceInjectKeys (InjectKeys mp1) (InjectKeys mp2) = InjectKeys (difference mp1 mp2)
differenceMaybeInjectKeys f (InjectKeys mp1) (InjectKeys mp2) = InjectKeys (differenceMaybe f mp1 mp2)
isSubsetOfInjectKeys (InjectKeys mp1) (InjectKeys mp2) = isSubsetOf mp1 mp2
isSubmapOfInjectKeys f (InjectKeys mp1) (InjectKeys mp2) = isSubmapOf f mp1 mp2
mapInjectKeys f (InjectKeys mp) = InjectKeys (map f mp)
mapInjectKeys' f (InjectKeys mp) = InjectKeys (map' f mp)
mapMaybeInjectKeys f (InjectKeys mp) = InjectKeys (mapMaybe f mp)
mapWithInjectionKeys f tk@(InjectKeys mp) = InjectKeys (mapWithKey (\k a -> f (outjectFor tk k) a) mp)
mapWithInjectionKeys' f tk@(InjectKeys mp) = InjectKeys (mapWithKey' (\k a -> f (outjectFor tk k) a) mp)
filterInjectKeys f (InjectKeys mp) = InjectKeys (filter f mp)
foldElemsInjectKeys f b (InjectKeys mp) = foldElems f b mp
foldKeysInjectKeys f b tk@(InjectKeys mp) = foldKeys (\ k b' -> f (outjectFor tk k) b') b mp
foldAssocsInjectKeys f b tk@(InjectKeys mp) = foldAssocs (\ k a b' -> f (outjectFor tk k) a b') b mp
foldElemsInjectKeys' f b (InjectKeys mp) = foldElems' f b mp
foldKeysInjectKeys' f b tk@(InjectKeys mp) = foldKeys' (\ k b' -> f (outjectFor tk k) b') b mp
foldAssocsInjectKeys' f b tk@(InjectKeys mp) = foldAssocs' (\ k a b' -> f (outjectFor tk k) a b') b mp
foldElemsAscInjectKeys f b (InjectKeys mp) = foldElemsAsc f b mp
foldElemsDescInjectKeys f b (InjectKeys mp) = foldElemsDesc f b mp
foldKeysAscInjectKeys f b tk@(InjectKeys mp) = foldKeysAsc (\ k b' -> f (outjectFor tk k) b') b mp
foldKeysDescInjectKeys f b tk@(InjectKeys mp) = foldKeysDesc (\ k b' -> f (outjectFor tk k) b') b mp
foldAssocsAscInjectKeys f b tk@(InjectKeys mp) = foldAssocsAsc (\ k a b' -> f (outjectFor tk k) a b') b mp
foldAssocsDescInjectKeys f b tk@(InjectKeys mp) = foldAssocsDesc (\ k a b' -> f (outjectFor tk k) a b') b mp
foldElemsAscInjectKeys' f b (InjectKeys mp) = foldElemsAsc' f b mp
foldElemsDescInjectKeys' f b (InjectKeys mp) = foldElemsDesc' f b mp
foldKeysAscInjectKeys' f b tk@(InjectKeys mp) = foldKeysAsc' (\ k b' -> f (outjectFor tk k) b') b mp
foldKeysDescInjectKeys' f b tk@(InjectKeys mp) = foldKeysDesc' (\ k b' -> f (outjectFor tk k) b') b mp
foldAssocsAscInjectKeys' f b tk@(InjectKeys mp) = foldAssocsAsc' (\ k a b' -> f (outjectFor tk k) a b') b mp
foldAssocsDescInjectKeys' f b tk@(InjectKeys mp) = foldAssocsDesc' (\ k a b' -> f (outjectFor tk k) a b') b mp
foldElemsUIntInjectKeys f b (InjectKeys mp) = foldElemsUInt f b mp
validInjectKeys (InjectKeys mp) = valid mp
compareInjectionKeys tk k1 k2 = compareKey (innerMap tk) (injectFor tk k1) (injectFor tk k2)
where innerMap :: InjectKeys t k1 k2 map a -> map a
innerMap = undefined
instance (Eq (map a)) => Eq (InjectKeys t k1 k2 map a) where
(InjectKeys kmp1) == (InjectKeys kmp2) = (kmp1 == kmp2)
instance (Ord (map a)) => Ord (InjectKeys t k1 k2 map a) where
compare (InjectKeys kmp1) (InjectKeys kmp2) = compare kmp1 kmp2
instance (Typeable1 map) => Typeable1 (InjectKeys t k1 k2 map) where
typeOf1 m = mkTyConApp (mkTyCon "Data.GMap.InjectKeys.InjectKeys") [typeOf1 innermp]
where InjectKeys innermp = m
instance (Typeable1 (InjectKeys t k1 k2 map), Typeable a) => Typeable (InjectKeys t k1 k2 map a) where
typeOf = typeOfDefault
instance (Map map k2) => Functor (InjectKeys t k1 k2 map) where
fmap = mapInjectKeys
instance (Map map k2, M.Monoid a) => M.Monoid (InjectKeys t k1 k2 map a) where
mempty = emptyInjectKeys
mappend map0 map1 = unionInjectKeys M.mappend map0 map1
mconcat maps = L.foldr (unionInjectKeys M.mappend) emptyInjectKeys maps
instance (Map map k2) => F.Foldable (InjectKeys t k1 k2 map) where
fold mp = foldElemsInjectKeys M.mappend M.mempty mp
foldMap f mp = foldElemsInjectKeys (\a b -> M.mappend (f a) b) M.mempty mp
foldr f b0 mp = foldElemsInjectKeys f b0 mp
foldl f b0 mp = foldElemsInjectKeys (flip f) b0 mp