module Data.GMap.UnitMap
(
UnitMap
) where
import Data.GMap
import qualified Data.Monoid as M (Monoid(..))
import qualified Data.Foldable as F (Foldable(..))
import Data.Typeable
import qualified Data.List as L (foldr)
import GHC.Base hiding (map)
import qualified Text.Read as R (Read(..),Lexeme(..),parens,prec,lexP,readListPrecDefault)
import Data.Maybe
newtype UnitMap a = UnitMap (Maybe a)
instance Map UnitMap () where
empty = emptyUnitMap
singleton = singletonUnitMap
pair = pairUnitMap
nonEmpty = nonEmptyUnitMap
status = statusUnitMap
addSize = addSizeUnitMap
lookup = lookupUnitMap
alter = alterUnitMap
vennMaybe = vennMaybeUnitMap
unionMaybe = unionMaybeUnitMap
isSubsetOf = isSubsetOfUnitMap
isSubmapOf = isSubmapOfUnitMap
mapMaybe = mapMaybeUnitMap
mapWithKey = mapWithKeyUnitMap
mapWithKey' = mapWithKeyUnitMap'
filter = filterUnitMap
foldKeys = foldKeysUnitMap
foldElems = foldElemsUnitMap
foldAssocs = foldAssocsUnitMap
foldKeys' = foldKeysUnitMap
foldElems' = foldElemsUnitMap
foldAssocs' = foldAssocsUnitMap
foldElemsUInt = foldElemsUIntUnitMap
valid = validUnitMap
instance OrderedMap UnitMap () where
compareKey = compareKeyUnitMap
foldElemsAsc = foldElemsUnitMap
foldElemsDesc = foldElemsUnitMap
foldKeysAsc = foldKeysUnitMap
foldKeysDesc = foldKeysUnitMap
foldAssocsAsc = foldAssocsUnitMap
foldAssocsDesc = foldAssocsUnitMap
foldElemsAsc' = foldElemsUnitMap
foldElemsDesc' = foldElemsUnitMap
foldKeysAsc' = foldKeysUnitMap
foldKeysDesc' = foldKeysUnitMap
foldAssocsAsc' = foldAssocsUnitMap
foldAssocsDesc' = foldAssocsUnitMap
emptyUnitMap :: UnitMap a
emptyUnitMap = UnitMap Nothing
singletonUnitMap :: () -> a -> UnitMap a
singletonUnitMap _ a = UnitMap (Just a)
pairUnitMap :: () -> () -> Maybe (a -> a -> UnitMap a)
pairUnitMap _ _ = Nothing
nonEmptyUnitMap :: UnitMap a -> Maybe (UnitMap a)
nonEmptyUnitMap (UnitMap Nothing) = Nothing
nonEmptyUnitMap ugt = Just ugt
statusUnitMap :: UnitMap a -> Status () a
statusUnitMap (UnitMap (Just a)) = One () a
statusUnitMap _ = None
addSizeUnitMap :: UnitMap a -> Int# -> Int#
addSizeUnitMap (UnitMap Nothing) n = n
addSizeUnitMap _ n = (n +# 1#)
lookupUnitMap :: () -> UnitMap a -> Maybe a
lookupUnitMap _ (UnitMap mba) = mba
alterUnitMap :: (Maybe a -> Maybe a) -> () -> UnitMap a -> UnitMap a
alterUnitMap f _ (UnitMap mba) = UnitMap (f mba)
vennMaybeUnitMap :: (a -> b -> Maybe c) -> UnitMap a -> UnitMap b -> (UnitMap a, UnitMap c, UnitMap b)
vennMaybeUnitMap _ (UnitMap Nothing) (UnitMap Nothing) = (UnitMap Nothing, UnitMap Nothing, UnitMap Nothing)
vennMaybeUnitMap _ (UnitMap ja ) (UnitMap Nothing) = (UnitMap ja , UnitMap Nothing, UnitMap Nothing)
vennMaybeUnitMap _ (UnitMap Nothing) (UnitMap jb ) = (UnitMap Nothing, UnitMap Nothing, UnitMap jb )
vennMaybeUnitMap f (UnitMap (Just a)) (UnitMap (Just b)) = (UnitMap Nothing, UnitMap (f a b), UnitMap Nothing)
unionMaybeUnitMap :: (a -> a -> Maybe a) -> UnitMap a -> UnitMap a -> UnitMap a
unionMaybeUnitMap _ (UnitMap Nothing) (UnitMap Nothing) = UnitMap Nothing
unionMaybeUnitMap _ (UnitMap ja ) (UnitMap Nothing) = UnitMap ja
unionMaybeUnitMap _ (UnitMap Nothing) (UnitMap jb ) = UnitMap jb
unionMaybeUnitMap f (UnitMap (Just a)) (UnitMap (Just b)) = UnitMap (f a b)
isSubsetOfUnitMap :: UnitMap a -> UnitMap b -> Bool
isSubsetOfUnitMap (UnitMap Nothing ) _ = True
isSubsetOfUnitMap (UnitMap (Just _)) (UnitMap (Just _)) = True
isSubsetOfUnitMap _ _ = False
isSubmapOfUnitMap :: (a -> b -> Bool) -> UnitMap a -> UnitMap b -> Bool
isSubmapOfUnitMap _ (UnitMap Nothing ) _ = True
isSubmapOfUnitMap f (UnitMap (Just a)) (UnitMap (Just b)) = f a b
isSubmapOfUnitMap _ _ _ = False
mapMaybeUnitMap :: (a -> Maybe b) -> UnitMap a -> UnitMap b
mapMaybeUnitMap f (UnitMap (Just a)) = UnitMap (f a)
mapMaybeUnitMap _ _ = emptyUnitMap
mapWithKeyUnitMap :: (() -> a -> b) -> UnitMap a -> UnitMap b
mapWithKeyUnitMap f (UnitMap (Just a)) = UnitMap (Just (f () a))
mapWithKeyUnitMap _ _ = emptyUnitMap
mapWithKeyUnitMap' :: (() -> a -> b) -> UnitMap a -> UnitMap b
mapWithKeyUnitMap' f (UnitMap (Just a)) = let b = f () a in b `seq` UnitMap (Just b)
mapWithKeyUnitMap' _ _ = emptyUnitMap
filterUnitMap :: (a -> Bool) -> UnitMap a -> UnitMap a
filterUnitMap p u@(UnitMap (Just a)) = if p a then u else emptyUnitMap
filterUnitMap _ _ = emptyUnitMap
foldKeysUnitMap :: (() -> b -> b) -> b -> UnitMap a -> b
foldKeysUnitMap f b (UnitMap mba) = case mba of
Just _ -> f () b
Nothing -> b
foldElemsUnitMap :: (a -> b -> b) -> b -> UnitMap a -> b
foldElemsUnitMap f b (UnitMap mba) = case mba of
Just a -> f a b
Nothing -> b
foldAssocsUnitMap :: (() -> a -> b -> b) -> b -> UnitMap a -> b
foldAssocsUnitMap f b (UnitMap mba) = case mba of
Just a -> f () a b
Nothing -> b
foldElemsUIntUnitMap :: (a -> Int# -> Int#) -> Int# -> UnitMap a -> Int#
foldElemsUIntUnitMap f n (UnitMap mba) = case mba of
Just a -> f a n
Nothing -> n
validUnitMap :: UnitMap a -> Maybe String
validUnitMap _ = Nothing
compareKeyUnitMap :: UnitMap a -> () -> () -> Ordering
compareKeyUnitMap _ _ _ = EQ
instance Eq a => Eq (UnitMap a) where
UnitMap mba0 == UnitMap mba1 = mba0 == mba1
instance Ord a => Ord (UnitMap a) where
compare (UnitMap Nothing ) (UnitMap Nothing ) = EQ
compare (UnitMap Nothing ) (UnitMap (Just _ )) = LT
compare (UnitMap (Just _ )) (UnitMap Nothing ) = GT
compare (UnitMap (Just a0)) (UnitMap (Just a1)) = compare a0 a1
instance Show a => Show (UnitMap a) where
showsPrec d mp = showParen (d > 10) $
showString "fromAssocs " . shows (assocs mp)
instance R.Read a => R.Read (UnitMap a) where
readPrec = R.parens $ R.prec 10 $ do R.Ident "fromAssocs" <- R.lexP
xs <- R.readPrec
return (fromAssocs xs)
readListPrec = R.readListPrecDefault
instance Typeable1 UnitMap where
typeOf1 _ = mkTyConApp (mkTyCon "Data.GMap.UnitMap.UnitMap") []
instance Typeable a => Typeable (UnitMap a) where
typeOf = typeOfDefault
instance Functor (UnitMap) where
fmap = Data.GMap.map
instance (M.Monoid a) => M.Monoid (UnitMap a) where
mempty = emptyUnitMap
mappend map0 map1 = union M.mappend map0 map1
mconcat maps = L.foldr (union M.mappend) emptyUnitMap maps
instance F.Foldable (UnitMap) where
fold mp = foldElemsUnitMap M.mappend M.mempty mp
foldMap f mp = foldElemsUnitMap (\a b -> M.mappend (f a) b) M.mempty mp
foldr f b0 mp = foldElemsUnitMap f b0 mp
foldl f b0 mp = foldElemsUnitMap (flip f) b0 mp