{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
module Data.Registry.Rio
( module Data.Registry.Rio,
singleton,
cacheAt
)
where
import Control.Monad.Morph
import Control.Monad.Trans.Resource
import Data.Dynamic
import Data.Registry.Internal.Cache
import Data.Registry.Make (make)
import Data.Registry.Registry
import Protolude
newtype Rio a = Rio {forall a. Rio a -> ReaderT Cache (ResourceT IO) a
rioRun :: ReaderT Cache (ResourceT IO) a}
deriving (forall a b. a -> Rio b -> Rio a
forall a b. (a -> b) -> Rio a -> Rio b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Rio b -> Rio a
$c<$ :: forall a b. a -> Rio b -> Rio a
fmap :: forall a b. (a -> b) -> Rio a -> Rio b
$cfmap :: forall a b. (a -> b) -> Rio a -> Rio b
Functor, Functor Rio
forall a. a -> Rio a
forall a b. Rio a -> Rio b -> Rio a
forall a b. Rio a -> Rio b -> Rio b
forall a b. Rio (a -> b) -> Rio a -> Rio b
forall a b c. (a -> b -> c) -> Rio a -> Rio b -> Rio c
forall (f :: * -> *).
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. Rio a -> Rio b -> Rio a
$c<* :: forall a b. Rio a -> Rio b -> Rio a
*> :: forall a b. Rio a -> Rio b -> Rio b
$c*> :: forall a b. Rio a -> Rio b -> Rio b
liftA2 :: forall a b c. (a -> b -> c) -> Rio a -> Rio b -> Rio c
$cliftA2 :: forall a b c. (a -> b -> c) -> Rio a -> Rio b -> Rio c
<*> :: forall a b. Rio (a -> b) -> Rio a -> Rio b
$c<*> :: forall a b. Rio (a -> b) -> Rio a -> Rio b
pure :: forall a. a -> Rio a
$cpure :: forall a. a -> Rio a
Applicative, Applicative Rio
forall a. a -> Rio a
forall a b. Rio a -> Rio b -> Rio b
forall a b. Rio a -> (a -> Rio b) -> Rio b
forall (m :: * -> *).
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 -> Rio a
$creturn :: forall a. a -> Rio a
>> :: forall a b. Rio a -> Rio b -> Rio b
$c>> :: forall a b. Rio a -> Rio b -> Rio b
>>= :: forall a b. Rio a -> (a -> Rio b) -> Rio b
$c>>= :: forall a b. Rio a -> (a -> Rio b) -> Rio b
Monad, MonadReader Cache, Monad Rio
forall a. IO a -> Rio a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: forall a. IO a -> Rio a
$cliftIO :: forall a. IO a -> Rio a
MonadIO, MonadIO Rio
forall a. ResourceT IO a -> Rio a
forall (m :: * -> *).
MonadIO m -> (forall a. ResourceT IO a -> m a) -> MonadResource m
liftResourceT :: forall a. ResourceT IO a -> Rio a
$cliftResourceT :: forall a. ResourceT IO a -> Rio a
MonadResource, MonadIO Rio
forall b. ((forall a. Rio a -> IO a) -> IO b) -> Rio b
forall (m :: * -> *).
MonadIO m
-> (forall b. ((forall a. m a -> IO a) -> IO b) -> m b)
-> MonadUnliftIO m
withRunInIO :: forall b. ((forall a. Rio a -> IO a) -> IO b) -> Rio b
$cwithRunInIO :: forall b. ((forall a. Rio a -> IO a) -> IO b) -> Rio b
MonadUnliftIO)
runRio :: MonadIO m => Rio a -> m a
runRio :: forall (m :: * -> *) a. MonadIO m => Rio a -> m a
runRio = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadUnliftIO m => ResourceT m a -> m a
runResourceT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Rio a -> ResourceT IO a
runCache
execRio :: MonadIO m => Rio a -> m (a, Cache)
execRio :: forall (m :: * -> *) a. MonadIO m => Rio a -> m (a, Cache)
execRio = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadUnliftIO m => ResourceT m a -> m a
runResourceT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Rio a -> ResourceT IO (a, Cache)
execCache
withRio :: MonadIO m => Rio a -> (a -> IO b) -> m b
withRio :: forall (m :: * -> *) a b. MonadIO m => Rio a -> (a -> IO b) -> m b
withRio Rio a
action a -> IO b
f = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadUnliftIO m => ResourceT m a -> m a
runResourceT forall a b. (a -> b) -> a -> b
$ do
a
a <- forall a. Rio a -> ResourceT IO a
runCache Rio a
action
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ a -> IO b
f a
a
withRioM :: (MonadResource (m (ResourceT IO)), MFunctor m) => Rio a -> (a -> m IO b) -> m IO b
withRioM :: forall (m :: (* -> *) -> * -> *) a b.
(MonadResource (m (ResourceT IO)), MFunctor m) =>
Rio a -> (a -> m IO b) -> m IO b
withRioM Rio a
action a -> m IO b
f = forall {k} (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
(b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
hoist forall (m :: * -> *) a. MonadUnliftIO m => ResourceT m a -> m a
runResourceT forall a b. (a -> b) -> a -> b
$ do
a
a <- forall (m :: * -> *) a. MonadResource m => ResourceT IO a -> m a
liftResourceT (forall a. Rio a -> ResourceT IO a
runCache Rio a
action)
forall {k} (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
(b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
hoist forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (a -> m IO b
f a
a)
runCache :: Rio a -> ResourceT IO a
runCache :: forall a. Rio a -> ResourceT IO a
runCache (Rio ReaderT Cache (ResourceT IO) a
action) = do
Cache
cache <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall (m :: * -> *). MonadIO m => m Cache
newCache
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT Cache (ResourceT IO) a
action Cache
cache
execCache :: Rio a -> ResourceT IO (a, Cache)
execCache :: forall a. Rio a -> ResourceT IO (a, Cache)
execCache (Rio ReaderT Cache (ResourceT IO) a
action) = do
Cache
cache <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall (m :: * -> *). MonadIO m => m Cache
newCache
(,Cache
cache) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT Cache (ResourceT IO) a
action Cache
cache
liftRio :: ResourceT IO a -> Rio a
liftRio :: forall a. ResourceT IO a -> Rio a
liftRio = forall a. ReaderT Cache (ResourceT IO) a -> Rio a
Rio forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift
withRegistry :: forall a b ins out m. (Typeable a, MonadIO m, MakeSingletons out) => Registry ins out -> (a -> IO b) -> m b
withRegistry :: forall a b (ins :: [*]) (out :: [*]) (m :: * -> *).
(Typeable a, MonadIO m, MakeSingletons out) =>
Registry ins out -> (a -> IO b) -> m b
withRegistry Registry ins out
registry a -> IO b
f =
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadUnliftIO m => ResourceT m a -> m a
runResourceT (forall a (ins :: [*]) (out :: [*]).
(Typeable a, MakeSingletons out) =>
Registry ins out -> ResourceT IO a
runRegistryT @a Registry ins out
registry forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> IO b
f)
withRegistryM ::
forall a b ins out m.
(Typeable a, MonadResource (m (ResourceT IO)), MFunctor m, MakeSingletons out) =>
Registry ins out ->
(a -> m IO b) ->
m IO b
withRegistryM :: forall a b (ins :: [*]) (out :: [*]) (m :: (* -> *) -> * -> *).
(Typeable a, MonadResource (m (ResourceT IO)), MFunctor m,
MakeSingletons out) =>
Registry ins out -> (a -> m IO b) -> m IO b
withRegistryM = forall (m :: (* -> *) -> * -> *) a b.
(MonadResource (m (ResourceT IO)), MFunctor m) =>
Rio a -> (a -> m IO b) -> m IO b
withRioM forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (ins :: [*]) (out :: [*]).
Typeable a =>
Registry ins out -> a
make @(Rio a) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (ins :: [*]) (out :: [*]).
MakeSingletons out =>
Registry ins out -> Registry ins out
singletons
runRegistryT :: forall a ins out. (Typeable a, MakeSingletons out) => Registry ins out -> ResourceT IO a
runRegistryT :: forall a (ins :: [*]) (out :: [*]).
(Typeable a, MakeSingletons out) =>
Registry ins out -> ResourceT IO a
runRegistryT = forall a. Rio a -> ResourceT IO a
runCache forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (ins :: [*]) (out :: [*]).
Typeable a =>
Registry ins out -> a
make @(Rio a) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (ins :: [*]) (out :: [*]).
MakeSingletons out =>
Registry ins out -> Registry ins out
singletons
singletons :: forall ins out. (MakeSingletons out) => Registry ins out -> Registry ins out
singletons :: forall (ins :: [*]) (out :: [*]).
MakeSingletons out =>
Registry ins out -> Registry ins out
singletons Registry ins out
r = forall (todo :: [*]) (ins :: [*]) (out :: [*]).
SingletonsRegistry todo ins out -> Registry ins out
_singletonsRegistry forall a b. (a -> b) -> a -> b
$ forall (ls :: [*]) (ins :: [*]) (out :: [*]).
MakeSingletons ls =>
SingletonsRegistry ls ins out -> SingletonsRegistry '[] ins out
makeSingletons (forall (ins :: [*]) (out :: [*]).
Registry ins out -> SingletonsRegistry out ins out
startSingletonsRegistry Registry ins out
r)
newtype SingletonsRegistry (todo :: [Type]) (ins :: [Type]) (out :: [Type]) = SingletonsRegistry {forall (todo :: [*]) (ins :: [*]) (out :: [*]).
SingletonsRegistry todo ins out -> Registry ins out
_singletonsRegistry :: Registry ins out}
startSingletonsRegistry :: Registry ins out -> SingletonsRegistry out ins out
startSingletonsRegistry :: forall (ins :: [*]) (out :: [*]).
Registry ins out -> SingletonsRegistry out ins out
startSingletonsRegistry = forall (todo :: [*]) (ins :: [*]) (out :: [*]).
Registry ins out -> SingletonsRegistry todo ins out
SingletonsRegistry
makeSingletonsRegistry :: forall todo ins out. Registry ins out -> SingletonsRegistry todo ins out
makeSingletonsRegistry :: forall (todo :: [*]) (ins :: [*]) (out :: [*]).
Registry ins out -> SingletonsRegistry todo ins out
makeSingletonsRegistry = forall (todo :: [*]) (ins :: [*]) (out :: [*]).
Registry ins out -> SingletonsRegistry todo ins out
SingletonsRegistry @todo
class MakeSingletons ls where
makeSingletons :: SingletonsRegistry ls ins out -> SingletonsRegistry '[] ins out
instance MakeSingletons '[] where
makeSingletons :: forall (ins :: [*]) (out :: [*]).
SingletonsRegistry '[] ins out -> SingletonsRegistry '[] ins out
makeSingletons = forall a. a -> a
identity
instance {-# OVERLAPPING #-} (Typeable a, MakeSingletons rest) => MakeSingletons (Rio a : rest) where
makeSingletons :: forall (ins :: [*]) (out :: [*]).
SingletonsRegistry (Rio a : rest) ins out
-> SingletonsRegistry '[] ins out
makeSingletons (SingletonsRegistry Registry ins out
r) =
forall (ls :: [*]) (ins :: [*]) (out :: [*]).
MakeSingletons ls =>
SingletonsRegistry ls ins out -> SingletonsRegistry '[] ins out
makeSingletons forall a b. (a -> b) -> a -> b
$ forall (todo :: [*]) (ins :: [*]) (out :: [*]).
Registry ins out -> SingletonsRegistry todo ins out
SingletonsRegistry @rest (forall a (ins :: [*]) (out :: [*]).
Typeable a =>
(a -> a) -> Registry ins out -> Registry ins out
tweakUnspecialized @(Rio a) forall a (m :: * -> *).
(Typeable a, MonadIO m, MonadReader Cache m) =>
m a -> m a
singleton Registry ins out
r)
instance (MakeSingletons rest) => MakeSingletons (a : rest) where
makeSingletons :: forall (ins :: [*]) (out :: [*]).
SingletonsRegistry (a : rest) ins out
-> SingletonsRegistry '[] ins out
makeSingletons (SingletonsRegistry Registry ins out
r) = forall (ls :: [*]) (ins :: [*]) (out :: [*]).
MakeSingletons ls =>
SingletonsRegistry ls ins out -> SingletonsRegistry '[] ins out
makeSingletons (forall (todo :: [*]) (ins :: [*]) (out :: [*]).
Registry ins out -> SingletonsRegistry todo ins out
makeSingletonsRegistry @rest Registry ins out
r)