    -- |
    -- Module      : Basement.Monad
    -- License     : BSD-style
    -- Maintainer  : Vincent Hanquez <vincent@snarc.org>
    -- Stability   : experimental
    -- Portability : portable
    --
    -- Allow to run operation in ST and IO, without having to
    -- distinguinsh between the two. Most operations exposes
    -- the bare nuts and bolts of how IO and ST actually
    -- works, and relatively easy to shoot yourself in the foot
    --
    -- this is highly similar to the Control.Monad.Primitive
    -- in the primitive package
    --
    {-# LANGUAGE MagicHash #-}
    {-# LANGUAGE UnboxedTuples #-}
    {-# LANGUAGE ExistentialQuantification #-}
    {-# LANGUAGE ConstraintKinds #-}
    module Basement.Monad
        ( PrimMonad(..)
        , MonadFailure(..)
        , unPrimMonad_
        , unsafePrimCast
        , unsafePrimToST
        , unsafePrimToIO
        , unsafePrimFromIO
        , primTouch
        ) where

    import qualified Prelude
    import           GHC.ST
    import           GHC.STRef
    import           GHC.IORef
    import           GHC.IO
    import           GHC.Prim
    import           Basement.Compat.Base (Exception, (.), ($), Applicative, Monad)

    -- | Primitive monad that can handle mutation.
    --
    -- For example: IO and ST.
    class (Prelude.Functor m, Applicative m, Prelude.Monad m) => PrimMonad m where
        -- | type of state token associated with the PrimMonad m
        type PrimState m
        -- | type of variable associated with the PrimMonad m
        type PrimVar m :: * -> *
        -- | Unwrap the State# token to pass to a function a primitive function that returns an unboxed state and a value.
        primitive :: (State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
        -- | Throw Exception in the primitive monad
        primThrow :: Exception e => e -> m a
        -- | Run a Prim monad from a dedicated state#
        unPrimMonad  :: m a -> State# (PrimState m) -> (# State# (PrimState m), a #)

        -- | Build a new variable in the Prim Monad
        primVarNew :: a -> m (PrimVar m a)
        -- | Read the variable in the Prim Monad
        primVarRead :: PrimVar m a -> m a
        -- | Write the variable in the Prim Monad
        primVarWrite :: PrimVar m a -> a -> m ()

    -- | just like `unwrapPrimMonad` but throw away the result and return just the new State#
    unPrimMonad_ :: PrimMonad m => m () -> State# (PrimState m) -> State# (PrimState m)
    unPrimMonad_ :: m () -> State# (PrimState m) -> State# (PrimState m)
    unPrimMonad_ p :: m ()
    p st :: State# (PrimState m)
    st =
        case m () -> State# (PrimState m) -> (# State# (PrimState m), () #)
    forall (m :: * -> *) a.
    PrimMonad m =>
    m a -> State# (PrimState m) -> (# State# (PrimState m), a #)
    unPrimMonad m ()
    p State# (PrimState m)
    st of
            (# st' :: State# (PrimState m)
    st', () #) -> State# (PrimState m)
    st'
    {-# INLINE unPrimMonad_ #-}

    instance PrimMonad IO where
        type PrimState IO = RealWorld
        type PrimVar IO = IORef
        primitive :: (State# (PrimState IO) -> (# State# (PrimState IO), a #)) -> IO a
    primitive = (State# (PrimState IO) -> (# State# (PrimState IO), a #)) -> IO a
    forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
    IO
        {-# INLINE primitive #-}
        primThrow :: e -> IO a
    primThrow = e -> IO a
    forall e a. Exception e => e -> IO a
    throwIO
        unPrimMonad :: IO a -> State# (PrimState IO) -> (# State# (PrimState IO), a #)
    unPrimMonad (IO p :: State# RealWorld -> (# State# RealWorld, a #)
    p) = State# RealWorld -> (# State# RealWorld, a #)
    State# (PrimState IO) -> (# State# (PrimState IO), a #)
    p
        {-# INLINE unPrimMonad #-}
        primVarNew :: a -> IO (PrimVar IO a)
    primVarNew = a -> IO (PrimVar IO a)
    forall a. a -> IO (IORef a)
    newIORef
        primVarRead :: PrimVar IO a -> IO a
    primVarRead = PrimVar IO a -> IO a
    forall a. IORef a -> IO a
    readIORef
        primVarWrite :: PrimVar IO a -> a -> IO ()
    primVarWrite = PrimVar IO a -> a -> IO ()
    forall a. IORef a -> a -> IO ()
    writeIORef

    instance PrimMonad (ST s) where
        type PrimState (ST s) = s
        type PrimVar (ST s) = STRef s
        primitive :: (State# (PrimState (ST s)) -> (# State# (PrimState (ST s)), a #))
    -> ST s a
    primitive = (State# (PrimState (ST s)) -> (# State# (PrimState (ST s)), a #))
    -> ST s a
    forall s a. STRep s a -> ST s a
    ST
        {-# INLINE primitive #-}
        primThrow :: e -> ST s a
    primThrow = IO a -> ST s a
    forall a s. IO a -> ST s a
    unsafeIOToST (IO a -> ST s a) -> (e -> IO a) -> e -> ST s a
    forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
    Category cat =>
    cat b c -> cat a b -> cat a c
    . e -> IO a
    forall e a. Exception e => e -> IO a
    throwIO
        unPrimMonad :: ST s a
    -> State# (PrimState (ST s)) -> (# State# (PrimState (ST s)), a #)
    unPrimMonad (ST p :: STRep s a
    p) = STRep s a
    State# (PrimState (ST s)) -> (# State# (PrimState (ST s)), a #)
    p
        {-# INLINE unPrimMonad #-}
        primVarNew :: a -> ST s (PrimVar (ST s) a)
    primVarNew = a -> ST s (PrimVar (ST s) a)
    forall a s. a -> ST s (STRef s a)
    newSTRef
        primVarRead :: PrimVar (ST s) a -> ST s a
    primVarRead = PrimVar (ST s) a -> ST s a
    forall s a. STRef s a -> ST s a
    readSTRef
        primVarWrite :: PrimVar (ST s) a -> a -> ST s ()
    primVarWrite = PrimVar (ST s) a -> a -> ST s ()
    forall s a. STRef s a -> a -> ST s ()
    writeSTRef

    -- | Convert a prim monad to another prim monad.
    --
    -- The net effect is that it coerce the state repr to another,
    -- so the runtime representation should be the same, otherwise
    -- hilary ensues.
    unsafePrimCast :: (PrimMonad m1, PrimMonad m2) => m1 a -> m2 a
    unsafePrimCast :: m1 a -> m2 a
    unsafePrimCast m :: m1 a
    m = (State# (PrimState m2) -> (# State# (PrimState m2), a #)) -> m2 a
    forall (m :: * -> *) a.
    PrimMonad m =>
    (State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
    primitive ((State# (PrimState m1) -> (# State# (PrimState m1), a #))
    -> State# (PrimState m2) -> (# State# (PrimState m2), a #)
    unsafeCoerce# (m1 a -> State# (PrimState m1) -> (# State# (PrimState m1), a #)
    forall (m :: * -> *) a.
    PrimMonad m =>
    m a -> State# (PrimState m) -> (# State# (PrimState m), a #)
    unPrimMonad m1 a
    m))
    {-# INLINE unsafePrimCast #-}

    -- | Convert any prim monad to an ST monad
    unsafePrimToST :: PrimMonad prim => prim a -> ST s a
    unsafePrimToST :: prim a -> ST s a
    unsafePrimToST = prim a -> ST s a
    forall (m1 :: * -> *) (m2 :: * -> *) a.
    (PrimMonad m1, PrimMonad m2) =>
    m1 a -> m2 a
    unsafePrimCast
    {-# INLINE unsafePrimToST #-}

    -- | Convert any prim monad to an IO monad
    unsafePrimToIO :: PrimMonad prim => prim a -> IO a
    unsafePrimToIO :: prim a -> IO a
    unsafePrimToIO = prim a -> IO a
    forall (m1 :: * -> *) (m2 :: * -> *) a.
    (PrimMonad m1, PrimMonad m2) =>
    m1 a -> m2 a
    unsafePrimCast
    {-# INLINE unsafePrimToIO #-}

    -- | Convert any IO monad to a prim monad
    unsafePrimFromIO :: PrimMonad prim => IO a -> prim a
    unsafePrimFromIO :: IO a -> prim a
    unsafePrimFromIO = IO a -> prim a
    forall (m1 :: * -> *) (m2 :: * -> *) a.
    (PrimMonad m1, PrimMonad m2) =>
    m1 a -> m2 a
    unsafePrimCast
    {-# INLINE unsafePrimFromIO #-}

    -- | Touch primitive lifted to any prim monad
    primTouch :: PrimMonad m => a -> m ()
    primTouch :: a -> m ()
    primTouch x :: a
    x = IO () -> m ()
    forall (prim :: * -> *) a. PrimMonad prim => IO a -> prim a
    unsafePrimFromIO (IO () -> m ()) -> IO () -> m ()
    forall a b. (a -> b) -> a -> b
    $ (State# (PrimState IO) -> (# State# (PrimState IO), () #)) -> IO ()
    forall (m :: * -> *) a.
    PrimMonad m =>
    (State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
    primitive ((State# (PrimState IO) -> (# State# (PrimState IO), () #))
     -> IO ())
    -> (State# (PrimState IO) -> (# State# (PrimState IO), () #))
    -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \s :: State# (PrimState IO)
    s -> case a -> State# RealWorld -> State# RealWorld
    forall k1. k1 -> State# RealWorld -> State# RealWorld
    touch# a
    x State# RealWorld
    State# (PrimState IO)
    s of { s2 :: State# RealWorld
    s2 -> (# State# RealWorld
    State# (PrimState IO)
    s2, () #) }
    {-# INLINE primTouch #-}

    -- | Monad that can represent failure
    --
    -- Similar to MonadFail but with a parametrized Failure linked to the Monad
    class Monad m => MonadFailure m where
        -- | The associated type with the MonadFailure, representing what
        -- failure can be encoded in this monad
        type Failure m

        -- | Raise a Failure through a monad.
        mFail :: Failure m -> m ()

    instance MonadFailure Prelude.Maybe where
        type Failure Prelude.Maybe = ()
        mFail :: Failure Maybe -> Maybe ()
    mFail _ = Maybe ()
    forall k1. Maybe k1
    Prelude.Nothing
    instance MonadFailure (Prelude.Either a) where
        type Failure (Prelude.Either a) = a
        mFail :: Failure (Either a) -> Either a ()
    mFail a :: Failure (Either a)
    a = a -> Either a ()
    forall a b. a -> Either a b
    Prelude.Left a
    Failure (Either a)
    a