diff --git a/i18n/de.po b/i18n/de.po --- a/i18n/de.po +++ b/i18n/de.po @@ -90,10 +90,14 @@ msgid "Rows" msgstr "Zeilen" -#: src/Run.hs:0 src/Controller/Menu/Table/Copy.hs:0 +#: src/Run.hs:0 msgid "Copy" msgstr "Kopieren" +#: src/Run.hs:0 +msgid "Formula" +msgstr "Formel" + #: src/Run.hs:0 src/Controller/Menu/Table/Delete.hs:0 msgid "Delete" msgstr "Löschen" @@ -103,10 +107,24 @@ msgstr "Transponieren" #: src/Run.hs:0 -msgid "Reevaluate all cells" -msgstr "Alle Zellen auswerten" +msgid "Rename" +msgstr "Umbenennen" +#: src/Run.hs:0 src/Controller/Dialog.hs:0 +#: src/Controller/Menu/Table/Rename.hs:0 +msgid "Column" +msgstr "Spalte" + +#: src/Run.hs:0 src/Controller/Dialog.hs:0 +#: src/Controller/Menu/Table/Rename.hs:0 +msgid "Row" +msgstr "Zeile" + #: src/Run.hs:0 +msgid "Filter" +msgstr "Filtern" + +#: src/Run.hs:0 msgid "Statistics" msgstr "Statistik" @@ -159,10 +177,6 @@ msgstr "Typ-Fehler in" #: src/Model/CellContent.hs:0 -msgid "In" -msgstr "In" - -#: src/Model/CellContent.hs:0 msgid "Unknown identifier" msgstr "Unbekannter Bezeichner" @@ -183,6 +197,10 @@ msgstr "Funktionsaufruf" #: src/Model/CellExpression/Parser.hs:0 +msgid "constant" +msgstr "Konstante" + +#: src/Model/CellExpression/Parser.hs:0 msgid "number" msgstr "Nummer" @@ -207,6 +225,10 @@ msgstr "Subausdruck" #: src/Model/CellExpression/Parser.hs:0 +msgid "if-then-else expression" +msgstr "if-then-else-Ausdruck" + +#: src/Model/CellExpression/Parser.hs:0 msgid "end of input" msgstr "Ende der Eingabe" @@ -223,10 +245,6 @@ msgstr "Alle Dateien" #: src/Controller/Dialog.hs:0 -msgid "Column" -msgstr "Spalte" - -#: src/Controller/Dialog.hs:0 msgid "to" msgstr "nach" @@ -246,6 +264,58 @@ msgid "No columns selected" msgstr "Keine Spalten ausgewählt" +#: src/Controller/Dialog.hs:0 +msgid "No rows selected" +msgstr "Keine Zeilen ausgewählt" + +#: src/Controller/Dialog.hs:0 +msgid "Are you sure?" +msgstr "Sind Sie sicher?" + +#: src/Controller/Grid.hs:0 +msgid "Copy row" +msgstr "Zeile kopieren" + +#: src/Controller/Grid.hs:0 +msgid "Delete row" +msgstr "Zeile löschen" + +#: src/Controller/Grid.hs:0 +msgid "Insert row" +msgstr "Zeile einfügen" + +#: src/Controller/Grid.hs:0 +msgid "Transpose row" +msgstr "Zeile transponieren" + +#: src/Controller/Grid.hs:0 src/Controller/Menu/Table/Rename.hs:0 +msgid "Rename row" +msgstr "Zeile umbenennen" + +#: src/Controller/Grid.hs:0 +msgid "Copy column" +msgstr "Spalte kopieren" + +#: src/Controller/Grid.hs:0 +msgid "Delete column" +msgstr "Spalte löschen" + +#: src/Controller/Grid.hs:0 +msgid "Insert column" +msgstr "Spalte einfügen" + +#: src/Controller/Grid.hs:0 +msgid "Transpose column" +msgstr "Spalte transponieren" + +#: src/Controller/Grid.hs:0 src/Controller/Menu/Table/Rename.hs:0 +msgid "Rename column" +msgstr "Spalte umbenennen" + +#: src/Controller/Grid.hs:0 src/Controller/Menu/Table/Copy.hs:0 +msgid "Copy formula" +msgstr "Formel kopieren" + #: src/Controller/Menu/File/NewClose.hs:0 msgid "Save?" msgstr "Speichern?" @@ -283,12 +353,8 @@ msgstr "Entferne Leerzeichen" #: src/Controller/Menu/File/Import/Csv.hs:0 -msgid "Try parsing numbers" -msgstr "Versuche Zahlen zu interpretieren" - -#: src/Controller/Menu/File/Import/Csv.hs:0 -msgid "&Import" -msgstr "&Importieren" +msgid "&Import ..." +msgstr "&Importieren ..." #: src/Controller/Menu/File/Export/Image.hs:0 msgid "Font size (pt)" @@ -321,14 +387,14 @@ #: src/Controller/Menu/File/Export/Image.hs:0 #: src/Controller/Menu/File/Export/Diagram/BarChart.hs:0 #: src/Controller/Menu/File/Export/Diagram/BoxPlot.hs:0 -msgid "&Export" -msgstr "&Exportieren" +msgid "&Export ..." +msgstr "&Exportieren ..." #: src/Controller/Menu/File/Export/Image.hs:0 #: src/Controller/Menu/File/Export/Diagram/BarChart.hs:0 #: src/Controller/Menu/File/Export/Diagram/BoxPlot.hs:0 -msgid "&Preview" -msgstr "&Vorschau" +msgid "&Preview ..." +msgstr "&Vorschau ..." #: src/Controller/Menu/File/Export/ImageParameters.hs:0 msgid "By extension" @@ -383,6 +449,66 @@ msgid "&Add" msgstr "&Hinzufügen" +#: src/Controller/Menu/Table/Copy.hs:0 +msgid "Copy columns" +msgstr "Spalten kopieren" + +#: src/Controller/Menu/Table/Copy.hs:0 +msgid "C&opy" +msgstr "&Kopieren" + +#: src/Controller/Menu/Table/Copy.hs:0 +msgid "Copy rows" +msgstr "Zeilen kopieren" + +#: src/Controller/Menu/Table/Copy.hs:0 +msgid "Source" +msgstr "Quelle" + +#: src/Controller/Menu/Table/Copy.hs:0 +msgid "Destination" +msgstr "Ziel" + +#: src/Controller/Menu/Table/Copy.hs:0 +msgid "No valid source or destination selected" +msgstr "Ungültige(s) Quelle/Ziel" + +#: src/Controller/Menu/Table/Delete.hs:0 +msgid "&Delete" +msgstr "&Löschen" + +#: src/Controller/Menu/Table/Rename.hs:0 +msgid "Label" +msgstr "Beschriftung" + +#: src/Controller/Menu/Table/Rename.hs:0 +msgid "&Rename" +msgstr "&Umbenennen" + +#: src/Controller/Menu/Table/Transpose.hs:0 +msgid "&Transpose" +msgstr "&Transponieren" + +#: src/Controller/Menu/Table/Filter.hs:0 +msgid "Filter rows" +msgstr "Zeilen filter" + +#: src/Controller/Menu/Table/Filter.hs:0 +msgid "Filter columns" +msgstr "Spalten filtern" + +#: src/Controller/Menu/Table/Filter.hs:0 +msgid "Filter condition" +msgstr "Filter-Bedingung" + +#: src/Controller/Menu/Table/Filter.hs:0 +msgid "&Filter" +msgstr "&Filtern" + +#: src/Controller/Menu/Table/Filter.hs:0 +msgid "Unexpected results:" +msgstr "Unerwartete Ergebnisse" + #: src/Controller/Menu/Statistics/Descriptive.hs:0 msgid "Descriptive Statistics" msgstr "Deskriptive Statistik" @@ -471,3 +597,15 @@ #: src/Controller/Menu/Statistics/Pivot.hs:0 msgid "Total" msgstr "Total" + +#~ msgid "&Import" +#~ msgstr "&Importieren" + +#~ msgid "&Export" +#~ msgstr "&Exportieren" + +#~ msgid "&Preview" +#~ msgstr "&Vorschau" + +#~ msgid "&Copy" +#~ msgstr "&Kopieren" diff --git a/i18n/en.po b/i18n/en.po --- a/i18n/en.po +++ b/i18n/en.po @@ -93,10 +93,14 @@ msgid "Rows" msgstr "" -#: src/Run.hs:0 src/Controller/Menu/Table/Copy.hs:0 +#: src/Run.hs:0 msgid "Copy" msgstr "Copy" +#: src/Run.hs:0 +msgid "Formula" +msgstr "" + #: src/Run.hs:0 src/Controller/Menu/Table/Delete.hs:0 msgid "Delete" msgstr "Delete" @@ -106,10 +110,25 @@ msgstr "" #: src/Run.hs:0 -msgid "Reevaluate all cells" -msgstr "Reevaluate all cells" +msgid "Rename" +msgstr "" +#: src/Run.hs:0 src/Controller/Dialog.hs:0 +#: src/Controller/Menu/Table/Rename.hs:0 +#, fuzzy +msgid "Column" +msgstr "Column" + +#: src/Run.hs:0 src/Controller/Dialog.hs:0 +#: src/Controller/Menu/Table/Rename.hs:0 +msgid "Row" +msgstr "" + #: src/Run.hs:0 +msgid "Filter" +msgstr "" + +#: src/Run.hs:0 msgid "Statistics" msgstr "Statistics" @@ -164,10 +183,6 @@ msgstr "" #: src/Model/CellContent.hs:0 -msgid "In" -msgstr "" - -#: src/Model/CellContent.hs:0 #, fuzzy msgid "Unknown identifier" msgstr "File" @@ -189,6 +204,10 @@ msgstr "" #: src/Model/CellExpression/Parser.hs:0 +msgid "constant" +msgstr "" + +#: src/Model/CellExpression/Parser.hs:0 msgid "number" msgstr "" @@ -213,6 +232,10 @@ msgstr "" #: src/Model/CellExpression/Parser.hs:0 +msgid "if-then-else expression" +msgstr "" + +#: src/Model/CellExpression/Parser.hs:0 msgid "end of input" msgstr "" @@ -229,11 +252,6 @@ msgstr "" #: src/Controller/Dialog.hs:0 -#, fuzzy -msgid "Column" -msgstr "Column" - -#: src/Controller/Dialog.hs:0 msgid "to" msgstr "" @@ -254,6 +272,58 @@ msgid "No columns selected" msgstr "" +#: src/Controller/Dialog.hs:0 +msgid "No rows selected" +msgstr "" + +#: src/Controller/Dialog.hs:0 +msgid "Are you sure?" +msgstr "" + +#: src/Controller/Grid.hs:0 +msgid "Copy row" +msgstr "" + +#: src/Controller/Grid.hs:0 +msgid "Delete row" +msgstr "" + +#: src/Controller/Grid.hs:0 +msgid "Insert row" +msgstr "" + +#: src/Controller/Grid.hs:0 +msgid "Transpose row" +msgstr "" + +#: src/Controller/Grid.hs:0 src/Controller/Menu/Table/Rename.hs:0 +msgid "Rename row" +msgstr "" + +#: src/Controller/Grid.hs:0 +msgid "Copy column" +msgstr "" + +#: src/Controller/Grid.hs:0 +msgid "Delete column" +msgstr "" + +#: src/Controller/Grid.hs:0 +msgid "Insert column" +msgstr "" + +#: src/Controller/Grid.hs:0 +msgid "Transpose column" +msgstr "" + +#: src/Controller/Grid.hs:0 src/Controller/Menu/Table/Rename.hs:0 +msgid "Rename column" +msgstr "" + +#: src/Controller/Grid.hs:0 src/Controller/Menu/Table/Copy.hs:0 +msgid "Copy formula" +msgstr "" + #: src/Controller/Menu/File/NewClose.hs:0 #, fuzzy msgid "Save?" @@ -293,14 +363,9 @@ msgstr "" #: src/Controller/Menu/File/Import/Csv.hs:0 -msgid "Try parsing numbers" +msgid "&Import ..." msgstr "" -#: src/Controller/Menu/File/Import/Csv.hs:0 -#, fuzzy -msgid "&Import" -msgstr "Export" - #: src/Controller/Menu/File/Export/Image.hs:0 msgid "Font size (pt)" msgstr "" @@ -333,14 +398,13 @@ #: src/Controller/Menu/File/Export/Image.hs:0 #: src/Controller/Menu/File/Export/Diagram/BarChart.hs:0 #: src/Controller/Menu/File/Export/Diagram/BoxPlot.hs:0 -#, fuzzy -msgid "&Export" -msgstr "Export" +msgid "&Export ..." +msgstr "" #: src/Controller/Menu/File/Export/Image.hs:0 #: src/Controller/Menu/File/Export/Diagram/BarChart.hs:0 #: src/Controller/Menu/File/Export/Diagram/BoxPlot.hs:0 -msgid "&Preview" +msgid "&Preview ..." msgstr "" #: src/Controller/Menu/File/Export/ImageParameters.hs:0 @@ -397,6 +461,66 @@ msgid "&Add" msgstr "" +#: src/Controller/Menu/Table/Copy.hs:0 +msgid "Copy columns" +msgstr "" + +#: src/Controller/Menu/Table/Copy.hs:0 +msgid "C&opy" +msgstr "" + +#: src/Controller/Menu/Table/Copy.hs:0 +msgid "Copy rows" +msgstr "" + +#: src/Controller/Menu/Table/Copy.hs:0 +msgid "Source" +msgstr "" + +#: src/Controller/Menu/Table/Copy.hs:0 +msgid "Destination" +msgstr "" + +#: src/Controller/Menu/Table/Copy.hs:0 +msgid "No valid source or destination selected" +msgstr "" + +#: src/Controller/Menu/Table/Delete.hs:0 +msgid "&Delete" +msgstr "" + +#: src/Controller/Menu/Table/Rename.hs:0 +msgid "Label" +msgstr "" + +#: src/Controller/Menu/Table/Rename.hs:0 +msgid "&Rename" +msgstr "" + +#: src/Controller/Menu/Table/Transpose.hs:0 +msgid "&Transpose" +msgstr "" + +#: src/Controller/Menu/Table/Filter.hs:0 +msgid "Filter rows" +msgstr "" + +#: src/Controller/Menu/Table/Filter.hs:0 +msgid "Filter columns" +msgstr "" + +#: src/Controller/Menu/Table/Filter.hs:0 +msgid "Filter condition" +msgstr "" + +#: src/Controller/Menu/Table/Filter.hs:0 +msgid "&Filter" +msgstr "" + +#: src/Controller/Menu/Table/Filter.hs:0 +msgid "Unexpected results:" +msgstr "" + #: src/Controller/Menu/Statistics/Descriptive.hs:0 #, fuzzy msgid "Descriptive Statistics" @@ -484,6 +608,17 @@ #: src/Controller/Menu/Statistics/Pivot.hs:0 msgid "Total" msgstr "" + +#, fuzzy +#~ msgid "&Import" +#~ msgstr "Export" + +#, fuzzy +#~ msgid "&Export" +#~ msgstr "Export" + +#~ msgid "Reevaluate all cells" +#~ msgstr "Reevaluate all cells" #, fuzzy #~ msgid "Save in" diff --git a/i18n/messages.pot b/i18n/messages.pot --- a/i18n/messages.pot +++ b/i18n/messages.pot @@ -88,10 +88,14 @@ msgid "Rows" msgstr "" -#: src/Run.hs:0 src/Controller/Menu/Table/Copy.hs:0 +#: src/Run.hs:0 msgid "Copy" msgstr "" +#: src/Run.hs:0 +msgid "Formula" +msgstr "" + #: src/Run.hs:0 src/Controller/Menu/Table/Delete.hs:0 msgid "Delete" msgstr "" @@ -101,10 +105,24 @@ msgstr "" #: src/Run.hs:0 -msgid "Reevaluate all cells" +msgid "Rename" msgstr "" +#: src/Run.hs:0 src/Controller/Dialog.hs:0 +#: src/Controller/Menu/Table/Rename.hs:0 +msgid "Column" +msgstr "" + +#: src/Run.hs:0 src/Controller/Dialog.hs:0 +#: src/Controller/Menu/Table/Rename.hs:0 +msgid "Row" +msgstr "" + #: src/Run.hs:0 +msgid "Filter" +msgstr "" + +#: src/Run.hs:0 msgid "Statistics" msgstr "" @@ -157,10 +175,6 @@ msgstr "" #: src/Model/CellContent.hs:0 -msgid "In" -msgstr "" - -#: src/Model/CellContent.hs:0 msgid "Unknown identifier" msgstr "" @@ -181,6 +195,10 @@ msgstr "" #: src/Model/CellExpression/Parser.hs:0 +msgid "constant" +msgstr "" + +#: src/Model/CellExpression/Parser.hs:0 msgid "number" msgstr "" @@ -205,6 +223,10 @@ msgstr "" #: src/Model/CellExpression/Parser.hs:0 +msgid "if-then-else expression" +msgstr "" + +#: src/Model/CellExpression/Parser.hs:0 msgid "end of input" msgstr "" @@ -221,10 +243,6 @@ msgstr "" #: src/Controller/Dialog.hs:0 -msgid "Column" -msgstr "" - -#: src/Controller/Dialog.hs:0 msgid "to" msgstr "" @@ -244,6 +262,58 @@ msgid "No columns selected" msgstr "" +#: src/Controller/Dialog.hs:0 +msgid "No rows selected" +msgstr "" + +#: src/Controller/Dialog.hs:0 +msgid "Are you sure?" +msgstr "" + +#: src/Controller/Grid.hs:0 +msgid "Copy row" +msgstr "" + +#: src/Controller/Grid.hs:0 +msgid "Delete row" +msgstr "" + +#: src/Controller/Grid.hs:0 +msgid "Insert row" +msgstr "" + +#: src/Controller/Grid.hs:0 +msgid "Transpose row" +msgstr "" + +#: src/Controller/Grid.hs:0 src/Controller/Menu/Table/Rename.hs:0 +msgid "Rename row" +msgstr "" + +#: src/Controller/Grid.hs:0 +msgid "Copy column" +msgstr "" + +#: src/Controller/Grid.hs:0 +msgid "Delete column" +msgstr "" + +#: src/Controller/Grid.hs:0 +msgid "Insert column" +msgstr "" + +#: src/Controller/Grid.hs:0 +msgid "Transpose column" +msgstr "" + +#: src/Controller/Grid.hs:0 src/Controller/Menu/Table/Rename.hs:0 +msgid "Rename column" +msgstr "" + +#: src/Controller/Grid.hs:0 src/Controller/Menu/Table/Copy.hs:0 +msgid "Copy formula" +msgstr "" + #: src/Controller/Menu/File/NewClose.hs:0 msgid "Save?" msgstr "" @@ -281,11 +351,7 @@ msgstr "" #: src/Controller/Menu/File/Import/Csv.hs:0 -msgid "Try parsing numbers" -msgstr "" - -#: src/Controller/Menu/File/Import/Csv.hs:0 -msgid "&Import" +msgid "&Import ..." msgstr "" #: src/Controller/Menu/File/Export/Image.hs:0 @@ -319,13 +385,13 @@ #: src/Controller/Menu/File/Export/Image.hs:0 #: src/Controller/Menu/File/Export/Diagram/BarChart.hs:0 #: src/Controller/Menu/File/Export/Diagram/BoxPlot.hs:0 -msgid "&Export" +msgid "&Export ..." msgstr "" #: src/Controller/Menu/File/Export/Image.hs:0 #: src/Controller/Menu/File/Export/Diagram/BarChart.hs:0 #: src/Controller/Menu/File/Export/Diagram/BoxPlot.hs:0 -msgid "&Preview" +msgid "&Preview ..." msgstr "" #: src/Controller/Menu/File/Export/ImageParameters.hs:0 @@ -379,6 +445,66 @@ #: src/Controller/Menu/Table/Add.hs:0 msgid "&Add" +msgstr "" + +#: src/Controller/Menu/Table/Copy.hs:0 +msgid "Copy columns" +msgstr "" + +#: src/Controller/Menu/Table/Copy.hs:0 +msgid "C&opy" +msgstr "" + +#: src/Controller/Menu/Table/Copy.hs:0 +msgid "Copy rows" +msgstr "" + +#: src/Controller/Menu/Table/Copy.hs:0 +msgid "Source" +msgstr "" + +#: src/Controller/Menu/Table/Copy.hs:0 +msgid "Destination" +msgstr "" + +#: src/Controller/Menu/Table/Copy.hs:0 +msgid "No valid source or destination selected" +msgstr "" + +#: src/Controller/Menu/Table/Delete.hs:0 +msgid "&Delete" +msgstr "" + +#: src/Controller/Menu/Table/Rename.hs:0 +msgid "Label" +msgstr "" + +#: src/Controller/Menu/Table/Rename.hs:0 +msgid "&Rename" +msgstr "" + +#: src/Controller/Menu/Table/Transpose.hs:0 +msgid "&Transpose" +msgstr "" + +#: src/Controller/Menu/Table/Filter.hs:0 +msgid "Filter rows" +msgstr "" + +#: src/Controller/Menu/Table/Filter.hs:0 +msgid "Filter columns" +msgstr "" + +#: src/Controller/Menu/Table/Filter.hs:0 +msgid "Filter condition" +msgstr "" + +#: src/Controller/Menu/Table/Filter.hs:0 +msgid "&Filter" +msgstr "" + +#: src/Controller/Menu/Table/Filter.hs:0 +msgid "Unexpected results:" msgstr "" #: src/Controller/Menu/Statistics/Descriptive.hs:0 diff --git a/lhae.cabal b/lhae.cabal --- a/lhae.cabal +++ b/lhae.cabal @@ -1,5 +1,5 @@ Name: lhae -Version: 0.0.2 +Version: 0.0.3 Cabal-Version: >= 1.6 License: GPL License-file: COPYING @@ -41,61 +41,65 @@ Other-modules: - Util.Gnuplot - Util.DynArray - CellCoordinate - Model.GridHeader - Model.CellContent - Model.CellExpression.Evaluator.Common - Model.CellExpression.Evaluator.Math - Model.CellExpression.Evaluator - Model.Cell - Model.CellExpression.Parser - View.Component.TextWindow - Util.Sexp - Util.Sexpable - Controller.Menu.File.Export.Diagram.BarChartParameters - Controller.Menu.File.Export.Diagram.BoxPlotParameters - Controller.Menu.File.Import.CsvParameters - Util.Color - Util - View.Component.Grid - View.Component.Notebook - View - View.Modes - Model.Grid - Model - View.FormulaInput - View.GridPage - I18n - Util.FileType - Controller.Menu.File.Export.ImageParameters - View.Dialog.Complex - View.Dialog.Simple - Constants - Config - Controller - Controller.Cell - Controller.Menu.Table.Add - Controller.Grid - Controller.FormulaInput - Controller.Menu.Table.Reevaluate - Controller.Canonical - Controller.SaveConfig - Controller.Dialog - Controller.Menu.File.Open - Controller.Menu.File.Save - Controller.Menu.File.NewClose - Controller.Menu.File.Import.Csv - Controller.Menu.File.Export.Image - Controller.Menu.Table.Copy - Controller.Menu.Table.Delete - Controller.Menu.Table.Transpose - Controller.Menu.Statistics.FrequencyDistribution - Controller.Menu.Statistics.Descriptive - Controller.Menu.Statistics.Pivot - Controller.Menu.File.Export.Diagram.Common - Controller.Menu.File.Export.Diagram.BarChart - Controller.Menu.File.Export.Diagram.BoxPlot - Run - Main + Util.Gnuplot + Util.DynArray + CellCoordinate + Model.GridHeader + View.Component.TextWindow + Util.Sexp + Util.Sexpable + Controller.Menu.File.Export.Diagram.BoxPlotParameters + Controller.Menu.File.Import.CsvParameters + Util.Color + Util + Controller.Menu.File.Export.Diagram.BarChartParameters + View.Component.Grid + View.Component.Notebook + View + View.Modes + View.FormulaInput + View.GridPage + ModelToView + I18n + Util.FileType + Controller.Menu.File.Export.ImageParameters + View.Dialog.Complex + Model.CellContent + Model.CellExpression.Evaluator.Common + Model.CellExpression.Evaluator.Math + Model.CellExpression.Evaluator + Model.Cell + Model.CellExpression.Parser + Model.Grid + Model + View.Dialog.Simple + Constants + Config + Controller + Controller.Cell + Controller.Grid + Controller.Menu.Table.Add + Controller.FormulaInput + Controller.Canonical + Controller.Menu.Table.Filter + Controller.SaveConfig + Controller.Dialog + Controller.Menu.File.Open + Controller.Menu.File.Save + Controller.Menu.File.NewClose + Controller.Menu.File.Import.Csv + Controller.Menu.File.Export.Image + Controller.Menu.Table.Copy + Controller.Menu.Table.Delete + Controller.Menu.Table.Transpose + Controller.Menu.Table.Rename + Controller.Menu.Statistics.FrequencyDistribution + Controller.Menu.Statistics.Descriptive + Controller.Menu.Statistics.Pivot + Controller.Menu.File.Export.Diagram.Common + Controller.Menu.File.Export.Diagram.BarChart + Controller.Menu.File.Export.Diagram.BoxPlot + Run + Main + + diff --git a/src/Config.hs b/src/Config.hs --- a/src/Config.hs +++ b/src/Config.hs @@ -11,7 +11,7 @@ import Data.Maybe (fromMaybe) import qualified I18n import Util.Sexp (Sexp(..),parseFile,prettyPrint) -import Util.Sexpable (Sexpable(..),PSE,unexpected,recordToSexp,recordFromSexp) +import Util.Sexpable (Sexpable(..),PSE,recordToSexp,recordFromSexp) import qualified Controller.Menu.File.Export.ImageParameters as EImage import qualified Controller.Menu.File.Export.Diagram.BarChartParameters as EBarChart import qualified Controller.Menu.File.Export.Diagram.BoxPlotParameters as EBoxPlot @@ -62,7 +62,7 @@ List [Atom "boxPlotExportParameters",params] -> do option <- fromSexp params return $ config {boxPlotExportParameters = option} - _ -> unexpected sexp + _ -> return config load :: FilePath -> IO (Either String Config) load filePath = do diff --git a/src/Controller.hs b/src/Controller.hs --- a/src/Controller.hs +++ b/src/Controller.hs @@ -1,6 +1,6 @@ module Controller (CtrlData,Controller,new,onView,onModel,onGridView ,onGridModel,setOnConfig,getFromConfig - ,currentConfig) + ,currentConfig,withCtrlData,ctrlData) where import Control.Monad.Reader @@ -48,3 +48,9 @@ getFromConfig :: (Config -> a) -> Controller a getFromConfig getter = asks config >>= liftIO . readIORef >>= return . getter + +withCtrlData :: Controller a -> CtrlData -> IO a +withCtrlData = runReaderT + +ctrlData :: Controller CtrlData +ctrlData = ask diff --git a/src/Controller/Canonical.hs b/src/Controller/Canonical.hs --- a/src/Controller/Canonical.hs +++ b/src/Controller/Canonical.hs @@ -1,66 +1,73 @@ -module Controller.Canonical (Row,Column,RowData,ColumnData - ,getRow,getColumn - ,addRow,addColumn,addRow',addColumn' - ,writeRowData,writeColumnData) +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 Controller.Grid (writeCells) -import qualified Controller.Menu.Table.Add as Add +import qualified Controller.Grid as Grid import View.Component.Grid (numDataRows,numDataColumns,getColumnLabel ,getRowLabel) -import CellCoordinate (coordRange) - -type ColumnData = [String] -type Column = (String,ColumnData) -type RowData = [String] -type Row = (String,RowData) +import Model.CellContent (CellExpr) +import CellCoordinate (CellCoord,coordRange) -getRow :: Int -> Controller Row -getRow row = do +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) -getColumn :: Int -> Controller Column -getColumn col = do +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) -addColumn :: (Maybe String,ColumnData) -> Controller () -addColumn (label,cells) = do - index <- onGridView numDataColumns - Add.addColumn label - writeColumnData index 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 -addColumn' :: Column -> Controller () -addColumn' (label,cells) = addColumn (Just label,cells) +addColumnInput label cells = do + index <- onGridView numDataColumns + maybe (Grid.addNColumns 1) (\l -> Grid.addColumns [l]) label + writeColumnInput index cells -addRow :: (Maybe String,RowData) -> Controller () -addRow (label,cells) = do +addRowExpr,addColumnExpr :: Maybe String -> [CellExpr] -> Controller () +addRowExpr label cells = do index <- onGridView numDataRows - Add.addRow label - writeRowData index cells + maybe (Grid.addNRows 1) (\l -> Grid.addRows [l]) label + writeRowExpr index cells -addRow' :: Row -> Controller () -addRow' (label,cells) = addRow (Just label,cells) +addColumnExpr label cells = do + index <- onGridView numDataColumns + maybe (Grid.addNColumns 1) (\l -> Grid.addColumns [l]) label + writeColumnExpr index cells -writeColumnData :: Int -> ColumnData -> Controller () -writeColumnData index columnData = do - rowsInView <- onGridView numDataRows - let range = let numRows = max rowsInView $ length columnData - in coordRange ((0,index),(numRows-1,index)) - writeCells $ zip range columnData +writeRowInput,writeColumnInput :: Int -> [String] -> Controller () +writeRowInput = writeRow Grid.writeCellInput +writeColumnInput = writeColumn Grid.writeCellInput -writeRowData :: Int -> RowData -> Controller () -writeRowData index rowData = do +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)) - writeCells $ zip range rowData - + 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 diff --git a/src/Controller/Cell.hs b/src/Controller/Cell.hs --- a/src/Controller/Cell.hs +++ b/src/Controller/Cell.hs @@ -8,8 +8,8 @@ import View.Component.Grid (setValue,getCursorPos) import View.FormulaInput (logString) import Model.Grid (getCell) -import Model.Cell (showValue,input,value) -import Model.CellContent (CellValue(Error)) +import Model.Cell (showValueInGrid,input,value) +import Model.CellContent (CellValue(EmptyValue,Error)) import CellCoordinate (CellCoord) getInput :: CellCoord -> Controller String @@ -17,15 +17,16 @@ updateInView :: [CellCoord] -> Controller () updateInView coords = - forM_ coords $ \c -> do cell <- onGridModel $ getCell c - onGridView $ setValue c $ showValue cell + forM_ coords $ \c -> + do cell <- onGridModel $ getCell c + onGridView $ setValue c $ showValueInGrid cell showContent :: CellCoord -> Controller () showContent coords = do cell <- onGridModel $ getCell coords - let info = case value cell of - Error e -> show e - _ -> input cell + let info = case value cell of EmptyValue -> show EmptyValue + Error e -> show e + _ -> input cell onView $ logString info showSelectedContent :: Controller () diff --git a/src/Controller/Dialog.hs b/src/Controller/Dialog.hs --- a/src/Controller/Dialog.hs +++ b/src/Controller/Dialog.hs @@ -1,15 +1,18 @@ module Controller.Dialog (openFileDialog,saveFileDialog ,chooseColumnDialog ,chooseColumnsDialog + ,chooseRowDialog ,chooseRowsDialog - ,chooseColumnsAndTableDialog --- ,pushColorButton + ,chooseColumnsAndTableDialog,chooseRowsAndTableDialog ,previewImage,warning ,nonNumericDataWarningText,nonNumericDataWarning - ,noColumnsSelectedText,noColumnsSelected) + ,noColumnsSelectedText,noColumnsSelected + ,noRowsSelectedText,noRowsSelected + ,whenSure) where import Control.Applicative ((<$>)) +import Control.Monad (when) import Graphics.UI.WX (Prop ((:=)),on) import qualified Graphics.UI.WX as WX import qualified Graphics.UI.WXCore as WXC @@ -43,43 +46,53 @@ justWhen result $ setOnConfig . setLastHandledPath . takeDirectory return result -chooseOneFromListDialog :: String -> String -> [String] -> Controller (Maybe Int) -chooseOneFromListDialog dialogCaption listCaption list = +chooseOneFromListDialog :: String -> String -> String -> [String] + -> Maybe Int -> Controller (Maybe Int) +chooseOneFromListDialog dialogCaption listCaption okLabel list init = let listBox = SingleListBox list id $ \_ -> id dialog = Modifier Margin $ Column [ Modifier (Boxed listCaption) $ Modifier HFill $ Widget listBox - , Modifier Center $ Row [ okButton (), cancelButton]] + , Modifier Center $ Row [ Widget $ DefaultButton okLabel () + , cancelButton]] in maybe Nothing id - <$> (onView $ showSimpleDialog dialogCaption dialog Nothing) + <$> (onView $ showSimpleDialog dialogCaption dialog init) -chooseSomeFromListDialog :: String -> String -> [String] -> Controller [Int] -chooseSomeFromListDialog dialogCaption listCaption list = +chooseSomeFromListDialog :: String -> String -> String -> [String] + -> [Int] -> Controller [Int] +chooseSomeFromListDialog dialogCaption listCaption okLabel list init = let listBox = MultiListBox list id $ \_ -> id dialog = Modifier Margin $ Column [ Modifier (Boxed listCaption) $ Modifier HFill $ Widget listBox - , Modifier Center $ Row [ okButton (), cancelButton]] + , Modifier Center $ Row [ Widget $ DefaultButton okLabel () + , cancelButton]] in - maybe [] id <$> (onView $ showSimpleDialog dialogCaption dialog []) + maybe [] id + <$> (onView $ showSimpleDialog dialogCaption dialog init) -chooseColumnDialog :: String -> Controller (Maybe Int) -chooseColumnDialog caption = - onGridView getColumnLabels - >>= chooseOneFromListDialog caption (__ "Column") +chooseColumnDialog :: String -> String -> Maybe Int -> Controller (Maybe Int) +chooseColumnDialog caption okLabel init = do + labels <- onGridView getColumnLabels + chooseOneFromListDialog caption (__ "Column") okLabel labels init -chooseColumnsDialog :: String -> Controller [Int] -chooseColumnsDialog caption = - onGridView getColumnLabels - >>= chooseSomeFromListDialog caption (__ "Columns") +chooseRowDialog :: String -> String -> Maybe Int -> Controller (Maybe Int) +chooseRowDialog caption okLabel init = do + labels <- onGridView getRowLabels + chooseOneFromListDialog caption (__ "Row") okLabel labels init -chooseRowsDialog :: String -> Controller [Int] -chooseRowsDialog caption = - onGridView getRowLabels - >>= chooseSomeFromListDialog caption (__ "Rows") +chooseColumnsDialog :: String -> String -> [Int] -> Controller [Int] +chooseColumnsDialog caption okLabel init = do + labels <- onGridView getColumnLabels + chooseSomeFromListDialog caption (__ "Columns") okLabel labels init -chooseSomethingAndTableDialog :: String -> String -> [String] - -> Controller (Maybe ([Int],Maybe Int)) -chooseSomethingAndTableDialog dialogCaption someCaption something = do +chooseRowsDialog :: String -> String -> [Int] -> Controller [Int] +chooseRowsDialog caption okLabel init = do + labels <- onGridView getRowLabels + chooseSomeFromListDialog caption (__ "Rows") okLabel labels init + +chooseSomethingAndTableDialog :: String -> String -> String -> [String] + -> [Int] -> Controller (Maybe ([Int],Maybe Int)) +chooseSomethingAndTableDialog dialogCaption someCaption okLabel something init = do tableCaptions <- onView captions let someList = MultiListBox something fst $ \(_,table) some -> (some,table) @@ -92,15 +105,21 @@ , Modifier (Boxed $ __ "Table") $ Widget tableList ] , Modifier Center $ Row - [ okButton (), cancelButton]] - onView $ showSimpleDialog dialogCaption dialog ([],Nothing) + [Widget $ DefaultButton okLabel (), cancelButton]] + onView $ showSimpleDialog dialogCaption dialog (init,Nothing) -chooseColumnsAndTableDialog :: String +chooseColumnsAndTableDialog :: String -> String -> [Int] -> Controller (Maybe ([Int],Maybe Int)) -chooseColumnsAndTableDialog caption = - onGridView getColumnLabels - >>= chooseSomethingAndTableDialog caption (__ "Columns") +chooseColumnsAndTableDialog caption okLabel init = do + labels <- onGridView getColumnLabels + chooseSomethingAndTableDialog caption (__ "Columns") okLabel labels init +chooseRowsAndTableDialog :: String -> String -> [Int] + -> Controller (Maybe ([Int],Maybe Int)) +chooseRowsAndTableDialog caption okLabel init = do + labels <- onGridView getRowLabels + chooseSomethingAndTableDialog caption (__ "Rows") okLabel labels init + previewImage :: WXC.Bitmap () -> Controller () previewImage bitmap = let drawBitmap dc _ = WX.drawBitmap dc bitmap WX.pointZero False [] @@ -133,3 +152,18 @@ noColumnsSelected :: Controller () noColumnsSelected = warning noColumnsSelectedText + +noRowsSelectedText :: String +noRowsSelectedText = __ "No rows selected" + +noRowsSelected :: Controller () +noRowsSelected = warning noRowsSelectedText + +whenSure :: String -> Controller () -> Controller () +whenSure caption doThis = + let caption' = caption ++ ": " ++ (__ "Are you sure?") + in do + sure <- onView $ \view -> + WX.confirmDialog (frame view) caption' caption' False + when sure doThis + diff --git a/src/Controller/FormulaInput.hs b/src/Controller/FormulaInput.hs --- a/src/Controller/FormulaInput.hs +++ b/src/Controller/FormulaInput.hs @@ -3,7 +3,7 @@ import Controller (Controller,onView,onGridView) import Controller.Cell (showSelectedContent) -import Controller.Grid (writeCell) +import Controller.Grid (writeCellInput) import View.FormulaInput (formula) import View.Component.Grid (getCursorPos) @@ -11,5 +11,5 @@ eventHandler = do input <- onView formula coords <- onGridView $ getCursorPos - writeCell coords input + writeCellInput [(coords,input)] showSelectedContent diff --git a/src/Controller/Grid.hs b/src/Controller/Grid.hs --- a/src/Controller/Grid.hs +++ b/src/Controller/Grid.hs @@ -1,45 +1,65 @@ module Controller.Grid (new,changePageEventHandler - ,setFilePath,deleteCurrent,changePageTo - ,writeCell,writeCells + ,deleteCurrent,changePageTo + ,writeCellInput,writeCellExpr + ,addRows,addColumns,addNRows,addNColumns + ,deleteRows,deleteColumns + ,insertRow,insertColumn ,updateRowLabel,updateColumnLabel - ,updateRowLabels,updateColumnLabels - ,markAsSaved) + ,updateRowLabels,updateColumnLabels,batched) where -import Control.Monad.Reader +import Control.Monad.Trans (liftIO) +import Control.Monad (forM_,when) +import Control.Applicative ((<$>)) +import Data.Char (chr,ord) +import Graphics.UI.WX (Prop ((:=)),on) +import qualified Graphics.UI.WX as WX import qualified Graphics.UI.WXCore as WXC -import Controller (Controller,onView,onModel,onGridModel,onGridView) +import Controller (Controller,onView,onModel,onGridModel,onGridView + ,ctrlData,withCtrlData) +import {-# SOURCE #-} qualified Controller.Menu.Table.Copy as Copy +import {-# SOURCE #-} qualified Controller.Menu.Table.Delete as Delete +import {-# SOURCE #-} qualified Controller.Menu.Table.Transpose as Transpose +import {-# SOURCE #-} qualified Controller.Menu.Table.Rename as Rename import Controller.Cell (updateInView,showContent,showSelectedContent) -import Controller.Menu.Table.Add (addRow,addColumn) -import View (onGrid,info) -import qualified View.GridPage as GridPage -import View.Component.Grid (getRowLabel,getColumnLabel,numDataRows - ,numDataColumns) -import qualified View.Component.Grid as GridV -import View.Dialog.Simple (input) -import View.Modes (formulaMode) import qualified Model as M -import qualified Model.Grid as GridM import qualified Model.Cell as Cell -import System.FilePath (takeFileName) -import Util (justWhen) -import CellCoordinate (CellCoord) +import qualified Model.Grid as GridM +import Model.CellContent (CellExpr) +import qualified View.Component.Grid as GridV +import View (frame,onGrid) +import View.Modes (formulaMode) +import qualified View.GridPage as GridPage import View.FormulaInput (logString) +import qualified View.Dialog.Simple as Dialog +import Util (justWhen,whenM) +import I18n (__) +import qualified ModelToView +import CellCoordinate (CellCoord,coordRange) -new :: Maybe FilePath -> Controller () -new filePath = +data LabelType = Row | Column +data LabelClickInfo = LabelClickInfo + { labelType :: LabelType + , labelIndex :: Int + , labelPoint :: WX.Point + } +data CellClickInfo = CellClickInfo { cellCoord :: CellCoord + , cellPoint :: WX.Point + } + +new :: Controller () +new = let addModel id = - do viewInfo <- onView $ return . info - onModel $ M.addGrid id viewInfo - justWhen filePath $ onGridModel . GridM.setFilePath + do modelToView <- onView $ return . ModelToView.new + onModel $ M.addGrid id modelToView addView grid = - do onView $ GridPage.add (fmap takeFileName filePath) grid - ctrl <- ask + do onView $ GridPage.add grid + ctrl <- ctrlData onView $ \view -> onGrid view $ \grid -> do WXC.gridOnGridEvent grid $ \event -> - runReaderT (eventHandler event) ctrl + withCtrlData (eventHandler event) ctrl WXC.windowOnKeyDown grid $ GridPage.keyEventHandler view in do @@ -47,31 +67,19 @@ addModel gridViewId addView gridView -setFilePath :: FilePath -> Controller () -setFilePath filePath = do - onView $ GridPage.setCurrentCaption $ takeFileName filePath - onGridModel $ GridM.setFilePath filePath - -markAsUnsaved :: Controller () -markAsUnsaved = do - caption <- onView GridPage.getCurrentCaption - when (head caption /= '*') - $ onView $ GridPage.setCurrentCaption $ '*':caption +lastRow,lastColumn :: Int -> Controller Bool +lastRow row = do + rows <- onGridView GridV.numDataRows + return $ row == rows -markAsSaved :: Controller () -markAsSaved = do - x:xs <- onView GridPage.getCurrentCaption - when (x == '*') $ onView $ GridPage.setCurrentCaption xs +lastColumn col = do + cols <- onGridView GridV.numDataColumns + return $ col == cols -deleteCurrent :: Controller () -deleteCurrent = do - onModel M.deleteCurrent - onView GridPage.deleteCurrent - next <- onView GridPage.currentSelectionId - case next of - Just n -> do onModel $ M.setCurrent n - showSelectedContent - Nothing -> onView $ logString "" +extendWhenClicked :: CellCoord -> Controller () +extendWhenClicked (row,column) = do + whenM (lastRow row) $ addNRows 1 + whenM (lastColumn column) $ addNColumns 1 eventHandler :: WXC.EventGrid -> Controller () eventHandler event = @@ -79,15 +87,17 @@ WXC.GridLabelMouse row col (WXC.MouseLeftDown {}) -> do extendWhenClicked (row,col) liftIO WXC.propagateEvent - WXC.GridLabelMouse row col (WXC.MouseLeftDClick {}) -> - do value <- if col == -1 - then onGridView $ getRowLabel row - else onGridView $ getColumnLabel col - value' <- onView $ input "Label" value - justWhen value' $ if col == -1 - then updateRowLabel row - else updateColumnLabel col - + WXC.GridLabelMouse row col (WXC.MouseRightDown pt _) -> + if col == -1 + then whenM (not <$> lastRow row) + $ labelClickDialog $ LabelClickInfo Row row pt + else whenM (not <$> lastColumn col) + $ labelClickDialog $ LabelClickInfo Column col pt + WXC.GridCellMouse row col (WXC.MouseRightDown pt _) -> + do lRow <- lastRow row + lCol <- lastColumn col + when (not lRow && not lCol) $ cellClickDialog + $ CellClickInfo (row,col) pt WXC.GridCellMouse row col (WXC.MouseLeftDown {}) -> do extendWhenClicked (row,col) liftIO WXC.propagateEvent @@ -101,6 +111,76 @@ liftIO WXC.propagateEvent _ -> liftIO WXC.propagateEvent +labelClickDialog :: LabelClickInfo -> Controller () +labelClickDialog info = do + cData <- ctrlData + let (copyLabel,deleteLabel,insertLabel,transposeLabel,renameLabel) = + case labelType info of Row -> ( __ "Copy row" + , __ "Delete row" + , __ "Insert row" + , __ "Transpose row" + , __ "Rename row") + Column -> ( __ "Copy column" + , __ "Delete column" + , __ "Insert column" + , __ "Transpose column" + , __ "Rename column") + onCopy = + case labelType info of + Row -> Copy.rowEventHandlerWith [labelIndex info] + Column -> Copy.columnEventHandlerWith [labelIndex info] + + onDelete = + case labelType info of + Row -> Delete.rowEventHandlerWith [labelIndex info] + Column -> Delete.columnEventHandlerWith [labelIndex info] + + onInsert = do + result <- onView $ Dialog.input insertLabel "" + justWhen result $ \label -> + case labelType info of + Row -> insertRow label $ labelIndex info + Column -> insertColumn label $ labelIndex info + + onTranspose = + case labelType info of + Row -> Transpose.rowEventHandlerWith [labelIndex info] + Column -> Transpose.columnEventHandlerWith [labelIndex info] + + onRename = + case labelType info of + Row -> Rename.rowEventHandlerWith $ labelIndex info + Column -> Rename.columnEventHandlerWith $ labelIndex info + + makeMenu = do + menu <- WX.menuPane [] + let makeItem label ctrl = + WX.menuItem menu [ WX.text := label + , on WX.command := withCtrlData ctrl cData] + + makeItem copyLabel onCopy + makeItem deleteLabel onDelete + makeItem insertLabel onInsert + makeItem transposeLabel onTranspose + makeItem renameLabel onRename + return menu + + menu <- liftIO makeMenu + onView $ WX.menuPopup menu (labelPoint info) . frame + +cellClickDialog :: CellClickInfo -> Controller () +cellClickDialog info = do + cData <- ctrlData + let onCopy = Copy.formulaAtEventHandler $ cellCoord info + makeMenu = do + menu <- WX.menuPane [] + WX.menuItem menu [ WX.text := __ "Copy formula" + , on WX.command := withCtrlData onCopy cData] + return menu + + menu <- liftIO makeMenu + onView $ WX.menuPopup menu (cellPoint info) . frame + changePageEventHandler :: Controller () changePageEventHandler = do Just n <- onView $ GridPage.currentSelectionNum @@ -109,55 +189,127 @@ onModel $ M.setCurrent id showSelectedContent +deleteCurrent :: Controller () +deleteCurrent = do + onModel M.deleteCurrent + onView GridPage.deleteCurrent + next <- onView GridPage.currentSelectionId + case next of + Just n -> do onModel $ M.setCurrent n + showSelectedContent + Nothing -> onView $ logString "" + changePageTo :: Int -> Controller () changePageTo = onView . GridPage.fireSelectionEvent -extendWhenClicked :: CellCoord -> Controller () -extendWhenClicked (row,column) = do +extendWhenAddingCells :: [(CellCoord,a)] -> Controller () +extendWhenAddingCells cells = + let (maxRow,maxCol) = maximum $ map fst cells + in do + newRows <- do rows <- onGridView GridV.numDataRows + return $ maxRow - rows + 1 + newCols <- do cols <- onGridView GridV.numDataColumns + return $ maxCol - cols + 1 + + when (newRows > 0) $ addNRows newRows + when (newCols > 0) $ addNColumns newCols + +writeCellInput :: [(CellCoord,String)] -> Controller () +writeCellInput [] = return () +writeCellInput cells = do + extendWhenAddingCells cells + forM_ cells $ \(coord,input) -> do + onGridModel (GridM.setCellInput coord input) >>= updateInView + +writeCellExpr :: [(CellCoord,CellExpr)] -> Controller () +writeCellExpr [] = return () +writeCellExpr cells = do + extendWhenAddingCells cells + forM_ cells $ \(coord,expr) -> do + onGridModel (GridM.setCellExpr coord expr) >>= updateInView + +updateAllCellsInView :: Controller () +updateAllCellsInView = do rows <- onGridView GridV.numDataRows cols <- onGridView GridV.numDataColumns - when (row == rows) $ addRow Nothing - when (column == cols) $ addColumn Nothing + updateInView $ coordRange ((0,0),(rows-1,cols-1)) +{- Reihenfolge wichtig: + 1. zu Model hinzufügen + 2. zu View hinzufügen +-} +addRows,addColumns :: [String] -> Controller () +addRows [] = return () +addRows captions = do + onGridModel $ GridM.addRows captions + onGridView $ GridV.addRows captions + updateAllCellsInView + +addColumns [] = return () +addColumns captions = do + onGridModel $ GridM.addColumns captions + onGridView $ GridV.addColumns captions + updateAllCellsInView + +addNRows,addNColumns :: Int -> Controller () +addNRows n = do + rows <- onGridView GridV.numDataRows + addRows $ map show [rows+1..rows+n] + +addNColumns n = do + cols <- onGridView GridV.numDataColumns + addColumns $ map columnName [cols..cols+n-1] + where columnName i = + let number = (i `div` 26) + 1 + in + replicate number $ chr $ (i `mod` 26) + ord 'A' + +deleteRows,deleteColumns :: [Int] -> Controller () +deleteRows rows = do + onGridModel $ GridM.deleteRows rows + onGridView $ GridV.deleteRows $ reverse rows + updateAllCellsInView + +deleteColumns cols = do + onGridModel $ GridM.deleteColumns cols + onGridView $ GridV.deleteColumns $ reverse cols + updateAllCellsInView + +insertRow,insertColumn :: String -> Int -> Controller () +insertRow label i = do + onGridView $ GridV.insertRowBefore label i + onGridModel $ GridM.insertRowBefore label i + updateAllCellsInView + +insertColumn label i = do + onGridView $ GridV.insertColumnBefore label i + onGridModel $ GridM.insertColumnBefore label i + updateAllCellsInView + updateRowLabel,updateColumnLabel :: Int -> String -> Controller () updateRowLabel n to = do changed <- onGridModel $ GridM.updateRowLabel n to onGridView $ GridV.setRowLabel n to updateInView changed showSelectedContent - markAsUnsaved + updateColumnLabel n to = do changed <- onGridModel $ GridM.updateColumnLabel n to onGridView $ GridV.setColumnLabel n to updateInView changed showSelectedContent - markAsUnsaved updateRowLabels,updateColumnLabels :: [String] -> Controller () updateRowLabels labels = do - n <- onGridView numDataRows + n <- onGridView GridV.numDataRows forM_ (zip [0..n-1] labels) $ uncurry updateRowLabel updateColumnLabels labels = do - n <- onGridView numDataColumns + n <- onGridView GridV.numDataColumns forM_ (zip [0..n-1] labels) $ uncurry updateColumnLabel -writeCell :: CellCoord -> String -> Controller () -writeCell coord input = writeCells [(coord,input)] - -writeCells :: [(CellCoord,String)] -> Controller () -writeCells [] = return () -writeCells cells = - let (maxRow,maxCol) = maximum $ map fst cells - in do - rows <- onGridView numDataRows - cols <- onGridView numDataColumns - - forM_ [rows..maxRow] $ \_ -> addRow Nothing - forM_ [cols..maxCol] $ \_ -> addColumn Nothing - - forM_ cells $ \(coord,input) -> do - changed <- onGridModel $ GridM.setCell coord input - updateInView changed - - markAsUnsaved - +batched :: Controller a -> Controller a +batched doThis = do + onGridView WXC.gridBeginBatch + result <- doThis + onGridView WXC.gridEndBatch + return result diff --git a/src/Controller/Menu/File/Export/Diagram/BarChart.hs b/src/Controller/Menu/File/Export/Diagram/BarChart.hs --- a/src/Controller/Menu/File/Export/Diagram/BarChart.hs +++ b/src/Controller/Menu/File/Export/Diagram/BarChart.hs @@ -67,8 +67,8 @@ $ Widget $ MultiListBox columnLabels columns setCols ] , Modifier Center $ Row - [ Widget $ DefaultButton (__ "&Export") Export - , Widget $ Button (__ "&Preview") Preview + [ Widget $ DefaultButton (__ "&Export ...") Export + , Widget $ Button (__ "&Preview ...") Preview , cancelButton]] dataFileContent :: Parameters -> Controller (Either String String) diff --git a/src/Controller/Menu/File/Export/Diagram/BarChartParameters.hs b/src/Controller/Menu/File/Export/Diagram/BarChartParameters.hs --- a/src/Controller/Menu/File/Export/Diagram/BarChartParameters.hs +++ b/src/Controller/Menu/File/Export/Diagram/BarChartParameters.hs @@ -4,9 +4,10 @@ where import Prelude hiding (Left,Right) +import Util (maybeRead) import Util.Sexp (Sexp(..)) -import Util.Sexpable (Sexpable(..),PSE,unexpected,recordToSexp - ,recordFromSexp) +import Util.Sexpable (Sexpable(..),PSE,unexpected,unknownAtom + ,recordToSexp,recordFromSexp) data LegendPosition = Left | Center | Right deriving (Show,Read) type Legend = Maybe LegendPosition @@ -43,7 +44,9 @@ instance Sexpable LegendPosition where toSexp = toSexp . show - fromSexp (Atom a) = return $ read a + fromSexp (Atom a) = case maybeRead a of + Just lp -> return lp + Nothing -> unknownAtom a fromSexp sexp = unexpected sexp instance Sexpable Parameters where @@ -66,4 +69,4 @@ List [Atom "legend",legend] -> do parameter <- fromSexp legend return $ p {legend = parameter} - _ -> unexpected sexp + _ -> return p diff --git a/src/Controller/Menu/File/Export/Diagram/BoxPlot.hs b/src/Controller/Menu/File/Export/Diagram/BoxPlot.hs --- a/src/Controller/Menu/File/Export/Diagram/BoxPlot.hs +++ b/src/Controller/Menu/File/Export/Diagram/BoxPlot.hs @@ -63,8 +63,8 @@ $ Widget $ MultiListBox columnLabels columns setCols ] , Modifier Center $ Row - [ Widget $ DefaultButton (__ "&Export") Export - , Widget $ Button (__ "&Preview") Preview + [ Widget $ DefaultButton (__ "&Export ...") Export + , Widget $ Button (__ "&Preview ...") Preview , cancelButton]] dataFileContent :: Parameters -> Controller (Either String String) diff --git a/src/Controller/Menu/File/Export/Diagram/BoxPlotParameters.hs b/src/Controller/Menu/File/Export/Diagram/BoxPlotParameters.hs --- a/src/Controller/Menu/File/Export/Diagram/BoxPlotParameters.hs +++ b/src/Controller/Menu/File/Export/Diagram/BoxPlotParameters.hs @@ -3,8 +3,7 @@ where import Util.Sexp (Sexp(..)) -import Util.Sexpable (Sexpable(..),PSE,unexpected,recordToSexp - ,recordFromSexp) +import Util.Sexpable (Sexpable(..),PSE,recordToSexp,recordFromSexp) data Parameters = Parameters { columns :: [Int] , boxWidth :: Double @@ -30,4 +29,4 @@ List [Atom "gaps",g] -> do parameter <- fromSexp g return $ p {gaps = parameter} - _ -> unexpected sexp + _ -> return p diff --git a/src/Controller/Menu/File/Export/Image.hs b/src/Controller/Menu/File/Export/Image.hs --- a/src/Controller/Menu/File/Export/Image.hs +++ b/src/Controller/Menu/File/Export/Image.hs @@ -69,8 +69,8 @@ (intFromFileType . fileType) setFileType] ] , Modifier Center $ Row - [ Widget $ DefaultButton (__ "&Export") Export - , Widget $ Button (__ "&Preview") Preview + [ Widget $ DefaultButton (__ "&Export ...") Export + , Widget $ Button (__ "&Preview ...") Preview , cancelButton] ] diff --git a/src/Controller/Menu/File/Export/ImageParameters.hs b/src/Controller/Menu/File/Export/ImageParameters.hs --- a/src/Controller/Menu/File/Export/ImageParameters.hs +++ b/src/Controller/Menu/File/Export/ImageParameters.hs @@ -6,8 +6,7 @@ import Util.Color (Color (..)) import Util.FileType (FileType(..),extension) import Util.Sexp (Sexp(..)) -import Util.Sexpable (Sexpable(..),PSE,unexpected,recordToSexp - ,recordFromSexp) +import Util.Sexpable (Sexpable(..),PSE,recordToSexp,recordFromSexp) import I18n (__) data Parameters = Parameters { fontPointSize :: Int @@ -59,7 +58,7 @@ List [Atom "fileType",fileType] -> do parameter <- fromSexp fileType return $ p {fileType = parameter} - _ -> unexpected sexp + _ -> return p fileTypeList :: [String] fileTypeList = [ (__ "By extension") diff --git a/src/Controller/Menu/File/Import/Csv.hs b/src/Controller/Menu/File/Import/Csv.hs --- a/src/Controller/Menu/File/Import/Csv.hs +++ b/src/Controller/Menu/File/Import/Csv.hs @@ -8,7 +8,7 @@ import Controller.Menu.File.Import.CsvParameters (Parameters(..)) import Controller.Dialog (openFileDialog) import qualified Controller.Grid as Grid -import Controller.Canonical (addRow) +import Controller.Canonical (addRowInput) import Config (csvImportParameters) import Util (justWhen,breakAt,maybeRead) import qualified Util @@ -36,7 +36,6 @@ setFirstCol p b = p {firstColumnContainsLabels = b} setFirstRow p b = p {firstRowContainsLabels = b} setStripWhitespace p b = p {stripWhitespace = b} - setParseNumbers p b = p {tryParsingNumbers = b} in Modifier Margin $ Column [ Grid [[ Label $ __ "Column delimiter" @@ -48,26 +47,25 @@ ,[ Label $ __ "First row contains labels" , Widget $ CheckBox "" firstRowContainsLabels setFirstRow] ,[ Label $ __ "Strip whitespace" - , Widget $ CheckBox "" stripWhitespace setStripWhitespace] - ,[ Label $ __ "Try parsing numbers" - , Widget $ CheckBox "" tryParsingNumbers setParseNumbers]] + , Widget $ CheckBox "" stripWhitespace setStripWhitespace]] , Modifier Center $ Row - [ Widget $ DefaultButton (__ "&Import") () + [ Widget $ DefaultButton (__ "&Import ...") () , cancelButton]] importCsvFile :: Parameters -> FilePath -> Controller () importCsvFile params filePath = do - Grid.new Nothing - rows <- breakAt (rowDelimiter params) <$> (liftIO $ readFile filePath) - if firstRowContainsLabels params - then let labels = - let values = breakAt (columnDelimiter params) $ head rows - in - map (mayStripWhitespace params) values - in do - forM_ (tail rows) $ importRow params - Grid.updateColumnLabels labels - else forM_ rows $ importRow params + Grid.new + Grid.batched $ do + rows <- breakAt (rowDelimiter params) <$> (liftIO $ readFile filePath) + if firstRowContainsLabels params + then let labels = + let values = breakAt (columnDelimiter params) $ head rows + in + map (mayStripWhitespace params) values + in do + forM_ (tail rows) $ importRow params + Grid.updateColumnLabels labels + else forM_ rows $ importRow params importRow :: Parameters -> String -> Controller () importRow params row = @@ -76,25 +74,11 @@ then Just $ mayStripWhitespace params $ head csvValues else Nothing rowData = if firstColumnContainsLabels params - then map (getCellInput params) $ tail csvValues - else map (getCellInput params) csvValues + then map (mayStripWhitespace params) $ tail csvValues + else map (mayStripWhitespace params) csvValues in - addRow (label,rowData) + addRowInput label rowData mayStripWhitespace :: Parameters -> String -> String mayStripWhitespace params = if stripWhitespace params then Util.stripWhitespace else id - -getCellInput :: Parameters -> String -> String -getCellInput params = - let mayParseNumber x = - if tryParsingNumbers params - then case maybeRead x :: Maybe Double of - Just number -> show number - Nothing -> show x - else show x - in - mayParseNumber . mayStripWhitespace params - - - diff --git a/src/Controller/Menu/File/Import/CsvParameters.hs b/src/Controller/Menu/File/Import/CsvParameters.hs --- a/src/Controller/Menu/File/Import/CsvParameters.hs +++ b/src/Controller/Menu/File/Import/CsvParameters.hs @@ -3,19 +3,17 @@ where import Util.Sexp (Sexp(..)) -import Util.Sexpable (Sexpable(..),PSE,unexpected,recordToSexp - ,recordFromSexp) +import Util.Sexpable (Sexpable(..),PSE,recordToSexp,recordFromSexp) data Parameters = Parameters { columnDelimiter :: Char , rowDelimiter :: Char , firstColumnContainsLabels :: Bool , firstRowContainsLabels :: Bool , stripWhitespace :: Bool - , tryParsingNumbers :: Bool } defaultParams :: Parameters -defaultParams = Parameters ' ' '\n' True True True True +defaultParams = Parameters ' ' '\n' True True True instance Sexpable Parameters where toSexp = recordToSexp @@ -24,7 +22,6 @@ , ("firstColumnContainsLabels", toSexp . firstColumnContainsLabels) , ("firstRowContainsLabels", toSexp . firstRowContainsLabels) , ("stripWhitespace", toSexp . stripWhitespace) - , ("tryParsingNumbers", toSexp . tryParsingNumbers) ] fromSexp = recordFromSexp setParam defaultParams @@ -46,10 +43,7 @@ List [Atom "stripWhitespace",strip] -> do parameter <- fromSexp strip return $ p {stripWhitespace = parameter} - List [Atom "tryParsingNumbers",try] -> do - parameter <- fromSexp try - return $ p {tryParsingNumbers = parameter} - _ -> unexpected sexp + _ -> return p diff --git a/src/Controller/Menu/File/NewClose.hs b/src/Controller/Menu/File/NewClose.hs --- a/src/Controller/Menu/File/NewClose.hs +++ b/src/Controller/Menu/File/NewClose.hs @@ -2,30 +2,31 @@ (newEventHandler,closeEventHandler,closeAllEventHandler) where -import Control.Monad (forM_,when) +import Control.Monad (when) import Controller (Controller,onView,onGridModel) import qualified Controller.Grid as Grid import qualified Controller.Menu.File.Save as Save -import qualified Controller.Menu.Table.Add as Add -import Model.Grid (getFilePath) +import Model.Grid (getFilePath,isSaved) import View.Dialog.Simple (confirm) import View (isGridOpen) import I18n (__) newEventHandler,closeEventHandler,closeAllEventHandler :: Controller () newEventHandler = do - Grid.new Nothing - forM_ [1..5] $ \_ -> Add.addRow Nothing - forM_ [1..5] $ \_ -> Add.addColumn Nothing + Grid.new + Grid.addNRows 5 + Grid.addNColumns 5 closeEventHandler = do - saveFirst <- - do filePath <- onGridModel getFilePath - case filePath of - Nothing -> onView $ confirm (__ "Save?") (__ "Save?") - Just f -> onView $ confirm (__ "Save?") - $ unwords [__ "Save as",f,"?"] - when saveFirst Save.saveEventHandler + saved <- onGridModel isSaved + when (not saved) $ + do saveFirst <- + do filePath <- onGridModel getFilePath + case filePath of + Nothing -> onView $ confirm (__ "Save?") (__ "Save?") + Just f -> onView $ confirm (__ "Save?") + $ unwords [__ "Save as",f,"?"] + when saveFirst Save.saveEventHandler Grid.deleteCurrent closeAllEventHandler = do diff --git a/src/Controller/Menu/File/Open.hs b/src/Controller/Menu/File/Open.hs --- a/src/Controller/Menu/File/Open.hs +++ b/src/Controller/Menu/File/Open.hs @@ -3,13 +3,12 @@ import Control.Monad (forM_) import Control.Monad.Trans (liftIO) -import qualified Graphics.UI.WXCore as WXC -import Controller (Controller,onGridView,onGridModel) +import Controller (Controller,onGridModel) import qualified Controller.Grid as Grid -import Controller.Menu.Table.Add (addRow,addColumn) -import Controller.Canonical (writeRowData) +import Controller.Cell (showSelectedContent) +import Controller.Canonical (writeRowInput) import Controller.Dialog (openFileDialog,warning) -import Model.Grid (resizeTo) +import Model.Grid (resizeTo,save) import Util (justWhen) import Util.Sexp (Sexp(..),ValidSexp(..),parseFile,validate) import I18n (__) @@ -36,24 +35,24 @@ case content of Left error -> invalidFile filePath error Right sexp -> if validate validTableSexp sexp == True - then loadTable filePath sexp + then do loadTable filePath sexp + showSelectedContent else invalidFile filePath $ __ "Invalid s-expression" loadTable :: FilePath -> Sexp -> Controller () loadTable filePath (List [List rows,List cols,List cells]) = do - Grid.new $ Just filePath - onGridView WXC.gridBeginBatch - onGridModel $ resizeTo (length rows,length cols) + Grid.new + Grid.batched $ do + onGridModel $ resizeTo (length rows,length cols) - forM_ rows $ \(Atom a) -> addRow $ Just a - forM_ cols $ \(Atom a) -> addColumn $ Just a - loadCells cells + Grid.addRows $ map (\(Atom a) -> a) rows + Grid.addColumns $ map (\(Atom a) -> a) cols + loadCells cells - onGridView WXC.gridEndBatch - Grid.markAsSaved + onGridModel $ save filePath loadCells :: [Sexp] -> Controller () loadCells rows = do forM_ (zip [0..] rows) $ \(r,List row) -> - writeRowData r $ map (\(Atom value) -> value) row + writeRowInput r $ map (\(Atom value) -> value) row diff --git a/src/Controller/Menu/File/Save.hs b/src/Controller/Menu/File/Save.hs --- a/src/Controller/Menu/File/Save.hs +++ b/src/Controller/Menu/File/Save.hs @@ -4,14 +4,13 @@ import Control.Monad (forM) import Control.Monad.Trans (liftIO) import Controller (Controller,onGridView,onGridModel) -import Controller.Grid (setFilePath,markAsSaved) import Controller.Dialog (saveFileDialog) import View.Component.Grid (getRowLabel,getColumnLabel ,numDataRows,numDataColumns) import Util (justWhen) import Util.Sexp (Sexp(..),prettyPrint) import Model.Cell (input) -import Model.Grid (getCell,getFilePath) +import Model.Grid (getCell,getFilePath,save) import I18n (__) saveAsEventHandler,saveEventHandler :: Controller () @@ -20,16 +19,15 @@ justWhen result saveAs saveEventHandler = do - result <- onGridModel getFilePath - case result of - Nothing -> saveAsEventHandler - Just path -> saveAs path + do result <- onGridModel getFilePath + case result of + Nothing -> saveAsEventHandler + Just path -> saveAs path saveAs :: FilePath -> Controller () saveAs filePath = do toSexp >>= liftIO . writeFile filePath . prettyPrint - setFilePath filePath - markAsSaved + onGridModel $ save filePath toSexp :: Controller Sexp toSexp = do diff --git a/src/Controller/Menu/Statistics/Descriptive.hs b/src/Controller/Menu/Statistics/Descriptive.hs --- a/src/Controller/Menu/Statistics/Descriptive.hs +++ b/src/Controller/Menu/Statistics/Descriptive.hs @@ -4,13 +4,13 @@ import Prelude hiding (max,min) import Control.Monad (foldM,forM_,when) import Control.Applicative ((<$>)) -import Data.Maybe (catMaybes) +import Data.Maybe (catMaybes,mapMaybe) import Controller (Controller,onView,onGridView,onGridModel) import qualified Controller.Grid as Grid import Controller.Dialog (nonNumericDataWarning) -import Controller.Menu.Table.Add (addColumn) -import Controller.Canonical (addRow) +import Controller.Canonical (addRowExpr) import Util (justWhen) +import Model.CellContent (CellExpr (NumberExpr)) import Model.Grid (getColumnValues) import Model.CellExpression.Evaluator.Common (getNumList) import qualified Model.CellExpression.Evaluator.Math as Math @@ -73,19 +73,25 @@ $ columns params when (not $ null result) $ - do Grid.new Nothing - when (calcMean params) $ addColumn $ Just $ __ "Mean" - when (calcMedian params) $ addColumn $ Just $ __ "Median" - when (calcStdDeviation params) $ addColumn $ Just $ __ "Standard Deviation" - when (calcMax params) $ addColumn $ Just $ __ "Maximum" - when (calcMin params) $ addColumn $ Just $ __ "Minimum" + do Grid.new + Grid.addColumns $ paramsToLabels params forM_ (reverse result) $ \desc -> - do addRow (Just $ label desc,descriptiveToRow desc) + do addRowExpr (Just $ label desc) $ descriptiveToRow desc when (not $ null invalidCols) $ nonNumericDataWarning $ reverse invalidCols +paramsToLabels :: Parameters -> [String] +paramsToLabels params = + let toLabel (get,label) = if get params then Just label else Nothing + in + mapMaybe toLabel [ (calcMean,__ "Mean") + , (calcMedian, __ "Median") + , (calcStdDeviation, __ "Standard Deviation") + , (calcMax, __ "Maximum") + , (calcMin, __ "Minimum")] + descriptive :: Parameters -> Result -> Int -> Controller Result descriptive params (invalidCols,xs) col = do colLabel <- onGridView $ getColumnLabel col @@ -105,10 +111,10 @@ , Descriptive colLabel mean median stdDev max min : xs ) -descriptiveToRow :: Descriptive -> [String] +descriptiveToRow :: Descriptive -> [CellExpr] descriptiveToRow desc = - map show $ catMaybes [ mean desc - , median desc - , stdDeviation desc - , max desc, min desc - ] + map NumberExpr $ catMaybes [ mean desc + , median desc + , stdDeviation desc + , max desc, min desc + ] diff --git a/src/Controller/Menu/Statistics/FrequencyDistribution.hs b/src/Controller/Menu/Statistics/FrequencyDistribution.hs --- a/src/Controller/Menu/Statistics/FrequencyDistribution.hs +++ b/src/Controller/Menu/Statistics/FrequencyDistribution.hs @@ -4,25 +4,26 @@ import Control.Monad (forM_) import Data.List (nub) import Controller (Controller,onGridView) -import View.Component.Grid (getColumnValues) -import Util (justWhen) import qualified Controller.Grid as Grid -import Controller.Canonical (addRow) -import Controller.Menu.Table.Add (addColumn) +import Controller.Canonical (addRowExpr) import Controller.Dialog (chooseColumnDialog) +import View.Component.Grid (getColumnValues) +import View.Dialog.Complex (okLabel) +import Model.CellContent (CellExpr(NumberExpr)) +import Util (justWhen) import I18n (__) eventHandler :: Controller () eventHandler = do - selection <- chooseColumnDialog $ __ "Frequency Distribution" + selection <- chooseColumnDialog (__ "Frequency Distribution") okLabel Nothing justWhen selection $ \colIndex -> do values <- onGridView $ getColumnValues colIndex - Grid.new Nothing - addColumn $ Just $ __ "Frequency" - addColumn $ Just $ __ "Percentage" + Grid.new + Grid.addColumns [__ "Frequency", __ "Percentage"] forM_ (freqDist values) $ \(value,freq,perc) -> - do addRow (Just value,[show freq, show perc]) + do addRowExpr (Just value) + [NumberExpr $ fromIntegral freq, NumberExpr perc] freqDist :: [String] -> [(String,Int,Double)] freqDist values = diff --git a/src/Controller/Menu/Statistics/Pivot.hs b/src/Controller/Menu/Statistics/Pivot.hs --- a/src/Controller/Menu/Statistics/Pivot.hs +++ b/src/Controller/Menu/Statistics/Pivot.hs @@ -5,14 +5,14 @@ import Data.List (nub) import Data.Maybe (mapMaybe) import Controller (Controller,onView,onGridView,onGridModel) -import Controller.Canonical (addColumn,addRow) +import Controller.Canonical (addColumnExpr,addRowExpr) import qualified Controller.Grid as Grid import Controller.Dialog (warning) import View.Component.Grid (getColumnLabels) import View.Dialog.Complex (Layout (..),Widget (..),Modifier (..) ,showSimpleDialog,okButton,cancelButton) import Model.Grid (getColumnValues) -import Model.CellContent (CellValue (NumberValue)) +import Model.CellContent (CellValue (NumberValue),valueToExpr) import qualified Model.CellExpression.Evaluator.Math as Math import Model.CellExpression.Evaluator.Common (fLength,getNumList) import Util (justWhen) @@ -109,7 +109,7 @@ then warning (__ "Can not apply aggregator to selected data column (e.g. because of non-numeric data).") >> return False else do - Grid.new Nothing + Grid.new let association = zip3 abscissa ordinate datas nubOrdinate = nub ordinate @@ -119,7 +119,7 @@ then Just value else Nothing ) association - in apply aggregator values + in valueToExpr $ apply aggregator values aggregate abscissaValue ordinateValue = aggregateSome $ \a o -> a == abscissaValue && o == ordinateValue @@ -129,18 +129,18 @@ aggregateSome $ \_ o -> o == ordinateValue forM_ nubAbscissa $ \abscissaValue -> - let column = map (show . aggregate abscissaValue) nubOrdinate + let column = map (aggregate abscissaValue) nubOrdinate in - addColumn (Just $ show abscissaValue,column) + addColumnExpr (Just $ show abscissaValue) column Grid.updateRowLabels $ map show nubOrdinate when makeTotals $ - let column = map (show . aggregateOrd) nubOrdinate - row = map (show . aggregateAbs) nubAbscissa - all = show $ aggregateSome (\_ _ -> True) + let column = map aggregateOrd nubOrdinate + row = map aggregateAbs nubAbscissa + all = aggregateSome (\_ _ -> True) in do - addColumn (Just $ __ "Total",column) - addRow (Just $ __ "Total",row ++ [all]) + addColumnExpr (Just $ __ "Total") column + addRowExpr (Just $ __ "Total") $ row ++ [all] return True diff --git a/src/Controller/Menu/Table/Add.hs b/src/Controller/Menu/Table/Add.hs --- a/src/Controller/Menu/Table/Add.hs +++ b/src/Controller/Menu/Table/Add.hs @@ -1,14 +1,9 @@ -module Controller.Menu.Table.Add (columnEventHandler,rowEventHandler - ,addRow,addColumn) +module Controller.Menu.Table.Add (columnEventHandler,rowEventHandler) where -import Control.Monad (forM_) -import Data.Char (chr,ord) import Data.List (intercalate) -import Controller (Controller,onView,onGridModel,onGridView) -import Controller.Cell (updateInView) -import qualified Model.Grid as GridM -import qualified View.Component.Grid as GridV +import Controller (Controller,onView) +import Controller.Grid (addRows,addColumns,addNRows,addNColumns) import View.Dialog.Complex (Layout (..),Widget (..),Modifier (..) ,showSimpleDialog,cancelButton) import Util (breakAt) @@ -25,10 +20,8 @@ (dialog $ __ "Add columns by") $ Parameters N 0 [] case result of Nothing -> return () - Just (Parameters {addBy=N, n=n}) -> - forM_ [1..n] $ \_ -> addColumn Nothing - Just (Parameters {addBy=Labels, labels=labels}) -> - forM_ labels $ addColumn . Just + Just (Parameters {addBy=N, n=n}) -> addNColumns n + Just (Parameters {addBy=Labels, labels=labels}) -> addColumns labels rowEventHandler :: Controller () rowEventHandler = do @@ -36,10 +29,8 @@ (dialog $ __ "Add rows by") $ Parameters N 0 [] case result of Nothing -> return () - Just (Parameters {addBy=N, n=n}) -> - forM_ [1..n] $ \_ -> addRow Nothing - Just (Parameters {addBy=Labels, labels=labels}) -> - forM_ labels $ addRow . Just + Just (Parameters {addBy=N, n=n}) -> addNRows n + Just (Parameters {addBy=Labels, labels=labels}) -> addRows labels dialog :: String -> Layout Parameters () dialog radioBoxCaption = @@ -58,25 +49,3 @@ , Widget $ TextEntry getLabels setLabels]] , Modifier Center $ Row [ Widget $ DefaultButton (__ "&Add") () , cancelButton]] - -{- Reihenfolge wichtig: - 1. zu View hinzufügen - 2. zu Model hinzufügen --} -addRow,addColumn :: Maybe String -> Controller () -addRow caption = do - rows <- onGridView GridV.numDataRows - let name = maybe (autoRowName rows) id caption - onGridView $ GridV.addRow name - onGridModel (GridM.addRow name) >>= updateInView - where autoRowName i = show $ i+1 - -addColumn caption = do - cols <- onGridView GridV.numDataColumns - let name = maybe (autoColumnName cols) id caption - onGridView $ GridV.addColumn name - onGridModel (GridM.addColumn name) >>= updateInView - where autoColumnName i = - let number = (i `div` 26) + 1 - in - replicate number $ chr $ (i `mod` 26) + ord 'A' diff --git a/src/Controller/Menu/Table/Copy.hs b/src/Controller/Menu/Table/Copy.hs --- a/src/Controller/Menu/Table/Copy.hs +++ b/src/Controller/Menu/Table/Copy.hs @@ -1,22 +1,97 @@ -module Controller.Menu.Table.Copy (eventHandler) +module Controller.Menu.Table.Copy + (columnEventHandler,rowEventHandler + ,columnEventHandlerWith,rowEventHandlerWith + ,formulaEventHandler,formulaAtEventHandler) where +import Control.Applicative ((<$>)) import Control.Monad (forM_,forM) -import Controller (Controller) -import Controller.Dialog (chooseColumnsAndTableDialog) -import Controller.Grid (changePageTo) -import Controller.Canonical (getColumn,addColumn') +import Controller (Controller,onView,onGridView,onGridModel) +import Controller.Dialog (chooseColumnsAndTableDialog,chooseRowsAndTableDialog + ,warning) +import Controller.Grid (changePageTo,writeCellInput) +import Controller.Canonical (getColumnInput,addColumnInput) +import View.Dialog.Complex (Layout (..),Widget (..),Modifier (..) + ,showSimpleDialog,cancelButton) +import View.Component.Grid (getRowLabel,getColumnLabel) +import Model.Grid (getCell,dependencyCoordsFromInput) +import Model.Cell (input) +import Model.CellContent (CellExpr (NamedReference),CellReference(Named) + ,NamedReference (NamedCell)) import Util (justWhen) import I18n (__) +import CellCoordinate (CellCoord) -eventHandler :: Controller () -eventHandler = do - result <- chooseColumnsAndTableDialog $ __ "Copy" +columnEventHandler,rowEventHandler :: Controller () +columnEventHandler = columnEventHandlerWith [] +rowEventHandler = rowEventHandlerWith [] + +columnEventHandlerWith,rowEventHandlerWith :: [Int] -> Controller () +columnEventHandlerWith init = do + result <- chooseColumnsAndTableDialog (__ "Copy columns") (__ "C&opy") init justWhen result $ \(cols,table) -> justWhen table $ copyColumnsTo cols -copyColumnsTo :: [Int] -> Int -> Controller () +rowEventHandlerWith init = do + result <- chooseRowsAndTableDialog (__ "Copy rows") (__ "C&opy") init + justWhen result $ \(rows,table) -> + justWhen table $ copyRowsTo rows + +copyColumnsTo,copyRowsTo :: [Int] -> Int -> Controller () copyColumnsTo cols tableN = do - columnData <- forM cols getColumn + columnData <- forM cols getColumnInput changePageTo tableN - forM_ columnData addColumn' + forM_ columnData $ \(label,xs) -> addColumnInput (Just label) xs + +copyRowsTo rows tableN = do + columnData <- forM rows getColumnInput + changePageTo tableN + forM_ columnData $ \(label,xs) -> addColumnInput (Just label) xs + +data CopyFormulaParameters = CopyFormulaParameters + { source :: String + , destination :: String + } + +defaultParams :: String -> CopyFormulaParameters +defaultParams s = CopyFormulaParameters s "" + +formulaEventHandler :: Controller () +formulaEventHandler = do + result <- onView $ showSimpleDialog (__ "Copy formula") + copyFormulaDialog $ defaultParams "" + justWhen result copyFormula + +formulaAtEventHandler :: CellCoord -> Controller () +formulaAtEventHandler (r,c) = do + ref <- do row <- onGridView $ getRowLabel r + col <- onGridView $ getColumnLabel c + return $ NamedReference $ NamedCell $ Named (row,col) + + result <- onView $ showSimpleDialog (__ "Copy formula") + copyFormulaDialog $ defaultParams $ show ref + justWhen result copyFormula + +copyFormulaDialog :: Layout CopyFormulaParameters () +copyFormulaDialog = + let setSource p s = p {source = s} + setDest p d = p {destination = d} + in + Modifier Margin $ Column + [ Grid [[ Label $ __ "Source" + , Modifier HFill $ Widget $ TextEntry source setSource] + ,[ Label $ __ "Destination" + , Modifier (MinSize (200,-1)) $ Widget $ TextEntry destination setDest] + ] + , Modifier Center $ Row [ Widget $ DefaultButton (__ "C&opy") () + , cancelButton]] + +copyFormula :: CopyFormulaParameters -> Controller () +copyFormula params = do + src <- onGridModel $ dependencyCoordsFromInput $ '=':source params + dest <- onGridModel $ dependencyCoordsFromInput $ '=':destination params + case (src,dest) of + ([s],_:_) -> do formula <- input <$> (onGridModel $ getCell s) + writeCellInput $ map (\d -> (d,formula)) dest + _ -> warning $ __ "No valid source or destination selected" + diff --git a/src/Controller/Menu/Table/Copy.hs-boot b/src/Controller/Menu/Table/Copy.hs-boot new file mode 100644 --- /dev/null +++ b/src/Controller/Menu/Table/Copy.hs-boot @@ -0,0 +1,10 @@ +module Controller.Menu.Table.Copy + (columnEventHandlerWith,rowEventHandlerWith + ,formulaAtEventHandler) +where + +import Controller (Controller) +import CellCoordinate (CellCoord) + +columnEventHandlerWith,rowEventHandlerWith :: [Int] -> Controller () +formulaAtEventHandler :: CellCoord -> Controller () diff --git a/src/Controller/Menu/Table/Delete.hs b/src/Controller/Menu/Table/Delete.hs --- a/src/Controller/Menu/Table/Delete.hs +++ b/src/Controller/Menu/Table/Delete.hs @@ -1,28 +1,20 @@ -module Controller.Menu.Table.Delete (columnEventHandler,rowEventHandler - ,deleteColumns,deleteRows) +module Controller.Menu.Table.Delete + (columnEventHandler,rowEventHandler + ,columnEventHandlerWith,rowEventHandlerWith) where -import Controller (Controller,onGridModel,onGridView) +import Controller (Controller) import Controller.Dialog (chooseColumnsDialog,chooseRowsDialog) -import qualified Controller.Menu.Table.Reevaluate as Reevaluate -import qualified Model.Grid as GridM -import qualified View.Component.Grid as GridV +import Controller.Grid (deleteRows,deleteColumns) import I18n (__) -columnEventHandler :: Controller () -columnEventHandler = chooseColumnsDialog (__ "Delete") >>= deleteColumns - -deleteColumns :: [Int] -> Controller () -deleteColumns cols = do - onGridModel $ GridM.deleteColumns cols - onGridView $ GridV.deleteColumns $ reverse cols - Reevaluate.eventHandler +columnEventHandlerWith,rowEventHandlerWith :: [Int] -> Controller () +columnEventHandlerWith cols = + chooseColumnsDialog (__ "Delete") (__ "&Delete") cols >>= deleteColumns -rowEventHandler :: Controller () -rowEventHandler = chooseRowsDialog (__ "Delete") >>= deleteRows +rowEventHandlerWith rows = + chooseRowsDialog (__ "Delete") (__ "&Delete") rows >>= deleteRows -deleteRows :: [Int] -> Controller () -deleteRows rows = do - onGridModel $ GridM.deleteRows rows - onGridView $ GridV.deleteRows $ reverse rows - Reevaluate.eventHandler +columnEventHandler,rowEventHandler :: Controller () +columnEventHandler = columnEventHandlerWith [] +rowEventHandler = rowEventHandlerWith [] diff --git a/src/Controller/Menu/Table/Delete.hs-boot b/src/Controller/Menu/Table/Delete.hs-boot new file mode 100644 --- /dev/null +++ b/src/Controller/Menu/Table/Delete.hs-boot @@ -0,0 +1,7 @@ +module Controller.Menu.Table.Delete + (columnEventHandlerWith,rowEventHandlerWith) +where + +import Controller (Controller) + +columnEventHandlerWith,rowEventHandlerWith :: [Int] -> Controller () diff --git a/src/Controller/Menu/Table/Filter.hs b/src/Controller/Menu/Table/Filter.hs new file mode 100644 --- /dev/null +++ b/src/Controller/Menu/Table/Filter.hs @@ -0,0 +1,78 @@ +module Controller.Menu.Table.Filter (rowEventHandler,columnEventHandler) + where + +import Prelude hiding (filter) +import Control.Applicative ((<$>)) +import Control.Monad (forM,forM_,when) +import Data.Maybe (catMaybes) +import Data.Either (partitionEithers) +import Controller (Controller,onView,onGridView,onGridModel) +import qualified Controller.Grid as Grid +import Controller.Canonical (addRowInput,addColumnInput) +import I18n (__) +import View.Dialog.Complex (Layout (..),Widget (..),Modifier (..) + ,showSimpleDialog,cancelButton) +import View.Dialog.Simple (warning) +import View.Component.Grid (numDataRows,numDataColumns + ,getRowValues,getColumnValues) +import Model.CellContent (CellValue (BoolValue)) +import Model.Grid (evaluateString) +import Util (justWhen) + +rowEventHandler :: Controller () +rowEventHandler = do + result <- onView $ showSimpleDialog (__ "Filter rows") dialog "" + justWhen result filterRows + +columnEventHandler :: Controller () +columnEventHandler = do + result <- onView $ showSimpleDialog (__ "Filter columns") dialog "" + justWhen result filterColumns + +dialog :: Layout String () +dialog = + Modifier Margin $ Column + [ Grid [[ Label $ __ "Filter condition" + , Modifier (MinSize (200,-1)) $ FocusOn $ TextEntry id (\_ -> id)] + ] + , Modifier Center $ Row [ Widget $ DefaultButton (__ "&Filter") () + , cancelButton]] + +filterRows :: String -> Controller () +filterRows input = do + n <- onGridView numDataRows + (rows,others) <- + do (others,rows) <- partitionEithers <$> forM [0..n-1] filter + return (catMaybes rows,take 10 others) + + when (not $ null rows) $ + Grid.new >> (forM_ rows $ addRowInput Nothing) + when (not $ null others) $ + onView $ warning $ unlines $ (__ "Unexpected results:"):others + where + filter i = + do result <- onGridModel $ evaluateString ('=':input) (i,-1) + case result of + BoolValue True -> (Right . Just) <$> + (onGridView $ getRowValues i) + BoolValue False -> return $ Right Nothing + _ -> return $ Left $ show result + +filterColumns :: String -> Controller () +filterColumns input = do + n <- onGridView numDataColumns + (cols,others) <- + do (others,cols) <- partitionEithers <$> forM [0..n-1] filter + return (catMaybes cols,take 10 others) + when (not $ null cols) $ + Grid.new >> (forM_ cols $ addColumnInput Nothing) + when (not $ null others) $ + onView $ warning $ unlines $ (__ "Unexpected results:"):others + where + filter i = + do result <- onGridModel $ evaluateString ('=':input) (-1,i) + case result of + BoolValue True -> (Right . Just) <$> + (onGridView $ getColumnValues i) + BoolValue False -> return $ Right Nothing + _ -> return $ Left $ show result diff --git a/src/Controller/Menu/Table/Reevaluate.hs b/src/Controller/Menu/Table/Reevaluate.hs deleted file mode 100644 --- a/src/Controller/Menu/Table/Reevaluate.hs +++ /dev/null @@ -1,18 +0,0 @@ -module Controller.Menu.Table.Reevaluate (eventHandler) - where - -import Control.Monad (forM_) -import Controller (Controller,onGridView,onGridModel) -import Controller.Cell (updateInView,showSelectedContent) -import View.Component.Grid (numDataRows,numDataColumns) -import Model.Grid (rewriteCell) - -eventHandler :: Controller () -eventHandler = do - rows <- onGridView numDataRows - cols <- onGridView numDataColumns - - forM_ [0..rows-1] $ \r -> forM_ [0..cols-1] $ \c -> - do changed <- onGridModel $ rewriteCell (r,c) - updateInView changed - showSelectedContent diff --git a/src/Controller/Menu/Table/Rename.hs b/src/Controller/Menu/Table/Rename.hs new file mode 100644 --- /dev/null +++ b/src/Controller/Menu/Table/Rename.hs @@ -0,0 +1,68 @@ +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]] diff --git a/src/Controller/Menu/Table/Rename.hs-boot b/src/Controller/Menu/Table/Rename.hs-boot new file mode 100644 --- /dev/null +++ b/src/Controller/Menu/Table/Rename.hs-boot @@ -0,0 +1,7 @@ +module Controller.Menu.Table.Rename + (columnEventHandlerWith,rowEventHandlerWith) +where + +import Controller (Controller) + +columnEventHandlerWith,rowEventHandlerWith :: Int -> Controller () diff --git a/src/Controller/Menu/Table/Transpose.hs b/src/Controller/Menu/Table/Transpose.hs --- a/src/Controller/Menu/Table/Transpose.hs +++ b/src/Controller/Menu/Table/Transpose.hs @@ -1,41 +1,50 @@ -module Controller.Menu.Table.Transpose (tableEventHandler - ,columnEventHandler - ,rowEventHandler) +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 (getColumn,getRow,addRow',addColumn') +import Controller.Canonical (getColumnInput,getRowInput + ,addRowInput,addColumnInput) import qualified Controller.Grid as Grid import View.Component.Grid (getRowLabels,getColumnLabels ,numDataColumns) import I18n (__) -tableEventHandler :: Controller () +tableEventHandler,columnEventHandler,rowEventHandler :: Controller () tableEventHandler = do n <- onGridView numDataColumns transposeColumns [0..n-1] -columnEventHandler :: Controller () -columnEventHandler = chooseColumnsDialog (__ "Transpose") >>= transposeColumns +columnEventHandler = columnEventHandlerWith [] +rowEventHandler = rowEventHandlerWith [] -rowEventHandler :: Controller () -rowEventHandler = chooseRowsDialog (__ "Transpose") >>= transposeRows +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 getColumn + columnData <- forM cols getColumnInput rowLabels <- onGridView getRowLabels - Grid.new Nothing - forM_ columnData addRow' + Grid.new + forM_ columnData $ \(label,xs) -> addRowInput (Just label) xs Grid.updateColumnLabels rowLabels transposeRows :: [Int] -> Controller () +transposeRows [] = return () transposeRows rows = do - rowData <- forM rows getRow + rowData <- forM rows getRowInput colLabels <- onGridView getColumnLabels - Grid.new Nothing - forM_ rowData addColumn' + Grid.new + forM_ rowData $ \(label,xs) -> addColumnInput (Just label) xs Grid.updateRowLabels colLabels diff --git a/src/Controller/Menu/Table/Transpose.hs-boot b/src/Controller/Menu/Table/Transpose.hs-boot new file mode 100644 --- /dev/null +++ b/src/Controller/Menu/Table/Transpose.hs-boot @@ -0,0 +1,7 @@ +module Controller.Menu.Table.Transpose + (columnEventHandlerWith,rowEventHandlerWith) +where + +import Controller (Controller) + +columnEventHandlerWith,rowEventHandlerWith :: [Int] -> Controller () diff --git a/src/Model.hs b/src/Model.hs --- a/src/Model.hs +++ b/src/Model.hs @@ -7,7 +7,7 @@ import qualified Data.IntMap as Map import Model.Grid (Grid) import qualified Model.Grid as G -import qualified View +import ModelToView (ModelToView) import Util (justWhen) type Current = (Key,Grid) @@ -41,8 +41,8 @@ grid <- Map.lookup key <$> (readIORef $ grids model) justWhen grid $ \g -> writeIORef (current model) $ Just (key,g) -addGrid :: Key -> View.Info -> Model -> IO () -addGrid key viewInfo model = do - grid <- G.new viewInfo +addGrid :: Key -> ModelToView -> Model -> IO () +addGrid key modelToView model = do + grid <- G.new modelToView modifyIORef (grids model) $ Map.insert key grid setCurrent key model diff --git a/src/Model/Cell.hs b/src/Model/Cell.hs --- a/src/Model/Cell.hs +++ b/src/Model/Cell.hs @@ -1,11 +1,11 @@ -module Model.Cell (Cell(..),empty,showValue +module Model.Cell (Cell(..),empty,showValueInGrid ,setExpression,setRuntimeErrorValue ,evaluate,addDependent,deleteDependent) where import qualified Data.List as List -import Model.CellContent (CellExpr(EmptyExpr),CellValue(EmptyValue,Error) - ,RuntimeReason,Reference) +import Model.CellContent (CellExpr(EmptyExpr),RuntimeReason,Reference + ,CellValue(EmptyValue,Error)) import qualified Model.CellContent as CC import qualified Model.CellExpression.Evaluator as E import CellCoordinate (CellCoord) @@ -29,8 +29,8 @@ setRuntimeErrorValue :: RuntimeReason -> Cell -> Cell setRuntimeErrorValue reason cell = cell {value = Error reason} -showValue :: Cell -> String -showValue = show . value +showValueInGrid :: Cell -> String +showValueInGrid = CC.showValueInGrid . value evaluate :: E.Lookup -> Cell -> IO Cell evaluate lookup cell = do diff --git a/src/Model/CellContent.hs b/src/Model/CellContent.hs --- a/src/Model/CellContent.hs +++ b/src/Model/CellContent.hs @@ -1,7 +1,9 @@ -module Model.CellContent (NamedReference (..),Reference (..) +module Model.CellContent (CellReference (..),NamedReference (..) + ,Reference (..) ,CompileReason (..),RuntimeReason (..) ,CellExpr (..),CellValue (..) - ,Symbol,dependencies) + ,Symbol,dependencies,showValueInGrid + ,valueToExpr) where import Data.List (intercalate) @@ -10,16 +12,25 @@ type Symbol = String -data NamedReference = NamedCell (String,String) - | NamedRange ((String,String),(String,String)) +data CellReference = Named (String,String) + | SameRow String + | SameColumn String + deriving (Eq) + +instance Show CellReference where + show (Named (r,c)) = concat ["$",r,",",c,"$"] + show (SameRow c) = concat ["$=,",c,"$"] + show (SameColumn r) = concat ["$",r,",=$"] + +data NamedReference = NamedCell CellReference + | NamedRange (CellReference,CellReference) | NamedColumn String | NamedRow String deriving (Eq) instance Show NamedReference where - show (NamedCell (r,c)) = concat ["$",r,",",c,"$"] - show (NamedRange (a,b)) = concat [ show $ NamedCell a - , ":",show $ NamedCell b] + show (NamedCell ref) = show ref + show (NamedRange (a,b)) = concat [show a, ":",show b] show (NamedColumn a) = concat ["$_,",a,"$"] show (NamedRow a) = concat ["$",a,"_$"] @@ -27,7 +38,7 @@ | Range (CellCoord,CellCoord) | Column Int | Row Int - deriving (Eq,Show) + deriving (Eq) data CompileReason = ParseError String | RefConversionError NamedReference @@ -41,14 +52,13 @@ data RuntimeReason = CompileError CompileReason | TypeError CellValue - | Inherited CellValue RuntimeReason | UnknownIdentifier Symbol deriving (Eq) instance Show RuntimeReason where show (CompileError a) = unwords [(__ "Compile error") ++ ":",show a] - show (TypeError a) = unwords [__ "Type error in",showValueInError a] - show (Inherited a b) = unwords [__ "In",showValueInError a,":",show b] + show (TypeError (Error a)) = show a + show (TypeError a) = unwords [__ "Type error in",show a] show (UnknownIdentifier a) = unwords [__ "Unknown identifier",a] data CellExpr = EmptyExpr @@ -60,40 +70,89 @@ | UnaryOp Symbol CellExpr | BinaryOp Symbol CellExpr CellExpr | Call Symbol CellExpr + | Constant Symbol | Sub CellExpr + | IfThenElse CellExpr CellExpr CellExpr | CompileErrorExpr CompileReason - deriving (Eq,Show) + deriving (Eq) +instance Show CellExpr where + show EmptyExpr = "" + show (NumberExpr a) = show a + show (StringExpr a) = show a + show (ListExpr a) = concat ["[",intercalate "," $ map show a,"]"] + show (NamedReference a) = show a + show (UnaryOp a b) = a ++ show b + show (BinaryOp a b c) = unwords [show b,a,show c] + show (Call a b) = unwords [a,show b] + show (Constant a) = a + show (Sub a) = concat ["(",show a,")"] + show (IfThenElse a b c) = unwords ["if",show a,"then",show b,"else",show c] + data CellValue = EmptyValue | NumberValue Double | StringValue String | ListValue [CellValue] + | BoolValue Bool | Error RuntimeReason deriving (Eq) +instance Ord CellValue where + compare EmptyValue EmptyValue = EQ + compare (NumberValue a) (NumberValue b) = compare a b + compare (StringValue a) (StringValue b) = compare a b + compare (BoolValue a) (BoolValue b) = compare a b + instance Show CellValue where - show EmptyValue = "" + show EmptyValue = __ "Empty" show (NumberValue a) = show a show (StringValue a) = a show (ListValue a) = concat ["[",intercalate "," $ map show a,"]"] - show (Error _) = __ "Error" + show (BoolValue True) = "true" + show (BoolValue False) = "false" + show (Error e) = show e +-- -> Model.Grid.referenceConversion dependencies :: CellExpr -> [Reference] dependencies expr = case expr of Reference ref -> [ref] ListExpr a -> concat $ map dependencies a UnaryOp _ a -> dependencies a - BinaryOp _ a b -> (dependencies a) ++ (dependencies b) + BinaryOp _ a b -> concatMap dependencies [a,b] Call _ a -> dependencies a Sub a -> dependencies a + IfThenElse a b c -> concatMap dependencies [a,b,c] _ -> [] +{- +replaceBy :: CellExpr -> CellExpr -> CellExpr +replaceBy new expr = + if expr == new then new + else case expr of + ListExpr a -> ListExpr $ map (replaceBy new) a + UnaryOp a b -> UnaryOp a $ replaceBy new b + BinaryOp a b c -> BinaryOp a (replaceBy new b) (replaceBy new c) + Call a b -> Call a $ replaceBy new b + Sub a -> Sub $ replaceBy new a + IfThenElse a b c -> IfThenElse (replaceBy new a) + (replaceBy new b) (replaceBy new c) + _ -> expr +-} +valueToExpr :: CellValue -> CellExpr +valueToExpr value = + case value of + EmptyValue -> EmptyExpr + NumberValue a -> NumberExpr a + StringValue a -> StringExpr a + ListValue a -> ListExpr $ map valueToExpr a + BoolValue True -> Constant "true" + BoolValue False -> Constant "false" -showValueInError :: CellValue -> String -showValueInError value = +showValueInGrid :: CellValue -> String +showValueInGrid value = case value of - EmptyValue -> __ "Empty" + EmptyValue -> "" ListValue a -> - concat ["[",intercalate "," $ map showValueInError a,"]"] + concat ["[",intercalate "," $ map showValueInGrid a,"]"] + Error _ -> __ "Error" _ -> show value - diff --git a/src/Model/CellExpression/Evaluator.hs b/src/Model/CellExpression/Evaluator.hs --- a/src/Model/CellExpression/Evaluator.hs +++ b/src/Model/CellExpression/Evaluator.hs @@ -7,32 +7,45 @@ import Model.CellContent (CellExpr (..),CellValue(..),RuntimeReason(..) ,Reference(..),Symbol) import Model.CellExpression.Evaluator.Common - (withNum,withList,withNumList,getNumList,fLength) + (fLength,withNum,withList,withNumList,getNumList,withBool) import Model.CellExpression.Evaluator.Math (mean,median) type Lookup = Reference -> IO CellValue evaluate :: Lookup -> CellExpr -> IO CellValue evaluate lookup e = - let binary f = return . mathBinary f - eval = evaluate lookup - in - case e of - EmptyExpr -> return $ EmptyValue - NumberExpr a -> return $ NumberValue a - StringExpr a -> return $ StringValue a - ListExpr a -> ListValue <$> forM a eval - Reference a -> lookup a - UnaryOp "-" a -> forM [NumberExpr 0,a] eval >>= binary (-) - BinaryOp "+" a b -> forM [a,b] eval >>= binary (+) - BinaryOp "-" a b -> forM [a,b] eval >>= binary (-) - BinaryOp "*" a b -> forM [a,b] eval >>= binary (*) - BinaryOp "/" a b -> forM [a,b] eval >>= binary (/) - BinaryOp "^" a b -> forM [a,b] eval >>= binary (**) - Call f arg -> evaluateFun f <$> eval arg - Sub a -> eval a - NamedReference _ -> error "Model.CellExpression.Evaluator.evaluate: NamedReference" - CompileErrorExpr a -> return $ Error $ CompileError a + case e of + EmptyExpr -> return $ EmptyValue + NumberExpr a -> return $ NumberValue a + StringExpr a -> return $ StringValue a + ListExpr a -> ListValue <$> forM a eval + Reference a -> lookup a + UnaryOp "-" a -> mathBinary (-) <$> forM [NumberExpr 0,a] eval + BinaryOp "+" a b -> mathBinary (+) <$> forM [a,b] eval + BinaryOp "-" a b -> mathBinary (-) <$> forM [a,b] eval + BinaryOp "*" a b -> mathBinary (*) <$> forM [a,b] eval + BinaryOp "/" a b -> mathBinary (/) <$> forM [a,b] eval + BinaryOp "^" a b -> mathBinary (**) <$> forM [a,b] eval + BinaryOp "==" a b -> relation (==) <$> forM [a,b] eval + BinaryOp "/=" a b -> relation (/=) <$> forM [a,b] eval + BinaryOp "<" a b -> relation (<) <$> forM [a,b] eval + BinaryOp "<=" a b -> relation (<=) <$> forM [a,b] eval + BinaryOp ">" a b -> relation (>) <$> forM [a,b] eval + BinaryOp ">=" a b -> relation (>=) <$> forM [a,b] eval + BinaryOp "&&" a b -> logicalBinary (&&) <$> forM [a,b] eval + BinaryOp "||" a b -> logicalBinary (||) <$> forM [a,b] eval + Call f arg -> evaluateFun f <$> eval arg + Constant c -> return $ evaluateConstant c + Sub a -> eval a + IfThenElse if' then' else' -> + do ifValue <- eval if' + thenValue <- eval then' + elseValue <- eval else' + return $ withBool ifValue + (\c -> if c then thenValue else elseValue) + NamedReference a -> error $ "Model.CellExpression.Evaluator.evaluate: NamedReference: " ++ show a + CompileErrorExpr a -> return $ Error $ CompileError a + where eval = evaluate lookup evaluateFun :: Symbol -> CellValue -> CellValue evaluateFun f arg = @@ -42,9 +55,43 @@ "abs" -> withNum arg $ NumberValue . abs "mean" -> withNumList arg $ NumberValue . mean "median" -> withNumList arg $ NumberValue . median - unknown -> Error $ UnknownIdentifier unknown + "not" -> withBool arg $ BoolValue . not + _ -> Error $ UnknownIdentifier f +evaluateConstant :: Symbol -> CellValue +evaluateConstant c = + case c of + "true" -> BoolValue True + "false" -> BoolValue False + "pi" -> NumberValue pi + _ -> Error $ UnknownIdentifier c + mathBinary :: (Double -> Double -> Double) -> [CellValue] -> CellValue mathBinary f = either Error (\[a,b] -> NumberValue $ f a b) . getNumList +relation :: (CellValue -> CellValue -> Bool) -> [CellValue] -> CellValue +relation f [a,b] = + case (a,b) of + (Error x,_) -> Error x + (_,Error x) -> Error x + (EmptyValue,EmptyValue) -> BoolValue $ f a b + (NumberValue _,NumberValue _) -> BoolValue $ f a b + (StringValue _,StringValue _) -> BoolValue $ f a b + (ListValue xs,ListValue ys) -> + let isTrue (BoolValue True) = True + isTrue _ = False + in + BoolValue $ and $ map (isTrue . relation f) + $ zipWith (\x y -> [x,y]) xs ys + (BoolValue _,BoolValue _) -> BoolValue $ f a b + _ -> Error $ TypeError b + +logicalBinary :: (Bool -> Bool -> Bool) -> [CellValue] -> CellValue +logicalBinary f [a,b] = + case (a,b) of + (Error x,_) -> Error x + (_,Error x) -> Error x + (BoolValue x,BoolValue y) -> BoolValue $ f x y + (BoolValue _,_) -> Error $ TypeError b + _ -> Error $ TypeError a diff --git a/src/Model/CellExpression/Evaluator/Common.hs b/src/Model/CellExpression/Evaluator/Common.hs --- a/src/Model/CellExpression/Evaluator/Common.hs +++ b/src/Model/CellExpression/Evaluator/Common.hs @@ -1,43 +1,44 @@ module Model.CellExpression.Evaluator.Common - (withNum,withString,withList,withNumList,getNumList,fLength) + (fLength,withNum,withString,withList,withNumList,getNumList + ,withBool) where import Model.CellContent (CellValue (..),RuntimeReason(..)) +fLength :: Num b => [a] -> b +fLength = fromIntegral . length + withNum :: CellValue -> (Double -> CellValue) -> CellValue withNum value f = case value of NumberValue a -> f a - Error a -> Error $ Inherited value a - a -> Error $ TypeError a + _ -> Error $ TypeError value withString :: CellValue -> (String -> CellValue) -> CellValue withString value f = case value of StringValue a -> f a - Error a -> Error $ Inherited value a - a -> Error $ TypeError a + _ -> Error $ TypeError value withList :: CellValue -> ([CellValue] -> CellValue) -> CellValue withList value f = case value of ListValue a -> f a - Error a -> Error $ Inherited value a - a -> Error $ TypeError a + _ -> Error $ TypeError value withNumList :: CellValue -> ([Double] -> CellValue) -> CellValue withNumList value f = case value of - ListValue a -> either (Error . Inherited value) f $ getNumList a - Error a -> Error $ Inherited value a - a -> Error $ TypeError a + ListValue a -> either (\_ -> Error $ TypeError value) f $ getNumList a + _ -> Error $ TypeError value getNumList :: [CellValue] -> Either RuntimeReason [Double] getNumList = foldr (\value accu -> case (value,accu) of (NumberValue n,Right list) -> Right $ n:list - (Error a,Right _) -> Left $ Inherited value a - (a,Right _) -> Left $ TypeError a - (_,Left a) -> Left a + (_,Right _) -> Left $ TypeError value + (_,Left _) -> accu ) (Right []) -fLength :: Num b => [a] -> b -fLength = fromIntegral . length +withBool :: CellValue -> (Bool -> CellValue) -> CellValue +withBool value f = + case value of BoolValue a -> f a + _ -> Error $ TypeError value diff --git a/src/Model/CellExpression/Parser.hs b/src/Model/CellExpression/Parser.hs --- a/src/Model/CellExpression/Parser.hs +++ b/src/Model/CellExpression/Parser.hs @@ -9,24 +9,27 @@ import qualified Text.ParserCombinators.Parsec.Expr as E import qualified Text.ParserCombinators.Parsec.Token as T import qualified Text.ParserCombinators.Parsec.Language as L -import Model.CellContent (CellExpr (..),NamedReference(..),CompileReason(..)) +import Model.CellContent (CellExpr (..),CellReference(..) + ,NamedReference(..),CompileReason(..)) import qualified Model.CellContent as CC import I18n (__) program,topLevelFormula,topLevelLiteral :: Parser CellExpr -expression,term,functionCall :: Parser CellExpr -number,stringExpr,list,subExpression :: Parser CellExpr -reference,cellRef,cellRangeRef :: Parser CellExpr +expression,term,functionCall,constant :: Parser CellExpr +number,stringExpr,subExpression :: Parser CellExpr +list,topLevelList :: Parser CellExpr +ifThenElse,reference,miscRef,cellRangeRef :: Parser CellExpr program = topLevelFormula <|> topLevelLiteral -topLevelLiteral = (try topLevelNumber) +topLevelLiteral = (try ( topLevelParser number + <|> topLevelList)) <|> (StringExpr <$> (P.many1 P.anyChar)) -topLevelNumber = do - whitespace - n <- NumberExpr <$> signedDouble - P.eof >> return n +topLevelParser :: Parser CellExpr -> Parser CellExpr +topLevelParser parser = do + result <- whitespace >> parser + P.eof >> return result topLevelFormula = do f <- P.char '=' >> whitespace >> expression @@ -41,47 +44,66 @@ , binary "/" CC.BinaryOp E.AssocLeft] ,[ binary "+" CC.BinaryOp E.AssocLeft , binary "-" CC.BinaryOp E.AssocLeft] + ,[ binary "==" CC.BinaryOp E.AssocLeft + , binary "/=" CC.BinaryOp E.AssocLeft + , binary ">" CC.BinaryOp E.AssocLeft + , binary ">=" CC.BinaryOp E.AssocLeft + , binary "<" CC.BinaryOp E.AssocLeft + , binary "<=" CC.BinaryOp E.AssocLeft] + ,[ binary "&&" CC.BinaryOp E.AssocLeft] + ,[ binary "||" CC.BinaryOp E.AssocLeft] ] where binary sign f = E.Infix $ do {reservedOp sign; return $ f sign} prefix sign f = E.Prefix $ do {reservedOp sign; return $ f sign} -term = subExpression <|> functionCall <|> number <|> list - <|> stringExpr <|> reference __ "formula" +term = subExpression <|> ifThenElse <|> try functionCall <|> constant + <|> number <|> list <|> stringExpr <|> reference __ "formula" functionCall = do { name <- identifier ; arg <- number <|> stringExpr <|> list - <|> reference <|> subExpression __ "argument" + <|> reference <|> subExpression + <|> constant __ "argument" ; return $ Call name arg } __ "function call" -number = (NumberExpr <$> double) __ "number" +constant = (Constant <$> identifier) __ "constant" +number = (NumberExpr <$> signedDouble) __ "number" + stringExpr = (StringExpr <$> stringLiteral) __ "string" -list = do { symbol "[" - ; l <- P.sepBy1 expression $ symbol "," - ; symbol "]" - ; return $ ListExpr l - } "list" +listParser :: Parser CellExpr -> Parser CellExpr +listParser parser = + do { reservedOp "[" + ; l <- P.sepBy1 parser $ reservedOp "," + ; reservedOp "]" + ; return $ ListExpr l + } "list" -reference = try cellRangeRef <|> try cellRef __ "reference" +list = listParser expression +topLevelList = listParser $ constant <|> number -cellRef = do { string "$" +reference = try cellRangeRef <|> try miscRef __ "reference" + +miscRef = do { string "$" ; row <- P.many1 (P.noneOf [',']) ; string "," ; column <- P.many1 (P.noneOf ['$']) ; string "$" ; whitespace - ; case (row,column) of - ("_",c) -> return $ NamedReference $ NamedColumn c - (r,"_") -> return $ NamedReference $ NamedRow r - _ -> return $ NamedReference $ NamedCell (row,column) + ; return $ NamedReference $ + case (row,column) of + ("_",c) -> NamedColumn c + (r,"_") -> NamedRow r + ("=",c) -> NamedCell $ SameRow c + (r,"=") -> NamedCell $ SameColumn r + _ -> NamedCell $ Named (row,column) } __ "cell reference" -cellRangeRef = do { NamedReference (NamedCell from) <- cellRef +cellRangeRef = do { NamedReference (NamedCell from) <- miscRef ; symbol ":" - ; NamedReference (NamedCell to) <- cellRef + ; NamedReference (NamedCell to) <- miscRef ; return $ NamedReference $ NamedRange (from,to) } __ "cell range reference" @@ -89,26 +111,36 @@ ; return $ Sub subExpr } __ "subexpression" -lexer :: T.TokenParser () -lexer = T.makeTokenParser $ L.emptyDef - { L.opStart = P.oneOf "+-*/~^:" - , L.opLetter = P.oneOf "+-*/~^:" - , L.reservedOpNames = ["+","-","*","/","~","^",":"] - , L.reservedNames = []} +ifThenElse = do { condition <- reserved "if" >> expression + ; thenBranch <- reserved "then" >> expression + ; elseBranch <- P.option EmptyExpr + $ reserved "else" >> expression + ; return $ IfThenElse condition thenBranch elseBranch + } __ "if-then-else expression" -double :: Parser Double -double = do - f <- T.naturalOrFloat lexer - case f of - Left i -> return $ realToFrac i - Right d -> return d +lexer :: T.TokenParser () +lexer = + let def = L.emptyDef + { L.opStart = P.oneOf "+-*/~^:[,]=<>&|" + , L.opLetter = L.opStart def + , L.reservedOpNames = ["+","-","*","/","~","^",":","[",",","]" + ,"=","==","/=","<","<=",">",">=","&&","||"] + , L.reservedNames = ["if","then","else"]} + in + T.makeTokenParser def signedDouble :: Parser Double signedDouble = - let signed = do symbol "-" - ((*) (-1)) <$> double + let double = do f <- T.naturalOrFloat lexer + case f of + Left i -> return $ realToFrac i + Right d -> return d + signed = symbol "-" >> ((*) (-1)) <$> double in P.choice [signed,double] + +reserved :: String -> Parser () +reserved = T.reserved lexer reservedOp :: String -> Parser () reservedOp = T.reservedOp lexer diff --git a/src/Model/Grid.hs b/src/Model/Grid.hs --- a/src/Model/Grid.hs +++ b/src/Model/Grid.hs @@ -1,44 +1,54 @@ -module Model.Grid (Grid,new,getCell,setCell,rewriteCell - ,updateCell,updateCellIO,resizeTo - ,addRow,addColumn,deleteColumns,deleteRows +module Model.Grid (Grid,new,getCell,setCellInput,setCellExpr + ,rewriteCell,updateCell,updateCellIO,resizeTo + ,addRows,addColumns,deleteColumns,deleteRows + ,insertRowBefore,insertColumnBefore ,updateRowLabel,updateColumnLabel ,columnIndex,rowIndex - ,setFilePath,getFilePath - ,getColumnValues) + ,dependencyCoordsFromInput,getFilePath,save,isSaved + ,getColumnValues,getRowValues,evaluateString) where -import Control.Monad (forM,forM_) +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(..),Reference(..) - ,NamedReference(..),CompileReason(..)) +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 qualified View +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 :: View.Info -> IO Grid -new viewInfo = do +new :: ModelToView -> IO Grid +new toView = 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) + 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 @@ -46,63 +56,83 @@ getCellValue :: CellCoord -> Grid -> IO CellValue getCellValue coord grid = Cell.value <$> getCell coord grid -setCell :: CellCoord -> String -> Grid -> IO [CellCoord] -setCell coord string grid = do +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 - deleteDependenciesOn cell - cell' <- do expr <- compile (parse string,coord) grid - return $ Cell.setExpression string expr cell - addDependenciesOn cell' + 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 - deleteDependenciesOn cell = + 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 + 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 = + 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 + 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 + 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 $ flip referencedCellValue grid - evalRec (coord@(row,col)) = do + 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 grid - changed3 <- evaluateHeaderDeps col columnHeader grid + changed2 <- evaluateHeaderDeps row rowHeader + changed3 <- evaluateHeaderDeps col columnHeader 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) +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 = @@ -114,44 +144,90 @@ 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 $ flip getCellValue grid) - + _ -> ListValue <$> (forM coord $ getCellValue `flip` grid) updateCellIO :: CellCoord -> (Cell -> IO Cell) -> Grid -> IO () -updateCellIO coord f = Dyn.updateIO coord f . cells +updateCellIO coord f grid = unsave grid + >> (Dyn.updateIO coord f $ cells grid) updateCell :: CellCoord -> (Cell -> Cell) -> Grid -> IO () -updateCell coord f = Dyn.update coord f . cells +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 -addRow,addColumn :: String -> Grid -> IO [CellCoord] -addRow name grid = do - i <- numViewGridRows grid - Header.setLabel name (i-1) $ rowHeader grid - evaluateAllHeaderDeps columnHeader grid +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 -addColumn name grid = do - i <- numViewGridCols grid - Header.setLabel name (i-1) $ columnHeader grid - evaluateAllHeaderDeps rowHeader 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) $ flip rewriteCell grid + forM (concat rowDeps) $ rewriteCell `flip` grid changed2 <- do headerDeps <- Header.dependents i $ rowHeader grid - forM headerDeps $ flip rewriteCell grid + forM headerDeps $ rewriteCell `flip` grid + unsave grid return $ (concat changed1) ++ (concat changed2) updateColumnLabel i to grid = do @@ -159,10 +235,11 @@ changed1 <- do rows <- numViewGridRows grid colDeps <- forM [0..rows] $ \r -> Cell.dependent <$> (getCell (r,i) grid) - forM (concat colDeps) $ flip rewriteCell grid + forM (concat colDeps) $ rewriteCell `flip` grid changed2 <- do headerDeps <- Header.dependents i $ columnHeader grid - forM headerDeps $ flip rewriteCell grid + forM headerDeps $ rewriteCell `flip` grid + unsave grid return $ (concat changed1) ++ (concat changed2) rowIndex,columnIndex :: String -> Grid -> IO (Maybe Int) @@ -180,58 +257,72 @@ getFilePath :: Grid -> IO (Maybe FilePath) getFilePath = readIORef . filePath -setFilePath :: FilePath -> Grid -> IO () -setFilePath path grid = writeIORef (filePath grid) $ Just path +save :: FilePath -> Grid -> IO () +save path grid = do + writeIORef (gridIsSaved grid) True + writeIORef (filePath grid) $ Just path + markAsSavedAs grid $ takeFileName path -deleteColumns :: [Int] -> Grid -> IO () -deleteColumns cols grid = do - Header.delete cols $ columnHeader grid - Dyn.deleteColumnsInMatrix cols $ cells grid +unsave :: Grid -> IO () +unsave grid = do + currentlySaved <- isSaved grid + writeIORef (gridIsSaved grid) False + when currentlySaved $ markAsUnsaved grid -deleteRows :: [Int] -> Grid -> IO () -deleteRows rows grid = do - Header.delete rows $ rowHeader grid - Dyn.deleteRowsInMatrix rows $ cells grid +isSaved :: Grid -> IO Bool +isSaved = readIORef . gridIsSaved -getColumnValues :: Int -> Grid -> IO [CellValue] -getColumnValues i grid = do +getColumnCells,getRowCells :: Int -> Grid -> IO [Cell] +getColumnCells i grid = do rows <- numViewGridRows grid - forM [0..rows-1] $ \row -> getCellValue (row,i) 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 grid + 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,at) grid = +checkReferenceLoop (expr,coord) 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 + depthFirstSearch coord' | coord' == coord = return True + depthFirstSearch coord' = do + deps <- Cell.dependencies <$> getCell coord' 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 +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' <- labelsToCoord a grid - b' <- labelsToCoord b grid - case (a',b') of - (Just x,Just y) -> return $ Just $ Range (x,y) - _ -> return Nothing + 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 = flip referenceConversion grid - + refConversion e = referenceConversion (e,(row,col)) grid in case expr of NamedReference ref -> do ref' <- convert ref @@ -245,4 +336,8 @@ 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 diff --git a/src/Model/GridHeader.hs b/src/Model/GridHeader.hs --- a/src/Model/GridHeader.hs +++ b/src/Model/GridHeader.hs @@ -1,6 +1,6 @@ module Model.GridHeader (Header,new,addDependent,deleteDependent ,dependents,allDependents,index,setLabel - ,delete,label) + ,insertLabelBefore,delete,label) where import Control.Applicative ((<$>)) @@ -8,7 +8,7 @@ import qualified Data.List as List import Data.Ix (range) import Util.DynArray (DynArray) -import qualified Util.DynArray as DynArray +import qualified Util.DynArray as Dyn import CellCoordinate (CellCoord) type Label = String @@ -16,31 +16,36 @@ type Header = DynArray Int Info new :: IO Header -new = DynArray.newLinearArray 0 ("",[]) +new = Dyn.newLinearArray 0 ("",[]) setLabel :: Label -> Int -> Header -> IO () -setLabel label to = DynArray.update to (\(_,deps) -> (label,deps)) +setLabel label to = Dyn.update to (\(_,deps) -> (label,deps)) +insertLabelBefore :: Label -> Int -> Int -> Header -> IO () +insertLabelBefore label i maxLabelIndex header = do + Dyn.insertEmptyIntoLinearArrayBefore i maxLabelIndex header + setLabel label i header + addDependent :: CellCoord -> Int -> Header -> IO () -addDependent dep to = DynArray.update to (\(l,deps) -> (l,dep:deps)) +addDependent dep to = Dyn.update to (\(l,deps) -> (l,dep:deps)) deleteDependent :: CellCoord -> Int -> Header -> IO () deleteDependent dep from = - DynArray.update from (\(l,deps) -> (l,List.delete dep deps)) + Dyn.update from (\(l,deps) -> (l,List.delete dep deps)) label :: Int -> Header -> IO Label -label i header = fst <$> DynArray.read i header +label i header = fst <$> Dyn.read i header dependents :: Int -> Header -> IO [CellCoord] -dependents i header = snd <$> DynArray.read i header +dependents i header = snd <$> Dyn.read i header allDependents :: Header -> IO [CellCoord] allDependents header = do - b <- DynArray.bounds header + b <- Dyn.bounds header concat <$> (forM (range b) $ \i -> dependents i header) index :: String -> Header -> IO (Maybe Int) -index label = DynArray.indexBy (\(l,_) -> label == l) +index label = Dyn.indexBy (\(l,_) -> label == l) delete :: [Int] -> Header -> IO () -delete = DynArray.deleteInLinearArray +delete = Dyn.deleteInLinearArray diff --git a/src/ModelToView.hs b/src/ModelToView.hs new file mode 100644 --- /dev/null +++ b/src/ModelToView.hs @@ -0,0 +1,20 @@ +module ModelToView (ModelToView(..),new) + where + +import View (View,onGrid) +import qualified View.Component.Grid as Grid +import qualified View.GridPage as GridPage + +data ModelToView = ModelToView { numDataRows :: IO Int + , numDataColumns :: IO Int + , markAsSavedAs :: String -> IO () + , markAsUnsaved :: IO () + } + +new :: View -> ModelToView +new view = ModelToView + { numDataRows = onGrid view Grid.numDataRows + , numDataColumns = onGrid view Grid.numDataColumns + , markAsSavedAs = GridPage.setCurrentCaption `flip` view + , markAsUnsaved = GridPage.markAsUnsaved view + } diff --git a/src/Run.hs b/src/Run.hs --- a/src/Run.hs +++ b/src/Run.hs @@ -2,7 +2,6 @@ where import Control.Monad (when) -import Control.Monad.Reader (runReaderT) import Graphics.UI.WX (Prop ((:=)),on) import qualified Graphics.UI.WX as WX import qualified Graphics.UI.WXCore as WXC @@ -33,7 +32,8 @@ import qualified Controller.Menu.Table.Copy as CCopy import qualified Controller.Menu.Table.Delete as CDelete import qualified Controller.Menu.Table.Transpose as CTranspose -import qualified Controller.Menu.Table.Reevaluate as CReevaluate +import qualified Controller.Menu.Table.Rename as CRename +import qualified Controller.Menu.Table.Filter as CFilter import qualified Controller.Menu.Statistics.FrequencyDistribution as CStatsFD import qualified Controller.Menu.Statistics.Descriptive as CDescriptive @@ -53,8 +53,8 @@ ctrl <- Controller.new config model view let ifGridOpen eventHandler = do opened <- View.isGridOpen view - when opened $ runReaderT eventHandler ctrl - call eventHandler = runReaderT eventHandler ctrl + when opened $ Controller.withCtrlData eventHandler ctrl + call eventHandler = Controller.withCtrlData eventHandler ctrl windowEH <- WXC.windowGetEventHandler notebook --frame notebookId <- WXC.windowGetId notebook @@ -65,9 +65,8 @@ WX.set formulaInput [ WX.processEnter := True , WX.enabled := False - , on WX.command := - do call CFormulaInput.eventHandler - VMode.gridMode view + , on WX.command := do call CFormulaInput.eventHandler + VMode.gridMode view , on WX.focus := \onFocus -> when (not onFocus) $ VMode.gridMode view ] @@ -99,6 +98,8 @@ tableCopy <- WX.menuPane [WX.text := (__ "Copy")] _ <- WX.menuSub tableMenu tableCopy [] tableCopyColumn <- WX.menuItem tableCopy [WX.text := (__ "Columns") ++ " ..."] + tableCopyRow <- WX.menuItem tableCopy [WX.text := (__ "Rows") ++ " ..."] + tableCopyFormula <- WX.menuItem tableCopy [WX.text := (__ "Formula") ++ " ..."] tableDelete <- WX.menuPane [WX.text := (__ "Delete")] _ <- WX.menuSub tableMenu tableDelete [] tableDeleteColumn <- WX.menuItem tableDelete [WX.text := (__ "Columns") ++ " ..."] @@ -108,7 +109,14 @@ tableTransposeTable <- WX.menuItem tableTranspose [WX.text := (__ "Table")] tableTransposeColumn <- WX.menuItem tableTranspose [WX.text := (__ "Columns") ++ " ..."] tableTransposeRow <- WX.menuItem tableTranspose [WX.text := (__ "Rows") ++ " ..."] - tableReevalAll <- WX.menuItem tableMenu [WX.text := (__ "Reevaluate all cells")] + tableRename <- WX.menuPane [WX.text := (__ "Rename")] + _ <- WX.menuSub tableMenu tableRename [] + tableRenameColumn <- WX.menuItem tableRename [WX.text := (__ "Column") ++ " ..."] + tableRenameRow <- WX.menuItem tableRename [WX.text := (__ "Row") ++ " ..."] + tableFilter <- WX.menuPane [WX.text := (__ "Filter")] + _ <- WX.menuSub tableMenu tableFilter [] + tableFilterRow <- WX.menuItem tableFilter [WX.text := (__ "Rows") ++ " ..."] + tableFilterColumn <- WX.menuItem tableFilter [WX.text := (__ "Columns") ++ " ..."] statisticsMenu <- WX.menuPane [WX.text := "&" ++ (__ "Statistics")] statsFreqDist <- WX.menuItem statisticsMenu [WX.text := (__ "Frequency Distribution") ++ " ..."] @@ -138,13 +146,18 @@ , on (WX.menu tableAddColumn) := ifGridOpen CAdd.columnEventHandler , on (WX.menu tableAddRow) := ifGridOpen CAdd.rowEventHandler - , on (WX.menu tableCopyColumn) := ifGridOpen CCopy.eventHandler + , on (WX.menu tableCopyColumn) := ifGridOpen CCopy.columnEventHandler + , on (WX.menu tableCopyRow) := ifGridOpen CCopy.rowEventHandler + , on (WX.menu tableCopyFormula) := ifGridOpen CCopy.formulaEventHandler , on (WX.menu tableDeleteColumn) := ifGridOpen CDelete.columnEventHandler , on (WX.menu tableDeleteRow) := ifGridOpen CDelete.rowEventHandler , on (WX.menu tableTransposeColumn) := ifGridOpen CTranspose.columnEventHandler , on (WX.menu tableTransposeRow) := ifGridOpen CTranspose.rowEventHandler , on (WX.menu tableTransposeTable) := ifGridOpen CTranspose.tableEventHandler - , on (WX.menu tableReevalAll) := ifGridOpen CReevaluate.eventHandler + , on (WX.menu tableRenameColumn) := ifGridOpen CRename.columnEventHandler + , on (WX.menu tableRenameRow) := ifGridOpen CRename.rowEventHandler + , on (WX.menu tableFilterColumn) := ifGridOpen CFilter.columnEventHandler + , on (WX.menu tableFilterRow) := ifGridOpen CFilter.rowEventHandler , on (WX.menu statsFreqDist) := ifGridOpen CStatsFD.eventHandler , on (WX.menu statsDescriptive) := ifGridOpen CDescriptive.eventHandler @@ -153,7 +166,4 @@ , on WX.closing := do ifGridOpen CFileNewClose.closeAllEventHandler call CSaveConfig.eventHandler WX.propagateEvent - - ] - return () diff --git a/src/Util.hs b/src/Util.hs --- a/src/Util.hs +++ b/src/Util.hs @@ -1,8 +1,10 @@ -module Util (justWhen,whenNothing,(<.>),deleteByIndices,breakAt +module Util (justWhen,whenNothing,whenM,unlessM + ,(<.>),deleteByIndices,breakAt ,maybeRead,stripWhitespace) where import Control.Applicative ((<$>)) +import Control.Monad (when,unless) import Control.Exception (assert) import Data.List (sort) import Data.Char (isSpace) @@ -16,6 +18,12 @@ whenNothing maybeThis doThis = case maybeThis of Nothing -> doThis _ -> return () + +whenM :: Monad m => m Bool -> m () -> m () +whenM this doThis = this >>= when `flip` doThis + +unlessM :: Monad m => m Bool -> m () -> m () +unlessM this doThis = this >>= unless `flip` doThis (<.>) :: Functor f => (a -> b) -> (c -> f a) -> c -> f b (<.>) p q arg = p <$> (q arg) diff --git a/src/Util/DynArray.hs b/src/Util/DynArray.hs --- a/src/Util/DynArray.hs +++ b/src/Util/DynArray.hs @@ -3,7 +3,10 @@ ,resizeTo,updateIO,update,bounds,index,indexBy ,elements,showDynArray ,deleteInLinearArray - ,deleteColumnsInMatrix,deleteRowsInMatrix) + ,deleteColumnsInMatrix,deleteRowsInMatrix + ,insertEmptyIntoLinearArrayBefore + ,insertEmptyRowIntoMatrixBefore + ,insertEmptyColumnIntoMatrixBefore) where import Prelude hiding (init,read) @@ -53,17 +56,21 @@ if inRange bounds i then readArray array i else return $ init dynArray +growArray :: Ix i => i -> DynArray i e -> IO () +growArray i dynArray = do + array <- readIORef $ ref dynArray + bounds <- getBounds array + array' <- ArrayIO.newArray (grow dynArray bounds i) $ init dynArray + copyUnsafe array array' + writeIORef (ref dynArray) array' + write :: Ix i => i -> e -> DynArray i e -> IO () write i e dynArray = do array <- readIORef $ ref dynArray bounds <- getBounds array if inRange bounds i then writeArray array i e - else do - array' <- ArrayIO.newArray (grow dynArray bounds i) $ init dynArray - copyUnsafe array array' - writeArray array' i e - writeIORef (ref dynArray) array' + else growArray i dynArray >> write i e dynArray writes :: (Ix i,Enum i) => i -> [e] -> DynArray i e -> IO () writes i es dynArray = @@ -106,6 +113,33 @@ elements :: Ix i => DynArray i e -> IO [e] elements dynArray = readIORef (ref dynArray) >>= getElems +insertEmptyIntoLinearArrayBefore :: Int -> Int -> DynArray Int e -> IO () +insertEmptyIntoLinearArrayBefore i maxCopy dynArray = do + maxBound <- snd <$> bounds dynArray + when (maxCopy >= maxBound) $ growArray maxCopy dynArray + array <- readIORef $ ref dynArray + forM_ [maxCopy,maxCopy-1..i] $ \n -> + readArray array n >>= writeArray array (n+1) + writeArray array i $ init dynArray + +insertEmptyRowIntoMatrixBefore :: Int -> Int -> DynArray (Int,Int) e -> IO () +insertEmptyRowIntoMatrixBefore i maxCopyRow dynArray = do + (maxRow,_) <- snd <$> bounds dynArray + when (maxCopyRow >= maxRow) $ growArray (maxCopyRow,0) dynArray + + forM_ [maxCopyRow,maxCopyRow-1..i] $ \n -> + copyRowUnsafe n (n+1) dynArray + writeEmptyRow i dynArray + +insertEmptyColumnIntoMatrixBefore :: Int -> Int -> DynArray (Int,Int) e -> IO () +insertEmptyColumnIntoMatrixBefore i maxCopyCol dynArray = do + (_,maxCol) <- snd <$> bounds dynArray + when (maxCopyCol >= maxCol) $ growArray (0,maxCopyCol) dynArray + + forM_ [maxCopyCol,maxCopyCol-1..i] $ \n -> + copyColumnUnsafe n (n+1) dynArray + writeEmptyColumn i dynArray + deleteInLinearArray :: [Int] -> DynArray Int e -> IO () deleteInLinearArray is dynArray = do assert (is == sort is) $ return () @@ -127,46 +161,60 @@ deleteColumnsInMatrix columns dynArray = do assert (columns == sort columns) $ return () array <- readIORef $ ref dynArray - ((minRow,minCol),(maxRow,maxCol)) <- getBounds array + ((_,minCol),(_,maxCol)) <- getBounds array - let copyColumn from to = - forM_ [minRow..maxRow] $ \r -> - readArray array (r,from) >>= writeArray array (r,to) - - deleteColumn (col:cols,deleted) index | col == index = + let deleteColumn (col:cols,deleted) index | col == index = return (cols,deleted+1) deleteColumn (cols,deleted) index = do - when (deleted > 0) $ copyColumn index $ index - deleted + when (deleted > 0) $ + copyColumnUnsafe index (index - deleted) dynArray return (cols,deleted) - resetColumnToInit col = - forM_ [minRow..maxRow] $ \r -> - writeArray array (r,col) $ init dynArray - (_,deleted) <- foldM deleteColumn (columns,0) [minCol..maxCol] - forM_ [maxCol-deleted+1..maxCol] resetColumnToInit + forM_ [maxCol-deleted+1..maxCol] $ writeEmptyColumn `flip` dynArray deleteRowsInMatrix :: [Int] -> DynArray (Int,Int) e -> IO () deleteRowsInMatrix rowsToDelete dynArray = do assert (rowsToDelete == sort rowsToDelete) $ return () array <- readIORef $ ref dynArray - ((minRow,minCol),(maxRow,maxCol)) <- getBounds array + ((minRow,_),(maxRow,_)) <- getBounds array - let copyRow from to = - forM_ [minCol..maxCol] $ \c -> - readArray array (from,c) >>= writeArray array (to,c) - - deleteRow (row:rows,deleted) index | row == index = + let deleteRow (row:rows,deleted) index | row == index = return (rows,deleted+1) deleteRow (rows,deleted) index = do - when (deleted > 0) $ copyRow index $ index - deleted + when (deleted > 0) $ + copyRowUnsafe index (index - deleted) dynArray return (rows,deleted) - resetRowToInit row = - forM_ [minCol..maxCol] $ \c -> - writeArray array (row,c) $ init dynArray - (_,deleted) <- foldM deleteRow (rowsToDelete,0) [minRow..maxRow] - forM_ [maxRow-deleted+1..maxRow] resetRowToInit + forM_ [maxRow-deleted+1..maxRow] $ writeEmptyRow `flip` dynArray + +copyColumnUnsafe :: Int -> Int -> DynArray (Int,Int) e -> IO () +copyColumnUnsafe from to dynArray = do + array <- readIORef $ ref dynArray + ((minRow,_),(maxRow,_)) <- getBounds array + forM_ [minRow..maxRow] $ \r -> + readArray array (r,from) >>= writeArray array (r,to) + +copyRowUnsafe :: Int -> Int -> DynArray (Int,Int) e -> IO () +copyRowUnsafe from to dynArray = do + array <- readIORef $ ref dynArray + ((_,minCol),(_,maxCol)) <- getBounds array + forM_ [minCol..maxCol] $ \c -> + readArray array (from,c) >>= writeArray array (to,c) + +writeEmptyColumn :: Int -> DynArray (Int,Int) e -> IO () +writeEmptyColumn i dynArray = do + array <- readIORef $ ref dynArray + ((minRow,_),(maxRow,_)) <- getBounds array + forM_ [minRow..maxRow] $ \r -> + writeArray array (r,i) $ init dynArray + +writeEmptyRow :: Int -> DynArray (Int,Int) e -> IO () +writeEmptyRow i dynArray = do + array <- readIORef $ ref dynArray + ((_,minCol),(_,maxCol)) <- getBounds array + forM_ [minCol..maxCol] $ \c -> + writeArray array (i,c) $ init dynArray diff --git a/src/View.hs b/src/View.hs --- a/src/View.hs +++ b/src/View.hs @@ -1,23 +1,18 @@ -module View (View(..),Info(..),onGrid,isGridOpen - ,info) +module View (View(..),onGrid,isGridOpen) where import qualified Graphics.UI.WX as WX -import qualified View.Component.Grid as Grid -import qualified View.Component.TextWindow as TextWindow -import qualified View.Component.Notebook as Notebook +import View.Component.Grid (Grid) +import View.Component.TextWindow (TextWindow) +import View.Component.Notebook (Notebook) data View = View { frame :: WX.Frame () - , formulaInput :: TextWindow.TextWindow - , notebook :: Notebook.Notebook - , current :: WX.Var (Maybe Grid.Grid) - } - -data Info = Info { numDataRows :: IO Int - , numDataColumns :: IO Int + , formulaInput :: TextWindow + , notebook :: Notebook + , current :: WX.Var (Maybe Grid) } -onGrid :: View -> (Grid.Grid -> IO a) -> IO a +onGrid :: View -> (Grid -> IO a) -> IO a onGrid view f = WX.varGet (current view) >>= \(Just grid) -> f grid isGridOpen :: View -> IO Bool @@ -26,8 +21,3 @@ return $ case current of Nothing -> False _ -> True - -info :: View -> Info -info view = Info { numDataRows = onGrid view Grid.numDataRows - , numDataColumns = onGrid view Grid.numDataColumns - } diff --git a/src/View/Component/Grid.hs b/src/View/Component/Grid.hs --- a/src/View/Component/Grid.hs +++ b/src/View/Component/Grid.hs @@ -5,13 +5,16 @@ ,getRowLabel,getColumnLabel ,getRowLabels,getColumnLabels ,setRowLabel,setColumnLabel - ,addRow,addColumn,numDataRows,numDataColumns + ,addRows,addColumns + ,insertRowBefore,insertColumnBefore + ,numDataRows,numDataColumns ,deleteColumns,deleteRows ) where import Control.Exception (assert) import Control.Monad (forM,forM_) +import Control.Applicative ((<$>)) import qualified Graphics.UI.WX as WX import qualified Graphics.UI.WXCore as WXC import Data.List (sort) @@ -86,39 +89,58 @@ rows <- numDataRows grid forM [0..rows-1] $ \i -> getValue (i,n) grid -addRow,addColumn :: String -> Grid -> IO () -addRow name grid = do - n <- numDataRows grid - WXC.gridAppendRows grid 1 True - setRowLabel n name grid - setRowLabel (n+1) "..." grid -addColumn name grid = do - n <- numDataColumns grid - WXC.gridAppendCols grid 1 True - setColumnLabel n name grid - setColumnLabel (n+1) "..." grid - -deleteColumns :: [Int] -> Grid -> IO () -deleteColumns cols grid = do - assert (reverse (sort cols) == cols) $ return () - labels <- getColumnLabels grid +addRows,addColumns :: [String] -> Grid -> IO () +addRows names grid = + let ls = length names + in do n <- numDataRows grid + WXC.gridAppendRows grid ls True + forM_ (zip [n..] names) $ \(i,name) -> + setRowLabel i name grid + setRowLabel (n + ls) "..." grid - forM_ cols $ \i -> WXC.gridDeleteCols grid i 1 True +addColumns names grid = + let ls = length names + in do n <- numDataColumns grid + WXC.gridAppendCols grid ls True + forM_ (zip [n..] names) $ \(i,name) -> + setColumnLabel i name grid + setColumnLabel (n + ls) "..." grid - -- Reset labels (because of buggy gridDeleteCols) - forM (zip [0..] $ deleteByIndices cols labels) $ \(col,label) -> - setColumnLabel col label grid +insertRowBefore,insertColumnBefore :: String -> Int -> Grid -> IO () +insertRowBefore name i grid = do + labels <- do (pre,post) <- splitAt i <$> getRowLabels grid + return $ pre ++ [name] ++ post + WXC.gridInsertRows grid i 1 True + resetRowLabels labels grid - numDataColumns grid >>= \n -> setColumnLabel n "..." grid +insertColumnBefore name i grid = do + labels <- do (pre,post) <- splitAt i <$> getColumnLabels grid + return $ pre ++ [name] ++ post + WXC.gridInsertCols grid i 1 True + resetColumnLabels labels grid deleteRows :: [Int] -> Grid -> IO () deleteRows rows grid = do assert (reverse (sort rows) == rows) $ return () labels <- getRowLabels grid forM_ rows $ \i -> WXC.gridDeleteRows grid i 1 True + resetRowLabels (deleteByIndices rows labels) grid - -- Reset labels (because of buggy gridDeleteCols) - forM (zip [0..] $ deleteByIndices rows labels) $ \(row,label) -> - setRowLabel row label grid +deleteColumns :: [Int] -> Grid -> IO () +deleteColumns cols grid = do + assert (reverse (sort cols) == cols) $ return () + labels <- getColumnLabels grid + forM_ cols $ \i -> WXC.gridDeleteCols grid i 1 True + resetColumnLabels (deleteByIndices cols labels) grid +-- Reset labels (because of buggy gridDelete* and gridInsert*) +resetRowLabels,resetColumnLabels :: [String] -> Grid -> IO () +resetRowLabels labels grid = do + forM (zip [0..] labels) $ \(row,label) -> + setRowLabel row label grid numDataRows grid >>= \n -> setRowLabel n "..." grid + +resetColumnLabels labels grid = do + forM (zip [0..] labels) $ \(col,label) -> + setColumnLabel col label grid + numDataColumns grid >>= \n -> setColumnLabel n "..." grid diff --git a/src/View/Dialog/Complex.hs b/src/View/Dialog/Complex.hs --- a/src/View/Dialog/Complex.hs +++ b/src/View/Dialog/Complex.hs @@ -1,6 +1,6 @@ module View.Dialog.Complex (Layout (..),Widget (..),Modifier (..) ,showDialog,showSimpleDialog - ,okButton,cancelButton) + ,okLabel,okButton,cancelButton) where import Control.Applicative ((<$>)) @@ -29,7 +29,7 @@ | CheckBox String (a -> Bool) (a -> Bool -> a) | RadioBox String [String] (a -> Int) (a -> Int -> a) -data Modifier = HFill | Center | Margin | Boxed String +data Modifier = HFill | Center | Margin | Boxed String | MinSize (Int,Int) data WXWidget a b = WXScrolledWindow (WX.ScrolledWindow ()) @@ -161,6 +161,7 @@ Modifier Center a -> WX.centre $ buildWXLayout a Modifier Margin a -> WX.margin 10 $ buildWXLayout a Modifier (Boxed text) a -> WX.boxed text $ buildWXLayout a + Modifier (MinSize (x,y)) a -> WX.minsize (WXC.sz x y) $ buildWXLayout a Modifiers xs a -> buildWXLayout $ foldr Modifier a xs WXWidget a -> WX.widget a @@ -241,8 +242,11 @@ WX.KeySpace -> return () _ -> WX.propagateEvent +okLabel :: String +okLabel = __ "&Ok" + okButton :: b -> Layout a b -okButton = Widget . DefaultButton (__ "&Ok") +okButton = Widget . DefaultButton okLabel cancelButton :: Layout a b cancelButton = Widget $ TerminationButton (__ "&Cancel") diff --git a/src/View/Dialog/Simple.hs b/src/View/Dialog/Simple.hs --- a/src/View/Dialog/Simple.hs +++ b/src/View/Dialog/Simple.hs @@ -10,7 +10,8 @@ input :: String -> String -> View -> IO (Maybe String) input caption = let dialog = Modifier Margin $ Column - [ FocusOn $ TextEntry id (\_ -> id) + [ Modifiers [Boxed caption,HFill] + $ FocusOn $ TextEntry id (\_ -> id) , Modifier Center $ Row [okButton (), cancelButton]] in diff --git a/src/View/GridPage.hs b/src/View/GridPage.hs --- a/src/View/GridPage.hs +++ b/src/View/GridPage.hs @@ -2,7 +2,8 @@ ,getCurrentCaption,setCurrentCaption ,keyEventHandler,captions ,currentSelectionNum,currentSelectionId,pageId - ,fireSelectionEvent) + ,fireSelectionEvent + ,markAsUnsaved) where import Control.Applicative ((<$>)) @@ -23,15 +24,12 @@ id <- WXC.windowGetId grid return (id,grid) -add :: Maybe String -> Grid -> View -> IO () -add maybeCaption grid view = +add :: Grid -> View -> IO () +add grid view = let nb = notebook view in do - caption <- case maybeCaption of - Nothing -> - do id <- show . abs <$> WXC.windowGetId grid - return $ unwords ["unnamed","[" ++ id ++ "]"] - Just c -> return c + caption <- do id <- show . abs <$> WXC.windowGetId grid + return $ unwords ["*unnamed","[" ++ id ++ "]"] Notebook.addGrid grid caption nb Notebook.currentSelectionNum nb >>= (\(Just n) -> setCurrent n view) @@ -94,3 +92,8 @@ WXC.KeyUp -> WXC.propagateEvent WXC.KeyDown -> WXC.propagateEvent _ -> return () + +markAsUnsaved :: View -> IO () +markAsUnsaved view = do + caption <- getCurrentCaption view + setCurrentCaption ('*':caption) view