Grid.hs

module Model.Grid (Grid,new,getCell,setCellInput,setCellExpr
                  ,rewriteCell,updateCell,updateCellIO,resizeTo
                  ,addRows,addColumns,deleteColumns,deleteRows
                  ,insertRowBefore,insertColumnBefore                  
                  ,updateRowLabel,updateColumnLabel
                  ,columnIndex,rowIndex
                  ,dependencyCoordsFromInput,getFilePath,save,isSaved
                  ,getColumnValues,getRowValues,evaluateString)
    where

import Control.Monad (forM,forM_,when)
import Control.Applicative ((<$>))
import Data.IORef
import System.FilePath (takeFileName)
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(..),CellReference(..)
                         ,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 ModelToView (ModelToView)
import qualified ModelToView

data Grid = Grid { cells :: DynArray CellCoord Cell
                 , rowHeader :: Header
                 , columnHeader :: Header
                 , filePath :: IORef (Maybe FilePath)
                 , gridIsSaved :: IORef Bool
                 , numViewGridRows :: IO Int
                 , numViewGridCols :: IO Int
                 , markAsSavedAs :: String -> IO ()
                 , markAsUnsaved :: IO ()
                 }

new :: ModelToView -> IO Grid
new toView = do
  cells <- Dyn.newMatrix (1,1) Cell.empty
  rowHeader <- Header.new
  columnHeader <- Header.new
  filePath <- newIORef Nothing
  gridIsSaved <- newIORef False
  return $ Grid cells rowHeader columnHeader filePath gridIsSaved
         (ModelToView.numDataRows toView) 
         (ModelToView.numDataColumns toView)
         (ModelToView.markAsSavedAs toView) 
         (ModelToView.markAsUnsaved toView) 

getCell :: CellCoord -> Grid -> IO Cell
getCell coord = Dyn.read coord . cells

getCellValue :: CellCoord -> Grid -> IO CellValue
getCellValue coord grid = Cell.value <$> getCell coord grid

setCellInput :: CellCoord -> String -> Grid -> IO [CellCoord]
setCellInput coord input grid = do
  expr <- compile (parse input,coord) grid
  setCell coord expr input grid

setCellExpr :: CellCoord -> CellExpr -> Grid -> IO [CellCoord]
setCellExpr coord expr grid = do
  expr' <- compile (expr,coord) grid
  setCell coord expr' ('=':show expr) grid

setCell :: CellCoord -> CellExpr -> String -> Grid -> IO [CellCoord]
setCell coord expr input grid = do
  unsave grid
  cell <- getCell coord grid
  deleteDependenciesOf cell
  let cell' = Cell.setExpression input expr cell
  Dyn.write coord cell' $ cells grid
  addDependenciesOf cell'
  evaluate coord grid
    where
      onCoords coords f = forM_ coords $ \c -> updateCell c f grid

      deleteDependenciesOf 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

      addDependenciesOf 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
  cell <- getCell coord grid
  if (not . null $ Cell.dependencies cell) 
   then setCellInput coord (Cell.input cell) grid else return []

rewriteAllCells :: Grid -> IO ()
rewriteAllCells grid = do
  rows <- numViewGridRows grid
  cols <- numViewGridCols grid
  forM_ [0..rows-1] $ \r ->
      forM_ [0..cols-1] $ \c -> rewriteCell (r,c) grid >> return ()

evaluate :: CellCoord -> Grid -> IO [CellCoord]
evaluate evalCoord grid = 
    let evaluateCell = Cell.evaluate $ referencedCellValue `flip` grid
        
        evaluateHeaderDeps i getHeader = do
          dependents <- Header.dependents i $ getHeader grid
          concat <$> (forM dependents $ \d -> evaluate d grid)

        evalRec (coord@(row,col)) = do          
          cell <- getCell coord grid
          updateCellIO coord evaluateCell grid
          changed1 <- forM (Cell.dependent cell) evalRec
          changed2 <- evaluateHeaderDeps row rowHeader
          changed3 <- evaluateHeaderDeps col columnHeader
          return $ coord : ((concat changed1) ++ changed2 ++ changed3)
    in
      evalRec evalCoord

evaluateString :: String -> CellCoord -> Grid -> IO CellValue
evaluateString input coord grid = do
  expr <- compile (parse input,coord) grid
  Cell.evaluate (referencedCellValue `flip` grid) 
                (Cell.setExpression input expr Cell.empty)
          >>= return . Cell.value

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))

dependencyCoordsFromInput :: String -> Grid -> IO [CellCoord]
dependencyCoordsFromInput input grid = 
    let parsed = parse input
        isValidRef ref = 
            case ref of NamedReference (NamedCell (SameRow _)) -> False
                        NamedReference (NamedCell (SameColumn _)) -> False
                        NamedReference _ -> True
                        ListExpr l -> and $ map isValidRef l
                        _ -> False
        getDepCoords expr =
            case expr of
              Reference r -> referencedCoords r grid
              ListExpr l -> concat <$> (forM l getDepCoords)
    in
      if not $ isValidRef parsed then return []
      else referenceConversion (parsed,(-1,-1)) grid >>= getDepCoords

referencedCellValue :: Reference -> Grid -> IO CellValue
referencedCellValue ref grid = do
  coord <- referencedCoords ref grid
  case ref of
    (Cell _) -> getCellValue (head coord) grid
    _ -> ListValue <$> (forM coord $ getCellValue `flip` grid)

updateCellIO :: CellCoord -> (Cell -> IO Cell) -> Grid -> IO ()
updateCellIO coord f grid = unsave grid 
                            >> (Dyn.updateIO coord f $ cells grid)

