module Rasa.Internal.ActionMonads
( Action(..)
, BufAction(..)
, ActionF(..)
, BufActionF(..)
, liftActionF
, liftBufAction
) where
import Rasa.Internal.Editor
import Rasa.Internal.Extensions
import Rasa.Internal.Buffer
import Rasa.Internal.Range
import Control.Monad.Free
import Control.Monad.IO.Class
import Data.Default
import Data.Typeable
import qualified Yi.Rope as Y
data ActionF next where
LiftIO :: IO next -> ActionF next
BufferDo :: [BufRef] -> BufAction r -> ([r] -> next) -> ActionF next
DispatchActionAsync :: IO (Action ()) -> next -> ActionF next
AsyncActionProvider :: ((Action () -> IO ()) -> IO ()) -> next -> ActionF next
AddBuffer :: Y.YiString -> (BufRef -> next) -> ActionF next
GetBufRefs :: ([BufRef] -> next) -> ActionF next
GetExt :: (Typeable ext, Show ext, Default ext) => (ext -> next) -> ActionF next
SetExt :: (Typeable ext, Show ext, Default ext) => ext -> next -> ActionF next
GetEditor :: (Editor -> next) -> ActionF next
GetBuffer :: BufRef -> (Maybe Buffer -> next) -> ActionF next
Exit :: next -> ActionF next
ShouldExit :: (Bool -> next) -> ActionF next
deriving instance Functor ActionF
liftActionF :: ActionF a -> Action a
liftActionF = Action . liftF
liftFIO :: IO r -> Action r
liftFIO = liftActionF . LiftIO
instance MonadIO Action where
liftIO = liftFIO
instance HasExtMonad Action where
getExt = liftActionF $ GetExt id
setExt newExt = liftActionF $ SetExt newExt ()
newtype Action a = Action
{ getAction :: Free ActionF a
} deriving (Functor, Applicative, Monad)
data BufActionF next where
GetText :: (Y.YiString -> next) -> BufActionF next
SetText :: Y.YiString -> next -> BufActionF next
GetBufRef :: (BufRef -> next) -> BufActionF next
GetBufExt :: (Typeable ext, Show ext, Default ext) => (ext -> next) -> BufActionF next
SetBufExt :: (Typeable ext, Show ext, Default ext) => ext -> next -> BufActionF next
SetRange :: CrdRange -> Y.YiString -> next -> BufActionF next
LiftAction :: Action r -> (r -> next) -> BufActionF next
BufLiftIO :: IO next -> BufActionF next
deriving instance Functor BufActionF
newtype BufAction a = BufAction
{ getBufAction :: Free BufActionF a
} deriving (Functor, Applicative, Monad)
liftBufAction :: BufActionF a -> BufAction a
liftBufAction = BufAction . liftF
liftBufActionFIO :: IO r -> BufAction r
liftBufActionFIO = liftBufAction . BufLiftIO
instance MonadIO BufAction where
liftIO = liftBufActionFIO
instance HasExtMonad BufAction where
getExt = liftBufAction $ GetBufExt id
setExt newExt = liftBufAction $ SetBufExt newExt ()