packages feed

lhae-0.0.3: src/Controller/Menu/Table/Transpose.hs

module Controller.Menu.Table.Transpose 
    (tableEventHandler,columnEventHandler,rowEventHandler
    ,columnEventHandlerWith,rowEventHandlerWith)
    where

import Control.Monad (forM_,forM)
import Controller (Controller,onGridView)
import Controller.Dialog (chooseColumnsDialog,chooseRowsDialog)
import Controller.Canonical (getColumnInput,getRowInput
                            ,addRowInput,addColumnInput)
import qualified Controller.Grid as Grid
import View.Component.Grid (getRowLabels,getColumnLabels
                           ,numDataColumns)
import I18n (__)

tableEventHandler,columnEventHandler,rowEventHandler :: Controller ()
tableEventHandler = do
  n <- onGridView numDataColumns
  transposeColumns [0..n-1]

columnEventHandler = columnEventHandlerWith []
rowEventHandler = rowEventHandlerWith []

columnEventHandlerWith,rowEventHandlerWith :: [Int] -> Controller ()
columnEventHandlerWith init =
    chooseColumnsDialog (__ "Transpose") (__ "&Transpose") init
    >>= transposeColumns

rowEventHandlerWith init = 
    chooseRowsDialog (__ "Transpose") (__ "&Transpose") init
    >>= transposeRows

transposeColumns :: [Int] -> Controller ()
transposeColumns [] = return ()
transposeColumns cols = do
  columnData <- forM cols getColumnInput
  rowLabels <- onGridView getRowLabels
  Grid.new
  forM_ columnData $ \(label,xs) -> addRowInput (Just label) xs
  Grid.updateColumnLabels rowLabels

transposeRows :: [Int] -> Controller ()
transposeRows [] = return ()
transposeRows rows = do
  rowData <- forM rows getRowInput
  colLabels <- onGridView getColumnLabels
  Grid.new
  forM_ rowData $ \(label,xs) -> addColumnInput (Just label) xs
  Grid.updateRowLabels colLabels