updateCell :: CellCoord -> (Cell -> Cell) -> Grid -> IO ()
updateCell coord f grid = unsave grid 
                          >> (Dyn.update coord f $ cells grid)

resizeTo :: CellCoord -> Grid -> IO ()
resizeTo (r,c) = Dyn.resizeTo ((0,0),(r-1,c-1)) . cells

addRows,addColumns :: [String] -> Grid -> IO ()
addRows names grid = do
  n <- numViewGridRows grid
  forM_ (zip [n..] names) $ \(i,name) -> 
      Header.setLabel name i $ rowHeader grid
  unsave grid >> rewriteAllCells grid

addColumns names grid = do
  n <- numViewGridCols grid
  forM_ (zip [n..] names) $ \(i,name) -> 
      Header.setLabel name i $ columnHeader grid
  unsave grid >> rewriteAllCells grid

deleteColumns :: [Int] -> Grid -> IO ()
deleteColumns cols grid = do
  Header.delete cols $ columnHeader grid
  Dyn.deleteColumnsInMatrix cols $ cells grid
  unsave grid >> rewriteAllCells grid

deleteRows :: [Int] -> Grid -> IO ()
deleteRows rows grid = do
  Header.delete rows $ rowHeader grid
  Dyn.deleteRowsInMatrix rows $ cells grid
  unsave grid >> rewriteAllCells grid

insertRowBefore,insertColumnBefore :: String -> Int -> Grid -> IO ()
insertRowBefore name i grid = do
  rows <- numViewGridRows grid
  Header.insertLabelBefore name i (rows-1) $ rowHeader grid
  Dyn.insertEmptyRowIntoMatrixBefore i (rows-1) $ cells grid
  unsave grid >> rewriteAllCells grid

insertColumnBefore name i grid = do
  cols <- numViewGridCols grid
  Header.insertLabelBefore name i (cols-1) $ columnHeader grid
  Dyn.insertEmptyColumnIntoMatrixBefore i (cols-1) $ cells grid
  unsave grid >> rewriteAllCells 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) $ rewriteCell `flip` grid
  changed2 <- do
    headerDeps <- Header.dependents i $ rowHeader grid
    forM headerDeps $ rewriteCell `flip` grid  
  unsave 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) $ rewriteCell `flip` grid
  changed2 <- do
    headerDeps <- Header.dependents i $ columnHeader grid
    forM headerDeps $ rewriteCell `flip` grid  
  unsave 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

save :: FilePath -> Grid -> IO ()
save path grid = do
  writeIORef (gridIsSaved grid) True
  writeIORef (filePath grid) $ Just path
  markAsSavedAs grid $ takeFileName path

unsave :: Grid -> IO ()
unsave grid = do
  currentlySaved <- isSaved grid
  writeIORef (gridIsSaved grid) False
  when currentlySaved $ markAsUnsaved grid

isSaved :: Grid -> IO Bool
isSaved = readIORef . gridIsSaved

getColumnCells,getRowCells :: Int -> Grid -> IO [Cell]
getColumnCells i grid = do
  rows <- numViewGridRows grid
  forM [0..rows-1] $ \row -> getCell (row,i) grid

getRowCells i grid = do
  cols <- numViewGridCols grid
  forM [0..cols-1] $ \col -> getCell (i,col) grid

getColumnValues,getRowValues :: Int -> Grid -> IO [CellValue]
getColumnValues i grid = map Cell.value <$> getColumnCells i grid
getRowValues i grid = map Cell.value <$> getRowCells i grid

compile :: (CellExpr,CellCoord) -> Grid -> IO CellExpr
compile (expr,coord) grid = do
  expr' <- referenceConversion (expr,coord) grid
  referenceLoop <- checkReferenceLoop (expr',coord) grid
  if referenceLoop then return $ CompileErrorExpr ReferenceLoop
   else return expr'

checkReferenceLoop :: (CellExpr,CellCoord) -> Grid -> IO Bool
checkReferenceLoop (expr,coord) grid =
    let searchOnDependencies deps = do
          refCoords <- do cs <- forM deps $ referencedCoords `flip` grid
                          return $ concat cs
          or <$> forM refCoords depthFirstSearch

        depthFirstSearch coord' | coord' == coord = return True
        depthFirstSearch coord' = do
          deps <- Cell.dependencies <$> getCell coord' grid
          searchOnDependencies deps      
    in
      searchOnDependencies $ CellContent.dependencies expr

referenceConversion :: (CellExpr,CellCoord) -> Grid -> IO CellExpr
referenceConversion (expr,(row,col)) grid =
    let convert (NamedCell (Named a)) = 
            fmap Cell <$> labelsToCoord a grid
        convert (NamedCell (SameRow colName)) =
            fmap (\c -> Cell (row,c)) <$> columnIndex colName grid
        convert (NamedCell (SameColumn rowName)) =
            fmap (\r -> Cell (r,col)) <$> rowIndex rowName grid
        convert (NamedRange (a,b)) = 
            do a' <- convert $ NamedCell a
               b' <- convert $ NamedCell b
               return $ case (a',b') of
                 (Just (Cell x),Just (Cell y)) -> Just $ Range (x,y) 
                 _ -> Nothing
        convert (NamedColumn a) = fmap Column <$> columnIndex a grid
        convert (NamedRow a) = fmap Row <$> rowIndex a grid
        refConversion e = referenceConversion (e,(row,col)) 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
         IfThenElse a b c -> do a' <- refConversion a
                                b' <- refConversion b
                                c' <- refConversion c
                                return $ IfThenElse a' b' c'
         _ -> return expr