Path.hs

{-
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 = scopedP path . 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 = transformScopedP injBundle

unbundleScopedP
    ::  Member (ScopedP path resource effect) r
    =>  Sem (ScopedP path resource (Bundle '[effect]) ': r) a -> Sem r a
unbundleScopedP = transformScopedP 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 = transformScopedP 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 f = transform \case
    Run res e -> Run res $ f e
    InScope path f -> InScope path f


type Scoped = ScopedP ()

scoped :: Member (Scoped resource effect) r => InterpreterFor effect r
scoped = scopedP_simple ()


scopedP
    :: ∀path resource effect r
    .  Member (ScopedP path resource effect) r
    => path -> InterpretersFor '[effect, Input path] r
scopedP path =
        scopedP_simple path
    >>> runInputConst 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 main =
    send $ InScope path \resource ->
        transform @effect (Run resource) main

scopedP_local
    :: ∀e path resource effect r a
    .  Member (ScopedP path resource effect) r
    => (resource -> resource) -> path -> InterpreterFor effect r
scopedP_local f path main =
    send $ InScope path \resource ->
        transform @effect (Run $ f resource) 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 withResource scopedInterpreter = run
  where
    run :: InterpreterFor (ScopedP path resource effect) r
    run =
        interpretH' \(Weaving effect s wv ex ins) -> case effect of
            Run resource act ->
                scopedInterpreter resource (liftSem $ injWeaving $ Weaving act s (raise . run . wv) ex ins)
            InScope path main ->
                ex <$> withResource path \resource -> run (wv (main resource <$ 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-----