module Polysemy.Reader.Compact where

import           Polysemy
import           Polysemy.Reader

import           GHC.Compact

-----------------------------------------------------------------------------
-- | Run a 'Reader' effect by compacting a value; otherwise behaves as normal.
-- Useful for 'Reader' effects which provide a large structure.
runReaderWithCompacted
    :: forall r i a
     . Member (Embed IO) r
    => i
    -> Sem (Reader i ': r) a
    -> Sem r a
runReaderWithCompacted :: i -> Sem (Reader i : r) a -> Sem r a
runReaderWithCompacted i
i Sem (Reader i : r) a
sem = do
    Compact i
compacted <- IO (Compact i) -> Sem r (Compact i)
forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
embed (i -> IO (Compact i)
forall a. a -> IO (Compact a)
compactWithSharing i
i)
    Compact i -> Sem (Reader i : r) a -> Sem r a
forall (r :: EffectRow) i a.
Member (Embed IO) r =>
Compact i -> Sem (Reader i : r) a -> Sem r a
runReaderWithExistingCompacted Compact i
compacted Sem (Reader i : r) a
sem
{-# INLINE runReaderWithCompacted #-}

-----------------------------------------------------------------------------
-- | Run a 'Reader' effect with a value in a compact region. Will not add 
-- 'local' values to the existing region, but will create a new region for it.
runReaderWithExistingCompacted
    :: forall r i a
     . Member (Embed IO) r
    => Compact i
    -> Sem (Reader i ': r) a
    -> Sem r a
runReaderWithExistingCompacted :: Compact i -> Sem (Reader i : r) a -> Sem r a
runReaderWithExistingCompacted Compact i
i = (forall (rInitial :: EffectRow) x.
 Reader i (Sem rInitial) x
 -> Tactical (Reader i) (Sem rInitial) r x)
-> Sem (Reader i : r) a -> Sem r a
forall (e :: (* -> *) -> * -> *) (r :: EffectRow) a.
(forall (rInitial :: EffectRow) x.
 e (Sem rInitial) x -> Tactical e (Sem rInitial) r x)
-> Sem (e : r) a -> Sem r a
interpretH ((forall (rInitial :: EffectRow) x.
  Reader i (Sem rInitial) x
  -> Tactical (Reader i) (Sem rInitial) r x)
 -> Sem (Reader i : r) a -> Sem r a)
-> (forall (rInitial :: EffectRow) x.
    Reader i (Sem rInitial) x
    -> Tactical (Reader i) (Sem rInitial) r x)
-> Sem (Reader i : r) a
-> Sem r a
forall a b. (a -> b) -> a -> b
$ \case
    Reader i (Sem rInitial) x
Ask       -> i -> Sem (WithTactics (Reader i) f (Sem rInitial) r) (f i)
forall (f :: * -> *) a (e :: (* -> *) -> * -> *) (m :: * -> *)
       (r :: EffectRow).
Functor f =>
a -> Sem (WithTactics e f m r) (f a)
pureT (Compact i -> i
forall a. Compact a -> a
getCompact Compact i
i)
    Local f m -> do
        Sem (Reader i : r) (f x)
mm <- Sem rInitial x
-> Sem
     (WithTactics (Reader i) f (Sem rInitial) r)
     (Sem (Reader i : r) (f x))
forall (m :: * -> *) a (e :: (* -> *) -> * -> *) (f :: * -> *)
       (r :: EffectRow).
m a -> Sem (WithTactics e f m r) (Sem (e : r) (f a))
runT Sem rInitial x
m
        let transformed :: i
transformed = i -> i
f (Compact i -> i
forall a. Compact a -> a
getCompact Compact i
i)
        Sem r (f x)
-> Sem (WithTactics (Reader i) f (Sem rInitial) r) (f x)
forall (e :: (* -> *) -> * -> *) (r :: EffectRow) a.
Sem r a -> Sem (e : r) a
raise (Sem r (f x)
 -> Sem (WithTactics (Reader i) f (Sem rInitial) r) (f x))
-> Sem r (f x)
-> Sem (WithTactics (Reader i) f (Sem rInitial) r) (f x)
forall a b. (a -> b) -> a -> b
$ i -> Sem (Reader i : r) (f x) -> Sem r (f x)
forall (r :: EffectRow) i a.
Member (Embed IO) r =>
i -> Sem (Reader i : r) a -> Sem r a
runReaderWithCompacted i
transformed Sem (Reader i : r) (f x)
mm
{-# INLINE runReaderWithExistingCompacted #-}