module Calamity.Internal.SnowflakeMap where
import Calamity.Internal.Utils ()
import Calamity.Types.Snowflake
import Control.DeepSeq
import Control.Lens.At
import Control.Lens.Iso
import Control.Lens.Wrapped
import Data.Aeson ( FromJSON(..), ToJSON(..), withArray )
import Data.Data
import qualified Data.Foldable as F
import Data.HashMap.Lazy ( HashMap )
import qualified Data.HashMap.Lazy as LH
import Data.Hashable
import GHC.Exts ( IsList )
import GHC.Generics
import TextShow
import qualified TextShow.Generic as TSG
import Unsafe.Coerce
newtype SnowflakeMap a = SnowflakeMap
{ unSnowflakeMap :: HashMap (Snowflake a) a
}
deriving ( Generic, Eq, Data, Ord, Show )
deriving ( TextShow ) via TSG.FromGeneric (SnowflakeMap a)
deriving newtype ( IsList, Semigroup, Monoid )
deriving anyclass ( NFData, Hashable )
instance Functor SnowflakeMap where
fmap f = SnowflakeMap . coerceSnowflakeMap . fmap f . unSnowflakeMap
instance Foldable SnowflakeMap where
foldr f b = Prelude.foldr f b . unSnowflakeMap
instance Traversable SnowflakeMap where
traverse f = fmap (SnowflakeMap . coerceSnowflakeMap) . traverse f . unSnowflakeMap
instance Wrapped (SnowflakeMap a) where
type Unwrapped (SnowflakeMap a) = HashMap (Snowflake a) a
_Wrapped' = iso unSnowflakeMap SnowflakeMap
type instance (Index (SnowflakeMap a)) = Snowflake a
type instance (IxValue (SnowflakeMap a)) = a
instance SnowflakeMap a ~ t => Rewrapped (SnowflakeMap b) a
instance Ixed (SnowflakeMap a) where
ix i = _Wrapped . ix i
instance At (SnowflakeMap a) where
at i = _Wrapped . at i
over :: (HashMap (Snowflake a) a -> HashMap (Snowflake b) b) -> SnowflakeMap a -> SnowflakeMap b
over f = SnowflakeMap . f . unSnowflakeMap
{-# INLINABLE over #-}
coerceSnowflakeMap :: HashMap (Snowflake a) v -> HashMap (Snowflake b) v
coerceSnowflakeMap = unsafeCoerce
{-# INLINABLE coerceSnowflakeMap #-}
empty :: SnowflakeMap a
empty = SnowflakeMap LH.empty
{-# INLINABLE empty #-}
singleton :: HasID' a => a -> SnowflakeMap a
singleton v = SnowflakeMap $ LH.singleton (getID v) v
{-# INLINABLE singleton #-}
null :: SnowflakeMap a -> Bool
null = LH.null . unSnowflakeMap
{-# INLINABLE null #-}
size :: SnowflakeMap a -> Int
size = LH.size . unSnowflakeMap
{-# INLINABLE size #-}
member :: Snowflake a -> SnowflakeMap a -> Bool
member k = LH.member k . unSnowflakeMap
{-# INLINABLE member #-}
lookup :: Snowflake a -> SnowflakeMap a -> Maybe a
lookup k = LH.lookup k . unSnowflakeMap
{-# INLINABLE lookup #-}
lookupDefault :: a -> Snowflake a -> SnowflakeMap a -> a
lookupDefault d k = LH.lookupDefault d k . unSnowflakeMap
{-# INLINABLE lookupDefault #-}
(!) :: SnowflakeMap a -> Snowflake a -> a
(!) m k = unSnowflakeMap m LH.! k
{-# INLINABLE (!) #-}
insert :: HasID' a => a -> SnowflakeMap a -> SnowflakeMap a
insert v = over $ LH.insert (getID v) v
{-# INLINABLE insert #-}
insertWith :: HasID' a => (a -> a -> a) -> a -> SnowflakeMap a -> SnowflakeMap a
insertWith f v = over $ LH.insertWith f (getID v) v
{-# INLINABLE insertWith #-}
delete :: Snowflake a -> SnowflakeMap a -> SnowflakeMap a
delete k = over $ LH.delete k
{-# INLINABLE delete #-}
adjust :: (a -> a) -> Snowflake a -> SnowflakeMap a -> SnowflakeMap a
adjust f k = over $ LH.adjust f k
{-# INLINABLE adjust #-}
update :: (a -> Maybe a) -> Snowflake a -> SnowflakeMap a -> SnowflakeMap a
update f k = over $ LH.update f k
{-# INLINABLE update #-}
alter :: (Maybe a -> Maybe a) -> Snowflake a -> SnowflakeMap a -> SnowflakeMap a
alter f k = over $ LH.alter f k
{-# INLINABLE alter #-}
union :: SnowflakeMap a -> SnowflakeMap a -> SnowflakeMap a
union m m' = SnowflakeMap $ LH.union (unSnowflakeMap m) (unSnowflakeMap m')
{-# INLINABLE union #-}
unionWith :: (a -> a -> a) -> SnowflakeMap a -> SnowflakeMap a -> SnowflakeMap a
unionWith f m m' = SnowflakeMap $ LH.unionWith f (unSnowflakeMap m) (unSnowflakeMap m')
{-# INLINABLE unionWith #-}
unionWithKey :: (Snowflake a -> a -> a -> a) -> SnowflakeMap a -> SnowflakeMap a -> SnowflakeMap a
unionWithKey f m m' = SnowflakeMap $ LH.unionWithKey f (unSnowflakeMap m) (unSnowflakeMap m')
{-# INLINABLE unionWithKey #-}
unions :: [SnowflakeMap a] -> SnowflakeMap a
unions = SnowflakeMap . LH.unions . Prelude.map unSnowflakeMap
{-# INLINABLE unions #-}
map :: (a1 -> a2) -> SnowflakeMap a1 -> SnowflakeMap a2
map f = over $ coerceSnowflakeMap . LH.map f
{-# INLINABLE map #-}
mapWithKey :: (Snowflake a1 -> a1 -> a2) -> SnowflakeMap a1 -> SnowflakeMap a2
mapWithKey f = over $ coerceSnowflakeMap . LH.mapWithKey f
{-# INLINABLE mapWithKey #-}
traverseWithKey :: Applicative f => (Snowflake a1 -> a1 -> f a2) -> SnowflakeMap a1 -> f (SnowflakeMap a2)
traverseWithKey f = fmap (SnowflakeMap . coerceSnowflakeMap) . LH.traverseWithKey f . unSnowflakeMap
{-# INLINABLE traverseWithKey #-}
difference :: SnowflakeMap a -> SnowflakeMap a -> SnowflakeMap a
difference m m' = SnowflakeMap $ LH.difference (unSnowflakeMap m) (unSnowflakeMap m')
{-# INLINABLE difference #-}
differenceWith :: (a -> a -> Maybe a) -> SnowflakeMap a -> SnowflakeMap a -> SnowflakeMap a
differenceWith f m m' = SnowflakeMap $ LH.differenceWith f (unSnowflakeMap m) (unSnowflakeMap m')
{-# INLINABLE differenceWith #-}
intersection :: SnowflakeMap a -> SnowflakeMap a -> SnowflakeMap a
intersection m m' = SnowflakeMap $ LH.intersection (unSnowflakeMap m) (unSnowflakeMap m')
{-# INLINABLE intersection #-}
intersectionWith :: (a -> a -> b) -> SnowflakeMap a -> SnowflakeMap a -> SnowflakeMap b
intersectionWith f m m' = SnowflakeMap . coerceSnowflakeMap $ LH.intersectionWith f (unSnowflakeMap m) (unSnowflakeMap m')
{-# INLINABLE intersectionWith #-}
intersectionWithKey :: (Snowflake a -> a -> a -> b) -> SnowflakeMap a -> SnowflakeMap a -> SnowflakeMap b
intersectionWithKey f m m' = SnowflakeMap . coerceSnowflakeMap $ LH.intersectionWithKey f (unSnowflakeMap m) (unSnowflakeMap m')
{-# INLINABLE intersectionWithKey #-}
foldl' :: (a -> b -> a) -> a -> SnowflakeMap b -> a
foldl' f s m = LH.foldl' f s $ unSnowflakeMap m
{-# INLINABLE foldl' #-}
foldlWithKey' :: (a -> Snowflake b -> b -> a) -> a -> SnowflakeMap b -> a
foldlWithKey' f s m = LH.foldlWithKey' f s $ unSnowflakeMap m
{-# INLINABLE foldlWithKey' #-}
foldr :: (b -> a -> a) -> a -> SnowflakeMap b -> a
foldr f s m = LH.foldr f s $ unSnowflakeMap m
{-# INLINABLE foldr #-}
foldrWithKey :: (Snowflake b -> b -> a -> a) -> a -> SnowflakeMap b -> a
foldrWithKey f s m = LH.foldrWithKey f s $ unSnowflakeMap m
{-# INLINABLE foldrWithKey #-}
filter :: (a -> Bool) -> SnowflakeMap a -> SnowflakeMap a
filter f = over $ LH.filter f
{-# INLINABLE filter #-}
filterWithKey :: (Snowflake a -> a -> Bool) -> SnowflakeMap a -> SnowflakeMap a
filterWithKey f = over $ LH.filterWithKey f
{-# INLINABLE filterWithKey #-}
mapMaybe :: (a -> Maybe b) -> SnowflakeMap a -> SnowflakeMap b
mapMaybe f = over $ coerceSnowflakeMap . LH.mapMaybe f
{-# INLINABLE mapMaybe #-}
mapMaybeWithKey :: (Snowflake a -> a -> Maybe b) -> SnowflakeMap a -> SnowflakeMap b
mapMaybeWithKey f = over $ coerceSnowflakeMap . LH.mapMaybeWithKey f
{-# INLINABLE mapMaybeWithKey #-}
keys :: SnowflakeMap a -> [Snowflake a]
keys = LH.keys . unSnowflakeMap
{-# INLINABLE keys #-}
elems :: SnowflakeMap a -> [a]
elems = LH.elems . unSnowflakeMap
{-# INLINABLE elems #-}
toList :: SnowflakeMap a -> [(Snowflake a, a)]
toList = LH.toList . unSnowflakeMap
{-# INLINABLE toList #-}
fromList :: HasID' a => [a] -> SnowflakeMap a
fromList = SnowflakeMap . LH.fromList . Prelude.map (\v -> (getID v, v))
{-# INLINABLE fromList #-}
fromListWith :: HasID' a => (a -> a -> a) -> [a] -> SnowflakeMap a
fromListWith f = SnowflakeMap . LH.fromListWith f . Prelude.map (\v -> (getID v, v))
{-# INLINABLE fromListWith #-}
instance (FromJSON a, HasID' a) => FromJSON (SnowflakeMap a) where
parseJSON = withArray "SnowflakeMap" $ \l -> do
parsed <- traverse parseJSON l
pure . Calamity.Internal.SnowflakeMap.fromList . F.toList $ parsed
instance ToJSON a => ToJSON (SnowflakeMap a) where
toEncoding = toEncoding . elems