module SimpleH.Containers(
DataMap(..),
AList(..),
S.Set,M.Map,
member,delete,minsert,insert
)
where
import SimpleH.Core
import SimpleH.Functor
import SimpleH.Lens
import qualified Data.Set as S
import qualified Data.Map as M
class DataMap m k a | m -> k a where
lookup :: k -> m -> Maybe a
alter :: (Maybe a -> Maybe a) -> k -> m -> m
member :: DataMap m k Void => k -> m -> Bool
member = map (at (from _maybe)) . lookup
delete :: DataMap m k a => k -> m -> m
delete = alter (const Nothing)
minsert :: (Monoid a, DataMap m k a) => k -> m -> m
minsert = alter (const (Just zero))
insert :: DataMap m k a => a -> k -> m -> m
insert = alter . const . Just
instance Ord a => DataMap (S.Set a) a Void where
lookup = _mapping' _maybe-. S.member
alter f a s | bef && not aft = S.delete a s
| aft && not bef = S.insert a s
| otherwise = s
where bef = S.member a s ; aft = (_maybe %~ f) bef
instance Ord k => DataMap (M.Map k a) k a where
lookup = M.lookup ; alter = M.alter
instance Ord a => Semigroup (S.Set a) where (+) = S.union
instance Ord a => Monoid (S.Set a) where zero = S.empty
instance Ord k => Semigroup (M.Map k a) where (+) = M.union
instance Ord k => Monoid (M.Map k a) where zero = M.empty
instance Functor (M.Map k) where map = M.map
newtype AList k a = AList { getAList :: [(k,a)] }
newtype Bimap a b = Bimap (M.Map a b,M.Map b a)
deriving (Semigroup,Monoid)
_inverse :: Iso' (Bimap a b) (Bimap b a)
_inverse = iso (\(Bimap (a,b)) -> Bimap (b,a)) (\(Bimap (a,b)) -> Bimap (b,a))
instance (Ord a,Ord b) => DataMap (Bimap a b) a b where
lookup a (Bimap (ma,_)) = lookup a ma
alter f a (Bimap (ma,mb)) = Bimap (ma',
(maybe id delete b
>>> maybe id (insert a) b') mb)
where b = lookup a ma ; b' = lookup a ma'
ma' = alter f a ma
instance (Ord b,Ord a) => DataMap (Flip Bimap b a) b a where
lookup b (Flip (Bimap (_,mb))) = lookup b mb
alter f b = from (_inverse._Flip) %~ alter f b