-- SPDX-License-Identifier: CC0-1.0
{-
Each contributor licenses you to do everything with this work that
would otherwise infringe any patent claims they can license or become
able to license.
-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-|
This modules provides the `STE` effect; a way to run
the effect purely, with `Prim`, or with `IOE`; and
functions for lifting abstract and concrete
state-transformer actions into `Eff`.
-}
module Effectful.ST
  ( -- * Effect
    STE
    -- * Handlers
  , runSTE
  , steAsPrim
  , steAsIOE
    -- * Operations
    -- ** Prim to STE
  , primToSTE
  , stToSTE
  , stToSTE'
  , ioToSTE
    -- ** Prim to IOE
  , primToIOE
  , stToIOE
  , stToIOE'
  ) where

import Control.Monad.ST ( RealWorld, ST )
import qualified Control.Monad.ST.Lazy as L

import Unsafe.Coerce ( unsafeCoerce )
import GHC.IO ( IO(IO) )

import Effectful
    ( type (:>), Effect, Dispatch(Static), DispatchOf, Eff, IOE )
import Effectful.Dispatch.Static
    ( evalStaticRep,
      unsafeEff_,
      SideEffects(NoSideEffects),
      StaticRep )
import Effectful.Prim ( Prim )
import Effectful.Internal.Effect ( type (:>)(..) )

import Control.Monad.Primitive
    ( PrimBase(..), PrimMonad(PrimState) )

data STE s :: Effect
-- ^ An effect for delimited primitive state-transformer actions.
type instance DispatchOf (STE s) = Static NoSideEffects
data instance StaticRep (STE s) = STERep

instance {-# INCOHERENT #-} s1 ~ s2 => STE s1 :> (STE s2 : es) where
  reifyIndex :: Int
reifyIndex = Int
0

-- | Run an 'Eff' computation with primitive state-transformer actions purely.
runSTE :: (forall s. Eff (STE s : es) a) -> Eff es a
runSTE :: forall (es :: [(* -> *) -> * -> *]) a.
(forall s. Eff (STE s : es) a) -> Eff es a
runSTE forall s. Eff (STE s : es) a
eff = forall (e :: (* -> *) -> * -> *) (sideEffects :: SideEffects)
       (es :: [(* -> *) -> * -> *]) a.
(DispatchOf e ~ 'Static sideEffects, MaybeIOE sideEffects es) =>
StaticRep e -> Eff (e : es) a -> Eff es a
evalStaticRep forall s. StaticRep (STE s)
STERep forall s. Eff (STE s : es) a
eff

-- | Interpret `STE` as `Prim`.
steAsPrim :: Prim :> es => Eff (STE (PrimState (Eff es)) : es) a -> Eff es a
steAsPrim :: forall (es :: [(* -> *) -> * -> *]) a.
(Prim :> es) =>
Eff (STE (PrimState (Eff es)) : es) a -> Eff es a
steAsPrim = forall (e :: (* -> *) -> * -> *) (sideEffects :: SideEffects)
       (es :: [(* -> *) -> * -> *]) a.
(DispatchOf e ~ 'Static sideEffects, MaybeIOE sideEffects es) =>
StaticRep e -> Eff (e : es) a -> Eff es a
evalStaticRep forall s. StaticRep (STE s)
STERep

-- | Interpret `STE` as `IOE`.
steAsIOE :: IOE :> es => Eff (STE RealWorld : es) a -> Eff es a
steAsIOE :: forall (es :: [(* -> *) -> * -> *]) a.
(IOE :> es) =>
Eff (STE RealWorld : es) a -> Eff es a
steAsIOE = forall (e :: (* -> *) -> * -> *) (sideEffects :: SideEffects)
       (es :: [(* -> *) -> * -> *]) a.
(DispatchOf e ~ 'Static sideEffects, MaybeIOE sideEffects es) =>
StaticRep e -> Eff (e : es) a -> Eff es a
evalStaticRep forall s. StaticRep (STE s)
STERep

-- | Lift a primitive state-transformer action with `STE`.
primToSTE
  :: (PrimBase m, STE s :> es, PrimState m ~ s)
  => m a -> Eff es a
primToSTE :: forall (m :: * -> *) s (es :: [(* -> *) -> * -> *]) a.
(PrimBase m, STE s :> es, PrimState m ~ s) =>
m a -> Eff es a
primToSTE = forall a (es :: [(* -> *) -> * -> *]). IO a -> Eff es a
unsafeEff_ forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b
unsafeCoerce forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
PrimBase m =>
m a -> State# (PrimState m) -> (# State# (PrimState m), a #)
internal

-- | Lift a strict `ST` action with `STE`.
stToSTE :: (STE s :> es) => ST s a -> Eff es a
stToSTE :: forall s (es :: [(* -> *) -> * -> *]) a.
(STE s :> es) =>
ST s a -> Eff es a
stToSTE = forall (m :: * -> *) s (es :: [(* -> *) -> * -> *]) a.
(PrimBase m, STE s :> es, PrimState m ~ s) =>
m a -> Eff es a
primToSTE

-- | Lift a lazy `L.ST` action with `STE`.
stToSTE' :: (STE s :> es) => L.ST s a -> Eff es a
stToSTE' :: forall s (es :: [(* -> *) -> * -> *]) a.
(STE s :> es) =>
ST s a -> Eff es a
stToSTE' = forall (m :: * -> *) s (es :: [(* -> *) -> * -> *]) a.
(PrimBase m, STE s :> es, PrimState m ~ s) =>
m a -> Eff es a
primToSTE

-- | Lift an IO action with `STE`.
ioToSTE :: (STE RealWorld :> es) => IO a -> Eff es a
ioToSTE :: forall (es :: [(* -> *) -> * -> *]) a.
(STE RealWorld :> es) =>
IO a -> Eff es a
ioToSTE = forall (m :: * -> *) s (es :: [(* -> *) -> * -> *]) a.
(PrimBase m, STE s :> es, PrimState m ~ s) =>
m a -> Eff es a
primToSTE

-- | Lift a primitive state-transformer action with `IOE`.
primToIOE
  :: (PrimBase m, IOE :> es, PrimState m ~ RealWorld)
  => m a -> Eff es a
primToIOE :: forall (m :: * -> *) (es :: [(* -> *) -> * -> *]) a.
(PrimBase m, IOE :> es, PrimState m ~ RealWorld) =>
m a -> Eff es a
primToIOE = forall a (es :: [(* -> *) -> * -> *]). IO a -> Eff es a
unsafeEff_ forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
PrimBase m =>
m a -> State# (PrimState m) -> (# State# (PrimState m), a #)
internal

-- | Lift a strict `ST` action with `IOE`.
stToIOE :: (IOE :> es) => ST RealWorld a -> Eff es a
stToIOE :: forall (es :: [(* -> *) -> * -> *]) a.
(IOE :> es) =>
ST RealWorld a -> Eff es a
stToIOE = forall (m :: * -> *) (es :: [(* -> *) -> * -> *]) a.
(PrimBase m, IOE :> es, PrimState m ~ RealWorld) =>
m a -> Eff es a
primToIOE

-- | Lift a lazy `L.ST` action with `IOE`.
stToIOE' :: (IOE :> es) => L.ST RealWorld a -> Eff es a
stToIOE' :: forall (es :: [(* -> *) -> * -> *]) a.
(IOE :> es) =>
ST RealWorld a -> Eff es a
stToIOE' = forall (m :: * -> *) (es :: [(* -> *) -> * -> *]) a.
(PrimBase m, IOE :> es, PrimState m ~ RealWorld) =>
m a -> Eff es a
primToIOE