{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE UnboxedTuples #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
-- |
-- Module      : Data.Prim.StableName
-- Copyright   : (c) Alexey Kuleshevich 2020
-- License     : BSD3
-- Maintainer  : Alexey Kuleshevich <alexey@kuleshevi.ch>
-- Stability   : experimental
-- Portability : non-portable
--
module Data.Prim.StableName
  ( StableName(..)
  , makeStableName
  , makeAnyStableName
  , hashStableName
  , eqStableName
  ) where

import Control.Prim.Monad
import GHC.Exts
#if MIN_VERSION_base(4,12,0)
import GHC.StableName (StableName(..), eqStableName, hashStableName)

-- | Orphan instance defined in "Data.Prim.StableName"
instance Show (StableName a) where
  showsPrec :: Int -> StableName a -> ShowS
showsPrec = Int -> StableName a -> ShowS
forall a. Int -> StableName a -> ShowS
showPrecStableName

#else

-- | For compatibility with newer ghc versions this is a redifined version of
-- `System.Mem.StableName.StableName`. Prior to @base-4.12.0.0@ constructor was not
-- exported, hence this definition, starting with GHC-8.6 @StableName@ is re-exported from
-- @GHC.StableName@
data StableName a = StableName (StableName# a)

instance Eq (StableName a) where
  (==) = eqStableName

instance Show (StableName a) where
  showsPrec = showPrecStableName

-- | Convert a 'StableName' to an 'Int'.  The 'Int' returned is not
-- necessarily unique; several 'StableName's may map to the same 'Int'
-- (in practice however, the chances of this are small, so the result
-- of 'hashStableName' makes a good hash key).
hashStableName :: StableName a -> Int
hashStableName (StableName sn) = I# (stableNameToInt# sn)

-- | Equality on 'StableName' that does not require that the types of
-- the arguments match.
--
-- @since 0.1.0
eqStableName :: StableName a -> StableName b -> Bool
eqStableName (StableName sn1) (StableName sn2) =
  case eqStableName# sn1 sn2 of
    0# -> False
    _  -> True
#endif

showPrecStableName :: Int -> StableName a -> ShowS
showPrecStableName :: Int -> StableName a -> ShowS
showPrecStableName Int
n StableName a
sname =
  case Int
n of
    Int
0 -> ShowS
inner
    Int
_ -> (Char
'(' Char -> ShowS
forall a. a -> [a] -> [a]
:) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
inner ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
')' Char -> ShowS
forall a. a -> [a] -> [a]
:)
  where
    inner :: ShowS
inner = (String
"StableName " String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall a. Show a => a -> ShowS
shows (StableName a -> Int
forall a. StableName a -> Int
hashStableName StableName a
sname)

-- | Makes a 'StableName' for an arbitrary object.  The object passed as
-- the first argument is not evaluated by 'makeStableName'.
makeStableName :: MonadPrim RW m => a -> m (StableName a)
makeStableName :: a -> m (StableName a)
makeStableName a
a =
  (State# RealWorld -> (# State# RealWorld, StableName a #))
-> m (StableName a)
forall s (m :: * -> *) a.
MonadPrim s m =>
(State# s -> (# State# s, a #)) -> m a
prim ((State# RealWorld -> (# State# RealWorld, StableName a #))
 -> m (StableName a))
-> (State# RealWorld -> (# State# RealWorld, StableName a #))
-> m (StableName a)
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s ->
    case a -> State# RealWorld -> (# State# RealWorld, StableName# a #)
forall a.
a -> State# RealWorld -> (# State# RealWorld, StableName# a #)
makeStableName# a
a State# RealWorld
s of
      (# State# RealWorld
s', StableName# a
sn #) -> (# State# RealWorld
s', StableName# a -> StableName a
forall a. StableName# a -> StableName a
StableName StableName# a
sn #)

-- | Similar to
-- [`makeDynamicStableName`](http://hackage.haskell.org/package/stable-maps/docs/System-Mem-StableName-Dynamic.html),
-- but returns `StableName` `Any` and is generalized to `MonadPrim`
makeAnyStableName :: MonadPrim RW m => a -> m (StableName Any)
makeAnyStableName :: a -> m (StableName Any)
makeAnyStableName a
a =
  (State# RealWorld -> (# State# RealWorld, StableName Any #))
-> m (StableName Any)
forall s (m :: * -> *) a.
MonadPrim s m =>
(State# s -> (# State# s, a #)) -> m a
prim ((State# RealWorld -> (# State# RealWorld, StableName Any #))
 -> m (StableName Any))
-> (State# RealWorld -> (# State# RealWorld, StableName Any #))
-> m (StableName Any)
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s ->
    case a -> State# RealWorld -> (# State# RealWorld, StableName# a #)
forall a.
a -> State# RealWorld -> (# State# RealWorld, StableName# a #)
makeStableName# a
a State# RealWorld
s of
      (# State# RealWorld
s', StableName# a
sn# #) -> (# State# RealWorld
s', StableName# Any -> StableName Any
forall a. StableName# a -> StableName a
StableName (StableName# a -> StableName# Any
unsafeCoerce# StableName# a
sn#) #)