-- This Source Code Form is subject to the terms of the Mozilla Public
-- License, v. 2.0. If a copy of the MPL was not distributed with this
-- file, You can obtain one at https://mozilla.org/MPL/2.0/.

{- |
Copyright   :  (c) 2024 Sayo Koyoneda
License     :  MPL-2.0 (see the LICENSE file)
Maintainer  :  ymdfield@outlook.jp
Portability :  portable
-}
module Control.Monad.Hefty.Unlift where

import Control.Monad.Hefty (Eff, interpretH, runEff, send0, type (~>))
import Data.Effect.Unlift (UnliftBase (WithRunInBase), UnliftIO)

runUnliftBase :: forall b. (Monad b) => Eff '[UnliftBase b] '[b] ~> b
runUnliftBase :: forall (b :: * -> *). Monad b => Eff '[UnliftBase b] '[b] ~> b
runUnliftBase =
    Eff '[] '[b] x -> b x
Eff '[] '[b] ~> b
forall (m :: * -> *). Monad m => Eff '[] '[m] ~> m
runEff (Eff '[] '[b] x -> b x)
-> (Eff '[UnliftBase b] '[b] x -> Eff '[] '[b] x)
-> Eff '[UnliftBase b] '[b] x
-> b x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UnliftBase b ~~> Eff '[] '[b])
-> Eff '[UnliftBase b] '[b] ~> Eff '[] '[b]
forall (e :: (* -> *) -> * -> *) (eh :: [(* -> *) -> * -> *])
       (ef :: [* -> *]).
HFunctor e =>
(e ~~> Eff eh ef) -> Eff (e : eh) ef ~> Eff eh ef
interpretH \(WithRunInBase (Eff '[] '[b] ~> b) -> b x
f) ->
        b x -> Eff '[] '[b] x
forall (e :: * -> *) (eh :: [(* -> *) -> * -> *]) (ef :: [* -> *])
       x.
e x -> Eff eh (e : ef) x
send0 (b x -> Eff '[] '[b] x) -> b x -> Eff '[] '[b] x
forall a b. (a -> b) -> a -> b
$ (Eff '[] '[b] ~> b) -> b x
f Eff '[] '[b] x -> b x
Eff '[] '[b] ~> b
forall (m :: * -> *). Monad m => Eff '[] '[m] ~> m
runEff

runUnliftIO :: Eff '[UnliftIO] '[IO] ~> IO
runUnliftIO :: Eff '[UnliftIO] '[IO] ~> IO
runUnliftIO = Eff '[UnliftIO] '[IO] x -> IO x
Eff '[UnliftIO] '[IO] ~> IO
forall (b :: * -> *). Monad b => Eff '[UnliftBase b] '[b] ~> b
runUnliftBase
{-# INLINE runUnliftIO #-}