packages feed

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

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

import Controller (Controller,onView,onGridView)
import Controller.Dialog (noColumnsSelected,noRowsSelected)
import Controller.Grid (updateRowLabel,updateColumnLabel)
import View.Component.Grid (getRowLabel,getColumnLabel
                           ,getRowLabels,getColumnLabels)
import View.Dialog.Complex (Layout (..),Widget (..),Modifier (..)
                           ,showSimpleDialog,cancelButton)
import I18n (__)

data Parameters = Parameters { from :: Maybe Int
                             , to :: String}

columnEventHandler :: Controller ()
columnEventHandler = columnEventHandlerBase Nothing

columnEventHandlerWith :: Int -> Controller ()
columnEventHandlerWith = columnEventHandlerBase . Just

columnEventHandlerBase :: Maybe Int -> Controller ()
columnEventHandlerBase col = do
  labels <- onGridView getColumnLabels
  initTo <- maybe (return "") (onGridView . getColumnLabel) col
  result <- onView $ showSimpleDialog (__ "Rename column")
            (dialog (__ "Column") labels) $ Parameters col initTo
  case result of
    Nothing -> return ()
    Just (Parameters {from = Nothing}) -> do noColumnsSelected
                                             return ()
    Just (Parameters {from = Just from,to = to}) ->
        updateColumnLabel from to

rowEventHandler :: Controller ()
rowEventHandler = rowEventHandlerBase Nothing

rowEventHandlerWith :: Int -> Controller ()
rowEventHandlerWith = rowEventHandlerBase . Just

rowEventHandlerBase :: Maybe Int -> Controller ()
rowEventHandlerBase row = do
  labels <- onGridView getRowLabels
  initTo <- maybe (return "") (onGridView . getRowLabel) row
  result <- onView $ showSimpleDialog (__ "Rename row")
            (dialog (__ "Row") labels) $ Parameters row initTo
  case result of
    Nothing -> return ()
    Just (Parameters {from = Nothing}) -> do noRowsSelected
                                             return ()
    Just (Parameters {from = Just from,to = to}) ->
        updateRowLabel from to
        
dialog :: String -> [String] -> Layout Parameters ()
dialog listCaption labels =
    let setFrom p f = p {from = f}
        setTo p t = p {to = t}
        listBox = SingleListBox labels from setFrom
        labelEntry = TextEntry to setTo
    in
      Modifier Margin $ Column
        [ Modifier (Boxed listCaption) $ Modifier HFill $ Widget listBox
        , Modifiers [Boxed $ __ "Label",HFill] $ FocusOn labelEntry
        , Modifier Center $ Row 
                   [ Widget $ DefaultButton (__ "&Rename") ()
                   , cancelButton]]