Canonical.hs

module Controller.Canonical (getRowInput,getColumnInput
                            ,addRowInput,addColumnInput
                            ,addRowExpr,addColumnExpr
                            ,writeRowInput,writeColumnInput
                            ,writeRowExpr,writeColumnExpr)
    where

import Control.Monad (forM)
import Controller (Controller,onGridView) 
import Controller.Cell (getInput)     
import qualified Controller.Grid as Grid
import View.Component.Grid (numDataRows,numDataColumns,getColumnLabel
                           ,getRowLabel)
import Model.CellContent (CellExpr)
import CellCoordinate (CellCoord,coordRange)

getRowInput :: Int -> Controller (String,[String])
getRowInput row = do
  label <- onGridView $ getRowLabel row
  cells <- do cols <- onGridView numDataColumns
              forM [0..cols-1] $ \c -> getInput (row,c)
  return (label,cells)

getColumnInput :: Int -> Controller (String,[String])
getColumnInput col = do
  label <- onGridView $ getColumnLabel col
  cells <- do rows <- onGridView numDataRows
              forM [0..rows-1] $ \r -> getInput (r,col)
  return (label,cells)

addRowInput,addColumnInput :: Maybe String -> [String] -> Controller ()
addRowInput label cells = do
  index <- onGridView numDataRows
  maybe (Grid.addNRows 1) (\l -> Grid.addRows [l]) label
  writeRowInput index cells

addColumnInput label cells = do
  index <- onGridView numDataColumns
  maybe (Grid.addNColumns 1) (\l -> Grid.addColumns [l]) label
  writeColumnInput index cells

addRowExpr,addColumnExpr :: Maybe String -> [CellExpr] -> Controller ()
addRowExpr label cells = do
  index <- onGridView numDataRows
  maybe (Grid.addNRows 1) (\l -> Grid.addRows [l]) label
  writeRowExpr index cells

addColumnExpr label cells = do
  index <- onGridView numDataColumns
  maybe (Grid.addNColumns 1) (\l -> Grid.addColumns [l]) label
  writeColumnExpr index cells

writeRowInput,writeColumnInput :: Int -> [String] -> Controller ()
writeRowInput = writeRow Grid.writeCellInput
writeColumnInput = writeColumn Grid.writeCellInput

writeRowExpr,writeColumnExpr :: Int -> [CellExpr] -> Controller ()
writeRowExpr = writeRow Grid.writeCellExpr
writeColumnExpr = writeColumn Grid.writeCellExpr

writeRow,writeColumn :: ([(CellCoord,a)] -> Controller ()) -> Int 
                     -> [a] -> Controller ()
writeRow write index rowData = do
  colsInView <- onGridView numDataColumns
  let range = let numCols = max colsInView $ length rowData
              in coordRange ((index,0),(index,numCols-1))
  write $ zip range rowData

writeColumn write index columnData = do
  rowsInView <- onGridView numDataRows
  let range = let numRows = max rowsInView $ length columnData
              in coordRange ((0,index),(numRows-1,index))
  write $ zip range columnData