module Rasa.Internal.Action where
import Control.Lens
import Control.Concurrent.Async
import Control.Monad.State
import Control.Monad.Reader
import Data.Dynamic
import Data.Map
import Data.Default
import Rasa.Internal.Buffer
import Rasa.Internal.Editor
data Hook = forall a. Hook a
type Hooks = Map TypeRep [Hook]
newtype Action a = Action
{ runAct :: StateT ActionState (ReaderT Hooks IO) a
} deriving (Functor, Applicative, Monad, MonadState ActionState, MonadReader Hooks, MonadIO)
execAction :: ActionState -> Hooks -> Action () -> IO ActionState
execAction actionState hooks action = flip runReaderT hooks . execStateT (runAct action) $ actionState
evalAction :: ActionState -> Hooks -> Action a -> IO a
evalAction actionState hooks action = flip runReaderT hooks $ evalStateT (runAct action) actionState
type AsyncAction = Async (Action ())
data ActionState = ActionState
{ _ed :: Editor
, _asyncs :: [AsyncAction]
}
makeClassy ''ActionState
instance HasEditor ActionState where
editor = ed
instance Default ActionState where
def = ActionState
{ _ed=def
, _asyncs=def
}
instance Show ActionState where
show as = show (_ed as)
newtype BufAction a = BufAction
{ getBufAction::StateT Buffer (ReaderT Hooks IO) a
} deriving (Functor, Applicative, Monad, MonadState Buffer, MonadReader Hooks, MonadIO)
liftBuf :: BufAction a -> BufRef -> Action (Maybe a)
liftBuf bufAct (BufRef bufRef) = do
mBuf <- use (buffers.at bufRef)
case mBuf of
Nothing -> return Nothing
Just buf -> do
hooks <- ask
(val, newBuf) <- liftIO $ flip runReaderT hooks . flip runStateT buf . getBufAction $ bufAct
buffers.at bufRef ?= newBuf
return . Just $ val