module RPN (
pushWidget, touchWidget, pullWidget, RPN (RPN), io2rpn,
widgetsFromRpn
) where
import Graphics.UI.Gtk (Widget,ContainerClass)
import Data.Monoid
import Control.Monad.State
import Data.Maybe
import Data.List
import CanBeCasted
type ActionType a = StateT [Widget] IO a
pushWidget :: ( CanBeCasted w ) => w -> ActionType ()
pushWidget w = case (glibCast w) of
Just w' -> modify (w':)
_ -> return ()
touchWidget :: (CanBeCasted a) => (a -> IO ()) -> ActionType ()
touchWidget f = liftM (listToMaybe . mapMaybe glibCast) get >>=
maybe (return ()) (liftIO . f)
pullWidget :: (CanBeCasted a, ContainerClass a) =>
(a -> Widget -> IO ()) -> ActionType ()
pullWidget f = do
casted <- liftM (map glibCast) get
let iC = take 1 $ findIndices isJust casted
let iW = [0..length casted 1] \\ iC
case (listToMaybe iC,listToMaybe iW) of
(Just ic, Just iw) -> do
let Just c = casted !! ic
w <- liftM (!! iw) get
liftIO $ f c w
modify $ (\(a,b) -> a ++ drop 1 b) . splitAt iw
_ -> return ()
newtype RPN = RPN ( ActionType () )
instance Monoid RPN where
mempty = RPN $ return ()
mappend (RPN a) (RPN b) = RPN (a >> b)
io2rpn :: (CanBeCasted w) => IO w -> RPN
io2rpn = RPN . (>>= pushWidget) . liftIO
widgetsFromRpn :: [RPN] -> IO [Widget]
widgetsFromRpn list = liftM reverse $ execStateT unified []
where RPN unified = mconcat list