{-# LANGUAGE MultiParamTypeClasses #-}
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 = map (at (from _maybe)) . lookup
delete = alter (const Nothing) 
minsert = alter (const (Just zero))  
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