-- | The snowflake type
module Calamity.Types.Snowflake (
  Snowflake (..),
  HasID (..),
  type HasID',
  HasIDField (..),
  HasIDFieldCoerce (..),
  type HasIDFieldCoerce',
  coerceSnowflake,
) where

import Data.Aeson
import Data.Bits
import Data.Data
import Data.Hashable
import Data.Kind
import Data.Text.Read
import Data.Vector.Unboxing qualified as U
import Data.Word
import GHC.Records (HasField (getField))
import TextShow
import Web.HttpApiData (ToHttpApiData)

-- Thanks sbrg
-- https://github.com/saevarb/haskord/blob/d1bb07bcc4f3dbc29f2dfd3351ff9f16fc100c07/haskord-lib/src/Haskord/Types/Common.hs#L78
newtype Snowflake (t :: Type) = Snowflake
  { forall t. Snowflake t -> Word64
fromSnowflake :: Word64
  }
  deriving stock (Snowflake t -> Snowflake t -> Bool
(Snowflake t -> Snowflake t -> Bool)
-> (Snowflake t -> Snowflake t -> Bool) -> Eq (Snowflake t)
forall t. Snowflake t -> Snowflake t -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall t. Snowflake t -> Snowflake t -> Bool
== :: Snowflake t -> Snowflake t -> Bool
$c/= :: forall t. Snowflake t -> Snowflake t -> Bool
/= :: Snowflake t -> Snowflake t -> Bool
Eq, Eq (Snowflake t)
Eq (Snowflake t)
-> (Snowflake t -> Snowflake t -> Ordering)
-> (Snowflake t -> Snowflake t -> Bool)
-> (Snowflake t -> Snowflake t -> Bool)
-> (Snowflake t -> Snowflake t -> Bool)
-> (Snowflake t -> Snowflake t -> Bool)
-> (Snowflake t -> Snowflake t -> Snowflake t)
-> (Snowflake t -> Snowflake t -> Snowflake t)
-> Ord (Snowflake t)
Snowflake t -> Snowflake t -> Bool
Snowflake t -> Snowflake t -> Ordering
Snowflake t -> Snowflake t -> Snowflake t
forall t. Eq (Snowflake t)
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall t. Snowflake t -> Snowflake t -> Bool
forall t. Snowflake t -> Snowflake t -> Ordering
forall t. Snowflake t -> Snowflake t -> Snowflake t
$ccompare :: forall t. Snowflake t -> Snowflake t -> Ordering
compare :: Snowflake t -> Snowflake t -> Ordering
$c< :: forall t. Snowflake t -> Snowflake t -> Bool
< :: Snowflake t -> Snowflake t -> Bool
$c<= :: forall t. Snowflake t -> Snowflake t -> Bool
<= :: Snowflake t -> Snowflake t -> Bool
$c> :: forall t. Snowflake t -> Snowflake t -> Bool
> :: Snowflake t -> Snowflake t -> Bool
$c>= :: forall t. Snowflake t -> Snowflake t -> Bool
>= :: Snowflake t -> Snowflake t -> Bool
$cmax :: forall t. Snowflake t -> Snowflake t -> Snowflake t
max :: Snowflake t -> Snowflake t -> Snowflake t
$cmin :: forall t. Snowflake t -> Snowflake t -> Snowflake t
min :: Snowflake t -> Snowflake t -> Snowflake t
Ord, Typeable (Snowflake t)
Typeable (Snowflake t)
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Snowflake t -> c (Snowflake t))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (Snowflake t))
-> (Snowflake t -> Constr)
-> (Snowflake t -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (Snowflake t)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (Snowflake t)))
-> ((forall b. Data b => b -> b) -> Snowflake t -> Snowflake t)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Snowflake t -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Snowflake t -> r)
-> (forall u. (forall d. Data d => d -> u) -> Snowflake t -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> Snowflake t -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Snowflake t -> m (Snowflake t))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Snowflake t -> m (Snowflake t))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Snowflake t -> m (Snowflake t))
-> Data (Snowflake t)
Snowflake t -> Constr
Snowflake t -> DataType
(forall b. Data b => b -> b) -> Snowflake t -> Snowflake t
forall {t}. Data t => Typeable (Snowflake t)
forall t. Data t => Snowflake t -> Constr
forall t. Data t => Snowflake t -> DataType
forall t.
Data t =>
(forall b. Data b => b -> b) -> Snowflake t -> Snowflake t
forall t u.
Data t =>
Int -> (forall d. Data d => d -> u) -> Snowflake t -> u
forall t u.
Data t =>
(forall d. Data d => d -> u) -> Snowflake t -> [u]
forall t r r'.
Data t =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Snowflake t -> r
forall t r r'.
Data t =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Snowflake t -> r
forall t (m :: * -> *).
(Data t, Monad m) =>
(forall d. Data d => d -> m d) -> Snowflake t -> m (Snowflake t)
forall t (m :: * -> *).
(Data t, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Snowflake t -> m (Snowflake t)
forall t (c :: * -> *).
Data t =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Snowflake t)
forall t (c :: * -> *).
Data t =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Snowflake t -> c (Snowflake t)
forall t (t :: * -> *) (c :: * -> *).
(Data t, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Snowflake t))
forall t (t :: * -> * -> *) (c :: * -> *).
(Data t, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Snowflake t))
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Snowflake t -> u
forall u. (forall d. Data d => d -> u) -> Snowflake t -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Snowflake t -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Snowflake t -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Snowflake t -> m (Snowflake t)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Snowflake t -> m (Snowflake t)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Snowflake t)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Snowflake t -> c (Snowflake t)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Snowflake t))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Snowflake t))
$cgfoldl :: forall t (c :: * -> *).
Data t =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Snowflake t -> c (Snowflake t)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Snowflake t -> c (Snowflake t)
$cgunfold :: forall t (c :: * -> *).
Data t =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Snowflake t)
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Snowflake t)
$ctoConstr :: forall t. Data t => Snowflake t -> Constr
toConstr :: Snowflake t -> Constr
$cdataTypeOf :: forall t. Data t => Snowflake t -> DataType
dataTypeOf :: Snowflake t -> DataType
$cdataCast1 :: forall t (t :: * -> *) (c :: * -> *).
(Data t, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Snowflake t))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Snowflake t))
$cdataCast2 :: forall t (t :: * -> * -> *) (c :: * -> *).
(Data t, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Snowflake t))
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Snowflake t))
$cgmapT :: forall t.
Data t =>
(forall b. Data b => b -> b) -> Snowflake t -> Snowflake t
gmapT :: (forall b. Data b => b -> b) -> Snowflake t -> Snowflake t
$cgmapQl :: forall t r r'.
Data t =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Snowflake t -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Snowflake t -> r
$cgmapQr :: forall t r r'.
Data t =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Snowflake t -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Snowflake t -> r
$cgmapQ :: forall t u.
Data t =>
(forall d. Data d => d -> u) -> Snowflake t -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Snowflake t -> [u]
$cgmapQi :: forall t u.
Data t =>
Int -> (forall d. Data d => d -> u) -> Snowflake t -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Snowflake t -> u
$cgmapM :: forall t (m :: * -> *).
(Data t, Monad m) =>
(forall d. Data d => d -> m d) -> Snowflake t -> m (Snowflake t)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Snowflake t -> m (Snowflake t)
$cgmapMp :: forall t (m :: * -> *).
(Data t, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Snowflake t -> m (Snowflake t)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Snowflake t -> m (Snowflake t)
$cgmapMo :: forall t (m :: * -> *).
(Data t, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Snowflake t -> m (Snowflake t)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Snowflake t -> m (Snowflake t)
Data)
  deriving newtype (Int -> Snowflake t -> ShowS
[Snowflake t] -> ShowS
Snowflake t -> String
(Int -> Snowflake t -> ShowS)
-> (Snowflake t -> String)
-> ([Snowflake t] -> ShowS)
-> Show (Snowflake t)
forall t. Int -> Snowflake t -> ShowS
forall t. [Snowflake t] -> ShowS
forall t. Snowflake t -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall t. Int -> Snowflake t -> ShowS
showsPrec :: Int -> Snowflake t -> ShowS
$cshow :: forall t. Snowflake t -> String
show :: Snowflake t -> String
$cshowList :: forall t. [Snowflake t] -> ShowS
showList :: [Snowflake t] -> ShowS
Show, Int -> Snowflake t -> Text
Int -> Snowflake t -> Builder
Int -> Snowflake t -> Text
[Snowflake t] -> Text
[Snowflake t] -> Builder
[Snowflake t] -> Text
Snowflake t -> Text
Snowflake t -> Builder
Snowflake t -> Text
(Int -> Snowflake t -> Builder)
-> (Snowflake t -> Builder)
-> ([Snowflake t] -> Builder)
-> (Int -> Snowflake t -> Text)
-> (Snowflake t -> Text)
-> ([Snowflake t] -> Text)
-> (Int -> Snowflake t -> Text)
-> (Snowflake t -> Text)
-> ([Snowflake t] -> Text)
-> TextShow (Snowflake t)
forall t. Int -> Snowflake t -> Text
forall t. Int -> Snowflake t -> Builder
forall t. Int -> Snowflake t -> Text
forall t. [Snowflake t] -> Text
forall t. [Snowflake t] -> Builder
forall t. [Snowflake t] -> Text
forall t. Snowflake t -> Text
forall t. Snowflake t -> Builder
forall t. Snowflake t -> Text
forall a.
(Int -> a -> Builder)
-> (a -> Builder)
-> ([a] -> Builder)
-> (Int -> a -> Text)
-> (a -> Text)
-> ([a] -> Text)
-> (Int -> a -> Text)
-> (a -> Text)
-> ([a] -> Text)
-> TextShow a
$cshowbPrec :: forall t. Int -> Snowflake t -> Builder
showbPrec :: Int -> Snowflake t -> Builder
$cshowb :: forall t. Snowflake t -> Builder
showb :: Snowflake t -> Builder
$cshowbList :: forall t. [Snowflake t] -> Builder
showbList :: [Snowflake t] -> Builder
$cshowtPrec :: forall t. Int -> Snowflake t -> Text
showtPrec :: Int -> Snowflake t -> Text
$cshowt :: forall t. Snowflake t -> Text
showt :: Snowflake t -> Text
$cshowtList :: forall t. [Snowflake t] -> Text
showtList :: [Snowflake t] -> Text
$cshowtlPrec :: forall t. Int -> Snowflake t -> Text
showtlPrec :: Int -> Snowflake t -> Text
$cshowtl :: forall t. Snowflake t -> Text
showtl :: Snowflake t -> Text
$cshowtlList :: forall t. [Snowflake t] -> Text
showtlList :: [Snowflake t] -> Text
TextShow, FromJSONKeyFunction [Snowflake t]
FromJSONKeyFunction (Snowflake t)
FromJSONKeyFunction (Snowflake t)
-> FromJSONKeyFunction [Snowflake t] -> FromJSONKey (Snowflake t)
forall t. FromJSONKeyFunction [Snowflake t]
forall t. FromJSONKeyFunction (Snowflake t)
forall a.
FromJSONKeyFunction a -> FromJSONKeyFunction [a] -> FromJSONKey a
$cfromJSONKey :: forall t. FromJSONKeyFunction (Snowflake t)
fromJSONKey :: FromJSONKeyFunction (Snowflake t)
$cfromJSONKeyList :: forall t. FromJSONKeyFunction [Snowflake t]
fromJSONKeyList :: FromJSONKeyFunction [Snowflake t]
FromJSONKey)
  deriving newtype (ToJSONKeyFunction [Snowflake t]
ToJSONKeyFunction (Snowflake t)
ToJSONKeyFunction (Snowflake t)
-> ToJSONKeyFunction [Snowflake t] -> ToJSONKey (Snowflake t)
forall t. ToJSONKeyFunction [Snowflake t]
forall t. ToJSONKeyFunction (Snowflake t)
forall a.
ToJSONKeyFunction a -> ToJSONKeyFunction [a] -> ToJSONKey a
$ctoJSONKey :: forall t. ToJSONKeyFunction (Snowflake t)
toJSONKey :: ToJSONKeyFunction (Snowflake t)
$ctoJSONKeyList :: forall t. ToJSONKeyFunction [Snowflake t]
toJSONKeyList :: ToJSONKeyFunction [Snowflake t]
ToJSONKey, Unbox (Rep (Snowflake t))
Unbox (Rep (Snowflake t))
-> (Snowflake t -> Rep (Snowflake t))
-> (Rep (Snowflake t) -> Snowflake t)
-> Unboxable (Snowflake t)
Rep (Snowflake t) -> Snowflake t
Snowflake t -> Rep (Snowflake t)
forall {t}. Unbox (Rep (Snowflake t))
forall a.
Unbox (Rep a) -> (a -> Rep a) -> (Rep a -> a) -> Unboxable a
forall t. Rep (Snowflake t) -> Snowflake t
forall t. Snowflake t -> Rep (Snowflake t)
$cunboxingFrom :: forall t. Snowflake t -> Rep (Snowflake t)
unboxingFrom :: Snowflake t -> Rep (Snowflake t)
$cunboxingTo :: forall t. Rep (Snowflake t) -> Snowflake t
unboxingTo :: Rep (Snowflake t) -> Snowflake t
U.Unboxable)
  deriving newtype (Snowflake t -> Text
Snowflake t -> Builder
Snowflake t -> ByteString
(Snowflake t -> Text)
-> (Snowflake t -> Builder)
-> (Snowflake t -> ByteString)
-> (Snowflake t -> Text)
-> ToHttpApiData (Snowflake t)
forall t. Snowflake t -> Text
forall t. Snowflake t -> Builder
forall t. Snowflake t -> ByteString
forall a.
(a -> Text)
-> (a -> Builder)
-> (a -> ByteString)
-> (a -> Text)
-> ToHttpApiData a
$ctoUrlPiece :: forall t. Snowflake t -> Text
toUrlPiece :: Snowflake t -> Text
$ctoEncodedUrlPiece :: forall t. Snowflake t -> Builder
toEncodedUrlPiece :: Snowflake t -> Builder
$ctoHeader :: forall t. Snowflake t -> ByteString
toHeader :: Snowflake t -> ByteString
$ctoQueryParam :: forall t. Snowflake t -> Text
toQueryParam :: Snowflake t -> Text
ToHttpApiData)

-- I'm pretty sure that Word64's hash just being 'fromIntegral' is a bad idea when
-- attempting to use it in a hashmap, so swizzle the bits a bit to give a good
-- distribution of bits
instance Hashable (Snowflake t) where
  hashWithSalt :: Int -> Snowflake t -> Int
hashWithSalt Int
salt (Snowflake Word64
a) =
    let initial :: Word64
initial = forall a b. (Integral a, Num b) => a -> b
fromIntegral @_ @Word64 (Int -> Word64) -> Int -> Word64
forall a b. (a -> b) -> a -> b
$ Int -> Word64 -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
salt Word64
a
        round1 :: Word64
round1 = (Word64
initial Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` Int
30 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`xor` Word64
initial) Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
0xbf58476d1ce4e5b9
        round2 :: Word64
round2 = (Word64
round1 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` Int
27 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`xor` Word64
round1) Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
0xbf58476d1ce4e5b9
        round3 :: Word64
round3 = (Word64
round2 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` Int
31 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`xor` Word64
round2)
     in forall a b. (Integral a, Num b) => a -> b
fromIntegral @_ @Int Word64
round3

instance ToJSON (Snowflake t) where
  toJSON :: Snowflake t -> Value
toJSON (Snowflake Word64
s) = Text -> Value
String (Text -> Value) -> (Word64 -> Text) -> Word64 -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Text
forall a. TextShow a => a -> Text
showt (Word64 -> Value) -> Word64 -> Value
forall a b. (a -> b) -> a -> b
$ Word64
s

instance FromJSON (Snowflake t) where
  parseJSON :: Value -> Parser (Snowflake t)
parseJSON = String
-> (Text -> Parser (Snowflake t)) -> Value -> Parser (Snowflake t)
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"Snowflake" ((Text -> Parser (Snowflake t)) -> Value -> Parser (Snowflake t))
-> (Text -> Parser (Snowflake t)) -> Value -> Parser (Snowflake t)
forall a b. (a -> b) -> a -> b
$ \Text
t -> do
    Word64
n <- case Reader Word64
forall a. Integral a => Reader a
decimal Text
t of
      Right (Word64
n, Text
_) -> Word64 -> Parser Word64
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Word64
n
      Left String
e -> String -> Parser Word64
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
e
    Snowflake t -> Parser (Snowflake t)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Snowflake t -> Parser (Snowflake t))
-> Snowflake t -> Parser (Snowflake t)
forall a b. (a -> b) -> a -> b
$ Word64 -> Snowflake t
forall t. Word64 -> Snowflake t
Snowflake Word64
n

coerceSnowflake :: Snowflake a -> Snowflake b
coerceSnowflake :: forall a b. Snowflake a -> Snowflake b
coerceSnowflake (Snowflake Word64
t) = Word64 -> Snowflake b
forall t. Word64 -> Snowflake t
Snowflake Word64
t

-- | A typeclass for types that contain snowflakes of type `b`
class HasID b a where
  -- | Retrieve the ID from the type
  getID :: a -> Snowflake b

type HasID' a = HasID a a

-- | A newtype wrapper for deriving HasID generically
newtype HasIDField field a = HasIDField a

instance (HasID b c, HasField field a c) => HasID b (HasIDField field a) where
  getID :: HasIDField field a -> Snowflake b
getID (HasIDField a
a) = forall b a. HasID b a => a -> Snowflake b
getID @b @c (c -> Snowflake b) -> c -> Snowflake b
forall a b. (a -> b) -> a -> b
$ forall (x :: k) r a. HasField x r a => r -> a
forall {k} (x :: k) r a. HasField x r a => r -> a
getField @field a
a

{- | A data `a` which contains an ID of type `Snowflake c`
   which should be swapped with `Snowflake b` upon fetching
-}
newtype HasIDFieldCoerce field a c = HasIDFieldCoerce a

type HasIDFieldCoerce' field a = HasIDFieldCoerce field a a

instance (HasID c d, HasField field a d) => HasID b (HasIDFieldCoerce field a c) where
  getID :: HasIDFieldCoerce field a c -> Snowflake b
getID (HasIDFieldCoerce a
a) = Snowflake c -> Snowflake b
forall a b. Snowflake a -> Snowflake b
coerceSnowflake (Snowflake c -> Snowflake b)
-> (d -> Snowflake c) -> d -> Snowflake b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. HasID b a => a -> Snowflake b
getID @c (d -> Snowflake b) -> d -> Snowflake b
forall a b. (a -> b) -> a -> b
$ forall (x :: k) r a. HasField x r a => r -> a
forall {k} (x :: k) r a. HasField x r a => r -> a
getField @field a
a

instance HasID a (Snowflake a) where
  getID :: Snowflake a -> Snowflake a
getID = Snowflake a -> Snowflake a
forall a. a -> a
id