{-
This module contains the modified source code from polysemy-conc-0.7.0.0 package
under 'BSD-2-Clause-Patent'. So that part is only licensed under
'AGPL-3.0-or-later AND BSD-2-Clause-Patent', other part is licensed under
'AGPL-3.0-or-later'.
-}

-- -----BEGIN AGPL-3.0-or-later PART-----
-- Copyright (C) 2022 Hisaket VioletRed

{-|
License     : See the header comment of the source file of this module.
Maintainer  : hisaket@outlook.jp
Stability   : experimental
Portability : POSIX
-}

{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
{-# HLINT ignore "Use camelCase" #-}

module Polysemy.Scoped.Path
    ( module Polysemy.Scoped.Path
    , Polysemy.Scoped.Path.Internal.ScopedP
    )
    where

import Polysemy
    ( Member
    , Sem
    , raise
    , InterpreterFor
    , InterpretersFor
    , Members
    , transform
    )
import Polysemy.Internal ( liftSem, send )
import Polysemy.Internal.Union ( injWeaving, Weaving(Weaving) )
import Control.Category ( (>>>) )
import Polysemy.Input ( Input, runInputConst )
import Polysemy.Bundle ( injBundle, Bundle )
import Polysemy.Scoped.Path.Internal
    ( ScopedP (Run, InScope), bundle, unbundle, weakenBundle, interpretH' )
import Polysemy.Internal.Sing ( KnownList )


-- | Variant of 'scopedP' in which cannot access to outer scope.
innerScopedP :: Member (ScopedP path resource (Bundle es)) r => path -> Sem es a -> Sem r a
innerScopedP :: path -> Sem es a -> Sem r a
innerScopedP path
path = path -> InterpretersFor '[Bundle es, Input path] r
forall path resource (effect :: (* -> *) -> * -> *)
       (r :: EffectRow).
Member (ScopedP path resource effect) r =>
path -> InterpretersFor '[effect, Input path] r
scopedP path
path (Sem (Bundle es : Input path : r) a -> Sem r a)
-> (Sem es a -> Sem (Bundle es : Input path : r) a)
-> Sem es a
-> Sem r a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sem es a -> Sem (Bundle es : Input path : r) a
forall (es :: EffectRow) a (r :: EffectRow).
Sem es a -> Sem (Bundle es : r) a
bundle

injScopedP
    ::  ∀effect es path resource r a
    .   (Member (ScopedP path resource (Bundle es)) r, Member effect es)
    =>  Sem (ScopedP path resource effect ': r) a -> Sem r a
injScopedP :: Sem (ScopedP path resource effect : r) a -> Sem r a
injScopedP = (forall (rInitial :: EffectRow) x.
 effect (Sem rInitial) x -> Bundle es (Sem rInitial) x)
-> Sem (ScopedP path resource effect : r) a -> Sem r a
forall path resource (e1 :: (* -> *) -> * -> *) (r :: EffectRow)
       (e0 :: (* -> *) -> * -> *) a.
Member (ScopedP path resource e1) r =>
(forall (rInitial :: EffectRow) x.
 e0 (Sem rInitial) x -> e1 (Sem rInitial) x)
-> Sem (ScopedP path resource e0 : r) a -> Sem r a
transformScopedP forall (rInitial :: EffectRow) x.
effect (Sem rInitial) x -> Bundle es (Sem rInitial) x
forall (e :: (* -> *) -> * -> *) (r :: EffectRow) (m :: * -> *) a.
Member e r =>
e m a -> Bundle r m a
injBundle

unbundleScopedP
    ::  Member (ScopedP path resource effect) r
    =>  Sem (ScopedP path resource (Bundle '[effect]) ': r) a -> Sem r a
unbundleScopedP :: Sem (ScopedP path resource (Bundle '[effect]) : r) a -> Sem r a
unbundleScopedP = (forall (rInitial :: EffectRow) x.
 Bundle '[effect] (Sem rInitial) x -> effect (Sem rInitial) x)
-> Sem (ScopedP path resource (Bundle '[effect]) : r) a -> Sem r a
forall path resource (e1 :: (* -> *) -> * -> *) (r :: EffectRow)
       (e0 :: (* -> *) -> * -> *) a.
Member (ScopedP path resource e1) r =>
(forall (rInitial :: EffectRow) x.
 e0 (Sem rInitial) x -> e1 (Sem rInitial) x)
-> Sem (ScopedP path resource e0 : r) a -> Sem r a
transformScopedP forall (rInitial :: EffectRow) x.
Bundle '[effect] (Sem rInitial) x -> effect (Sem rInitial) x
forall k k1 (e :: k -> k1 -> *) (m :: k) (a :: k1).
Bundle '[e] m a -> e m a
unbundle

weakenScopedP
    ::  ∀es0 es1 path resource r a
    .   (Member (ScopedP path resource (Bundle es1)) r, Members es0 es1, KnownList es0)
    =>  Sem (ScopedP path resource (Bundle es0) ': r) a -> Sem r a
weakenScopedP :: Sem (ScopedP path resource (Bundle es0) : r) a -> Sem r a
weakenScopedP = (forall (rInitial :: EffectRow) x.
 Bundle es0 (Sem rInitial) x -> Bundle es1 (Sem rInitial) x)
-> Sem (ScopedP path resource (Bundle es0) : r) a -> Sem r a
forall path resource (e1 :: (* -> *) -> * -> *) (r :: EffectRow)
       (e0 :: (* -> *) -> * -> *) a.
Member (ScopedP path resource e1) r =>
(forall (rInitial :: EffectRow) x.
 e0 (Sem rInitial) x -> e1 (Sem rInitial) x)
-> Sem (ScopedP path resource e0 : r) a -> Sem r a
transformScopedP forall (es :: EffectRow) (r :: EffectRow) (m :: * -> *) a.
(Members es r, KnownList es) =>
Bundle es m a -> Bundle r m a
forall (rInitial :: EffectRow) x.
Bundle es0 (Sem rInitial) x -> Bundle es1 (Sem rInitial) x
weakenBundle

transformScopedP
    ::  (Member (ScopedP path resource e1) r)
    =>  (∀rInitial x. e0 (Sem rInitial) x -> e1 (Sem rInitial) x)
    ->  Sem (ScopedP path resource e0 ': r) a
    ->  Sem r a
transformScopedP :: (forall (rInitial :: EffectRow) x.
 e0 (Sem rInitial) x -> e1 (Sem rInitial) x)
-> Sem (ScopedP path resource e0 : r) a -> Sem r a
transformScopedP forall (rInitial :: EffectRow) x.
e0 (Sem rInitial) x -> e1 (Sem rInitial) x
f = (forall (rInitial :: EffectRow) x.
 ScopedP path resource e0 (Sem rInitial) x
 -> ScopedP path resource e1 (Sem rInitial) x)
-> Sem (ScopedP path resource e0 : r) a -> Sem r a
forall (e1 :: (* -> *) -> * -> *) (e2 :: (* -> *) -> * -> *)
       (r :: EffectRow) a.
Member e2 r =>
(forall (rInitial :: EffectRow) x.
 e1 (Sem rInitial) x -> e2 (Sem rInitial) x)
-> Sem (e1 : r) a -> Sem r a
transform \case
    Run res e -> resource
-> e1 (Sem rInitial) x -> ScopedP path resource e1 (Sem rInitial) x
forall k path resource (effect :: (k -> *) -> k -> *) (m :: k -> *)
       (a :: k).
resource -> effect m a -> ScopedP path resource effect m a
Run resource
res (e1 (Sem rInitial) x -> ScopedP path resource e1 (Sem rInitial) x)
-> e1 (Sem rInitial) x -> ScopedP path resource e1 (Sem rInitial) x
forall a b. (a -> b) -> a -> b
$ e0 (Sem rInitial) x -> e1 (Sem rInitial) x
forall (rInitial :: EffectRow) x.
e0 (Sem rInitial) x -> e1 (Sem rInitial) x
f e0 (Sem rInitial) x
e
    InScope path f -> path
-> (resource -> Sem rInitial x)
-> ScopedP path resource e1 (Sem rInitial) x
forall k path resource (effect :: (k -> *) -> k -> *) (m :: k -> *)
       (a :: k).
path -> (resource -> m a) -> ScopedP path resource effect m a
InScope path
path resource -> Sem rInitial x
f


type Scoped = ScopedP ()

scoped :: Member (Scoped resource effect) r => InterpreterFor effect r
scoped :: InterpreterFor effect r
scoped = () -> InterpreterFor effect r
forall k k (e :: k) path resource (effect :: (* -> *) -> * -> *)
       (r :: EffectRow) (a :: k).
Member (ScopedP path resource effect) r =>
path -> InterpreterFor effect r
scopedP_simple ()


scopedP
    :: ∀path resource effect r
    .  Member (ScopedP path resource effect) r
    => path -> InterpretersFor '[effect, Input path] r
scopedP :: path -> InterpretersFor '[effect, Input path] r
scopedP path
path =
        path -> InterpreterFor effect (Input path : r)
forall k k (e :: k) path resource (effect :: (* -> *) -> * -> *)
       (r :: EffectRow) (a :: k).
Member (ScopedP path resource effect) r =>
path -> InterpreterFor effect r
scopedP_simple path
path
    (Sem (effect : Input path : r) a -> Sem (Input path : r) a)
-> (Sem (Input path : r) a -> Sem r a)
-> Sem (effect : Input path : r) a
-> Sem r a
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> path -> Sem (Input path : r) a -> Sem r a
forall i (r :: EffectRow) a. i -> Sem (Input i : r) a -> Sem r a
runInputConst path
path 

-- -----END AGPL-3.0-or-later PART-----
 
-- -----BEGIN AGPL-3.0-or-later AND BSD-2-Clause-Patent PART-----
{-
Copyright (c) 2020 Torsten Schmits
Copyright (c) 2022 Hisaket VioletRed
-}

-- The below functions are modified (or unmodified) version from modules
-- 'Polysemy.Conc.Effect.Scoped' and 'Polysemy.Conc.Interpreter.Scoped' in
-- polysemy-conc-0.7.0.0 package.

scopedP_simple
    :: ∀e path resource effect r a
    .  Member (ScopedP path resource effect) r
    => path -> InterpreterFor effect r
scopedP_simple :: path -> InterpreterFor effect r
scopedP_simple path
path Sem (effect : r) a
main =
    ScopedP path resource effect (Sem r) a -> Sem r a
forall (e :: (* -> *) -> * -> *) (r :: EffectRow) a.
Member e r =>
e (Sem r) a -> Sem r a
send (ScopedP path resource effect (Sem r) a -> Sem r a)
-> ScopedP path resource effect (Sem r) a -> Sem r a
forall a b. (a -> b) -> a -> b
$ path
-> (resource -> Sem r a) -> ScopedP path resource effect (Sem r) a
forall k path resource (effect :: (k -> *) -> k -> *) (m :: k -> *)
       (a :: k).
path -> (resource -> m a) -> ScopedP path resource effect m a
InScope path
path \resource
resource ->
        (forall (rInitial :: EffectRow) x.
 effect (Sem rInitial) x
 -> ScopedP path resource effect (Sem rInitial) x)
-> Sem (effect : r) a -> Sem r a
forall (e1 :: (* -> *) -> * -> *) (e2 :: (* -> *) -> * -> *)
       (r :: EffectRow) a.
Member e2 r =>
(forall (rInitial :: EffectRow) x.
 e1 (Sem rInitial) x -> e2 (Sem rInitial) x)
-> Sem (e1 : r) a -> Sem r a
transform @effect (resource
-> effect (Sem rInitial) x
-> ScopedP path resource effect (Sem rInitial) x
forall k path resource (effect :: (k -> *) -> k -> *) (m :: k -> *)
       (a :: k).
resource -> effect m a -> ScopedP path resource effect m a
Run resource
resource) Sem (effect : r) a
main

scopedP_local
    :: ∀e path resource effect r a
    .  Member (ScopedP path resource effect) r
    => (resource -> resource) -> path -> InterpreterFor effect r
scopedP_local :: (resource -> resource) -> path -> InterpreterFor effect r
scopedP_local resource -> resource
f path
path Sem (effect : r) a
main =
    ScopedP path resource effect (Sem r) a -> Sem r a
forall (e :: (* -> *) -> * -> *) (r :: EffectRow) a.
Member e r =>
e (Sem r) a -> Sem r a
send (ScopedP path resource effect (Sem r) a -> Sem r a)
-> ScopedP path resource effect (Sem r) a -> Sem r a
forall a b. (a -> b) -> a -> b
$ path
-> (resource -> Sem r a) -> ScopedP path resource effect (Sem r) a
forall k path resource (effect :: (k -> *) -> k -> *) (m :: k -> *)
       (a :: k).
path -> (resource -> m a) -> ScopedP path resource effect m a
InScope path
path \resource
resource ->
        (forall (rInitial :: EffectRow) x.
 effect (Sem rInitial) x
 -> ScopedP path resource effect (Sem rInitial) x)
-> Sem (effect : r) a -> Sem r a
forall (e1 :: (* -> *) -> * -> *) (e2 :: (* -> *) -> * -> *)
       (r :: EffectRow) a.
Member e2 r =>
(forall (rInitial :: EffectRow) x.
 e1 (Sem rInitial) x -> e2 (Sem rInitial) x)
-> Sem (e1 : r) a -> Sem r a
transform @effect (resource
-> effect (Sem rInitial) x
-> ScopedP path resource effect (Sem rInitial) x
forall k path resource (effect :: (k -> *) -> k -> *) (m :: k -> *)
       (a :: k).
resource -> effect m a -> ScopedP path resource effect m a
Run (resource
 -> effect (Sem rInitial) x
 -> ScopedP path resource effect (Sem rInitial) x)
-> resource
-> effect (Sem rInitial) x
-> ScopedP path resource effect (Sem rInitial) x
forall a b. (a -> b) -> a -> b
$ resource -> resource
f resource
resource) Sem (effect : r) a
main

runScopedP
    :: ∀path resource effect r
    .  (∀x. path -> (resource -> Sem r x) -> Sem r x)
    -> (resource -> InterpreterFor effect r)
    -> InterpreterFor (ScopedP path resource effect) r
runScopedP :: (forall x. path -> (resource -> Sem r x) -> Sem r x)
-> (resource -> InterpreterFor effect r)
-> InterpreterFor (ScopedP path resource effect) r
runScopedP forall x. path -> (resource -> Sem r x) -> Sem r x
withResource resource -> InterpreterFor effect r
scopedInterpreter = Sem (ScopedP path resource effect : r) a -> Sem r a
InterpreterFor (ScopedP path resource effect) r
run
  where
    run :: InterpreterFor (ScopedP path resource effect) r
    run :: Sem (ScopedP path resource effect : r) a -> Sem r a
run =
        (forall x.
 Weaving
   (ScopedP path resource effect)
   (Sem (ScopedP path resource effect : r))
   x
 -> Sem r x)
-> InterpreterFor (ScopedP path resource effect) r
forall (e :: (* -> *) -> * -> *) (r :: EffectRow).
(forall x. Weaving e (Sem (e : r)) x -> Sem r x)
-> InterpreterFor e r
interpretH' \(Weaving ScopedP path resource effect (Sem rInitial) a
effect f ()
s forall x.
f (Sem rInitial x) -> Sem (ScopedP path resource effect : r) (f x)
wv f a -> x
ex forall x. f x -> Maybe x
ins) -> case ScopedP path resource effect (Sem rInitial) a
effect of
            Run resource act ->
                resource -> Sem (effect : r) x -> Sem r x
resource -> InterpreterFor effect r
scopedInterpreter resource
resource (Union (effect : r) (Sem (effect : r)) x -> Sem (effect : r) x
forall (r :: EffectRow) a. Union r (Sem r) a -> Sem r a
liftSem (Union (effect : r) (Sem (effect : r)) x -> Sem (effect : r) x)
-> Union (effect : r) (Sem (effect : r)) x -> Sem (effect : r) x
forall a b. (a -> b) -> a -> b
$ Weaving effect (Sem (effect : r)) x
-> Union (effect : r) (Sem (effect : r)) x
forall (e :: (* -> *) -> * -> *) (r :: EffectRow) (m :: * -> *) a.
Member e r =>
Weaving e m a -> Union r m a
injWeaving (Weaving effect (Sem (effect : r)) x
 -> Union (effect : r) (Sem (effect : r)) x)
-> Weaving effect (Sem (effect : r)) x
-> Union (effect : r) (Sem (effect : r)) x
forall a b. (a -> b) -> a -> b
$ effect (Sem rInitial) a
-> f ()
-> (forall x. f (Sem rInitial x) -> Sem (effect : r) (f x))
-> (f a -> x)
-> (forall x. f x -> Maybe x)
-> Weaving effect (Sem (effect : r)) x
forall (f :: * -> *) (e :: (* -> *) -> * -> *)
       (rInitial :: EffectRow) a resultType (mAfter :: * -> *).
Functor f =>
e (Sem rInitial) a
-> f ()
-> (forall x. f (Sem rInitial x) -> mAfter (f x))
-> (f a -> resultType)
-> (forall x. f x -> Maybe x)
-> Weaving e mAfter resultType
Weaving effect (Sem rInitial) a
act f ()
s (Sem r (f x) -> Sem (effect : r) (f x)
forall (e :: (* -> *) -> * -> *) (r :: EffectRow) a.
Sem r a -> Sem (e : r) a
raise (Sem r (f x) -> Sem (effect : r) (f x))
-> (f (Sem rInitial x) -> Sem r (f x))
-> f (Sem rInitial x)
-> Sem (effect : r) (f x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sem (ScopedP path resource effect : r) (f x) -> Sem r (f x)
InterpreterFor (ScopedP path resource effect) r
run (Sem (ScopedP path resource effect : r) (f x) -> Sem r (f x))
-> (f (Sem rInitial x)
    -> Sem (ScopedP path resource effect : r) (f x))
-> f (Sem rInitial x)
-> Sem r (f x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (Sem rInitial x) -> Sem (ScopedP path resource effect : r) (f x)
forall x.
f (Sem rInitial x) -> Sem (ScopedP path resource effect : r) (f x)
wv) f a -> x
ex forall x. f x -> Maybe x
ins)
            InScope path main ->
                f a -> x
ex (f a -> x) -> Sem r (f a) -> Sem r x
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> path -> (resource -> Sem r (f a)) -> Sem r (f a)
forall x. path -> (resource -> Sem r x) -> Sem r x
withResource path
path \resource
resource -> Sem (ScopedP path resource effect : r) (f a) -> Sem r (f a)
InterpreterFor (ScopedP path resource effect) r
run (f (Sem rInitial a) -> Sem (ScopedP path resource effect : r) (f a)
forall x.
f (Sem rInitial x) -> Sem (ScopedP path resource effect : r) (f x)
wv (resource -> Sem rInitial a
main resource
resource Sem rInitial a -> f () -> f (Sem rInitial a)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ f ()
s))

{-
Redistribution and use in source and binary forms, with or without modification, are permitted provided that the
following conditions are met:

  1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following
  disclaimer.
  2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following
  disclaimer in the documentation and/or other materials provided with the distribution.

Subject to the terms and conditions of this license, each copyright holder and contributor hereby grants to those
receiving rights under this license a perpetual, worldwide, non-exclusive, no-charge, royalty-free, irrevocable (except
for failure to satisfy the conditions of this license) patent license to make, have made, use, offer to sell, sell,
import, and otherwise transfer this software, where such license applies only to those patent claims, already acquired
or hereafter acquired, licensable by such copyright holder or contributor that are necessarily infringed by:

  (a) their Contribution(s) (the licensed copyrights of copyright holders and non-copyrightable additions of
  contributors, in source or binary form) alone; or
  (b) combination of their Contribution(s) with the work of authorship to which such Contribution(s) was added by such
  copyright holder or contributor, if, at the time the Contribution is added, such addition causes such combination to
  be necessarily infringed. The patent license shall not apply to any other combinations which include the Contribution.

Except as expressly stated above, no rights or licenses from any copyright holder or contributor is granted under this
license, whether expressly, by implication, estoppel or otherwise.

DISCLAIMER

THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-}
-- -----END AGPL-3.0-or-later AND BSD-2-Clause-Patent PART-----