ST.hs

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

-- | Run an 'Eff' computation with primitive state-transformer actions purely.
runSTE :: (forall s. Eff (STE s : es) a) -> Eff es a
runSTE eff = evalStaticRep STERep eff

-- | Interpret `STE` as `Prim`.
steAsPrim :: Prim :> es => Eff (STE (PrimState (Eff es)) : es) a -> Eff es a
steAsPrim = evalStaticRep STERep

-- | Interpret `STE` as `IOE`.
steAsIOE :: IOE :> es => Eff (STE RealWorld : es) a -> Eff es a
steAsIOE = evalStaticRep STERep

-- | Lift a primitive state-transformer action with `STE`.
primToSTE
  :: (PrimBase m, STE s :> es, PrimState m ~ s)
  => m a -> Eff es a
primToSTE = unsafeEff_ . IO . unsafeCoerce . internal

-- | Lift a strict `ST` action with `STE`.
stToSTE :: (STE s :> es) => ST s a -> Eff es a
stToSTE = primToSTE

-- | Lift a lazy `L.ST` action with `STE`.
stToSTE' :: (STE s :> es) => L.ST s a -> Eff es a
stToSTE' = primToSTE

-- | Lift an IO action with `STE`.
ioToSTE :: (STE RealWorld :> es) => IO a -> Eff es a
ioToSTE = primToSTE

-- | Lift a primitive state-transformer action with `IOE`.
primToIOE
  :: (PrimBase m, IOE :> es, PrimState m ~ RealWorld)
  => m a -> Eff es a
primToIOE = unsafeEff_ . IO . internal

-- | Lift a strict `ST` action with `IOE`.
stToIOE :: (IOE :> es) => ST RealWorld a -> Eff es a
stToIOE = primToIOE

-- | Lift a lazy `L.ST` action with `IOE`.
stToIOE' :: (IOE :> es) => L.ST RealWorld a -> Eff es a
stToIOE' = primToIOE