Grid.hs

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