lhae 0.0.2 → 0.0.3
raw patch · 53 files changed
+1964/−828 lines, 53 files
Files
- i18n/de.po +159/−21
- i18n/en.po +157/−22
- i18n/messages.pot +143/−17
- lhae.cabal +63/−59
- src/Config.hs +2/−2
- src/Controller.hs +7/−1
- src/Controller/Canonical.hs +46/−39
- src/Controller/Cell.hs +8/−7
- src/Controller/Dialog.hs +66/−32
- src/Controller/FormulaInput.hs +2/−2
- src/Controller/Grid.hs +238/−86
- src/Controller/Menu/File/Export/Diagram/BarChart.hs +2/−2
- src/Controller/Menu/File/Export/Diagram/BarChartParameters.hs +7/−4
- src/Controller/Menu/File/Export/Diagram/BoxPlot.hs +2/−2
- src/Controller/Menu/File/Export/Diagram/BoxPlotParameters.hs +2/−3
- src/Controller/Menu/File/Export/Image.hs +2/−2
- src/Controller/Menu/File/Export/ImageParameters.hs +2/−3
- src/Controller/Menu/File/Import/Csv.hs +18/−34
- src/Controller/Menu/File/Import/CsvParameters.hs +3/−9
- src/Controller/Menu/File/NewClose.hs +14/−13
- src/Controller/Menu/File/Open.hs +14/−15
- src/Controller/Menu/File/Save.hs +6/−8
- src/Controller/Menu/Statistics/Descriptive.hs +22/−16
- src/Controller/Menu/Statistics/FrequencyDistribution.hs +10/−9
- src/Controller/Menu/Statistics/Pivot.hs +11/−11
- src/Controller/Menu/Table/Add.hs +7/−38
- src/Controller/Menu/Table/Copy.hs +86/−11
- src/Controller/Menu/Table/Copy.hs-boot +10/−0
- src/Controller/Menu/Table/Delete.hs +13/−21
- src/Controller/Menu/Table/Delete.hs-boot +7/−0
- src/Controller/Menu/Table/Filter.hs +78/−0
- src/Controller/Menu/Table/Reevaluate.hs +0/−18
- src/Controller/Menu/Table/Rename.hs +68/−0
- src/Controller/Menu/Table/Rename.hs-boot +7/−0
- src/Controller/Menu/Table/Transpose.hs +24/−15
- src/Controller/Menu/Table/Transpose.hs-boot +7/−0
- src/Model.hs +4/−4
- src/Model/Cell.hs +5/−5
- src/Model/CellContent.hs +79/−20
- src/Model/CellExpression/Evaluator.hs +68/−21
- src/Model/CellExpression/Evaluator/Common.hs +16/−15
- src/Model/CellExpression/Parser.hs +72/−40
- src/Model/Grid.hs +186/−91
- src/Model/GridHeader.hs +16/−11
- src/ModelToView.hs +20/−0
- src/Run.hs +23/−13
- src/Util.hs +9/−1
- src/Util/DynArray.hs +78/−30
- src/View.hs +8/−18
- src/View/Component/Grid.hs +47/−25
- src/View/Dialog/Complex.hs +7/−3
- src/View/Dialog/Simple.hs +2/−1
- src/View/GridPage.hs +11/−8
i18n/de.po view
@@ -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"
i18n/en.po view
@@ -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"
i18n/messages.pot view
@@ -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
lhae.cabal view
@@ -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++
src/Config.hs view
@@ -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
src/Controller.hs view
@@ -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
src/Controller/Canonical.hs view
@@ -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
src/Controller/Cell.hs view
@@ -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 ()
src/Controller/Dialog.hs view
@@ -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+
src/Controller/FormulaInput.hs view
@@ -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
src/Controller/Grid.hs view
@@ -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
src/Controller/Menu/File/Export/Diagram/BarChart.hs view
@@ -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)
src/Controller/Menu/File/Export/Diagram/BarChartParameters.hs view
@@ -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
src/Controller/Menu/File/Export/Diagram/BoxPlot.hs view
@@ -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)
src/Controller/Menu/File/Export/Diagram/BoxPlotParameters.hs view
@@ -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
src/Controller/Menu/File/Export/Image.hs view
@@ -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] ]
src/Controller/Menu/File/Export/ImageParameters.hs view
@@ -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")
src/Controller/Menu/File/Import/Csv.hs view
@@ -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- - -
src/Controller/Menu/File/Import/CsvParameters.hs view
@@ -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
src/Controller/Menu/File/NewClose.hs view
@@ -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
src/Controller/Menu/File/Open.hs view
@@ -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
src/Controller/Menu/File/Save.hs view
@@ -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
src/Controller/Menu/Statistics/Descriptive.hs view
@@ -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+ ]
src/Controller/Menu/Statistics/FrequencyDistribution.hs view
@@ -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 =
src/Controller/Menu/Statistics/Pivot.hs view
@@ -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
src/Controller/Menu/Table/Add.hs view
@@ -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'
src/Controller/Menu/Table/Copy.hs view
@@ -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"+
+ src/Controller/Menu/Table/Copy.hs-boot view
@@ -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 ()
src/Controller/Menu/Table/Delete.hs view
@@ -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 []
+ src/Controller/Menu/Table/Delete.hs-boot view
@@ -0,0 +1,7 @@+module Controller.Menu.Table.Delete + (columnEventHandlerWith,rowEventHandlerWith)+where++import Controller (Controller)++columnEventHandlerWith,rowEventHandlerWith :: [Int] -> Controller ()
+ src/Controller/Menu/Table/Filter.hs view
@@ -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
− src/Controller/Menu/Table/Reevaluate.hs
@@ -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
+ src/Controller/Menu/Table/Rename.hs view
@@ -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]]
+ src/Controller/Menu/Table/Rename.hs-boot view
@@ -0,0 +1,7 @@+module Controller.Menu.Table.Rename + (columnEventHandlerWith,rowEventHandlerWith)+where++import Controller (Controller)++columnEventHandlerWith,rowEventHandlerWith :: Int -> Controller ()
src/Controller/Menu/Table/Transpose.hs view
@@ -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
+ src/Controller/Menu/Table/Transpose.hs-boot view
@@ -0,0 +1,7 @@+module Controller.Menu.Table.Transpose + (columnEventHandlerWith,rowEventHandlerWith)+where++import Controller (Controller)++columnEventHandlerWith,rowEventHandlerWith :: [Int] -> Controller ()
src/Model.hs view
@@ -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
src/Model/Cell.hs view
@@ -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
src/Model/CellContent.hs view
@@ -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-
src/Model/CellExpression/Evaluator.hs view
@@ -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
src/Model/CellExpression/Evaluator/Common.hs view
@@ -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
src/Model/CellExpression/Parser.hs view
@@ -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
src/Model/Grid.hs view
@@ -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
src/Model/GridHeader.hs view
@@ -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
+ src/ModelToView.hs view
@@ -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+ }
src/Run.hs view
@@ -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 ()
src/Util.hs view
@@ -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)
src/Util/DynArray.hs view
@@ -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
src/View.hs view
@@ -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- }
src/View/Component/Grid.hs view
@@ -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
src/View/Dialog/Complex.hs view
@@ -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")
src/View/Dialog/Simple.hs view
@@ -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
src/View/GridPage.hs view
@@ -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