ScopedReader.hs

{-|
Copyright   : (c) Hisaket VioletRed, 2022
License     : AGPL-3.0-or-later
Maintainer  : hisaket@outlook.jp
Stability   : experimental

This module provides a scoped-reader manner.

In contrast to a normal 'Reader' effect, this manner makes connection of parameter type and effect explicit.

Example\:

>>> import Polysemy ( interpret, runM, embed )
>>> import Polysemy.Output ( Output (Output), output, runOutputSem )

>>> :{
runDebug :: Member (Output String) r => String -> InterpreterFor (ScopedReader String (Output String)) r
runDebug = runScopedReader \i -> interpret \(Output o) -> output $ "[" <> i <> "] " <> o
:}

>>> :{
runM $ runOutputSem (embed . putStrLn) $ runDebug "root" do
    scopedReader $ output "test message 0"
    scopedLocal (<> ".scope-A") do
        scopedReader $ output "test message 1"
        scopedReader $ output "test message 2"
        scopedLocal (<> ".scope-B") do
            scopedReader $ output "test message 3"
:}
[root] test message 0
[root.scope-A] test message 1
[root.scope-A] test message 2
[root.scope-A.scope-B] test message 3

-}

{-# LANGUAGE PartialTypeSignatures #-}
{-# OPTIONS_GHC -Wno-partial-type-signatures #-}

module Polysemy.ScopedReader where

import Polysemy
    ( Member, Sem, raise, raiseUnder, InterpreterFor, transform )
import Polysemy.Scoped.Path ( ScopedP, scopedP_local, runScopedP )
import Polysemy.Scoped.Path.Internal ( interpretH' )
import Control.Category ((>>>))
import Polysemy.Internal ( liftSem )
import Polysemy.Internal.Union
    ( ElemOf (Here), Union (Union), Weaving (Weaving) )


scopedLocal
    ::  ∀i p resource effect r
    .   Member (ScopedReader i effect) r
    =>  (i -> i) -> InterpreterFor (ScopedFix i effect) r
scopedLocal f = scopedFix . scopedP_local f () . raiseUnder

scopedReader :: Member (ScopedReader i effect) r => Sem (effect ': r) a -> Sem r a
scopedReader = scopedEffect

type ScopedReader i effect = ScopedFix i effect

runScopedReader :: (i -> InterpreterFor effect r) -> i -> Sem (ScopedReader i effect ': r) a -> Sem r a
runScopedReader int localEnv = 
    interpretH' \(Weaving e s wv ex ins) ->
        let send' :: _ -> Sem (_ ': _) _
            send' e' =
                liftSem $ Union Here
                    $ Weaving e' s (raise . runScopedReader int localEnv . wv) ex ins
        in case e of
            ScopedEffect e' -> int localEnv $ send' e'
            ScopedFix e' ->
                runScopedP (\() inner -> inner localEnv) (runScopedReader int) $ send' e'


data ScopedFixP p resource effect m a where
    ScopedEffect :: effect m a -> ScopedFixP p resource effect m a
    ScopedFix
        ::  ScopedP p resource (ScopedFixP p resource effect) m a
        ->  ScopedFixP p resource effect m a

type ScopedFix = ScopedFixP ()

scopedEffect :: Member (ScopedFixP p resource effect) r => Sem (effect ': r) a -> Sem r a
scopedEffect = transform ScopedEffect

scopedFix
    ::  Member (ScopedFixP p resource effect) r
    =>  Sem (ScopedP p resource (ScopedFixP p resource effect) ': r) a
    ->  Sem r a
scopedFix = transform ScopedFix