{-
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
-}

{-# LANGUAGE EmptyCase #-}

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

module Polysemy.Scoped.Path.Internal where

import Polysemy ( Sem, InterpreterFor, Members )
import Polysemy.Internal.Union
    ( decomp, hoist, membership
    , Union (Union), Weaving (Weaving), ElemOf (Here, There)
    )
import Polysemy.Internal
    ( Sem (Sem, runSem), hoistSem, InterpreterFor, Members )
import Control.Category ((>>>))
import Polysemy.FS.Scoped.Internal.MembersProof ( MembersProof )
import Polysemy.Internal.Sing ( SList (SEnd, SCons), KnownList (singList) )
import Polysemy.Bundle ( Bundle (Bundle) )

-- | Bundle all effects of 'Sem' into a single 'Bundle'.
bundle :: Sem es a -> Sem (Bundle es ': r) a
bundle =
    hoistSem \(Union w (Weaving e s wv ex ins)) ->
        Union Here $ Weaving (Bundle w e) s (bundle . wv) ex ins


subsumeBundle_id :: Sem (Bundle r ': r) a -> Sem r a
subsumeBundle_id = subsumeBundleUsing id

subsumeBundleUsing :: (∀e. ElemOf e es -> ElemOf e r) -> Sem (Bundle es ': r) a -> Sem r a
subsumeBundleUsing i = hoistSem $ \u -> hoist (subsumeBundleUsing i) $ case decomp u of
    Right (Weaving (Bundle pr e) s wv ex ins) ->
        Union (i pr) (Weaving e s wv ex ins)
    Left g -> g


unbundle :: Bundle '[e] m a -> e m a
unbundle = \case
    Bundle Here e -> e
    Bundle (There es) e -> case es of

weakenBundle :: (Members es r, KnownList es) => Bundle es m a -> Bundle r m a
weakenBundle (Bundle pr e) = Bundle (weakenMembership pr) e


weakenMembership :: (Members es r, KnownList es) => ElemOf e es -> ElemOf e r
weakenMembership = weakenMembership' singList

weakenMembership' :: Members es r => SList es -> ElemOf e es -> ElemOf e r
weakenMembership' l pr = case l of
    SEnd -> case pr of
    SCons xs -> case pr of
        Here -> membership
        There pr' -> weakenMembership' xs pr'

-- -----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
-}

data ScopedP path resource effect m a where
    Run :: ∀path resource effect m a. resource -> effect m a -> ScopedP path resource effect m a
    InScope :: ∀path resource effect m a. path -> (resource -> m a) -> ScopedP path resource effect m a

interpretH'
    :: (∀x. Weaving e (Sem (e : r)) x -> Sem r x)
    -> InterpreterFor e r
interpretH' h (Sem m) =
    Sem \k -> m $ decomp >>> \case
        Right wav -> runSem (h wav) k
        Left g -> k $ hoist (interpretH' h) g


{-
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-----