module Model (Model,new,onGrid,setCurrent,addGrid,deleteCurrent) where import Control.Applicative ((<$>)) import Data.IORef import Data.IntMap (IntMap,Key) import qualified Data.IntMap as Map import Model.Grid (Grid) import qualified Model.Grid as G import ModelToView (ModelToView) import Util (justWhen) type Current = (Key,Grid) data Model = Model { grids :: IORef (IntMap Grid) , current :: IORef (Maybe Current) } new :: IO Model new = do grids <- newIORef $ Map.empty current <- newIORef Nothing return $ Model grids current deleteCurrent :: Model -> IO () deleteCurrent model = onCurrent model $ \(key,_) -> modifyIORef (grids model) $ Map.delete key onGrid :: Model -> (Grid -> IO a) -> IO a onGrid model f = onCurrent model $ f . snd onCurrent :: Model -> (Current -> IO a) -> IO a onCurrent model f = readIORef (current model) >>= \maybeC -> case maybeC of Just c -> f c Nothing -> error "Model.onCurrent: Nothing" setCurrent :: Key -> Model -> IO () setCurrent key model = do grid <- Map.lookup key <$> (readIORef $ grids model) justWhen grid $ \g -> writeIORef (current model) $ Just (key,g) addGrid :: Key -> ModelToView -> Model -> IO () addGrid key modelToView model = do grid <- G.new modelToView modifyIORef (grids model) $ Map.insert key grid setCurrent key model