module Model.Grid (Grid,new,getCell,setCell,rewriteCell ,updateCell,updateCellIO,resizeTo ,addRow,addColumn,deleteColumns,deleteRows ,updateRowLabel,updateColumnLabel ,columnIndex,rowIndex ,setFilePath,getFilePath ,getColumnValues) where import Control.Monad (forM,forM_) import Control.Applicative ((<$>)) import Data.IORef import Util.DynArray (DynArray) import qualified Util.DynArray as Dyn import Model.Cell (Cell) import qualified Model.Cell as Cell import Model.CellContent (CellExpr(..),CellValue(..),Reference(..) ,NamedReference(..),CompileReason(..)) import qualified Model.CellContent as CellContent import Model.CellExpression.Parser (parse) import Model.GridHeader (Header) import qualified Model.GridHeader as Header import CellCoordinate (CellCoord,coordRange) import qualified View data Grid = Grid { cells :: DynArray CellCoord Cell , rowHeader :: Header , columnHeader :: Header , filePath :: IORef (Maybe FilePath) , numViewGridRows :: IO Int , numViewGridCols :: IO Int } new :: View.Info -> IO Grid new viewInfo = do cells <- Dyn.newMatrix (1,1) Cell.empty rowHeader <- Header.new columnHeader <- Header.new filePath <- newIORef Nothing return $ Grid cells rowHeader columnHeader filePath (View.numDataRows viewInfo) (View.numDataColumns viewInfo) getCell :: CellCoord -> Grid -> IO Cell getCell coord = Dyn.read coord . cells getCellValue :: CellCoord -> Grid -> IO CellValue getCellValue coord grid = Cell.value <$> getCell coord grid setCell :: CellCoord -> String -> Grid -> IO [CellCoord] setCell coord string grid = do cell <- getCell coord grid deleteDependenciesOn cell cell' <- do expr <- compile (parse string,coord) grid return $ Cell.setExpression string expr cell addDependenciesOn cell' Dyn.write coord cell' $ cells grid evaluate coord grid where onCoords coords f = forM_ coords $ \c -> updateCell c f grid deleteDependenciesOn cell = let onRef ref = case ref of Column a -> Header.deleteDependent coord a $ columnHeader grid Row a -> Header.deleteDependent coord a $ rowHeader grid _ -> do cs <- referencedCoords ref grid onCoords cs $ Cell.deleteDependent coord in forM_ (Cell.dependencies cell) onRef addDependenciesOn cell = let onRef ref = case ref of Column a -> Header.addDependent coord a $ columnHeader grid Row a -> Header.addDependent coord a $ rowHeader grid _ -> do cs <- referencedCoords ref grid onCoords cs $ Cell.addDependent coord in forM_ (Cell.dependencies cell) onRef rewriteCell :: CellCoord -> Grid -> IO [CellCoord] rewriteCell coord grid = do input <- Cell.input <$> getCell coord grid setCell coord input grid evaluate :: CellCoord -> Grid -> IO [CellCoord] evaluate evalCoord grid = let evaluateCell = Cell.evaluate $ flip referencedCellValue grid evalRec (coord@(row,col)) = do cell <- getCell coord grid updateCellIO coord evaluateCell grid changed1 <- forM (Cell.dependent cell) evalRec changed2 <- evaluateHeaderDeps row rowHeader grid changed3 <- evaluateHeaderDeps col columnHeader grid return $ coord : ((concat changed1) ++ changed2 ++ changed3) in evalRec evalCoord evaluateHeaderDeps :: Int -> (Grid -> Header) -> Grid -> IO [CellCoord] evaluateHeaderDeps i getHeader grid = do dependents <- Header.dependents i $ getHeader grid concat <$> (forM dependents $ \d -> evaluate d grid) evaluateAllHeaderDeps :: (Grid -> Header) -> Grid -> IO [CellCoord] evaluateAllHeaderDeps getHeader grid = do dependents <- Header.allDependents $ getHeader grid concat <$> (forM dependents $ \d -> evaluate d grid) referencedCoords :: Reference -> Grid -> IO [CellCoord] referencedCoords ref grid = case ref of Cell coord -> return [coord] Range (from,to) -> return $ coordRange (from,to) Column c -> do rows <- numViewGridRows grid return $ coordRange ((0,c),(rows-1,c)) Row r -> do cols <- numViewGridCols grid return $ coordRange ((r,0),(r,cols-1)) referencedCellValue :: Reference -> Grid -> IO CellValue referencedCellValue ref grid = do coord <- referencedCoords ref grid case ref of (Cell _) -> getCellValue (head coord) grid _ -> ListValue <$> (forM coord $ flip getCellValue grid) updateCellIO :: CellCoord -> (Cell -> IO Cell) -> Grid -> IO () updateCellIO coord f = Dyn.updateIO coord f . cells updateCell :: CellCoord -> (Cell -> Cell) -> Grid -> IO () updateCell coord f = Dyn.update coord f . cells resizeTo :: CellCoord -> Grid -> IO () resizeTo (r,c) = Dyn.resizeTo ((0,0),(r-1,c-1)) . cells addRow,addColumn :: String -> Grid -> IO [CellCoord] addRow name grid = do i <- numViewGridRows grid Header.setLabel name (i-1) $ rowHeader grid evaluateAllHeaderDeps columnHeader grid addColumn name grid = do i <- numViewGridCols grid Header.setLabel name (i-1) $ columnHeader grid evaluateAllHeaderDeps rowHeader grid updateRowLabel,updateColumnLabel :: Int -> String -> Grid -> IO [CellCoord] updateRowLabel i to grid = do Header.setLabel to i $ rowHeader grid changed1 <- do cols <- numViewGridCols grid rowDeps <- forM [0..cols] $ \c -> Cell.dependent <$> (getCell (i,c) grid) forM (concat rowDeps) $ flip rewriteCell grid changed2 <- do headerDeps <- Header.dependents i $ rowHeader grid forM headerDeps $ flip rewriteCell grid return $ (concat changed1) ++ (concat changed2) updateColumnLabel i to grid = do Header.setLabel to i $ columnHeader grid changed1 <- do rows <- numViewGridRows grid colDeps <- forM [0..rows] $ \r -> Cell.dependent <$> (getCell (r,i) grid) forM (concat colDeps) $ flip rewriteCell grid changed2 <- do headerDeps <- Header.dependents i $ columnHeader grid forM headerDeps $ flip rewriteCell grid return $ (concat changed1) ++ (concat changed2) rowIndex,columnIndex :: String -> Grid -> IO (Maybe Int) rowIndex name grid = Header.index name $ rowHeader grid columnIndex name grid = Header.index name $ columnHeader grid labelsToCoord :: (String,String) -> Grid -> IO (Maybe CellCoord) labelsToCoord (rowName,columnName) grid = do row <- rowIndex rowName grid col <- columnIndex columnName grid return $ case (row,col) of (Just r,Just c) -> Just (r,c) _ -> Nothing getFilePath :: Grid -> IO (Maybe FilePath) getFilePath = readIORef . filePath setFilePath :: FilePath -> Grid -> IO () setFilePath path grid = writeIORef (filePath grid) $ Just path deleteColumns :: [Int] -> Grid -> IO () deleteColumns cols grid = do Header.delete cols $ columnHeader grid Dyn.deleteColumnsInMatrix cols $ cells grid deleteRows :: [Int] -> Grid -> IO () deleteRows rows grid = do Header.delete rows $ rowHeader grid Dyn.deleteRowsInMatrix rows $ cells grid getColumnValues :: Int -> Grid -> IO [CellValue] getColumnValues i grid = do rows <- numViewGridRows grid forM [0..rows-1] $ \row -> getCellValue (row,i) grid compile :: (CellExpr,CellCoord) -> Grid -> IO CellExpr compile (expr,coord) grid = do expr' <- referenceConversion expr grid referenceLoop <- checkReferenceLoop (expr',coord) grid if referenceLoop then return $ CompileErrorExpr ReferenceLoop else return expr' checkReferenceLoop :: (CellExpr,CellCoord) -> Grid -> IO Bool checkReferenceLoop (expr,at) grid = let searchOnDependencies deps = do refCoords <- do cs <- forM deps $ referencedCoords `flip` grid return $ concat cs or <$> forM refCoords depthFirstSearch depthFirstSearch coords | coords == at = return True depthFirstSearch coords = do deps <- Cell.dependencies <$> getCell coords grid searchOnDependencies deps in searchOnDependencies $ CellContent.dependencies expr referenceConversion :: CellExpr -> Grid -> IO CellExpr referenceConversion expr grid = let convert (NamedCell a) = fmap Cell <$> labelsToCoord a grid convert (NamedRange (a,b)) = do a' <- labelsToCoord a grid b' <- labelsToCoord b grid case (a',b') of (Just x,Just y) -> return $ Just $ Range (x,y) _ -> return Nothing convert (NamedColumn a) = fmap Column <$> columnIndex a grid convert (NamedRow a) = fmap Row <$> rowIndex a grid refConversion = flip referenceConversion grid in case expr of NamedReference ref -> do ref' <- convert ref case ref' of Just r -> return $ Reference r Nothing -> return $ CompileErrorExpr $ RefConversionError ref ListExpr a -> ListExpr <$> forM a refConversion UnaryOp s a -> UnaryOp s <$> refConversion a BinaryOp s a b -> do a' <- refConversion a b' <- refConversion b return $ BinaryOp s a' b' Call s a -> Call s <$> refConversion a Sub a -> Sub <$> refConversion a _ -> return expr