content: {-# LANGUAGE FlexibleInstances #-}
  {-# LANGUAGE GeneralizedNewtypeDeriving #-}
  {-# LANGUAGE TypeFamilies #-}
  {-# LANGUAGE FunctionalDependencies #-}
  {-# LANGUAGE UndecidableInstances #-}
  module RIO.Prelude.RIO
    ( RIO (..)
    , runRIO
    , liftRIO
    , mapRIO
    -- SomeRef for Writer/State interfaces
    , SomeRef
    , HasStateRef (..)
    , HasWriteRef (..)
    , newSomeRef
    , newUnboxedSomeRef
    , readSomeRef
    , writeSomeRef
    , modifySomeRef
    ) where
  
  import GHC.Exts (RealWorld)
  
  import RIO.Prelude.Lens
  import RIO.Prelude.URef
  import RIO.Prelude.Reexports
  import Control.Monad.State (MonadState(..))
  import Control.Monad.Writer (MonadWriter(..))
  
  -- | The Reader+IO monad. This is different from a 'ReaderT' because:
  --
  -- * It's not a transformer, it hardcodes IO for simpler usage and
  -- error messages.
  --
  -- * Instances of typeclasses like 'MonadLogger' are implemented using
  -- classes defined on the environment, instead of using an
  -- underlying monad.
  newtype RIO env a = RIO { unRIO :: ReaderT env IO a }
    deriving (Functor,Applicative,Monad,MonadIO,MonadReader env,MonadThrow)
  
  instance Semigroup a => Semigroup (RIO env a) where
    (<>) = liftA2 (<>)
  instance Monoid a => Monoid (RIO env a) where
    mempty = pure mempty
    mappend = liftA2 mappend
  
  -- | Using the environment run in IO the action that requires that environment.
  --
  -- @since 0.0.1.0
  runRIO :: MonadIO m => env -> RIO env a -> m a
  runRIO env (RIO (ReaderT f)) = liftIO (f env)
  
  -- | Abstract `RIO` to an arbitrary `MonadReader` instance, which can handle IO.
  --
  -- @since 0.0.1.0
  liftRIO :: (MonadIO m, MonadReader env m) => RIO env a -> m a
  liftRIO rio = do
    env <- ask
    runRIO env rio
  
  -- | Lift one RIO env to another.
  --
  -- @since 0.1.13.0
  mapRIO :: (outer -> inner) -> RIO inner a -> RIO outer a
  mapRIO f m = do
    outer <- ask
    runRIO (f outer) m
  
  instance MonadUnliftIO (RIO env) where
    withRunInIO inner = RIO $ withRunInIO $ \run -> inner (run . unRIO)
    {-# INLINE withRunInIO #-}
  
  instance PrimMonad (RIO env) where
      type PrimState (RIO env) = PrimState IO
      primitive = RIO . ReaderT . const . primitive
  
  -- | Abstraction over how to read from and write to a mutable reference
  --
  -- @since 0.1.4.0
  data SomeRef a
    = SomeRef !(IO a) !(a -> IO ())
  
  -- | Read from a SomeRef
  --
  -- @since 0.1.4.0
  readSomeRef :: MonadIO m => SomeRef a -> m a
  readSomeRef (SomeRef x _) = liftIO x
  
  -- | Write to a SomeRef
  --
  -- @since 0.1.4.0
  writeSomeRef :: MonadIO m => SomeRef a -> a -> m ()
  writeSomeRef (SomeRef _ x) = liftIO . x
  
  -- | Modify a SomeRef
  -- This function is subject to change due to the lack of atomic operations
  --
  -- @since 0.1.4.0
  modifySomeRef :: MonadIO m => SomeRef a -> (a -> a) -> m ()
  modifySomeRef (SomeRef read' write) f =
    liftIO (read' >>= write . f)
  
  ioRefToSomeRef :: IORef a -> SomeRef a
  ioRefToSomeRef ref =
    SomeRef (readIORef ref)
            (modifyIORef' ref . const)
  
  uRefToSomeRef :: Unbox a => URef RealWorld a -> SomeRef a
  uRefToSomeRef ref =
    SomeRef (readURef ref) (writeURef ref)
  
  -- | Environment values with stateful capabilities to SomeRef
  --
  -- @since 0.1.4.0
  class HasStateRef s env | env -> s where
    stateRefL :: Lens' env (SomeRef s)
  
  -- | Identity state reference where the SomeRef is the env
  --
  -- @since 0.1.4.0
  instance HasStateRef a (SomeRef a) where
    stateRefL = id
  
  -- | Environment values with writing capabilities to SomeRef
  --
  -- @since 0.1.4.0
  class HasWriteRef w env | env -> w where
    writeRefL :: Lens' env (SomeRef w)
  
  -- | Identity write reference where the SomeRef is the env
  --
  -- @since 0.1.4.0
  instance HasWriteRef a (SomeRef a) where
    writeRefL = id
  
  instance HasStateRef s env => MonadState s (RIO env) where
    get = do
      ref <- view stateRefL
      liftIO $ readSomeRef ref
    put st = do
      ref <- view stateRefL
      liftIO $ writeSomeRef ref st
  
  instance (Monoid w, HasWriteRef w env) => MonadWriter w (RIO env) where
    tell value = do
      ref <- view writeRefL
      liftIO $ modifySomeRef ref (`mappend` value)
  
    listen action = do
      w1 <- view writeRefL >>= liftIO . readSomeRef
      a <- action
      w2 <- do
        refEnv <- view writeRefL
        v <- liftIO $ readSomeRef refEnv
        _ <- liftIO $ writeSomeRef refEnv w1
        return v
      return (a, w2)
  
    pass action = do
      (a, transF) <- action
      ref <- view writeRefL
      liftIO $ modifySomeRef ref transF
      return a
  
  -- | create a new boxed SomeRef
  --
  -- @since 0.1.4.0
  newSomeRef :: MonadIO m => a -> m (SomeRef a)
  newSomeRef a = do
    ioRefToSomeRef <$> newIORef a
  
  -- | create a new unboxed SomeRef
  --
  -- @since 0.1.4.0
  newUnboxedSomeRef :: (MonadIO m, Unbox a) => a -> m (SomeRef a)
  newUnboxedSomeRef a =
    uRefToSomeRef <$>   liftIO (newURef a)
  