content: -- | Module for custom instance of Data.HashMap.Strict that decodes from any list of objects that have an id field
  module Calamity.Internal.SnowflakeMap where
  
  import Calamity.Internal.Utils ()
  import Calamity.Types.Snowflake
  import Data.Aeson (FromJSON (..), ToJSON (..), withArray)
  import Data.Data
  import Data.Foldable qualified as F
  import Data.HashMap.Strict (HashMap)
  import Data.HashMap.Strict qualified as SH
  import Data.Hashable
  import GHC.Exts (IsList)
  import Optics
  import TextShow
  import Unsafe.Coerce
  
  newtype SnowflakeMap a = SnowflakeMap
    { unSnowflakeMap :: HashMap (Snowflake a) a
    }
    deriving stock (Eq, Data, Ord, Show)
    deriving (TextShow) via FromStringShow (SnowflakeMap a)
    deriving newtype (IsList, Semigroup, Monoid)
    deriving newtype (Hashable)
  
  -- instance At (SnowflakeMap a) where
  --   at k f m = at (unSnowflakeMap k) f m
  
  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
  
  type instance Index (SnowflakeMap a) = Snowflake a
  
  type instance IxValue (SnowflakeMap a) = a
  
  _SnowflakeMap ::
    ( Iso
        (SnowflakeMap a)
        (SnowflakeMap a1)
        (HashMap (Snowflake a) a)
        (HashMap (Snowflake a1) a1)
    )
  _SnowflakeMap = iso unSnowflakeMap SnowflakeMap
  
  instance Ixed (SnowflakeMap a) where
    ix i = _SnowflakeMap % ix i
    {-# INLINE ix #-}
  
  instance At (SnowflakeMap a) where
    at i = _SnowflakeMap % at i
    {-# INLINE at #-}
  
  overSM :: (HashMap (Snowflake a) a -> HashMap (Snowflake b) b) -> SnowflakeMap a -> SnowflakeMap b
  overSM f = SnowflakeMap . f . unSnowflakeMap
  {-# INLINEABLE overSM #-}
  
  -- SAFETY: 'Snowflake' always uses the underlying hash function (Word64)
  coerceSnowflakeMap :: HashMap (Snowflake a) v -> HashMap (Snowflake b) v
  coerceSnowflakeMap = unsafeCoerce
  {-# INLINEABLE coerceSnowflakeMap #-}
  
  empty :: SnowflakeMap a
  empty = SnowflakeMap SH.empty
  {-# INLINEABLE empty #-}
  
  singleton :: (HasID' a) => a -> SnowflakeMap a
  singleton v = SnowflakeMap $ SH.singleton (getID v) v
  {-# INLINEABLE singleton #-}
  
  null :: SnowflakeMap a -> Bool
  null = SH.null . unSnowflakeMap
  {-# INLINEABLE null #-}
  
  size :: SnowflakeMap a -> Int
  size = SH.size . unSnowflakeMap
  {-# INLINEABLE size #-}
  
  member :: Snowflake a -> SnowflakeMap a -> Bool
  member k = SH.member k . unSnowflakeMap
  {-# INLINEABLE member #-}
  
  lookup :: Snowflake a -> SnowflakeMap a -> Maybe a
  lookup k = SH.lookup k . unSnowflakeMap
  {-# INLINEABLE lookup #-}
  
  lookupDefault :: a -> Snowflake a -> SnowflakeMap a -> a
  lookupDefault d k = SH.lookupDefault d k . unSnowflakeMap
  {-# INLINEABLE lookupDefault #-}
  
  (!) :: SnowflakeMap a -> Snowflake a -> a
  (!) m k = unSnowflakeMap m SH.! k
  {-# INLINEABLE (!) #-}
  
  infixl 9 !
  
  insert :: (HasID' a) => a -> SnowflakeMap a -> SnowflakeMap a
  insert v = overSM $ SH.insert (getID v) v
  {-# INLINEABLE insert #-}
  
  insertWith :: (HasID' a) => (a -> a -> a) -> a -> SnowflakeMap a -> SnowflakeMap a
  insertWith f v = overSM $ SH.insertWith f (getID v) v
  {-# INLINEABLE insertWith #-}
  
  delete :: Snowflake a -> SnowflakeMap a -> SnowflakeMap a
  delete k = overSM $ SH.delete k
  {-# INLINEABLE delete #-}
  
  adjust :: (a -> a) -> Snowflake a -> SnowflakeMap a -> SnowflakeMap a
  adjust f k = overSM $ SH.adjust f k
  {-# INLINEABLE adjust #-}
  
  update :: (a -> Maybe a) -> Snowflake a -> SnowflakeMap a -> SnowflakeMap a
  update f k = overSM $ SH.update f k
  {-# INLINEABLE update #-}
  
  alter :: (Maybe a -> Maybe a) -> Snowflake a -> SnowflakeMap a -> SnowflakeMap a
  alter f k = overSM $ SH.alter f k
  {-# INLINEABLE alter #-}
  
  union :: SnowflakeMap a -> SnowflakeMap a -> SnowflakeMap a
  union m m' = SnowflakeMap $ SH.union (unSnowflakeMap m) (unSnowflakeMap m')
  {-# INLINEABLE union #-}
  
  unionWith :: (a -> a -> a) -> SnowflakeMap a -> SnowflakeMap a -> SnowflakeMap a
  unionWith f m m' = SnowflakeMap $ SH.unionWith f (unSnowflakeMap m) (unSnowflakeMap m')
  {-# INLINEABLE unionWith #-}
  
  unionWithKey :: (Snowflake a -> a -> a -> a) -> SnowflakeMap a -> SnowflakeMap a -> SnowflakeMap a
  unionWithKey f m m' = SnowflakeMap $ SH.unionWithKey f (unSnowflakeMap m) (unSnowflakeMap m')
  {-# INLINEABLE unionWithKey #-}
  
  unions :: [SnowflakeMap a] -> SnowflakeMap a
  unions = SnowflakeMap . SH.unions . Prelude.map unSnowflakeMap
  {-# INLINEABLE unions #-}
  
  map :: (a1 -> a2) -> SnowflakeMap a1 -> SnowflakeMap a2
  map f = overSM $ coerceSnowflakeMap . SH.map f
  {-# INLINEABLE map #-}
  
  mapWithKey :: (Snowflake a1 -> a1 -> a2) -> SnowflakeMap a1 -> SnowflakeMap a2
  mapWithKey f = overSM $ coerceSnowflakeMap . SH.mapWithKey f
  {-# INLINEABLE mapWithKey #-}
  
  traverseWithKey :: (Applicative f) => (Snowflake a1 -> a1 -> f a2) -> SnowflakeMap a1 -> f (SnowflakeMap a2)
  traverseWithKey f = fmap (SnowflakeMap . coerceSnowflakeMap) . SH.traverseWithKey f . unSnowflakeMap
  {-# INLINEABLE traverseWithKey #-}
  
  difference :: SnowflakeMap a -> SnowflakeMap a -> SnowflakeMap a
  difference m m' = SnowflakeMap $ SH.difference (unSnowflakeMap m) (unSnowflakeMap m')
  {-# INLINEABLE difference #-}
  
  differenceWith :: (a -> a -> Maybe a) -> SnowflakeMap a -> SnowflakeMap a -> SnowflakeMap a
  differenceWith f m m' = SnowflakeMap $ SH.differenceWith f (unSnowflakeMap m) (unSnowflakeMap m')
  {-# INLINEABLE differenceWith #-}
  
  intersection :: SnowflakeMap a -> SnowflakeMap a -> SnowflakeMap a
  intersection m m' = SnowflakeMap $ SH.intersection (unSnowflakeMap m) (unSnowflakeMap m')
  {-# INLINEABLE intersection #-}
  
  intersectionWith :: (a -> a -> b) -> SnowflakeMap a -> SnowflakeMap a -> SnowflakeMap b
  intersectionWith f m m' = SnowflakeMap . coerceSnowflakeMap $ SH.intersectionWith f (unSnowflakeMap m) (unSnowflakeMap m')
  {-# INLINEABLE intersectionWith #-}
  
  intersectionWithKey :: (Snowflake a -> a -> a -> b) -> SnowflakeMap a -> SnowflakeMap a -> SnowflakeMap b
  intersectionWithKey f m m' = SnowflakeMap . coerceSnowflakeMap $ SH.intersectionWithKey f (unSnowflakeMap m) (unSnowflakeMap m')
  {-# INLINEABLE intersectionWithKey #-}
  
  foldl' :: (a -> b -> a) -> a -> SnowflakeMap b -> a
  foldl' f s m = SH.foldl' f s $ unSnowflakeMap m
  {-# INLINEABLE foldl' #-}
  
  foldlWithKey' :: (a -> Snowflake b -> b -> a) -> a -> SnowflakeMap b -> a
  foldlWithKey' f s m = SH.foldlWithKey' f s $ unSnowflakeMap m
  {-# INLINEABLE foldlWithKey' #-}
  
  foldr :: (b -> a -> a) -> a -> SnowflakeMap b -> a
  foldr f s m = SH.foldr f s $ unSnowflakeMap m
  {-# INLINEABLE foldr #-}
  
  foldrWithKey :: (Snowflake b -> b -> a -> a) -> a -> SnowflakeMap b -> a
  foldrWithKey f s m = SH.foldrWithKey f s $ unSnowflakeMap m
  {-# INLINEABLE foldrWithKey #-}
  
  filter :: (a -> Bool) -> SnowflakeMap a -> SnowflakeMap a
  filter f = overSM $ SH.filter f
  {-# INLINEABLE filter #-}
  
  filterWithKey :: (Snowflake a -> a -> Bool) -> SnowflakeMap a -> SnowflakeMap a
  filterWithKey f = overSM $ SH.filterWithKey f
  {-# INLINEABLE filterWithKey #-}
  
  mapMaybe :: (a -> Maybe b) -> SnowflakeMap a -> SnowflakeMap b
  mapMaybe f = overSM $ coerceSnowflakeMap . SH.mapMaybe f
  {-# INLINEABLE mapMaybe #-}
  
  mapMaybeWithKey :: (Snowflake a -> a -> Maybe b) -> SnowflakeMap a -> SnowflakeMap b
  mapMaybeWithKey f = overSM $ coerceSnowflakeMap . SH.mapMaybeWithKey f
  {-# INLINEABLE mapMaybeWithKey #-}
  
  keys :: SnowflakeMap a -> [Snowflake a]
  keys = SH.keys . unSnowflakeMap
  {-# INLINEABLE keys #-}
  
  elems :: SnowflakeMap a -> [a]
  elems = SH.elems . unSnowflakeMap
  {-# INLINEABLE elems #-}
  
  toList :: SnowflakeMap a -> [(Snowflake a, a)]
  toList = SH.toList . unSnowflakeMap
  {-# INLINEABLE toList #-}
  
  fromList :: (HasID' a) => [a] -> SnowflakeMap a
  fromList = SnowflakeMap . SH.fromList . Prelude.map (\v -> (getID v, v))
  {-# INLINEABLE fromList #-}
  
  fromListWith :: (HasID' a) => (a -> a -> a) -> [a] -> SnowflakeMap a
  fromListWith f = SnowflakeMap . SH.fromListWith f . Prelude.map (\v -> (getID v, v))
  {-# INLINEABLE 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
    toJSON = toJSON . elems
    toEncoding = toEncoding . elems
  