{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Data.Record.Internal.GHC.Fresh (
MonadFresh(..)
, runFreshHsc
) where
import Control.Monad.Reader
import Data.Record.Internal.GHC.Shim
class Monad m => MonadFresh m where
freshName :: LRdrName -> m LRdrName
freshName = forall (m :: Type -> Type).
MonadFresh m =>
Bool -> LRdrName -> m LRdrName
freshName' Bool
True
freshName' :: Bool -> LRdrName -> m LRdrName
newtype Fresh a = WrapFresh { forall a. Fresh a -> ReaderT NameCacheIO IO a
unwrapFresh :: ReaderT NameCacheIO IO a }
deriving newtype (forall a b. a -> Fresh b -> Fresh a
forall a b. (a -> b) -> Fresh a -> Fresh b
forall (f :: Type -> Type).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Fresh b -> Fresh a
$c<$ :: forall a b. a -> Fresh b -> Fresh a
fmap :: forall a b. (a -> b) -> Fresh a -> Fresh b
$cfmap :: forall a b. (a -> b) -> Fresh a -> Fresh b
Functor, Functor Fresh
forall a. a -> Fresh a
forall a b. Fresh a -> Fresh b -> Fresh a
forall a b. Fresh a -> Fresh b -> Fresh b
forall a b. Fresh (a -> b) -> Fresh a -> Fresh b
forall a b c. (a -> b -> c) -> Fresh a -> Fresh b -> Fresh c
forall (f :: Type -> Type).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b. Fresh a -> Fresh b -> Fresh a
$c<* :: forall a b. Fresh a -> Fresh b -> Fresh a
*> :: forall a b. Fresh a -> Fresh b -> Fresh b
$c*> :: forall a b. Fresh a -> Fresh b -> Fresh b
liftA2 :: forall a b c. (a -> b -> c) -> Fresh a -> Fresh b -> Fresh c
$cliftA2 :: forall a b c. (a -> b -> c) -> Fresh a -> Fresh b -> Fresh c
<*> :: forall a b. Fresh (a -> b) -> Fresh a -> Fresh b
$c<*> :: forall a b. Fresh (a -> b) -> Fresh a -> Fresh b
pure :: forall a. a -> Fresh a
$cpure :: forall a. a -> Fresh a
Applicative, Applicative Fresh
forall a. a -> Fresh a
forall a b. Fresh a -> Fresh b -> Fresh b
forall a b. Fresh a -> (a -> Fresh b) -> Fresh b
forall (m :: Type -> Type).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> Fresh a
$creturn :: forall a. a -> Fresh a
>> :: forall a b. Fresh a -> Fresh b -> Fresh b
$c>> :: forall a b. Fresh a -> Fresh b -> Fresh b
>>= :: forall a b. Fresh a -> (a -> Fresh b) -> Fresh b
$c>>= :: forall a b. Fresh a -> (a -> Fresh b) -> Fresh b
Monad)
instance MonadFresh Fresh where
freshName' :: Bool -> LRdrName -> Fresh LRdrName
freshName' Bool
pfx (L SrcSpan
l RdrName
name) = forall a. ReaderT NameCacheIO IO a -> Fresh a
WrapFresh forall a b. (a -> b) -> a -> b
$ forall r (m :: Type -> Type) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \NameCacheIO
nc -> do
Unique
newUniq <- NameCacheIO -> IO Unique
takeUniqFromNameCacheIO NameCacheIO
nc
forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall l e. l -> e -> GenLocated l e
L SrcSpan
l forall a b. (a -> b) -> a -> b
$ Name -> RdrName
Exact forall a b. (a -> b) -> a -> b
$
Unique -> OccName -> SrcSpan -> Name
mkInternalName Unique
newUniq (OccName -> OccName
newOccName (RdrName -> OccName
rdrNameOcc RdrName
name)) SrcSpan
l
where
newOccName :: OccName -> OccName
newOccName :: OccName -> OccName
newOccName OccName
n = NameSpace -> String -> OccName
mkOccName (OccName -> NameSpace
occNameSpace OccName
n) forall a b. (a -> b) -> a -> b
$ String -> String
addPrefix forall a b. (a -> b) -> a -> b
$ OccName -> String
occNameString OccName
n
addPrefix :: String -> String
addPrefix :: String -> String
addPrefix = if Bool
pfx then (String
"_" forall a. [a] -> [a] -> [a]
++) else forall a. a -> a
id
runFresh :: Fresh a -> NameCacheIO -> IO a
runFresh :: forall a. Fresh a -> NameCacheIO -> IO a
runFresh = forall r (m :: Type -> Type) a. ReaderT r m a -> r -> m a
runReaderT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Fresh a -> ReaderT NameCacheIO IO a
unwrapFresh
runFreshHsc :: Fresh a -> Hsc a
runFreshHsc :: forall a. Fresh a -> Hsc a
runFreshHsc Fresh a
fa = do
HscEnv
env <- Hsc HscEnv
getHscEnv
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. Fresh a -> NameCacheIO -> IO a
runFresh Fresh a
fa (HscEnv -> NameCacheIO
hscNameCacheIO HscEnv
env)