├── .cabal-conf └── hackage.enc ├── .gitignore ├── .travis.yml ├── LICENSE ├── README.md ├── demos ├── image-format-guesser │ ├── ElementaryGtkProgram.cabal │ ├── Interface.glade │ ├── LICENSE │ ├── metrics.sh │ ├── src │ │ ├── CombinedEnvironment.hs │ │ ├── Controller.hs │ │ ├── Controller │ │ │ ├── Conditions.hs │ │ │ └── Conditions │ │ │ │ ├── ConditionDirection.hs │ │ │ │ ├── FilenameEntry.hs │ │ │ │ └── ResultLabel.hs │ │ ├── Extra │ │ │ └── UI │ │ │ │ └── Simplify │ │ │ │ ├── EntryBasic.hs │ │ │ │ └── LabelBasic.hs │ │ ├── Main.hs │ │ ├── Model │ │ │ ├── Model.hs │ │ │ ├── ProtectedModel.hs │ │ │ ├── ProtectedModel │ │ │ │ ├── Filename.hs │ │ │ │ └── ProtectedModelInternals.hs │ │ │ ├── ReactiveModel.hs │ │ │ └── ReactiveModel │ │ │ │ ├── Filename.hs │ │ │ │ ├── ModelEvents.hs │ │ │ │ └── ReactiveModelInternals.hs │ │ ├── View.hs │ │ └── View │ │ │ └── MainWindow │ │ │ └── Objects.hs │ └── tests │ │ ├── HLint.hs │ │ ├── HLintMain.hs │ │ └── HaddockCoverage.hs ├── keera-hails-demos-gtk-dunai │ ├── LICENSE │ ├── Setup.hs │ ├── keera-hails-demos-gtk-dunai.cabal │ ├── src │ │ └── HelloWorld.hs │ └── tests │ │ ├── HLint.hs │ │ ├── HLintMain.hs │ │ └── HaddockCoverage.hs ├── keera-hails-demos-gtk │ ├── LICENSE │ ├── Setup.hs │ ├── elementarygtkprogram │ │ ├── ElementaryGtkProgram.cabal │ │ ├── Interface.glade │ │ ├── LICENSE │ │ ├── metrics.sh │ │ ├── src │ │ │ ├── CombinedEnvironment.hs │ │ │ ├── Controller.hs │ │ │ ├── Controller │ │ │ │ └── Conditions.hs │ │ │ ├── Main.hs │ │ │ ├── Model │ │ │ │ ├── Model.hs │ │ │ │ ├── ProtectedModel.hs │ │ │ │ ├── ProtectedModel │ │ │ │ │ └── ProtectedModelInternals.hs │ │ │ │ ├── ReactiveModel.hs │ │ │ │ └── ReactiveModel │ │ │ │ │ ├── ModelEvents.hs │ │ │ │ │ └── ReactiveModelInternals.hs │ │ │ ├── View.hs │ │ │ └── View │ │ │ │ └── MainWindow │ │ │ │ └── Objects.hs │ │ └── tests │ │ │ ├── HLint.hs │ │ │ ├── HLintMain.hs │ │ │ └── HaddockCoverage.hs │ ├── keera-hails-demos-gtk.cabal │ ├── src │ │ └── HelloWorld.hs │ └── tests │ │ ├── HLint.hs │ │ ├── HLintMain.hs │ │ └── HaddockCoverage.hs ├── keera-hails-demos-small │ ├── LICENSE │ ├── Setup.hs │ ├── data │ │ ├── body.html │ │ └── head.html │ ├── keera-hails-demos-small.cabal │ └── src │ │ ├── Controller.hs │ │ ├── Data │ │ ├── Action.hs │ │ └── Calculator.hs │ │ ├── Main.hs │ │ ├── Model.hs │ │ ├── View.hs │ │ └── View │ │ ├── HTML.hs │ │ └── Types.hs ├── keera-hails-demos-soundplay │ ├── LICENSE │ ├── Setup.hs │ ├── baby.wav │ ├── keera-hails-demos-soundplay.cabal │ ├── src │ │ └── Main.hs │ └── tests │ │ ├── HLint.hs │ │ ├── HLintMain.hs │ │ └── HaddockCoverage.hs ├── keera-hails-demos-wiimote │ ├── Minimal.hs │ ├── MinimalFRP.hs │ ├── README.md │ ├── UI.glade │ ├── WMGui.hs │ ├── Wiimote.hs │ └── screenshots │ │ ├── gui.png │ │ ├── hwgui.png │ │ └── hwguiIR.png └── keera-hails-gtk-app │ ├── ChangeLog.md │ ├── LICENSE │ ├── README.md │ ├── Setup.hs │ ├── data │ └── Interface.glade │ └── keera-hails-gtk-app.cabal ├── keera-hails-i18n ├── LICENSE ├── README.md ├── Setup.hs ├── keera-hails-i18n.cabal ├── src │ └── Hails │ │ └── I18N │ │ ├── Gettext.hs │ │ └── Language.hs └── tests │ ├── HLint.hs │ ├── HLintMain.hs │ └── HaddockCoverage.hs ├── keera-hails-mvc-controller ├── CHANGELOG ├── LICENSE ├── README.md ├── Setup.hs ├── keera-hails-mvc-controller.cabal ├── src │ └── Hails │ │ └── MVC │ │ └── Controller │ │ └── ConditionDirection.hs └── tests │ ├── HLint.hs │ ├── HLintMain.hs │ └── HaddockCoverage.hs ├── keera-hails-mvc-environment-gtk ├── LICENSE ├── Setup.hs ├── keera-hails-mvc-environment-gtk.cabal ├── src │ └── Hails │ │ └── MVC │ │ ├── DefaultGtkEnvironment.hs │ │ └── GenericCombinedEnvironment.hs └── tests │ ├── HLint.hs │ ├── HLintMain.hs │ └── HaddockCoverage.hs ├── keera-hails-mvc-environment-gtk3 ├── LICENSE ├── Setup.hs ├── keera-hails-mvc-environment-gtk3.cabal ├── src │ └── Hails │ │ └── MVC │ │ ├── DefaultGtkEnvironment.hs │ │ └── GenericCombinedEnvironment.hs └── tests │ ├── HLint.hs │ └── HaddockCoverage.hs ├── keera-hails-mvc-model-lightmodel ├── CHANGELOG ├── LICENSE ├── README.md ├── Setup.hs ├── keera-hails-mvc-model-lightmodel.cabal ├── src │ └── Hails │ │ └── MVC │ │ └── Model │ │ ├── ProtectedModel.hs │ │ ├── ProtectedModel │ │ ├── Initialisation.hs │ │ └── Reactive.hs │ │ ├── ReactiveFields.hs │ │ ├── ReactiveModel.hs │ │ ├── ReactiveModel │ │ ├── Events.hs │ │ └── Initialisation.hs │ │ ├── THAccessors.hs │ │ └── THFields.hs └── tests │ ├── HLint.hs │ ├── HLintMain.hs │ └── HaddockCoverage.hs ├── keera-hails-mvc-model-protectedmodel ├── CHANGELOG ├── LICENSE ├── README.md ├── Setup.hs ├── keera-hails-mvc-model-protectedmodel.cabal ├── src │ └── Hails │ │ └── MVC │ │ └── Model │ │ ├── ProtectedModel.hs │ │ ├── ProtectedModel │ │ ├── Initialisation.hs │ │ └── Reactive.hs │ │ ├── ReactiveFields.hs │ │ ├── ReactiveModel.hs │ │ ├── ReactiveModel │ │ ├── Events.hs │ │ └── Initialisation.hs │ │ ├── THAccessors.hs │ │ └── THFields.hs └── tests │ ├── HLint.hs │ ├── HLintMain.hs │ └── HaddockCoverage.hs ├── keera-hails-mvc-solutions-config ├── LICENSE ├── README.md ├── Setup.hs ├── keera-hails-mvc-solutions-config.cabal ├── src │ └── Hails │ │ └── MVC │ │ └── Controller │ │ └── Conditions │ │ └── Config.hs └── tests │ ├── HLint.hs │ ├── HLintMain.hs │ └── HaddockCoverage.hs ├── keera-hails-mvc-solutions-gtk ├── LICENSE ├── Setup.hs ├── keera-hails-mvc-solutions-gtk.cabal ├── src │ ├── Hails │ │ ├── Graphics │ │ │ └── UI │ │ │ │ └── Gtk │ │ │ │ └── Simplify │ │ │ │ ├── AboutDialog.hs │ │ │ │ ├── Logger.hs │ │ │ │ ├── NameAndVersionTitleBar.hs │ │ │ │ ├── ProgramMainWindow.hs │ │ │ │ ├── RootLogger.hs │ │ │ │ ├── UpdateCheck.hs │ │ │ │ └── VersionNumberTitleBar.hs │ │ └── MVC │ │ │ └── Model │ │ │ └── ProtectedModel │ │ │ ├── LoggedModel.hs │ │ │ ├── NamedModel.hs │ │ │ ├── UpdatableModel.hs │ │ │ └── VersionedModel.hs │ └── Main.hs └── tests │ ├── HLint.hs │ ├── HLintMain.hs │ └── HaddockCoverage.hs ├── keera-hails-mvc-solutions-gtk3 ├── LICENSE ├── Setup.hs ├── keera-hails-mvc-solutions-gtk3.cabal ├── src │ ├── Hails │ │ ├── Graphics │ │ │ └── UI │ │ │ │ └── Gtk │ │ │ │ └── Simplify │ │ │ │ ├── AboutDialog.hs │ │ │ │ ├── Logger.hs │ │ │ │ ├── NameAndVersionTitleBar.hs │ │ │ │ ├── ProgramMainWindow.hs │ │ │ │ ├── RootLogger.hs │ │ │ │ ├── UpdateCheck.hs │ │ │ │ └── VersionNumberTitleBar.hs │ │ └── MVC │ │ │ └── Model │ │ │ └── ProtectedModel │ │ │ ├── LoggedModel.hs │ │ │ ├── NamedModel.hs │ │ │ ├── UpdatableModel.hs │ │ │ └── VersionedModel.hs │ └── Main.hs └── tests │ ├── HLint.hs │ └── HaddockCoverage.hs ├── keera-hails-mvc-view-gtk ├── LICENSE ├── README.md ├── Setup.hs ├── keera-hails-mvc-view-gtk.cabal ├── src │ └── Hails │ │ └── MVC │ │ └── View │ │ ├── DefaultViewGtk.hs │ │ ├── GladeView.hs │ │ ├── Gtk │ │ └── Builder.hs │ │ ├── GtkView.hs │ │ └── GtkView.hs.fixed └── tests │ ├── HLint.hs │ ├── HLintMain.hs │ └── HaddockCoverage.hs ├── keera-hails-mvc-view-gtk3 ├── LICENSE ├── Setup.hs ├── keera-hails-mvc-view-gtk3.cabal ├── src │ └── Hails │ │ └── MVC │ │ └── View │ │ ├── DefaultViewGtk.hs │ │ ├── GladeView.hs │ │ ├── Gtk │ │ └── Builder.hs │ │ ├── GtkView.hs │ │ └── GtkView.hs.fixed └── tests │ ├── HLint.hs │ └── HaddockCoverage.hs ├── keera-hails-mvc-view ├── CHANGELOG ├── LICENSE ├── README.md ├── Setup.hs ├── keera-hails-mvc-view.cabal ├── src │ └── Hails │ │ └── MVC │ │ └── View.hs └── tests │ ├── HLint.hs │ ├── HLintMain.hs │ └── HaddockCoverage.hs ├── keera-hails-reactive-cbmvar ├── LICENSE ├── README.md ├── Setup.hs ├── keera-hails-reactive-cbmvar.cabal ├── src │ └── Data │ │ └── CBMVar │ │ └── Reactive.hs └── tests │ ├── HLintMain.hs │ ├── HaddockCoverage.hs │ └── hlint.yaml ├── keera-hails-reactive-fs ├── LICENSE ├── README.md ├── keera-hails-reactive-fs.cabal ├── src │ └── Hails │ │ └── FS.hs └── tests │ ├── HLint.hs │ ├── HLintMain.hs │ └── HaddockCoverage.hs ├── keera-hails-reactive-gtk ├── CHANGELOG ├── LICENSE ├── README.md ├── Setup.hs ├── keera-hails-reactive-gtk.cabal ├── src │ └── Graphics │ │ └── UI │ │ └── Gtk │ │ ├── Reactive.hs │ │ └── Reactive │ │ ├── Button.hs │ │ ├── CheckMenuItem.hs │ │ ├── ColorButton.hs │ │ ├── Entry.hs │ │ ├── Gtk2.hs │ │ ├── Image.hs │ │ ├── Label.hs │ │ ├── MenuItem.hs │ │ ├── Property.hs │ │ ├── Scale.hs │ │ ├── SpinButton.hs │ │ ├── StatusIcon.hs │ │ ├── TextView.hs │ │ ├── ToggleButton.hs │ │ ├── ToolButton.hs │ │ ├── TreeView.hs │ │ ├── TypedComboBoxUnsafe.hs │ │ ├── Widget.hs │ │ └── Window.hs └── tests │ ├── HLint.hs │ ├── HLintMain.hs │ └── HaddockCoverage.hs ├── keera-hails-reactive-gtk3 ├── LICENSE ├── Setup.hs ├── keera-hails-reactive-gtk3.cabal ├── src │ └── Graphics │ │ └── UI │ │ └── Gtk │ │ ├── Reactive.hs │ │ └── Reactive │ │ ├── Button.hs │ │ ├── CheckMenuItem.hs │ │ ├── Entry.hs │ │ ├── Label.hs │ │ ├── MenuItem.hs │ │ ├── Scale.hs │ │ ├── SpinButton.hs │ │ ├── TextView.hs │ │ ├── ToggleButton.hs │ │ ├── ToolButton.hs │ │ └── TypedComboBoxUnsafe.hs └── tests │ ├── HLint.hs │ ├── HLintMain.hs │ └── HaddockCoverage.hs ├── keera-hails-reactive-htmldom ├── LICENSE ├── Setup.hs ├── keera-hails-reactive-htmldom.cabal ├── src │ └── Hails │ │ └── MVC │ │ └── View │ │ └── HTML.hs └── tests │ ├── HLint.hs │ ├── HLintMain.hs │ └── HaddockCoverage.hs ├── keera-hails-reactive-network ├── LICENSE ├── README.md ├── Setup.hs ├── keera-hails-reactive-network.cabal ├── src │ └── Hails │ │ └── Network.hs └── tests │ ├── HLint.hs │ ├── HLintMain.hs │ └── HaddockCoverage.hs ├── keera-hails-reactive-polling ├── LICENSE ├── README.md ├── Setup.hs ├── keera-hails-reactive-polling.cabal ├── src │ └── Hails │ │ └── Polling.hs └── tests │ ├── HLint.hs │ ├── HLintMain.hs │ └── HaddockCoverage.hs ├── keera-hails-reactive-qt ├── .gitignore ├── LICENSE ├── README.md ├── examples │ ├── Example.hs │ ├── minimal.hs │ └── reactive.hs ├── hails-reactive-qt.cabal ├── src │ └── Graphics │ │ └── UI │ │ └── Qt │ │ └── Reactive.hs └── tests │ ├── HLint.hs │ ├── HLintMain.hs │ └── HaddockCoverage.hs ├── keera-hails-reactive-wx ├── .gitignore ├── LICENSE ├── README.md ├── examples │ ├── Calc.hs │ ├── Minimal.hs │ ├── calc.wxg │ └── test.xrc ├── keera-hails-reactive-wx.cabal ├── src │ └── Graphics │ │ └── UI │ │ └── WX │ │ └── Reactive.hs └── tests │ ├── HLint.hs │ ├── HLintMain.hs │ └── HaddockCoverage.hs ├── keera-hails-reactive-yampa ├── LICENSE ├── README.md ├── Setup.hs ├── keera-hails-reactive-yampa.cabal ├── src │ └── Hails │ │ └── Yampa.hs └── tests │ ├── HLint.hs │ ├── HLintMain.hs │ └── HaddockCoverage.hs ├── keera-hails-reactivelenses ├── LICENSE ├── README.md ├── Setup.hs ├── keera-hails-reactivelenses.cabal ├── src │ └── Data │ │ └── ReactiveLens.hs └── tests │ ├── HLint.hs │ ├── HLintMain.hs │ ├── HaddockCoverage.hs │ └── Tasty.hs ├── keera-hails-reactivevalues ├── LICENSE ├── README.md ├── Setup.hs ├── keera-hails-reactivevalues.cabal ├── src │ ├── Control │ │ └── GFunctor.hs │ └── Data │ │ └── ReactiveValue.hs └── tests │ ├── HLint.hs │ ├── HLintMain.hs │ ├── HaddockCoverage.hs │ └── Tasty.hs └── keera-hails ├── LICENSE ├── Setup.hs ├── keera-hails.cabal ├── src ├── AppDataBasic.hs ├── AppDataFull.hs ├── HailsArgs.hs ├── Main.hs └── System │ └── Application.hs ├── templates ├── CombinedEnvironment.hs ├── Controller.hs ├── Controller │ └── Conditions.hs ├── Main.hs ├── Model │ ├── Model.hs │ ├── ProtectedModel.hs │ ├── ProtectedModel │ │ ├── ProtectedFields.hs │ │ └── ProtectedModelInternals.hs │ ├── ReactiveModel.hs │ └── ReactiveModel │ │ ├── ModelEvents.hs │ │ ├── ReactiveFields.hs │ │ └── ReactiveModelInternals.hs ├── Paths.hs ├── Paths │ └── CustomPaths.hs ├── View.hs └── View │ └── Objects.hs └── tests ├── HLint.hs ├── HLintMain.hs └── HaddockCoverage.hs /.cabal-conf/hackage.enc: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/keera-studios/keera-hails/dd88d71705524738f3f7a1800a30c723801e2dea/.cabal-conf/hackage.enc -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | dist 2 | cabal-dev 3 | *.o 4 | *.hi 5 | *.chi 6 | *.chs.h 7 | .virthualenv 8 | .hsenv 9 | *~ 10 | *.swp 11 | .cabal-sandbox/ 12 | cabal.sandbox.config 13 | cabal.config 14 | scripts 15 | .cabal-conf/hackage 16 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2013-2020, Keera Studios Ltd 2 | Copyright (c) 2010-2012, Ivan Perez 3 | 4 | All rights reserved. 5 | 6 | Redistribution and use in source and binary forms, with or without 7 | modification, are permitted provided that the following conditions are met: 8 | 9 | * Redistributions of source code must retain the above copyright 10 | notice, this list of conditions and the following disclaimer. 11 | 12 | * Redistributions in binary form must reproduce the above 13 | copyright notice, this list of conditions and the following 14 | disclaimer in the documentation and/or other materials provided 15 | with the distribution. 16 | 17 | * Neither the name of Ivan Perez, nor the name of Keera Studios, nor the 18 | names of other contributors may be used to endorse or promote products 19 | derived from this software without specific prior written permission. 20 | 21 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 22 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 23 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 24 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 25 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 26 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 27 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 28 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 29 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 30 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 31 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 32 | -------------------------------------------------------------------------------- /demos/image-format-guesser/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2013-2020, Keera Studios Ltd 2 | Copyright (c) 2010-2012, Ivan Perez 3 | 4 | All rights reserved. 5 | 6 | Redistribution and use in source and binary forms, with or without 7 | modification, are permitted provided that the following conditions are met: 8 | 9 | * Redistributions of source code must retain the above copyright 10 | notice, this list of conditions and the following disclaimer. 11 | 12 | * Redistributions in binary form must reproduce the above 13 | copyright notice, this list of conditions and the following 14 | disclaimer in the documentation and/or other materials provided 15 | with the distribution. 16 | 17 | * Neither the name of Ivan Perez, nor the name of Keera Studios, nor the 18 | names of other contributors may be used to endorse or promote products 19 | derived from this software without specific prior written permission. 20 | 21 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 22 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 23 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 24 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 25 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 26 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 27 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 28 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 29 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 30 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 31 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 32 | -------------------------------------------------------------------------------- /demos/image-format-guesser/metrics.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | FILES=$(find src/ | grep '.hs$') 3 | NLINES=0 4 | NHLINTMSGS=0 5 | for i in $FILES; do 6 | # hlint $i 7 | NHLINTMSGS_FILE=$(hlint $i | grep $i | wc -l) 8 | NHLINTMSGS=$((NHLINTMSGS + NHLINTMSGS_FILE)) 9 | # echo Number of hlint messages for \"$i\": $NHLINTMSGS_FILE 10 | NLINES_FILE=$(grep -ve '^\s*\(--.*\)\?$' $i | wc -l) ; 11 | NLINES=$((NLINES + NLINES_FILE)) ; 12 | # echo Number of lines for \"$i\": $NLINES_FILE 13 | done 14 | echo Total number of hlint messages: $NHLINTMSGS 15 | echo Total number of lines: $NLINES 16 | -------------------------------------------------------------------------------- /demos/image-format-guesser/src/CombinedEnvironment.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- 3 | -- Copyright : (C) Keera Studios Ltd, 2013 4 | -- License : BSD3 5 | -- Maintainer : support@keera.co.uk 6 | module CombinedEnvironment 7 | ( CRef 8 | , CEnv 9 | , GEnv.createCEnv 10 | , view 11 | , GEnv.model 12 | , createCRef 13 | , readIORef 14 | , writeIORef 15 | , updateView 16 | , onViewAsync 17 | ) 18 | where 19 | 20 | import Data.IORef 21 | 22 | -- Internal libraries 23 | import qualified Hails.MVC.GenericCombinedEnvironment as GEnv 24 | import qualified Hails.MVC.View.GtkView as GView 25 | 26 | import View 27 | import Model.ReactiveModel.ModelEvents 28 | import Model.Model 29 | 30 | type CEnv = GEnv.CEnv View Model ModelEvent 31 | type CRef = IORef CEnv 32 | 33 | view :: CEnv -> View 34 | view = GView.getGUI . GEnv.view 35 | 36 | updateView :: CEnv -> View -> CEnv 37 | updateView cenv v = cenv { GEnv.view = GView.GtkView v } 38 | 39 | createCRef :: Model -> IO CRef 40 | createCRef mb = newIORef =<< GEnv.createCEnv mb 41 | -------------------------------------------------------------------------------- /demos/image-format-guesser/src/Controller.hs: -------------------------------------------------------------------------------- 1 | -- | This contains the main controller. Many operations will be 2 | -- implemented in the Controller.* subsystem. This module simply 3 | -- initialises program. 4 | -- 5 | -- Copyright : (C) Keera Studios Ltd, 2013 6 | -- License : BSD3 7 | -- Maintainer : support@keera.co.uk 8 | module Controller where 9 | 10 | -- External imports 11 | import Data.IORef 12 | import Graphics.UI.Gtk 13 | 14 | -- Internal imports 15 | import View (initView, startView, mainWindowBuilder) 16 | import View.MainWindow.Objects 17 | import CombinedEnvironment 18 | import Controller.Conditions 19 | import Model.Model 20 | 21 | -- | Starts the program by creating the model, 22 | -- the view, starting all the concurrent threads, 23 | -- installing the hanlders for all the conditions 24 | -- and starting the view. 25 | startController :: IO () 26 | startController = do 27 | 28 | initView 29 | cenv <- createCEnv emptyBM 30 | mainWindow (mainWindowBuilder (view cenv)) 31 | >>= widgetShowAll 32 | 33 | installHandlers cenv 34 | 35 | startView 36 | -------------------------------------------------------------------------------- /demos/image-format-guesser/src/Controller/Conditions.hs: -------------------------------------------------------------------------------- 1 | -- | This module contains a series of conditions that must hold between 2 | -- the view and the model. Most of these conditions can be separated in 3 | -- two conditions: one that must be checked only when the model changes 4 | -- (and updates the view accordingly), and another that must be checked 5 | -- when the view receives an event (and updates the model accordingly). 6 | -- 7 | -- Copyright : (C) Keera Studios Ltd, 2013 8 | -- License : BSD3 9 | -- Maintainer : support@keera.co.uk 10 | module Controller.Conditions 11 | ( installHandlers 12 | ) 13 | where 14 | 15 | -- External libraries 16 | import Hails.MVC.View.GtkView (getGUI) 17 | 18 | -- External libraries: general conditions 19 | import qualified Hails.Graphics.UI.Gtk.Simplify.NameAndVersionTitleBar as Title 20 | import qualified Hails.Graphics.UI.Gtk.Simplify.ProgramMainWindow as PMW 21 | 22 | -- Internal libraries 23 | import CombinedEnvironment 24 | import View 25 | import View.MainWindow.Objects 26 | 27 | -- Internal libraries: specific conditions 28 | import qualified Controller.Conditions.FilenameEntry as Filename 29 | import qualified Controller.Conditions.ResultLabel as Result 30 | 31 | installHandlers :: CEnv -> IO() 32 | installHandlers cenv = do 33 | PMW.installHandlers cenv (mainWindow . mainWindowBuilder . getGUI) 34 | Title.installHandlers cenv (mainWindow . mainWindowBuilder . getGUI) 35 | Filename.installHandlers cenv 36 | Result.installHandlers cenv 37 | -------------------------------------------------------------------------------- /demos/image-format-guesser/src/Controller/Conditions/ConditionDirection.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- 3 | -- Copyright : (C) Keera Studios Ltd, 2013 4 | -- License : BSD3 5 | -- Maintainer : support@keera.co.uk 6 | module Controller.Conditions.ConditionDirection where 7 | 8 | data ConditionDirection = VM 9 | | MV 10 | 11 | -------------------------------------------------------------------------------- /demos/image-format-guesser/src/Controller/Conditions/FilenameEntry.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- 3 | -- Copyright : (C) Keera Studios Ltd, 2013 4 | -- License : BSD3 5 | -- Maintainer : support@keera.co.uk 6 | module Controller.Conditions.FilenameEntry where 7 | 8 | -- Internal libraries 9 | import CombinedEnvironment 10 | import View 11 | import View.MainWindow.Objects 12 | import Model.ProtectedModel 13 | import qualified Extra.UI.Simplify.EntryBasic as Extra 14 | 15 | installHandlers :: CEnv -> IO() 16 | installHandlers = 17 | Extra.installHandlers 18 | [ FilenameChanged ] 19 | (mainWindowFilenameEntry . mainWindowBuilder) 20 | -- Setter 21 | setFilename 22 | -- Getter 23 | ((fmap Just) . getFilename) 24 | -------------------------------------------------------------------------------- /demos/image-format-guesser/src/Extra/UI/Simplify/LabelBasic.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- 3 | -- Copyright : (C) Keera Studios Ltd, 2013 4 | -- License : BSD3 5 | -- Maintainer : support@keera.co.uk 6 | module Extra.UI.Simplify.LabelBasic 7 | (installHandlers) 8 | where 9 | 10 | -- External libraries 11 | import Control.Arrow 12 | import Control.Monad 13 | import Graphics.UI.Gtk 14 | import Graphics.UI.View hiding (View, onViewAsync) 15 | 16 | -- Internal libraries 17 | import CombinedEnvironment 18 | import View 19 | import Model.ProtectedModel 20 | 21 | type Accessor a = ViewElementAccessor' View a 22 | type Getter a = ProtectedModel -> IO a 23 | 24 | installHandlers :: [ ModelEvent ] -> Accessor Label -> Getter String -> CRef -> IO() 25 | installHandlers evs lblF getter cref = do 26 | pm <- fmap model $ readIORef cref 27 | mapM_ (\ev -> onEvent pm ev (condition cref lblF getter)) evs 28 | 29 | -- | Enforces the condition 30 | condition :: CRef -> Accessor Label -> Getter String -> IO() 31 | condition cref lblF getter = onViewAsync $ do 32 | (vw, pm) <- fmap (view &&& model) $ readIORef cref 33 | lbl <- lblF vw 34 | curViewValue <- get lbl labelLabel 35 | curModelValue <- getter pm 36 | when (curViewValue /= curModelValue) $ 37 | set lbl [ labelLabel := curModelValue ] 38 | -------------------------------------------------------------------------------- /demos/image-format-guesser/src/Main.hs: -------------------------------------------------------------------------------- 1 | -- | This is the main program with which the IDE is launched. 2 | -- 3 | -- Copyright : (C) Keera Studios Ltd, 2013 4 | -- License : BSD3 5 | -- Maintainer : support@keera.co.uk 6 | module Main where 7 | 8 | -- Internal imports 9 | import Controller 10 | 11 | -- |The IDE starts here. Here we simply call the controller, which takes control 12 | -- from now on. 13 | main :: IO () 14 | main = startController 15 | -------------------------------------------------------------------------------- /demos/image-format-guesser/src/Model/Model.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- 3 | -- Copyright : (C) Keera Studios Ltd, 2013 4 | -- License : BSD3 5 | -- Maintainer : support@keera.co.uk 6 | module Model.Model where 7 | 8 | import Data.ExtraVersion (Version (Version), VersionStatus (Alpha)) 9 | 10 | import Hails.MVC.Model.ProtectedModel.NamedModel 11 | import Hails.MVC.Model.ProtectedModel.VersionedModel 12 | 13 | type BasicModel = Model 14 | 15 | data Model = Model 16 | { name :: String 17 | , version :: Version 18 | , fileName :: String 19 | } 20 | deriving (Eq) 21 | 22 | emptyBM :: Model 23 | emptyBM = Model 24 | { name = "Elementary Gtk Demo with PRMVC" 25 | , version = Version 0 1 Alpha 0 26 | , fileName = "" 27 | } 28 | 29 | instance VersionedBasicModel Model where 30 | getBMVersion = version 31 | 32 | instance NamedBasicModel Model where 33 | getBMName = name 34 | -------------------------------------------------------------------------------- /demos/image-format-guesser/src/Model/ProtectedModel.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- 3 | -- Copyright : (C) Keera Studios Ltd, 2013 4 | -- License : BSD3 5 | -- Maintainer : support@keera.co.uk 6 | module Model.ProtectedModel 7 | ( ProtectedModel 8 | , onEvent 9 | , waitFor 10 | , module Exported 11 | ) 12 | where 13 | 14 | import Model.ProtectedModel.ProtectedModelInternals 15 | import Model.ReactiveModel.ModelEvents as Exported 16 | import Model.ProtectedModel.Filename as Exported 17 | -------------------------------------------------------------------------------- /demos/image-format-guesser/src/Model/ProtectedModel/Filename.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- 3 | -- Copyright : (C) Keera Studios Ltd, 2013 4 | -- License : BSD3 5 | -- Maintainer : support@keera.co.uk 6 | module Model.ProtectedModel.Filename where 7 | 8 | import Model.ProtectedModel.ProtectedModelInternals 9 | import qualified Model.ReactiveModel as RM 10 | 11 | setFilename :: ProtectedModel -> String -> IO () 12 | setFilename pm fn = applyToReactiveModel pm (`RM.setFilename` fn) 13 | 14 | getFilename :: ProtectedModel -> IO String 15 | getFilename = (`onReactiveModel` RM.getFilename) 16 | -------------------------------------------------------------------------------- /demos/image-format-guesser/src/Model/ProtectedModel/ProtectedModelInternals.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- 3 | -- Copyright : (C) Keera Studios Ltd, 2013 4 | -- License : BSD3 5 | -- Maintainer : support@keera.co.uk 6 | module Model.ProtectedModel.ProtectedModelInternals 7 | ( ProtectedModel 8 | , GPM.onReactiveModel 9 | , GPM.applyToReactiveModel 10 | , GPM.onEvent 11 | , GPM.waitFor 12 | ) 13 | where 14 | 15 | import qualified Hails.MVC.Model.ProtectedModel as GPM 16 | 17 | import Model.Model 18 | import Model.ReactiveModel.ModelEvents 19 | 20 | type ProtectedModel = GPM.ProtectedModel Model ModelEvent 21 | -------------------------------------------------------------------------------- /demos/image-format-guesser/src/Model/ReactiveModel.hs: -------------------------------------------------------------------------------- 1 | -- | This module holds the reactive program model. It holds a program model, 2 | -- but includes events that other threads can listen to, so that a change 3 | -- in a part of the model is notified to another part of the program. The 4 | -- reactive model is not necessarily concurrent (it doesn't have its own thread), 5 | -- although a facility is included to make it also concurrent (so that 6 | -- event handlers can be called as soon as they are present). 7 | -- 8 | -- Copyright : (C) Keera Studios Ltd, 2013 9 | -- License : BSD3 10 | -- Maintainer : support@keera.co.uk 11 | module Model.ReactiveModel 12 | ( ReactiveModel -- (basicModel, eventHandlers) 13 | -- * Construction 14 | , emptyRM 15 | -- * Access 16 | , pendingEvents 17 | , pendingHandlers 18 | -- * Modification 19 | , getPendingHandler 20 | , onEvent 21 | , module Exported 22 | ) 23 | where 24 | 25 | import Model.ReactiveModel.ReactiveModelInternals 26 | import Model.ReactiveModel.Filename as Exported 27 | -------------------------------------------------------------------------------- /demos/image-format-guesser/src/Model/ReactiveModel/Filename.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- 3 | -- Copyright : (C) Keera Studios Ltd, 2013 4 | -- License : BSD3 5 | -- Maintainer : support@keera.co.uk 6 | module Model.ReactiveModel.Filename where 7 | 8 | import qualified Model.Model as M 9 | import Model.ReactiveModel.ReactiveModelInternals 10 | import Model.ReactiveModel.ModelEvents 11 | 12 | setFilename :: ReactiveModel c -> String -> ReactiveModel c 13 | setFilename rm s' 14 | | s == s' = rm 15 | | otherwise = rm' `triggerEvent` FilenameChanged 16 | where s = M.fileName $ basicModel rm 17 | rm' = onBasicModel rm (\b -> b { M.fileName = s' }) 18 | 19 | getFilename :: ReactiveModel c -> String 20 | getFilename = M.fileName . basicModel 21 | -------------------------------------------------------------------------------- /demos/image-format-guesser/src/Model/ReactiveModel/ModelEvents.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- 3 | -- Copyright : (C) Keera Studios Ltd, 2013 4 | -- License : BSD3 5 | -- Maintainer : support@keera.co.uk 6 | module Model.ReactiveModel.ModelEvents 7 | ( ModelEvent (FilenameChanged) 8 | ) where 9 | 10 | import qualified Hails.MVC.Model.ReactiveModel as GRM 11 | 12 | data ModelEvent = UncapturedEvent 13 | | FilenameChanged 14 | deriving (Eq,Ord) 15 | 16 | instance GRM.Event ModelEvent where 17 | undoStackChangedEvent = UncapturedEvent 18 | -------------------------------------------------------------------------------- /demos/image-format-guesser/src/Model/ReactiveModel/ReactiveModelInternals.hs: -------------------------------------------------------------------------------- 1 | -- | This module holds the reactive program model. It holds a program model, 2 | -- but includes events that other threads can listen to, so that a change 3 | -- in a part of the model is notified to another part of the program. The 4 | -- reactive model is not necessarily concurrent (it doesn't have its own thread), 5 | -- although a facility is included to make it also concurrent (so that 6 | -- event handlers can be called as soon as they are present). 7 | -- 8 | -- Copyright : (C) Keera Studios Ltd, 2013 9 | -- License : BSD3 10 | -- Maintainer : support@keera.co.uk 11 | module Model.ReactiveModel.ReactiveModelInternals 12 | ( ReactiveModel 13 | , GRM.basicModel 14 | -- * Construction 15 | , GRM.emptyRM 16 | -- * Access 17 | , GRM.pendingEvents 18 | , GRM.pendingHandlers 19 | -- * Modification 20 | , GRM.getPendingHandler 21 | , GRM.onEvent 22 | , GRM.onBasicModel 23 | , GRM.triggerEvent 24 | ) 25 | where 26 | 27 | import qualified Hails.MVC.Model.ReactiveModel as GRM 28 | 29 | -- Internal imports 30 | import Model.Model 31 | import Model.ReactiveModel.ModelEvents 32 | 33 | type ReactiveModel = GRM.ReactiveModel Model ModelEvent 34 | -------------------------------------------------------------------------------- /demos/image-format-guesser/src/View.hs: -------------------------------------------------------------------------------- 1 | -- | Contains basic operations related to the GUI 2 | -- 3 | -- Copyright : (C) Keera Studios Ltd, 2013 4 | -- License : BSD3 5 | -- Maintainer : support@keera.co.uk 6 | module View where 7 | 8 | -- External libraries 9 | import Graphics.UI.Gtk 10 | import Hails.MVC.View.GtkView (GtkGUI(..)) 11 | 12 | -- Internal libraries 13 | import View.MainWindow.Objects 14 | 15 | -- | Initialises the GUI. This must be called before 16 | -- any other GUI operation. 17 | initView :: IO () 18 | initView = initGUI >>= \_ -> return () 19 | 20 | -- | Starts a thread for the view. 21 | startView :: IO () 22 | startView = mainGUI 23 | 24 | -- | Executes an operation on the view thread synchronously 25 | onViewSync :: IO a -> IO a 26 | onViewSync = postGUISync 27 | 28 | -- | Executes an operation on the view thread asynchronously 29 | onViewAsync :: IO () -> IO () 30 | onViewAsync = postGUIAsync 31 | 32 | -- | Destroys the view thread 33 | destroyView :: IO () 34 | destroyView = mainQuit 35 | 36 | instance GtkGUI View where 37 | initialise = createView 38 | 39 | -- | This datatype should hold the elements that we must track in the future 40 | -- (for instance, treeview models) 41 | data View = View 42 | { mainWindowBuilder :: Builder 43 | } 44 | 45 | createView :: IO View 46 | createView = do 47 | bldr <- loadInterface 48 | 49 | return 50 | View 51 | { mainWindowBuilder = bldr 52 | } 53 | 54 | -------------------------------------------------------------------------------- /demos/image-format-guesser/src/View/MainWindow/Objects.hs: -------------------------------------------------------------------------------- 1 | -- | This module contains oprations to access the objects in this interface, 2 | -- and one to obtain a builder from which they can be accessed. 3 | -- 4 | -- Copyright : (C) Keera Studios Ltd, 2013 5 | -- License : BSD3 6 | -- Maintainer : support@keera.co.uk 7 | module View.MainWindow.Objects where 8 | 9 | import Graphics.UI.Gtk 10 | 11 | -- | Returns a builder from which the objects in this part of the interface 12 | -- can be accessed. 13 | loadInterface :: IO Builder 14 | loadInterface = do 15 | builder <- builderNew 16 | builderAddFromFile builder "Interface.glade" 17 | return builder 18 | 19 | onBuilder :: (GObjectClass cls) 20 | => (GObject -> cls) -> String -> Builder -> IO cls 21 | onBuilder f s b = builderGetObject b f s 22 | 23 | -- | Returns the IDE's main window. 24 | mainWindow :: Builder -> IO Window 25 | mainWindow = onBuilder castToWindow "mainWindow" 26 | 27 | -- | Returns a label to show a message to the user 28 | mainWindowMessageLbl :: Builder -> IO Label 29 | mainWindowMessageLbl = onBuilder castToLabel "mainWindowMessageLbl" 30 | 31 | -- | Returns an entry to get a message to the user 32 | mainWindowFilenameEntry :: Builder -> IO Entry 33 | mainWindowFilenameEntry = onBuilder castToEntry "mainWindowFilenameEntry" 34 | -------------------------------------------------------------------------------- /demos/image-format-guesser/tests/HLint.hs: -------------------------------------------------------------------------------- 1 | import "hint" HLint.HLint 2 | 3 | -------------------------------------------------------------------------------- /demos/image-format-guesser/tests/HLintMain.hs: -------------------------------------------------------------------------------- 1 | ----------------------------------------------------------------------------- 2 | -- | 3 | -- Module : Main (hlint) 4 | -- Copyright : (C) 2013 Edward Kmett 5 | -- License : BSD-style (see the file LICENSE) 6 | -- Maintainer : Edward Kmett 7 | -- Stability : provisional 8 | -- Portability : portable 9 | -- 10 | -- This module runs HLint on the lens source tree. 11 | ----------------------------------------------------------------------------- 12 | module Main where 13 | 14 | import Control.Monad 15 | import Language.Haskell.HLint 16 | import System.Environment 17 | import System.Exit 18 | 19 | main :: IO () 20 | main = do 21 | args <- getArgs 22 | hints <- hlint $ ["src", "--cross", "--hint=tests/HLint.hs" ] ++ args 23 | unless (null hints) exitFailure 24 | -------------------------------------------------------------------------------- /demos/keera-hails-demos-gtk-dunai/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2015, Ivan Perez 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of Ivan Perez nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /demos/keera-hails-demos-gtk-dunai/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /demos/keera-hails-demos-gtk-dunai/tests/HLint.hs: -------------------------------------------------------------------------------- 1 | import "hint" HLint.HLint 2 | 3 | -------------------------------------------------------------------------------- /demos/keera-hails-demos-gtk-dunai/tests/HLintMain.hs: -------------------------------------------------------------------------------- 1 | ----------------------------------------------------------------------------- 2 | -- | 3 | -- Module : Main (hlint) 4 | -- Copyright : (C) 2013 Edward Kmett 5 | -- License : BSD-style (see the file LICENSE) 6 | -- Maintainer : Edward Kmett 7 | -- Stability : provisional 8 | -- Portability : portable 9 | -- 10 | -- This module runs HLint on the lens source tree. 11 | ----------------------------------------------------------------------------- 12 | module Main where 13 | 14 | import Control.Monad 15 | import Language.Haskell.HLint 16 | import System.Environment 17 | import System.Exit 18 | 19 | main :: IO () 20 | main = do 21 | args <- getArgs 22 | hints <- hlint $ ["src", "--cross", "--hint=tests/HLint.hs" ] ++ args 23 | unless (null hints) exitFailure 24 | -------------------------------------------------------------------------------- /demos/keera-hails-demos-gtk/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2015, Ivan Perez 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of Ivan Perez nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /demos/keera-hails-demos-gtk/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /demos/keera-hails-demos-gtk/elementarygtkprogram/Interface.glade: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 800 7 | 600 8 | False 9 | 10 | 11 | True 12 | False 13 | 14 | 15 | 16 | 17 | -------------------------------------------------------------------------------- /demos/keera-hails-demos-gtk/elementarygtkprogram/metrics.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | FILES=$(find src/ | grep '.hs$') 3 | NLINES=0 4 | NHLINTMSGS=0 5 | for i in $FILES; do 6 | # hlint $i 7 | NHLINTMSGS_FILE=$(hlint $i | grep $i | wc -l) 8 | NHLINTMSGS=$((NHLINTMSGS + NHLINTMSGS_FILE)) 9 | # echo Number of hlint messages for \"$i\": $NHLINTMSGS_FILE 10 | NLINES_FILE=$(grep -ve '^\s*\(--.*\)\?$' $i | wc -l) ; 11 | NLINES=$((NLINES + NLINES_FILE)) ; 12 | # echo Number of lines for \"$i\": $NLINES_FILE 13 | done 14 | echo Total number of hlint messages: $NHLINTMSGS 15 | echo Total number of lines: $NLINES 16 | -------------------------------------------------------------------------------- /demos/keera-hails-demos-gtk/elementarygtkprogram/src/CombinedEnvironment.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- 3 | -- Copyright : (C) Keera Studios Ltd, 2013 4 | -- License : BSD3 5 | -- Maintainer : support@keera.co.uk 6 | module CombinedEnvironment 7 | ( CRef 8 | , CEnv 9 | , GEnv.createCEnv 10 | , view 11 | , GEnv.model 12 | , createCRef 13 | , readIORef 14 | , writeIORef 15 | , updateView 16 | , onViewAsync 17 | ) 18 | where 19 | 20 | import Data.IORef 21 | 22 | -- Internal libraries 23 | import qualified Hails.MVC.View.GtkView as GView 24 | import qualified Hails.MVC.GenericCombinedEnvironment as GEnv 25 | 26 | import View 27 | import Model.ReactiveModel.ModelEvents 28 | import Model.Model 29 | 30 | type CEnv = GEnv.CEnv View Model ModelEvent 31 | -- type CRef = GEnv.CRef View Model ModelEvent 32 | type CRef = IORef CEnv 33 | 34 | view :: CEnv -> View 35 | view = GView.getGUI . GEnv.view 36 | 37 | updateView :: CEnv -> View -> CEnv 38 | updateView cenv v = cenv { GEnv.view = GView.GtkView v } 39 | 40 | createCRef :: Model -> IO CRef 41 | createCRef mb = newIORef =<< GEnv.createCEnv mb 42 | -------------------------------------------------------------------------------- /demos/keera-hails-demos-gtk/elementarygtkprogram/src/Controller.hs: -------------------------------------------------------------------------------- 1 | -- | This contains the main controller. Many operations will be 2 | -- implemented in the Controller.* subsystem. This module simply 3 | -- initialises program. 4 | -- 5 | -- Copyright : (C) Keera Studios Ltd, 2013 6 | -- License : BSD3 7 | -- Maintainer : support@keera.co.uk 8 | module Controller where 9 | 10 | -- External imports 11 | import Data.IORef 12 | import Graphics.UI.Gtk 13 | 14 | -- Internal imports 15 | import View (initView, startView, mainWindowBuilder) 16 | import View.MainWindow.Objects 17 | import CombinedEnvironment 18 | import Controller.Conditions 19 | import Model.Model 20 | 21 | -- | Starts the program by creating the model, 22 | -- the view, starting all the concurrent threads, 23 | -- installing the hanlders for all the conditions 24 | -- and starting the view. 25 | startController :: IO () 26 | startController = do 27 | 28 | initView 29 | env <- createCEnv emptyBM 30 | w <- mainWindow $ mainWindowBuilder $ view env 31 | widgetShowAll w 32 | 33 | installHandlers env 34 | 35 | startView 36 | -------------------------------------------------------------------------------- /demos/keera-hails-demos-gtk/elementarygtkprogram/src/Controller/Conditions.hs: -------------------------------------------------------------------------------- 1 | -- | This module contains a series of conditions that must hold between 2 | -- the view and the model. Most of these conditions can be separated in 3 | -- two conditions: one that must be checked only when the model changes 4 | -- (and updates the view accordingly), and another that must be checked 5 | -- when the view receives an event (and updates the model accordingly). 6 | -- 7 | -- Copyright : (C) Keera Studios Ltd, 2013 8 | -- License : BSD3 9 | -- Maintainer : support@keera.co.uk 10 | module Controller.Conditions 11 | ( installHandlers 12 | ) 13 | where 14 | 15 | -- External libraries 16 | import Hails.MVC.View.GtkView 17 | 18 | -- External libraries: general conditions 19 | -- Close main window 20 | import qualified Hails.Graphics.UI.Gtk.Simplify.ProgramMainWindow as PMW 21 | -- Name the main window 22 | import qualified Hails.Graphics.UI.Gtk.Simplify.NameAndVersionTitleBar as Title 23 | 24 | -- Internal libraries 25 | import CombinedEnvironment 26 | import View 27 | import View.MainWindow.Objects 28 | 29 | -- Internal libraries: specific conditions 30 | 31 | installHandlers :: CEnv -> IO() 32 | installHandlers cenv = do 33 | PMW.installHandlers cenv (mainWindow . mainWindowBuilder . getGUI) 34 | Title.installHandlers cenv (mainWindow . mainWindowBuilder . getGUI) 35 | -------------------------------------------------------------------------------- /demos/keera-hails-demos-gtk/elementarygtkprogram/src/Main.hs: -------------------------------------------------------------------------------- 1 | -- | This is the main program with which the IDE is launched. 2 | -- 3 | -- Copyright : (C) Keera Studios Ltd, 2013 4 | -- License : BSD3 5 | -- Maintainer : support@keera.co.uk 6 | module Main where 7 | 8 | -- Internal imports 9 | import Controller 10 | 11 | -- |The IDE starts here. Here we simply call the controller, which takes control 12 | -- from now on. 13 | main :: IO () 14 | main = startController 15 | -------------------------------------------------------------------------------- /demos/keera-hails-demos-gtk/elementarygtkprogram/src/Model/Model.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- 3 | -- Copyright : (C) Keera Studios Ltd, 2013 4 | -- License : BSD3 5 | -- Maintainer : support@keera.co.uk 6 | module Model.Model where 7 | 8 | import Data.ExtraVersion 9 | import Hails.MVC.Model.ProtectedModel.NamedModel 10 | import Hails.MVC.Model.ProtectedModel.VersionedModel 11 | 12 | type BasicModel = Model 13 | 14 | data Model = Model 15 | { name :: String 16 | , version :: Version 17 | } 18 | deriving (Eq) 19 | 20 | emptyBM :: Model 21 | emptyBM = Model 22 | { name = "Elementary Gtk Demo with PRMVC" 23 | , version = Version 0 1 Alpha 0 24 | } 25 | 26 | instance VersionedBasicModel Model where 27 | getBMVersion = version 28 | 29 | instance NamedBasicModel Model where 30 | getBMName = name 31 | -------------------------------------------------------------------------------- /demos/keera-hails-demos-gtk/elementarygtkprogram/src/Model/ProtectedModel.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- 3 | -- Copyright : (C) Keera Studios Ltd, 2013 4 | -- License : BSD3 5 | -- Maintainer : support@keera.co.uk 6 | module Model.ProtectedModel 7 | ( ProtectedModel 8 | , onEvent 9 | , waitFor 10 | , module Exported 11 | ) 12 | where 13 | 14 | import Model.ProtectedModel.ProtectedModelInternals 15 | import Model.ReactiveModel.ModelEvents as Exported 16 | -------------------------------------------------------------------------------- /demos/keera-hails-demos-gtk/elementarygtkprogram/src/Model/ProtectedModel/ProtectedModelInternals.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- 3 | -- Copyright : (C) Keera Studios Ltd, 2013 4 | -- License : BSD3 5 | -- Maintainer : support@keera.co.uk 6 | module Model.ProtectedModel.ProtectedModelInternals 7 | ( ProtectedModel 8 | , GPM.onReactiveModel 9 | , GPM.applyToReactiveModel 10 | , GPM.onEvent 11 | , GPM.waitFor 12 | ) 13 | where 14 | 15 | import Model.Model 16 | import Model.ReactiveModel.ModelEvents 17 | import qualified Control.Concurrent.Model.ProtectedModel as GPM 18 | 19 | type ProtectedModel = GPM.ProtectedModel Model ModelEvent 20 | -------------------------------------------------------------------------------- /demos/keera-hails-demos-gtk/elementarygtkprogram/src/Model/ReactiveModel.hs: -------------------------------------------------------------------------------- 1 | -- | This module holds the reactive program model. It holds a program model, 2 | -- but includes events that other threads can listen to, so that a change 3 | -- in a part of the model is notified to another part of the program. The 4 | -- reactive model is not necessarily concurrent (it doesn't have its own thread), 5 | -- although a facility is included to make it also concurrent (so that 6 | -- event handlers can be called as soon as they are present). 7 | -- 8 | -- Copyright : (C) Keera Studios Ltd, 2013 9 | -- License : BSD3 10 | -- Maintainer : support@keera.co.uk 11 | module Model.ReactiveModel 12 | ( ReactiveModel -- (basicModel, eventHandlers) 13 | -- * Construction 14 | , emptyRM 15 | -- * Access 16 | , pendingEvents 17 | , pendingHandlers 18 | -- * Modification 19 | , getPendingHandler 20 | , onEvent 21 | ) 22 | where 23 | 24 | import Model.ReactiveModel.ReactiveModelInternals 25 | -------------------------------------------------------------------------------- /demos/keera-hails-demos-gtk/elementarygtkprogram/src/Model/ReactiveModel/ModelEvents.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- 3 | -- Copyright : (C) Keera Studios Ltd, 2013 4 | -- License : BSD3 5 | -- Maintainer : support@keera.co.uk 6 | module Model.ReactiveModel.ModelEvents 7 | ( ModelEvent () 8 | ) where 9 | 10 | -- import GenericModel.GenericModelEvent 11 | import qualified Hails.MVC.Model.ReactiveModel as GRM 12 | 13 | data ModelEvent = UncapturedEvent 14 | deriving (Eq,Ord) 15 | 16 | instance GRM.Event ModelEvent where 17 | undoStackChangedEvent = UncapturedEvent 18 | -------------------------------------------------------------------------------- /demos/keera-hails-demos-gtk/elementarygtkprogram/src/Model/ReactiveModel/ReactiveModelInternals.hs: -------------------------------------------------------------------------------- 1 | -- | This module holds the reactive program model. It holds a program model, 2 | -- but includes events that other threads can listen to, so that a change 3 | -- in a part of the model is notified to another part of the program. The 4 | -- reactive model is not necessarily concurrent (it doesn't have its own thread), 5 | -- although a facility is included to make it also concurrent (so that 6 | -- event handlers can be called as soon as they are present). 7 | -- 8 | -- Copyright : (C) Keera Studios Ltd, 2013 9 | -- License : BSD3 10 | -- Maintainer : support@keera.co.uk 11 | module Model.ReactiveModel.ReactiveModelInternals 12 | ( ReactiveModel 13 | , GRM.basicModel 14 | -- * Construction 15 | , GRM.emptyRM 16 | -- * Access 17 | , GRM.pendingEvents 18 | , GRM.pendingHandlers 19 | -- * Modification 20 | , GRM.getPendingHandler 21 | , GRM.onEvent 22 | , GRM.onBasicModel 23 | , GRM.triggerEvent 24 | ) 25 | where 26 | 27 | -- Internal imports 28 | -- import GenericModel.GenericReactiveModel 29 | import Model.Model 30 | import Model.ReactiveModel.ModelEvents 31 | import qualified Hails.MVC.Model.ReactiveModel as GRM 32 | 33 | type ReactiveModel = GRM.ReactiveModel Model ModelEvent 34 | -------------------------------------------------------------------------------- /demos/keera-hails-demos-gtk/elementarygtkprogram/src/View.hs: -------------------------------------------------------------------------------- 1 | -- | Contains basic operations related to the GUI 2 | -- 3 | -- Copyright : (C) Keera Studios Ltd, 2013 4 | -- License : BSD3 5 | -- Maintainer : support@keera.co.uk 6 | module View where 7 | 8 | -- External libraries 9 | import Graphics.UI.Gtk 10 | import Hails.MVC.View.GtkView (GtkGUI(..)) 11 | 12 | -- Internal libraries 13 | import View.MainWindow.Objects 14 | 15 | -- | Initialises the GUI. This must be called before 16 | -- any other GUI operation. 17 | initView :: IO () 18 | initView = initGUI >>= \_ -> return () 19 | 20 | -- | Starts a thread for the view. 21 | startView :: IO () 22 | startView = mainGUI 23 | 24 | -- | Executes an operation on the view thread synchronously 25 | onViewSync :: IO a -> IO a 26 | onViewSync = postGUISync 27 | 28 | -- | Executes an operation on the view thread asynchronously 29 | onViewAsync :: IO () -> IO () 30 | onViewAsync = postGUIAsync 31 | 32 | -- | Destroys the view thread 33 | destroyView :: IO () 34 | destroyView = mainQuit 35 | 36 | instance GtkGUI View where 37 | initialise = createView 38 | 39 | -- | This datatype should hold the elements that we must track in the future 40 | -- (for instance, treeview models) 41 | data View = View 42 | { mainWindowBuilder :: Builder 43 | } 44 | 45 | createView :: IO View 46 | createView = do 47 | bldr <- loadInterface 48 | 49 | return 50 | View 51 | { mainWindowBuilder = bldr 52 | } 53 | 54 | -------------------------------------------------------------------------------- /demos/keera-hails-demos-gtk/elementarygtkprogram/src/View/MainWindow/Objects.hs: -------------------------------------------------------------------------------- 1 | -- | This module contains oprations to access the objects in this interface, 2 | -- and one to obtain a builder from which they can be accessed. 3 | -- 4 | -- Copyright : (C) Keera Studios Ltd, 2013 5 | -- License : BSD3 6 | -- Maintainer : support@keera.co.uk 7 | module View.MainWindow.Objects where 8 | 9 | import Graphics.UI.Gtk 10 | 11 | -- | Returns a builder from which the objects in this part of the interface 12 | -- can be accessed. 13 | loadInterface :: IO Builder 14 | loadInterface = do 15 | builder <- builderNew 16 | builderAddFromFile builder "Interface.glade" 17 | return builder 18 | 19 | -- | Returns the IDE's main window. 20 | mainWindow :: Builder -> IO Window 21 | mainWindow = onBuilder castToWindow "mainWindow" 22 | 23 | onBuilder :: (GObjectClass cls) => 24 | (GObject -> cls) -> String -> Builder -> IO cls 25 | onBuilder f s b = builderGetObject b f s 26 | -------------------------------------------------------------------------------- /demos/keera-hails-demos-gtk/elementarygtkprogram/tests/HLint.hs: -------------------------------------------------------------------------------- 1 | import "hint" HLint.HLint 2 | 3 | -------------------------------------------------------------------------------- /demos/keera-hails-demos-gtk/elementarygtkprogram/tests/HLintMain.hs: -------------------------------------------------------------------------------- 1 | ----------------------------------------------------------------------------- 2 | -- | 3 | -- Module : Main (hlint) 4 | -- Copyright : (C) 2013 Edward Kmett 5 | -- License : BSD-style (see the file LICENSE) 6 | -- Maintainer : Edward Kmett 7 | -- Stability : provisional 8 | -- Portability : portable 9 | -- 10 | -- This module runs HLint on the lens source tree. 11 | ----------------------------------------------------------------------------- 12 | module Main where 13 | 14 | import Control.Monad 15 | import Language.Haskell.HLint 16 | import System.Environment 17 | import System.Exit 18 | 19 | main :: IO () 20 | main = do 21 | args <- getArgs 22 | hints <- hlint $ ["src", "--cross", "--hint=tests/HLint.hs" ] ++ args 23 | unless (null hints) exitFailure 24 | -------------------------------------------------------------------------------- /demos/keera-hails-demos-gtk/src/HelloWorld.hs: -------------------------------------------------------------------------------- 1 | import Data.ReactiveValue 2 | import Graphics.UI.Gtk 3 | import Graphics.UI.Gtk.Reactive 4 | import Graphics.UI.Gtk.Reactive.Gtk2 5 | 6 | main = do 7 | -- View 8 | initGUI 9 | window <- windowNew 10 | set window [windowTitle := "Text Entry", containerBorderWidth := 10] 11 | 12 | vb <- vBoxNew False 0 13 | containerAdd window vb 14 | 15 | txtfield <- entryNew 16 | boxPackStart vb txtfield PackNatural 0 17 | 18 | lbl <- labelNew (Nothing :: Maybe String) 19 | boxPackStart vb lbl PackNatural 0 20 | 21 | widgetShowAll window 22 | 23 | -- Controller Rules 24 | (printMsg <^> entryTextReactive txtfield) =:> labelTextReactive lbl 25 | objectDestroyReactive window =:> mainQuit 26 | 27 | -- Run! 28 | mainGUI 29 | 30 | -- Pure controller functions that can be debugged independently 31 | printMsg "" = "" 32 | printMsg txt = "\"" ++ txt ++ "\" is " ++ qual ++ " to its reverse" 33 | where qual | txt == reverse txt = "equal" 34 | | otherwise = "not equal" 35 | -------------------------------------------------------------------------------- /demos/keera-hails-demos-gtk/tests/HLint.hs: -------------------------------------------------------------------------------- 1 | import "hint" HLint.HLint 2 | 3 | -------------------------------------------------------------------------------- /demos/keera-hails-demos-gtk/tests/HLintMain.hs: -------------------------------------------------------------------------------- 1 | ----------------------------------------------------------------------------- 2 | -- | 3 | -- Module : Main (hlint) 4 | -- Copyright : (C) 2013 Edward Kmett 5 | -- License : BSD-style (see the file LICENSE) 6 | -- Maintainer : Edward Kmett 7 | -- Stability : provisional 8 | -- Portability : portable 9 | -- 10 | -- This module runs HLint on the lens source tree. 11 | ----------------------------------------------------------------------------- 12 | module Main where 13 | 14 | import Control.Monad 15 | import Language.Haskell.HLint 16 | import System.Environment 17 | import System.Exit 18 | 19 | main :: IO () 20 | main = do 21 | args <- getArgs 22 | hints <- hlint $ ["src", "--cross", "--hint=tests/HLint.hs" ] ++ args 23 | unless (null hints) exitFailure 24 | -------------------------------------------------------------------------------- /demos/keera-hails-demos-small/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2020, Keera Studios Ltd 2 | 3 | All rights reserved. 4 | -------------------------------------------------------------------------------- /demos/keera-hails-demos-small/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /demos/keera-hails-demos-small/data/body.html: -------------------------------------------------------------------------------- 1 |
2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 |
31 |
32 | -------------------------------------------------------------------------------- /demos/keera-hails-demos-small/keera-hails-demos-small.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: >= 1.10 2 | build-type: Simple 3 | 4 | name: keera-hails-demos-small 5 | version: 0.1.0 6 | license: AllRightsReserved 7 | license-file: LICENSE 8 | 9 | executable keera-hails-demos-small 10 | main-is: Main.hs 11 | 12 | other-modules: 13 | Controller 14 | Data.Calculator 15 | Data.Action 16 | Model 17 | View 18 | View.Types 19 | View.HTML 20 | 21 | build-depends: 22 | base >= 4.11 && < 5 23 | , file-embed 24 | , ghcjs-dom >= 0.9 25 | , ghcjs-base 26 | , keera-callbacks 27 | , keera-hails-reactivevalues 28 | , keera-hails-reactive-cbmvar 29 | , keera-hails-reactive-htmldom 30 | 31 | -- We need no-missing-home-modules because cabal and ghcjs do not see that 32 | -- the modules are listed in other-modules. 33 | ghc-options: -threaded -Wall -Wno-missing-home-modules 34 | 35 | -- We use dedupe to make code smaller. 36 | ghcjs-options: -dedupe 37 | hs-source-dirs: src 38 | default-language: Haskell2010 39 | -------------------------------------------------------------------------------- /demos/keera-hails-demos-small/src/Controller.hs: -------------------------------------------------------------------------------- 1 | module Controller where 2 | 3 | -- External imports 4 | import Control.Monad (forM_) 5 | 6 | -- External imports: Keera Hails project 7 | import Data.ReactiveValue ((<:=), (<^>), (=:>)) 8 | 9 | -- Internal imports 10 | import Data.Action (Action (Clear, Equals)) 11 | import Model (Model, modelAddDigit, modelApplyAction, modelApplyOperator, 12 | modelValue, reactiveModel) 13 | import View (UI (..)) 14 | 15 | -- | Connect view and model using reactive rules 16 | controller :: UI -> Model -> IO () 17 | controller ui model = do 18 | textField ui <:= (show <^> modelValue model) 19 | 20 | forM_ (numbers ui) $ \button -> 21 | button =:> modelAddDigit model 22 | 23 | forM_ (operators ui) $ \button -> 24 | button =:> modelApplyOperator model 25 | 26 | forM_ (actions ui) $ \button -> 27 | button =:> modelApplyAction model 28 | -------------------------------------------------------------------------------- /demos/keera-hails-demos-small/src/Data/Action.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- Copyright : (C) Keera Studios Ltd, 2020 3 | -- License : BSD3 4 | -- Maintainer : support@keera.co.uk 5 | -- 6 | -- Abstract definition of an operator button in a calculator. 7 | module Data.Action where 8 | 9 | -- | Operator button in a calculator. We support both binary number 10 | -- operators and other operatots that whould return the final value. 11 | data Action = Equals | Clear 12 | deriving Eq 13 | -------------------------------------------------------------------------------- /demos/keera-hails-demos-small/src/Main.hs: -------------------------------------------------------------------------------- 1 | -- Internal imports 2 | import Controller (controller) 3 | import Model (reactiveModel) 4 | import View (buildUI) 5 | 6 | main :: IO () 7 | main = do 8 | ui <- buildUI 9 | model <- reactiveModel 10 | controller ui model 11 | -------------------------------------------------------------------------------- /demos/keera-hails-demos-small/src/View.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- Copyright : (C) Keera Studios Ltd, 2020 3 | -- License : BSD3 4 | -- Maintainer : support@keera.co.uk 5 | -- 6 | -- Abstract view. 7 | -- 8 | -- This module publishes an operation that defines the view in an abstract 9 | -- way (as a collection of reactive values), and an operation to construct 10 | -- that view. Currently, HTML is supported as a backend via GHCJS, but 11 | -- more backends could be supported and a selection via CPP flags could 12 | -- take place in this module. 13 | module View 14 | ( UI(..) 15 | , buildUI 16 | ) 17 | where 18 | 19 | import View.Types (UI(..)) 20 | import View.HTML (buildUI) 21 | -------------------------------------------------------------------------------- /demos/keera-hails-demos-small/src/View/Types.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- Copyright : (C) Keera Studios Ltd, 2020 3 | -- License : BSD3 4 | -- Maintainer : support@keera.co.uk 5 | -- 6 | -- Abstract view representation as a collection of reactive values. 7 | module View.Types where 8 | 9 | import Data.ReactiveValue (ReactiveFieldRead, ReactiveFieldReadWrite) 10 | 11 | import Data.Action (Action) 12 | 13 | -- | A UI is a collection of reactive values. For this calculator example, 14 | -- we will use one readable value for each number, one for each operator, and a 15 | -- read-write RV for the text field where the results have to be shown. 16 | data UI = UI 17 | { numbers :: [ReactiveFieldRead IO Int] -- 0 to 9 18 | , operators :: [ReactiveFieldRead IO (Int -> Int -> Int)] -- plus, minus, times, div 19 | , actions :: [ReactiveFieldRead IO Action] -- plus, minus, times, div 20 | , textField :: ReactiveFieldReadWrite IO String 21 | } 22 | -------------------------------------------------------------------------------- /demos/keera-hails-demos-soundplay/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2015, Ivan Perez 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of Ivan Perez nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /demos/keera-hails-demos-soundplay/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /demos/keera-hails-demos-soundplay/baby.wav: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/keera-studios/keera-hails/dd88d71705524738f3f7a1800a30c723801e2dea/demos/keera-hails-demos-soundplay/baby.wav -------------------------------------------------------------------------------- /demos/keera-hails-demos-soundplay/tests/HLint.hs: -------------------------------------------------------------------------------- 1 | import "hint" HLint.HLint 2 | 3 | -------------------------------------------------------------------------------- /demos/keera-hails-demos-soundplay/tests/HLintMain.hs: -------------------------------------------------------------------------------- 1 | ----------------------------------------------------------------------------- 2 | -- | 3 | -- Module : Main (hlint) 4 | -- Copyright : (C) 2013 Edward Kmett 5 | -- License : BSD-style (see the file LICENSE) 6 | -- Maintainer : Edward Kmett 7 | -- Stability : provisional 8 | -- Portability : portable 9 | -- 10 | -- This module runs HLint on the lens source tree. 11 | ----------------------------------------------------------------------------- 12 | module Main where 13 | 14 | import Control.Monad 15 | import Language.Haskell.HLint 16 | import System.Environment 17 | import System.Exit 18 | 19 | main :: IO () 20 | main = do 21 | args <- getArgs 22 | hints <- hlint $ ["src", "--cross", "--hint=tests/HLint.hs" ] ++ args 23 | unless (null hints) exitFailure 24 | -------------------------------------------------------------------------------- /demos/keera-hails-demos-wiimote/screenshots/gui.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/keera-studios/keera-hails/dd88d71705524738f3f7a1800a30c723801e2dea/demos/keera-hails-demos-wiimote/screenshots/gui.png -------------------------------------------------------------------------------- /demos/keera-hails-demos-wiimote/screenshots/hwgui.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/keera-studios/keera-hails/dd88d71705524738f3f7a1800a30c723801e2dea/demos/keera-hails-demos-wiimote/screenshots/hwgui.png -------------------------------------------------------------------------------- /demos/keera-hails-demos-wiimote/screenshots/hwguiIR.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/keera-studios/keera-hails/dd88d71705524738f3f7a1800a30c723801e2dea/demos/keera-hails-demos-wiimote/screenshots/hwguiIR.png -------------------------------------------------------------------------------- /demos/keera-hails-gtk-app/ChangeLog.md: -------------------------------------------------------------------------------- 1 | # Revision history for keera-hails-gtk-app 2 | 3 | ## 0.1 -- 2020-02-26 4 | 5 | * First version. 6 | -------------------------------------------------------------------------------- /demos/keera-hails-gtk-app/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2020, Keera Studios Ltd 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of Keera Studios nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /demos/keera-hails-gtk-app/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /demos/keera-hails-gtk-app/data/Interface.glade: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 800 7 | 600 8 | False 9 | 10 | 11 | True 12 | False 13 | 14 | 15 | True 16 | False 17 | Hello World!!! 18 | 19 | 20 | 13 21 | 8 22 | 23 | 24 | 25 | 26 | 27 | 28 | -------------------------------------------------------------------------------- /demos/keera-hails-gtk-app/keera-hails-gtk-app.cabal: -------------------------------------------------------------------------------- 1 | -- Copyright : (C) Keera Studios Ltd, 2020 2 | -- License : All Rights Reserved 3 | -- Maintainer : support@keera.co.uk 4 | 5 | cabal-version: >=1.10 6 | build-type: Simple 7 | 8 | name: keera-hails-gtk-app 9 | version: 0.8.0 10 | author: Myro Pavlenko 11 | maintainer: support@keera.co.uk 12 | homepage: https://github.com/keera-studios/keera-hails 13 | license: BSD3 14 | license-file: LICENSE 15 | category: Graphics 16 | synopsis: A demo built using keera-hails 17 | 18 | extra-source-files: 19 | ChangeLog.md 20 | 21 | data-files: 22 | data/Interface.glade 23 | 24 | executable keera-hails-gtk-app 25 | 26 | main-is: 27 | Main.hs 28 | 29 | other-modules: 30 | CombinedEnvironment 31 | Controller 32 | Controller.Conditions 33 | Model.Model 34 | Model.ProtectedModel 35 | Model.ProtectedModel.ProtectedFields 36 | Model.ProtectedModel.ProtectedModelInternals 37 | Model.ReactiveModel 38 | Model.ReactiveModel.ModelEvents 39 | Model.ReactiveModel.ReactiveFields 40 | Model.ReactiveModel.ReactiveModelInternals 41 | Paths 42 | Paths.CustomPaths 43 | View 44 | View.Objects 45 | 46 | build-depends: 47 | base >=4.12 && <4.13 48 | , gtk 49 | , keera-hails-mvc-environment-gtk 50 | , keera-hails-mvc-model-protectedmodel 51 | , keera-hails-mvc-view 52 | , keera-hails-mvc-view-gtk 53 | 54 | default-language: 55 | Haskell2010 56 | 57 | hs-source-dirs: 58 | src 59 | -------------------------------------------------------------------------------- /keera-hails-i18n/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2013-2020, Keera Studios Ltd 2 | Copyright (c) 2010-2012, Ivan Perez 3 | 4 | All rights reserved. 5 | 6 | Redistribution and use in source and binary forms, with or without 7 | modification, are permitted provided that the following conditions are met: 8 | 9 | * Redistributions of source code must retain the above copyright 10 | notice, this list of conditions and the following disclaimer. 11 | 12 | * Redistributions in binary form must reproduce the above 13 | copyright notice, this list of conditions and the following 14 | disclaimer in the documentation and/or other materials provided 15 | with the distribution. 16 | 17 | * Neither the name of Ivan Perez, nor the name of Keera Studios, nor the 18 | names of other contributors may be used to endorse or promote products 19 | derived from this software without specific prior written permission. 20 | 21 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 22 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 23 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 24 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 25 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 26 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 27 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 28 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 29 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 30 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 31 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 32 | -------------------------------------------------------------------------------- /keera-hails-i18n/README.md: -------------------------------------------------------------------------------- 1 | This convenience library lets applications use a file to configure language 2 | preference. It also gives functions to pick up the appropriate Gettext 3 | files for the chosen language upon application start. 4 | 5 | Although part of Keera Hails, this library does not depend on Reactive Values 6 | and can be used independently. It also does not require using a GUI of any 7 | kind. 8 | 9 | See also: https://github.com/keera-studios/keera-hails 10 | -------------------------------------------------------------------------------- /keera-hails-i18n/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /keera-hails-i18n/src/Hails/I18N/Gettext.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | -- | This module contains the function we need to use to get automatic 3 | -- translation on all the strings in our programs. 4 | -- 5 | -- Copyright : (C) Keera Studios Ltd, 2013 6 | -- License : BSD3 7 | -- Maintainer : support@keera.co.uk 8 | module Hails.I18N.Gettext where 9 | 10 | import Codec.Binary.UTF8.String (decodeString, isUTF8Encoded) 11 | import System.IO.Unsafe (unsafePerformIO) 12 | import Text.I18N.GetText (getText) 13 | 14 | -- | Translate a string using gettext. 15 | -- 16 | -- Note: This implementation decodes UTF-8 strings only in Linux. If it 17 | -- should also in other OSs, please open an issue on github. 18 | __ :: String -> String 19 | __ string 20 | #ifdef linux_HOST_OS 21 | | isUTF8Encoded translation = decodeString translation 22 | #endif 23 | | otherwise = translation 24 | where 25 | translation :: String 26 | translation = unsafePerformIO $ getText string 27 | -------------------------------------------------------------------------------- /keera-hails-i18n/tests/HLint.hs: -------------------------------------------------------------------------------- 1 | import "hint" HLint.HLint 2 | 3 | -------------------------------------------------------------------------------- /keera-hails-i18n/tests/HLintMain.hs: -------------------------------------------------------------------------------- 1 | ----------------------------------------------------------------------------- 2 | -- | 3 | -- Module : Main (hlint) 4 | -- Copyright : (C) 2013 Edward Kmett 5 | -- License : BSD-style (see the file LICENSE) 6 | -- Maintainer : Edward Kmett 7 | -- Stability : provisional 8 | -- Portability : portable 9 | -- 10 | -- This module runs HLint on the lens source tree. 11 | ----------------------------------------------------------------------------- 12 | module Main where 13 | 14 | import Control.Monad 15 | import Language.Haskell.HLint 16 | import System.Environment 17 | import System.Exit 18 | 19 | main :: IO () 20 | main = do 21 | args <- getArgs 22 | hints <- hlint $ ["src", "--cross", "--hint=tests/HLint.hs" ] ++ args 23 | unless (null hints) exitFailure 24 | -------------------------------------------------------------------------------- /keera-hails-mvc-controller/CHANGELOG: -------------------------------------------------------------------------------- 1 | 2022-04-05 Alexander Pavlenko 2 | 3 | * keera-hails-mvc-controller.cabal: Add constraints on dependency on base. 4 | Version bump (0.8.0). Conform to new style guide. 5 | 6 | 2020-08-13 Alexander Pavlenko 7 | 8 | * CHANGELOG: Fix typo in 2020-05-27 entry. 9 | * keera-hails-mvc-controller.cabal: Cleaning. Version bump (0.7.0). 10 | 11 | 2020-05-27 Alexander Pavlenko 12 | 13 | * keera-hails-mvc-controller.cabal: Version bump (0.6.0). 14 | 15 | 2014-06-04 Ivan Perez 16 | 17 | * Adds project to hudson-backed continuous integration server. 18 | -------------------------------------------------------------------------------- /keera-hails-mvc-controller/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2013-2020, Keera Studios Ltd 2 | Copyright (c) 2010-2012, Ivan Perez 3 | 4 | All rights reserved. 5 | 6 | Redistribution and use in source and binary forms, with or without 7 | modification, are permitted provided that the following conditions are met: 8 | 9 | * Redistributions of source code must retain the above copyright 10 | notice, this list of conditions and the following disclaimer. 11 | 12 | * Redistributions in binary form must reproduce the above 13 | copyright notice, this list of conditions and the following 14 | disclaimer in the documentation and/or other materials provided 15 | with the distribution. 16 | 17 | * Neither the name of Ivan Perez, nor the name of Keera Studios, nor the 18 | names of other contributors may be used to endorse or promote products 19 | derived from this software without specific prior written permission. 20 | 21 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 22 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 23 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 24 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 25 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 26 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 27 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 28 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 29 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 30 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 31 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 32 | -------------------------------------------------------------------------------- /keera-hails-mvc-controller/README.md: -------------------------------------------------------------------------------- 1 | hails-mvc-controller 2 | ==================== 3 | 4 | Aspects purely related to controller conditions (minimal package). 5 | 6 | Controllers update models and views, and the conditions/event handlers can 7 | work both ways. Before Keera Hails' reactive values were introduced, I used 8 | directional conditions to keep models and views in sync. Since most update 9 | operations in one direction were almost verbatim copies of update operations 10 | in the other direction, I often decided to create only one and pass the direction 11 | of the update as a parameter. 12 | 13 | This package contains that pattern: direction of updates in MVC Controller's 14 | handlers. It is only useful in combination with the rest of Keera Hails suite. 15 | 16 | Installation 17 | ==================== 18 | 19 | It has no strange dependencies, so you should be able to install it normally 20 | with cabal. It is not in hackage, so you'll have to clone the repo first. 21 | 22 | $ git clone git@github.com:keera-studios/hails-mvc-controller.git 23 | $ cd hails-mvc-controller 24 | $ cabal install 25 | 26 | (Note: I prefer to use cabal-dev or cabal sandboxes, and I recommend that you 27 | do the same.) 28 | -------------------------------------------------------------------------------- /keera-hails-mvc-controller/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /keera-hails-mvc-controller/src/Hails/MVC/Controller/ConditionDirection.hs: -------------------------------------------------------------------------------- 1 | -- | Conditions to update a program can go from the view to the model 2 | -- and from the model to the view. Future versions must "ignore" this 3 | -- completely and simply work even if the constraints are of kind 4 | -- Model-to-Model or View-to-View. 5 | -- 6 | -- Copyright : (C) Keera Studios Ltd, 2013 7 | -- License : BSD3 8 | -- Maintainer : support@keera.co.uk 9 | module Hails.MVC.Controller.ConditionDirection where 10 | 11 | -- | Direction of an update condition: view to model, or model to view. 12 | data ConditionDirection = VM 13 | | MV 14 | 15 | -------------------------------------------------------------------------------- /keera-hails-mvc-controller/tests/HLint.hs: -------------------------------------------------------------------------------- 1 | import "hint" HLint.HLint 2 | 3 | -------------------------------------------------------------------------------- /keera-hails-mvc-controller/tests/HLintMain.hs: -------------------------------------------------------------------------------- 1 | ----------------------------------------------------------------------------- 2 | -- | 3 | -- Module : Main (hlint) 4 | -- Copyright : (C) 2013 Edward Kmett 5 | -- License : BSD-style (see the file LICENSE) 6 | -- Maintainer : Edward Kmett 7 | -- Stability : provisional 8 | -- Portability : portable 9 | -- 10 | -- This module runs HLint on the lens source tree. 11 | ----------------------------------------------------------------------------- 12 | module Main where 13 | 14 | import Control.Monad 15 | import Language.Haskell.HLint 16 | import System.Environment 17 | import System.Exit 18 | 19 | main :: IO () 20 | main = do 21 | args <- getArgs 22 | hints <- hlint $ ["src", "--cross", "--hint=tests/HLint.hs" ] ++ args 23 | unless (null hints) exitFailure 24 | -------------------------------------------------------------------------------- /keera-hails-mvc-environment-gtk/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /keera-hails-mvc-environment-gtk/src/Hails/MVC/DefaultGtkEnvironment.hs: -------------------------------------------------------------------------------- 1 | -- | Environment that contains both a model and a view. 2 | -- 3 | -- Combined enviroments (CEnvs) are types that combine a model and 4 | -- a view. They allow for easy installing of rules that keep both 5 | -- in sync. 6 | -- 7 | -- This module provides a slightly more abstract and convenient interface to 8 | -- 'Hails.MVC.GenericCombinedEnvironment', in which the view is extacted from 9 | -- the wrapper when it is accessed. 10 | -- 11 | -- Copyright : (C) Keera Studios Ltd, 2013 12 | -- License : BSD3 13 | -- Maintainer : support@keera.co.uk 14 | module Hails.MVC.DefaultGtkEnvironment 15 | ( -- * Combined Environments (CEnvs) 16 | GEnv.CEnv 17 | -- * CEnv construction 18 | , GEnv.createCEnv 19 | -- * CEnv access 20 | , view 21 | , GEnv.model 22 | -- * CEnv updates 23 | , GEnv.installCondition 24 | , GEnv.installConditions 25 | ) 26 | where 27 | 28 | -- Internal libraries 29 | import qualified Hails.MVC.GenericCombinedEnvironment as GEnv 30 | import Hails.MVC.Model.ReactiveModel (Event) 31 | import qualified Hails.MVC.View.GtkView as GtkView 32 | 33 | -- | View in the CEnv of an MVC application. 34 | view :: (GtkView.GtkGUI a, Event c) => GEnv.CEnv a b c -> a 35 | view = GtkView.getGUI . GEnv.view 36 | -------------------------------------------------------------------------------- /keera-hails-mvc-environment-gtk/tests/HLint.hs: -------------------------------------------------------------------------------- 1 | import "hint" HLint.HLint 2 | 3 | -------------------------------------------------------------------------------- /keera-hails-mvc-environment-gtk/tests/HLintMain.hs: -------------------------------------------------------------------------------- 1 | ----------------------------------------------------------------------------- 2 | -- | 3 | -- Module : Main (hlint) 4 | -- Copyright : (C) 2013 Edward Kmett 5 | -- License : BSD-style (see the file LICENSE) 6 | -- Maintainer : Edward Kmett 7 | -- Stability : provisional 8 | -- Portability : portable 9 | -- 10 | -- This module runs HLint on the lens source tree. 11 | ----------------------------------------------------------------------------- 12 | module Main where 13 | 14 | import Control.Monad 15 | import Language.Haskell.HLint 16 | import System.Environment 17 | import System.Exit 18 | 19 | main :: IO () 20 | main = do 21 | args <- getArgs 22 | hints <- hlint $ ["src", "--cross", "--hint=tests/HLint.hs" ] ++ args 23 | unless (null hints) exitFailure 24 | -------------------------------------------------------------------------------- /keera-hails-mvc-environment-gtk3/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /keera-hails-mvc-environment-gtk3/src/Hails/MVC/DefaultGtkEnvironment.hs: -------------------------------------------------------------------------------- 1 | -- | Environment that contains both a model and a view. 2 | -- 3 | -- Combined enviroments (CEnvs) are types that combine a model and 4 | -- a view. They allow for easy installing of rules that keep both 5 | -- in sync. 6 | -- 7 | -- This module provides a slightly more abstract and convenient interface to 8 | -- 'Hails.MVC.GenericCombinedEnvironment', in which the view is extacted from 9 | -- the wrapper when it is accessed. 10 | -- 11 | -- Copyright : (C) Keera Studios Ltd, 2013 12 | -- License : BSD3 13 | -- Maintainer : support@keera.co.uk 14 | module Hails.MVC.DefaultGtkEnvironment 15 | ( -- * Combined Environments (CEnvs) 16 | GEnv.CEnv 17 | -- * CEnv construction 18 | , GEnv.createCEnv 19 | -- * CEnv access 20 | , view 21 | , GEnv.model 22 | -- * CEnv updates 23 | , GEnv.installCondition 24 | , GEnv.installConditions 25 | ) 26 | where 27 | 28 | -- Internal libraries 29 | import qualified Hails.MVC.GenericCombinedEnvironment as GEnv 30 | import Hails.MVC.Model.ReactiveModel (Event) 31 | import qualified Hails.MVC.View.GtkView as GtkView 32 | 33 | -- | View in the CEnv of an MVC application. 34 | view :: (GtkView.GtkGUI a, Event c) => GEnv.CEnv a b c -> a 35 | view = GtkView.getGUI . GEnv.view 36 | -------------------------------------------------------------------------------- /keera-hails-mvc-environment-gtk3/tests/HLint.hs: -------------------------------------------------------------------------------- 1 | import "hint" HLint.HLint 2 | 3 | -------------------------------------------------------------------------------- /keera-hails-mvc-model-lightmodel/CHANGELOG: -------------------------------------------------------------------------------- 1 | 2022-04-05 Alexander Pavlenko 2 | 3 | * keera-hails-mvc-model-lightmodel.cabal: Add constraints on dependency 4 | on base. Version bump (0.8.0). Conform to new style guide. 5 | 6 | 2020-08-13 Alexander Pavlenko 7 | 8 | * CHANGELOG: Fix errors in 2020-05-27 entry. 9 | * keera-hails-mvc-model-lightmodel: Cleaning. Version bump 10 | (0.7.0). 11 | 12 | 2020-05-27 Alexander Pavlenko 13 | 14 | * keera-hails-mvc-model-lightmodel: Version bump (0.6.0). 15 | 16 | 2015-06-03 Ivan Perez 17 | 18 | * keera-hails-mvc-model-lightmodel: Renames haskell package. Adds 19 | description. 20 | 21 | 2015-01-28 Ivan Perez 22 | 23 | * Adds a light protected model without an undo stack. 24 | -------------------------------------------------------------------------------- /keera-hails-mvc-model-lightmodel/README.md: -------------------------------------------------------------------------------- 1 | This library enabled creating (lightweight) protected models that can be used 2 | with the reactive programming library Hails. 3 | 4 | Protected models are mutable variables that can only be accessed in a 5 | thread-safe manner via a specific API, and whose changes you can listen to. 6 | Protected models are meant to contain the model of an application in MVC, so 7 | that one can later write reactive (synchronisation) rules. 8 | 9 | See the rest of Keera's hails-* projects to know more about this. 10 | -------------------------------------------------------------------------------- /keera-hails-mvc-model-lightmodel/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /keera-hails-mvc-model-lightmodel/src/Hails/MVC/Model/ProtectedModel/Initialisation.hs: -------------------------------------------------------------------------------- 1 | -- | Contains only one operation to notify that the system's been 2 | -- initialised. 3 | -- 4 | -- Copyright : (C) Keera Studios Ltd, 2013 5 | -- License : BSD3 6 | -- Maintainer : support@keera.co.uk 7 | module Hails.MVC.Model.ProtectedModel.Initialisation where 8 | 9 | import qualified Hails.MVC.Model.ReactiveModel.Initialisation as RM 10 | import Hails.MVC.Model.ReactiveModel.Events 11 | import Hails.MVC.Model.ProtectedModel 12 | 13 | initialiseSystem :: InitialisedEvent c => ProtectedModel a c -> IO () 14 | initialiseSystem = (`applyToReactiveModel` RM.initialiseSystem) 15 | -------------------------------------------------------------------------------- /keera-hails-mvc-model-lightmodel/src/Hails/MVC/Model/ReactiveFields.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- 3 | -- Copyright : (C) Keera Studios Ltd, 2013 4 | -- License : BSD3 5 | -- Maintainer : support@keera.co.uk 6 | module Hails.MVC.Model.ReactiveFields where 7 | 8 | import Hails.MVC.Model.ReactiveModel 9 | 10 | -- TODO: With the new reactive lenses interface, 11 | -- this should uses lenses instead. A 'Field' is 12 | -- just a lens, augmented with an event and a 13 | -- precondition checker. 14 | 15 | -- The following code presents a possibly simpler way of creating reactive 16 | -- fields in a reactive model. 17 | type Field a b c = (b -> a, a -> b -> Bool, a -> b -> b, c) 18 | 19 | preTrue :: a -> b -> Bool 20 | preTrue _ _ = True 21 | 22 | fieldSetter :: (Eq a, Event c) => 23 | Field a b c -> ReactiveModel b c d -> a -> ReactiveModel b c d 24 | fieldSetter f@(_, pre, rSet, ev) rm newVal 25 | | fieldGetter f rm == newVal = rm 26 | | not $ pre newVal $ basicModel rm = triggerEvent rm ev 27 | | otherwise = triggerEvent rm' ev 28 | where rm' = rm `onBasicModel` rSet newVal 29 | 30 | fieldGetter :: (Event c) => Field a b c -> ReactiveModel b c d -> a 31 | fieldGetter (rGet,_,_,_) = rGet . basicModel 32 | -------------------------------------------------------------------------------- /keera-hails-mvc-model-lightmodel/src/Hails/MVC/Model/ReactiveModel/Events.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveDataTypeable #-} 2 | -- | This module contains all the events in our program. 3 | -- 4 | -- FIXME: Because we want events to be comparable, we need to use the 5 | -- same datatype. It remains to be checked whether using an instance 6 | -- of Typeable and an existential type will be enough to have a good 7 | -- instance of Eq and therefore a heterogeneous model (wrt. events). 8 | -- 9 | -- Copyright : (C) Keera Studios Ltd, 2013 10 | -- License : BSD3 11 | -- Maintainer : support@keera.co.uk 12 | module Hails.MVC.Model.ReactiveModel.Events 13 | where 14 | 15 | -- import GenericModel.GenericModelEvent 16 | import qualified Hails.MVC.Model.ReactiveModel as GRM 17 | 18 | class GRM.Event a => InitialisedEvent a where 19 | initialisedEvent :: a 20 | -------------------------------------------------------------------------------- /keera-hails-mvc-model-lightmodel/src/Hails/MVC/Model/ReactiveModel/Initialisation.hs: -------------------------------------------------------------------------------- 1 | -- | Contains only one operation to notify that the system's been 2 | -- initialised. 3 | -- 4 | -- Copyright : (C) Keera Studios Ltd, 2013 5 | -- License : BSD3 6 | -- Maintainer : support@keera.co.uk 7 | module Hails.MVC.Model.ReactiveModel.Initialisation where 8 | 9 | import Hails.MVC.Model.ReactiveModel 10 | import Hails.MVC.Model.ReactiveModel.Events 11 | 12 | initialiseSystem :: InitialisedEvent b 13 | => ReactiveModel a b c -> ReactiveModel a b c 14 | initialiseSystem = (`triggerEvent` initialisedEvent) 15 | -------------------------------------------------------------------------------- /keera-hails-mvc-model-lightmodel/tests/HLint.hs: -------------------------------------------------------------------------------- 1 | import "hint" HLint.HLint 2 | 3 | -------------------------------------------------------------------------------- /keera-hails-mvc-model-lightmodel/tests/HLintMain.hs: -------------------------------------------------------------------------------- 1 | ----------------------------------------------------------------------------- 2 | -- | 3 | -- Module : Main (hlint) 4 | -- Copyright : (C) 2013 Edward Kmett 5 | -- License : BSD-style (see the file LICENSE) 6 | -- Maintainer : Edward Kmett 7 | -- Stability : provisional 8 | -- Portability : portable 9 | -- 10 | -- This module runs HLint on the lens source tree. 11 | ----------------------------------------------------------------------------- 12 | module Main where 13 | 14 | import Control.Monad 15 | import Language.Haskell.HLint 16 | import System.Environment 17 | import System.Exit 18 | 19 | main :: IO () 20 | main = do 21 | args <- getArgs 22 | hints <- hlint $ ["src", "--cross", "--hint=tests/HLint.hs" ] ++ args 23 | unless (null hints) exitFailure 24 | -------------------------------------------------------------------------------- /keera-hails-mvc-model-protectedmodel/CHANGELOG: -------------------------------------------------------------------------------- 1 | 2022-04-05 Alexander Pavlenko 2 | 3 | * keera-hails-mvc-model-protectedmodel.cabal: Add constraints on dependency 4 | on base. Version bump (0.8.0). Conform to new style guide. 5 | 6 | 2020-08-13 Alexander Pavlenko 7 | 8 | * CHANGELOG: Fix typo in 2020-05-27 entry. 9 | * keera-hails-mvc-model-protectedmodel.cabal: Cleaning. Version bump 10 | (0.7.0). 11 | 12 | 2020-05-27 Alexander Pavlenko 13 | 14 | * keera-hails-mvc-model-protectedmodel.cabal: Version bump (0.6.0). 15 | 16 | 2015-06-03 Ivan Perez 17 | 18 | * keera-hails-mvc-model-protectedmodel.cabal: Renames package. Adds 19 | description. 20 | 21 | 2015-05-05 Ivan Perez 22 | 23 | * src/: Adds monad to field accessor definition. Adds RV field 24 | generator that takes undo stack into account. 25 | * keera-hails-mvc-model-protectedmodel.cabal: version bump (0.3.5) 26 | 27 | 2014-06-04 Ivan Perez 28 | 29 | * Adds project to hudson-backed continuous integration server. 30 | * Adds TODO file with pending tasks. 31 | -------------------------------------------------------------------------------- /keera-hails-mvc-model-protectedmodel/README.md: -------------------------------------------------------------------------------- 1 | Reactive Values are mutable values with change propagation. They can be 2 | composed to create new RVs, and linked together so that changes to one 3 | propagate towards others. Reactive Values are typed (by the type of the 4 | contents and by their access properties); when they are connected, the type of 5 | the contents must match and the access properties must be compatible. 6 | 7 | Protected Models are thread-safe mutable values with change propagation. Every 8 | Protected Model is seen as a collection of Reactive Values. Protected Models 9 | may register changes, giving the possibility of undoing them. 10 | 11 | Protected Models are meant to enclose an MVC's application Model so that it is 12 | completely thread-safe, coherent, and change propagation is efficient. Each PM 13 | comes with its own change propagation notification loop. 14 | 15 | See https://github.com/keera-studios/keera-hails for more details. 16 | -------------------------------------------------------------------------------- /keera-hails-mvc-model-protectedmodel/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /keera-hails-mvc-model-protectedmodel/src/Hails/MVC/Model/ProtectedModel/Initialisation.hs: -------------------------------------------------------------------------------- 1 | -- | Contains only one operation to notify that the system's been 2 | -- initialised. 3 | -- 4 | -- Copyright : (C) Keera Studios Ltd, 2013 5 | -- License : BSD3 6 | -- Maintainer : support@keera.co.uk 7 | module Hails.MVC.Model.ProtectedModel.Initialisation where 8 | 9 | import qualified Hails.MVC.Model.ReactiveModel.Initialisation as RM 10 | import Hails.MVC.Model.ReactiveModel.Events 11 | import Hails.MVC.Model.ProtectedModel 12 | 13 | initialiseSystem :: InitialisedEvent c => ProtectedModel a c -> IO () 14 | initialiseSystem = (`applyToReactiveModel` RM.initialiseSystem) 15 | -------------------------------------------------------------------------------- /keera-hails-mvc-model-protectedmodel/src/Hails/MVC/Model/ReactiveFields.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- 3 | -- Copyright : (C) Keera Studios Ltd, 2013 4 | -- License : BSD3 5 | -- Maintainer : support@keera.co.uk 6 | module Hails.MVC.Model.ReactiveFields where 7 | 8 | import Hails.MVC.Model.ReactiveModel 9 | 10 | -- The following code presents a possibly simpler way of creating reactive 11 | -- fields in a reactive model. 12 | type Field a b c = (b -> a, a -> b -> Bool, a -> b -> b, c) 13 | 14 | preTrue :: a -> b -> Bool 15 | preTrue = const $ const True 16 | 17 | fieldSetter :: (Eq a, Event c) 18 | => Field a b c -> ReactiveModel b c d -> a -> ReactiveModel b c d 19 | fieldSetter f@(_, pre, rSet, ev) rm newVal 20 | | fieldGetter f rm == newVal = rm 21 | | not $ pre newVal $ basicModel rm = triggerEvent rm ev 22 | | otherwise = triggerEvent rm' ev 23 | where rm' = rm `onBasicModel` rSet newVal 24 | 25 | fieldGetter :: (Event c) => Field a b c -> ReactiveModel b c d -> a 26 | fieldGetter (rGet,_,_,_) = rGet . basicModel 27 | 28 | fieldSetterUndo :: (Eq a, Event c) 29 | => Field a b c -> ReactiveModel b c d -> a -> ReactiveModel b c d 30 | fieldSetterUndo f@(_, pre, rSet, ev) rm newVal 31 | | fieldGetter f rm == newVal = rm 32 | | not $ pre newVal $ basicModel rm = triggerEvent rm ev 33 | | otherwise = triggerEvent rm' ev 34 | where rm' = recordChange rm (rSet newVal) [ev] 35 | -------------------------------------------------------------------------------- /keera-hails-mvc-model-protectedmodel/src/Hails/MVC/Model/ReactiveModel/Events.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveDataTypeable #-} 2 | -- | This module contains all the events in our program. 3 | -- 4 | -- FIXME: Because we want events to be comparable, we need to use the 5 | -- same datatype. It remains to be checked whether using an instance 6 | -- of Typeable and an existential type will be enough to have a good 7 | -- instance of Eq and therefore a heterogeneous model (wrt. events). 8 | -- 9 | -- Copyright : (C) Keera Studios Ltd, 2013 10 | -- License : BSD3 11 | -- Maintainer : support@keera.co.uk 12 | module Hails.MVC.Model.ReactiveModel.Events 13 | where 14 | 15 | -- import GenericModel.GenericModelEvent 16 | import qualified Hails.MVC.Model.ReactiveModel as GRM 17 | 18 | class GRM.Event a => InitialisedEvent a where 19 | initialisedEvent :: a 20 | -------------------------------------------------------------------------------- /keera-hails-mvc-model-protectedmodel/src/Hails/MVC/Model/ReactiveModel/Initialisation.hs: -------------------------------------------------------------------------------- 1 | -- | Contains only one operation to notify that the system's been 2 | -- initialised. 3 | -- 4 | -- Copyright : (C) Keera Studios Ltd, 2013 5 | -- License : BSD3 6 | -- Maintainer : support@keera.co.uk 7 | module Hails.MVC.Model.ReactiveModel.Initialisation where 8 | 9 | import Hails.MVC.Model.ReactiveModel 10 | import Hails.MVC.Model.ReactiveModel.Events 11 | 12 | initialiseSystem :: InitialisedEvent b 13 | => ReactiveModel a b c -> ReactiveModel a b c 14 | initialiseSystem = (`triggerEvent` initialisedEvent) 15 | -------------------------------------------------------------------------------- /keera-hails-mvc-model-protectedmodel/tests/HLint.hs: -------------------------------------------------------------------------------- 1 | import "hint" HLint.HLint 2 | 3 | -------------------------------------------------------------------------------- /keera-hails-mvc-model-protectedmodel/tests/HLintMain.hs: -------------------------------------------------------------------------------- 1 | ----------------------------------------------------------------------------- 2 | -- | 3 | -- Module : Main (hlint) 4 | -- Copyright : (C) 2013 Edward Kmett 5 | -- License : BSD-style (see the file LICENSE) 6 | -- Maintainer : Edward Kmett 7 | -- Stability : provisional 8 | -- Portability : portable 9 | -- 10 | -- This module runs HLint on the lens source tree. 11 | ----------------------------------------------------------------------------- 12 | module Main where 13 | 14 | import Control.Monad 15 | import Language.Haskell.HLint 16 | import System.Environment 17 | import System.Exit 18 | 19 | main :: IO () 20 | main = do 21 | args <- getArgs 22 | hints <- hlint $ ["src", "--cross", "--hint=tests/HLint.hs" ] ++ args 23 | unless (null hints) exitFailure 24 | -------------------------------------------------------------------------------- /keera-hails-mvc-solutions-config/README.md: -------------------------------------------------------------------------------- 1 | Hails Solutions config 2 | ==================================== 3 | 4 | This package contains a design pattern for reading from/writing to 5 | configuration files. 6 | 7 | It provides you with a type synonym of what your Config IO should look like, 8 | and two default operations that work well in (afaik) all platforms. 9 | 10 | 11 | Installation 12 | ==================================== 13 | 14 | Because the operatiosn handle errors (which are slightly different from pure 15 | haskell exceptions in Gtk), this package depends on MissingK 16 | (https://github.com/keera-studios/MissingK) 17 | 18 | Apart from that, all dependencies are standard. 19 | 20 | Including the dependencies of MissingK, you'll need: 21 | 22 | libraries: glib2.0 23 | 24 | $ apt-get install libglib2.0-dev 25 | 26 | programs: alex happy gtk2hs-buildtools 27 | 28 | $ apt-get install happy alex && cabal install gtk2hs-buildtools 29 | 30 | haskell packages: 31 | 32 | $ git clone git://github.com/keera-studios/MissingK.git 33 | $ git clone git://github.com/keera-studios/hails-mvc-solutions-config.git 34 | $ cd MissingK 35 | $ cabal install 36 | $ cd ../hails-mvc-solutions-config 37 | $ cabal install 38 | -------------------------------------------------------------------------------- /keera-hails-mvc-solutions-config/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /keera-hails-mvc-solutions-config/src/Hails/MVC/Controller/Conditions/Config.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- 3 | -- Copyright : (C) Keera Studios Ltd, 2013 4 | -- License : BSD3 5 | -- Maintainer : support@keera.co.uk 6 | module Hails.MVC.Controller.Conditions.Config where 7 | 8 | import qualified Control.Exception as E 9 | import Control.Monad 10 | import System.FilePath 11 | import System.Directory 12 | 13 | import Control.Exception.Extra 14 | 15 | -- | A config IO layer reads and writes 16 | -- an environment from a string. It's like a 17 | -- read/show combination for configuration files 18 | -- to and from Environments 19 | type ConfigIO e = ( Maybe String -> e -> IO () -- Reader 20 | , e -> IO String -- Shower 21 | ) 22 | 23 | defaultRead :: ConfigIO e -> String -> e -> IO() 24 | defaultRead (readConf, _) app cenv = 25 | void $ E.handle (anyway (readConf Nothing cenv)) $ do 26 | dir <- getAppUserDataDirectory app 27 | let file = dir "config" 28 | c <- readFile file 29 | readConf (Just c) cenv 30 | 31 | defaultWrite :: ConfigIO e -> String -> e -> IO() 32 | defaultWrite (_, showConf) app cenv = 33 | void $ E.handle (anyway (return ())) $ do 34 | dir <- getAppUserDataDirectory app 35 | createDirectoryIfMissing True dir 36 | let file = dir "config" 37 | writeFile file =<< showConf cenv 38 | -------------------------------------------------------------------------------- /keera-hails-mvc-solutions-config/tests/HLint.hs: -------------------------------------------------------------------------------- 1 | import "hint" HLint.HLint 2 | 3 | -------------------------------------------------------------------------------- /keera-hails-mvc-solutions-config/tests/HLintMain.hs: -------------------------------------------------------------------------------- 1 | ----------------------------------------------------------------------------- 2 | -- | 3 | -- Module : Main (hlint) 4 | -- Copyright : (C) 2013 Edward Kmett 5 | -- License : BSD-style (see the file LICENSE) 6 | -- Maintainer : Edward Kmett 7 | -- Stability : provisional 8 | -- Portability : portable 9 | -- 10 | -- This module runs HLint on the lens source tree. 11 | ----------------------------------------------------------------------------- 12 | module Main where 13 | 14 | import Control.Monad 15 | import Language.Haskell.HLint 16 | import System.Environment 17 | import System.Exit 18 | 19 | main :: IO () 20 | main = do 21 | args <- getArgs 22 | hints <- hlint $ ["src", "--cross", "--hint=tests/HLint.hs" ] ++ args 23 | unless (null hints) exitFailure 24 | -------------------------------------------------------------------------------- /keera-hails-mvc-solutions-gtk/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /keera-hails-mvc-solutions-gtk/src/Hails/Graphics/UI/Gtk/Simplify/NameAndVersionTitleBar.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- 3 | -- Copyright : (C) Keera Studios Ltd, 2013 4 | -- License : BSD3 5 | -- Maintainer : support@keera.co.uk 6 | module Hails.Graphics.UI.Gtk.Simplify.NameAndVersionTitleBar where 7 | 8 | import Control.Arrow 9 | import Control.Monad 10 | import Control.Monad.Reader (liftIO) 11 | import Data.ExtraVersion 12 | -- import Graphics.UI.Gtk.GenericView 13 | import Graphics.UI.Gtk 14 | import Hails.MVC.View 15 | import Hails.MVC.View.GtkView 16 | import Hails.MVC.GenericCombinedEnvironment 17 | import Hails.MVC.Model.ReactiveModel (Event) 18 | import Hails.MVC.Model.ProtectedModel.VersionedModel 19 | import Hails.MVC.Model.ProtectedModel.NamedModel 20 | 21 | installHandlers :: (GtkGUI a, VersionedBasicModel b, NamedBasicModel b, Event c) 22 | => CEnv a b c 23 | -> ViewElementAccessorIO (GtkView a) Window 24 | -> IO () 25 | installHandlers cenv wF = void $ do 26 | let vw = view cenv 27 | w <- wF vw 28 | w `on` mapEvent $ liftIO (onViewAsync vw (condition cenv wF)) >> return False 29 | 30 | condition :: (GtkGUI a, VersionedBasicModel b, NamedBasicModel b, Event c) 31 | => CEnv a b c 32 | -> ViewElementAccessorIO (GtkView a) Window 33 | -> IO () 34 | condition cenv wF = do 35 | let (vw, pm) = (view &&& model) cenv 36 | w <- wF vw 37 | pn <- getName pm 38 | vn <- fmap versionToString $ getVersion pm 39 | t <- windowGetTitle w 40 | let titleMust = pn ++ " " ++ vn 41 | when (t /= titleMust) $ windowSetTitle w titleMust 42 | -------------------------------------------------------------------------------- /keera-hails-mvc-solutions-gtk/src/Hails/Graphics/UI/Gtk/Simplify/ProgramMainWindow.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- 3 | -- Copyright : (C) Keera Studios Ltd, 2013 4 | -- License : BSD3 5 | -- Maintainer : support@keera.co.uk 6 | module Hails.Graphics.UI.Gtk.Simplify.ProgramMainWindow where 7 | 8 | import Control.Monad.Reader (liftIO) 9 | import Hails.MVC.Model.ReactiveModel (Event) 10 | import Hails.MVC.GenericCombinedEnvironment 11 | import Graphics.UI.Gtk 12 | import Hails.MVC.View 13 | import Hails.MVC.View.GtkView 14 | 15 | installHandlers :: (GtkGUI a, Event c) 16 | => CEnv a b c 17 | -> ViewElementAccessorIO (GtkView a) Window 18 | -> IO () 19 | installHandlers cenv wF = do 20 | let vw = view cenv 21 | w <- wF vw 22 | _ <- w `on` deleteEvent $ liftIO $ condition cenv 23 | return () 24 | 25 | condition :: (GtkGUI a, Event c) 26 | => CEnv a b c 27 | -> IO Bool 28 | condition cenv = do 29 | let vw = view cenv 30 | onViewAsync vw $ destroyView vw 31 | return False 32 | -------------------------------------------------------------------------------- /keera-hails-mvc-solutions-gtk/src/Hails/MVC/Model/ProtectedModel/LoggedModel.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleInstances #-} 2 | -- | 3 | -- 4 | -- Copyright : (C) Keera Studios Ltd, 2013 5 | -- License : BSD3 6 | -- Maintainer : support@keera.co.uk 7 | module Hails.MVC.Model.ProtectedModel.LoggedModel where 8 | 9 | import Hails.MVC.Model.ProtectedModel 10 | import Hails.MVC.Model.ReactiveModel 11 | import Control.Monad 12 | import Language.Haskell.TH.Syntax 13 | import Language.Haskell.TH.DeriveField 14 | import System.Log.Logger 15 | 16 | class LoggedBasicModel a where 17 | getBMLogName :: a -> String 18 | 19 | class LoggedProtectedModel a where 20 | getLogName :: a -> IO String 21 | getLog :: a -> IO Logger 22 | 23 | instance (Event b, LoggedBasicModel a) => LoggedProtectedModel (ProtectedModel a b) where 24 | 25 | getLogName = (`onReactiveModel` getRMLogName) 26 | where getRMLogName = getBMLogName . basicModel 27 | 28 | getLog = getLogName >=> getLogger 29 | 30 | deriveLogged :: Name -> Q [Dec] 31 | deriveLogged = 32 | deriveField "LoggedBasicModel" "getBMLogName" "logName" 33 | -------------------------------------------------------------------------------- /keera-hails-mvc-solutions-gtk/src/Hails/MVC/Model/ProtectedModel/NamedModel.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- 3 | -- Copyright : (C) Keera Studios Ltd, 2013 4 | -- License : BSD3 5 | -- Maintainer : support@keera.co.uk 6 | module Hails.MVC.Model.ProtectedModel.NamedModel where 7 | 8 | import Hails.MVC.Model.ProtectedModel 9 | import Hails.MVC.Model.ReactiveModel 10 | import Language.Haskell.TH.Syntax 11 | import Language.Haskell.TH.DeriveField 12 | 13 | class NamedBasicModel a where 14 | getBMName :: a -> String 15 | 16 | class NamedProtectedModel a where 17 | getName :: a -> IO String 18 | 19 | -- class NamedReactiveModel a where 20 | -- getRMName :: a -> String 21 | -- 22 | -- instance NamedBasicModel a => NamedReactiveModel (ReactiveModel a) where 23 | -- getRMName = getBMName . basicModel 24 | 25 | instance (Event b, NamedBasicModel a) => NamedProtectedModel (ProtectedModel a b) where 26 | getName = (`onReactiveModel` getRMName) 27 | where getRMName = getBMName . basicModel 28 | 29 | deriveNamed :: Name -> Q [Dec] 30 | deriveNamed = 31 | deriveField "NamedBasicModel" "getBMName" "name" 32 | -------------------------------------------------------------------------------- /keera-hails-mvc-solutions-gtk/src/Hails/MVC/Model/ProtectedModel/UpdatableModel.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleInstances #-} 2 | -- | 3 | -- 4 | -- Copyright : (C) Keera Studios Ltd, 2013 5 | -- License : BSD3 6 | -- Maintainer : support@keera.co.uk 7 | module Hails.MVC.Model.ProtectedModel.UpdatableModel where 8 | 9 | import Hails.MVC.Model.ReactiveModel 10 | import Hails.MVC.Model.ProtectedModel 11 | 12 | import Data.ExtraVersion 13 | 14 | import Hails.MVC.Model.ProtectedModel.VersionedModel 15 | 16 | class VersionedBasicModel a => UpdatableBasicModel a where 17 | getBMUpdateURI :: a -> String 18 | getBMMaxVersionAvail :: a -> Maybe Version 19 | setBMMaxVersionAvail :: a -> Version -> a 20 | 21 | class VersionedProtectedModel a => UpdatableProtectedModel a where 22 | getUpdateURI :: a -> IO String 23 | getMaxVersionAvail :: a -> IO (Maybe Version) 24 | setMaxVersionAvail :: a -> Version -> IO () 25 | 26 | class Event a => UpdateNotifiableEvent a where 27 | updateNotificationEvent :: a 28 | 29 | instance (UpdatableBasicModel a, UpdateNotifiableEvent b) => UpdatableProtectedModel (ProtectedModel a b) where 30 | getUpdateURI = (`onReactiveModel` getRMUpdateURI) 31 | where getRMUpdateURI = getBMUpdateURI . basicModel 32 | getMaxVersionAvail = (`onReactiveModel` getRMMaxVersionAvail) 33 | where getRMMaxVersionAvail = getBMMaxVersionAvail . basicModel 34 | setMaxVersionAvail pm v = pm `applyToReactiveModel` setRMMaxVersionAvail 35 | where setRMMaxVersionAvail rm = let rm' = rm `onBasicModel` (`setBMMaxVersionAvail` v) 36 | in triggerEvent rm' updateNotificationEvent 37 | -------------------------------------------------------------------------------- /keera-hails-mvc-solutions-gtk/src/Hails/MVC/Model/ProtectedModel/VersionedModel.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- 3 | -- Copyright : (C) Keera Studios Ltd, 2013 4 | -- License : BSD3 5 | -- Maintainer : support@keera.co.uk 6 | module Hails.MVC.Model.ProtectedModel.VersionedModel where 7 | 8 | import Data.ExtraVersion 9 | 10 | import Hails.MVC.Model.ProtectedModel 11 | import Hails.MVC.Model.ReactiveModel 12 | import Language.Haskell.TH.Syntax 13 | import Language.Haskell.TH.DeriveField 14 | 15 | class VersionedBasicModel a where 16 | getBMVersion :: a -> Version 17 | 18 | class VersionedProtectedModel a where 19 | getVersion :: a -> IO Version 20 | 21 | -- class VersionedReactiveModel a where 22 | -- getRMVersion :: a -> String 23 | -- 24 | -- instance VersionedBasicModel a => VersionedReactiveModel (ReactiveModel a) where 25 | -- getRMVersion = getBMVersion . basicModel 26 | 27 | instance (Event b, VersionedBasicModel a) => VersionedProtectedModel (ProtectedModel a b) where 28 | getVersion = (`onReactiveModel` getRMVersion) 29 | where getRMVersion = getBMVersion . basicModel 30 | 31 | deriveVersioned :: Name -> Q [Dec] 32 | deriveVersioned = 33 | deriveField "VersionedBasicModel" "getBMVersion" "version" 34 | -------------------------------------------------------------------------------- /keera-hails-mvc-solutions-gtk/tests/HLint.hs: -------------------------------------------------------------------------------- 1 | import "hint" HLint.HLint 2 | 3 | -------------------------------------------------------------------------------- /keera-hails-mvc-solutions-gtk/tests/HLintMain.hs: -------------------------------------------------------------------------------- 1 | ----------------------------------------------------------------------------- 2 | -- | 3 | -- Module : Main (hlint) 4 | -- Copyright : (C) 2013 Edward Kmett 5 | -- License : BSD-style (see the file LICENSE) 6 | -- Maintainer : Edward Kmett 7 | -- Stability : provisional 8 | -- Portability : portable 9 | -- 10 | -- This module runs HLint on the lens source tree. 11 | ----------------------------------------------------------------------------- 12 | module Main where 13 | 14 | import Control.Monad 15 | import Language.Haskell.HLint 16 | import System.Environment 17 | import System.Exit 18 | 19 | main :: IO () 20 | main = do 21 | args <- getArgs 22 | hints <- hlint $ ["src", "--cross", "--hint=tests/HLint.hs" ] ++ args 23 | unless (null hints) exitFailure 24 | -------------------------------------------------------------------------------- /keera-hails-mvc-solutions-gtk3/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /keera-hails-mvc-solutions-gtk3/src/Hails/Graphics/UI/Gtk/Simplify/NameAndVersionTitleBar.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- 3 | -- Copyright : (C) Keera Studios Ltd, 2013 4 | -- License : BSD3 5 | -- Maintainer : support@keera.co.uk 6 | module Hails.Graphics.UI.Gtk.Simplify.NameAndVersionTitleBar where 7 | 8 | import Control.Arrow 9 | import Control.Monad 10 | import Control.Monad.Reader (liftIO) 11 | import Data.ExtraVersion 12 | -- import Graphics.UI.Gtk.GenericView 13 | import Graphics.UI.Gtk 14 | import Hails.MVC.View 15 | import Hails.MVC.View.GtkView 16 | import Hails.MVC.GenericCombinedEnvironment 17 | import Hails.MVC.Model.ReactiveModel (Event) 18 | import Hails.MVC.Model.ProtectedModel.VersionedModel 19 | import Hails.MVC.Model.ProtectedModel.NamedModel 20 | 21 | installHandlers :: (GtkGUI a, VersionedBasicModel b, NamedBasicModel b, Event c) 22 | => CEnv a b c 23 | -> ViewElementAccessorIO (GtkView a) Window 24 | -> IO () 25 | installHandlers cenv wF = void $ do 26 | let vw = view cenv 27 | w <- wF vw 28 | w `on` mapEvent $ liftIO (onViewAsync vw (condition cenv wF)) >> return False 29 | 30 | condition :: (GtkGUI a, VersionedBasicModel b, NamedBasicModel b, Event c) 31 | => CEnv a b c 32 | -> ViewElementAccessorIO (GtkView a) Window 33 | -> IO () 34 | condition cenv wF = do 35 | let (vw, pm) = (view &&& model) cenv 36 | w <- wF vw 37 | pn <- getName pm 38 | vn <- fmap versionToString $ getVersion pm 39 | t <- get w windowTitle 40 | let titleMust = pn ++ " " ++ vn 41 | when (t /= titleMust) $ set w [ windowTitle := titleMust ] 42 | -------------------------------------------------------------------------------- /keera-hails-mvc-solutions-gtk3/src/Hails/Graphics/UI/Gtk/Simplify/ProgramMainWindow.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- 3 | -- Copyright : (C) Keera Studios Ltd, 2013 4 | -- License : BSD3 5 | -- Maintainer : support@keera.co.uk 6 | module Hails.Graphics.UI.Gtk.Simplify.ProgramMainWindow where 7 | 8 | import Control.Monad.Reader (liftIO) 9 | import Hails.MVC.Model.ReactiveModel (Event) 10 | import Hails.MVC.GenericCombinedEnvironment 11 | import Graphics.UI.Gtk 12 | import Hails.MVC.View 13 | import Hails.MVC.View.GtkView 14 | 15 | installHandlers :: (GtkGUI a, Event c) 16 | => CEnv a b c 17 | -> ViewElementAccessorIO (GtkView a) Window 18 | -> IO () 19 | installHandlers cenv wF = do 20 | let vw = view cenv 21 | w <- wF vw 22 | _ <- w `on` deleteEvent $ liftIO $ condition cenv 23 | return () 24 | 25 | condition :: (GtkGUI a, Event c) 26 | => CEnv a b c 27 | -> IO Bool 28 | condition cenv = do 29 | let vw = view cenv 30 | onViewAsync vw $ destroyView vw 31 | return False 32 | -------------------------------------------------------------------------------- /keera-hails-mvc-solutions-gtk3/src/Hails/MVC/Model/ProtectedModel/LoggedModel.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleInstances #-} 2 | -- | 3 | -- 4 | -- Copyright : (C) Keera Studios Ltd, 2013 5 | -- License : BSD3 6 | -- Maintainer : support@keera.co.uk 7 | module Hails.MVC.Model.ProtectedModel.LoggedModel where 8 | 9 | import Hails.MVC.Model.ProtectedModel 10 | import Hails.MVC.Model.ReactiveModel 11 | import Control.Monad 12 | import Language.Haskell.TH.Syntax 13 | import Language.Haskell.TH.DeriveField 14 | import System.Log.Logger 15 | 16 | class LoggedBasicModel a where 17 | getBMLogName :: a -> String 18 | 19 | class LoggedProtectedModel a where 20 | getLogName :: a -> IO String 21 | getLog :: a -> IO Logger 22 | 23 | instance (Event b, LoggedBasicModel a) => LoggedProtectedModel (ProtectedModel a b) where 24 | 25 | getLogName = (`onReactiveModel` getRMLogName) 26 | where getRMLogName = getBMLogName . basicModel 27 | 28 | getLog = getLogName >=> getLogger 29 | 30 | deriveLogged :: Name -> Q [Dec] 31 | deriveLogged = 32 | deriveField "LoggedBasicModel" "getBMLogName" "logName" 33 | -------------------------------------------------------------------------------- /keera-hails-mvc-solutions-gtk3/src/Hails/MVC/Model/ProtectedModel/NamedModel.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- 3 | -- Copyright : (C) Keera Studios Ltd, 2013 4 | -- License : BSD3 5 | -- Maintainer : support@keera.co.uk 6 | module Hails.MVC.Model.ProtectedModel.NamedModel where 7 | 8 | import Hails.MVC.Model.ProtectedModel 9 | import Hails.MVC.Model.ReactiveModel 10 | import Language.Haskell.TH.Syntax 11 | import Language.Haskell.TH.DeriveField 12 | 13 | class NamedBasicModel a where 14 | getBMName :: a -> String 15 | 16 | class NamedProtectedModel a where 17 | getName :: a -> IO String 18 | 19 | -- class NamedReactiveModel a where 20 | -- getRMName :: a -> String 21 | -- 22 | -- instance NamedBasicModel a => NamedReactiveModel (ReactiveModel a) where 23 | -- getRMName = getBMName . basicModel 24 | 25 | instance (Event b, NamedBasicModel a) => NamedProtectedModel (ProtectedModel a b) where 26 | getName = (`onReactiveModel` getRMName) 27 | where getRMName = getBMName . basicModel 28 | 29 | deriveNamed :: Name -> Q [Dec] 30 | deriveNamed = 31 | deriveField "NamedBasicModel" "getBMName" "name" 32 | -------------------------------------------------------------------------------- /keera-hails-mvc-solutions-gtk3/src/Hails/MVC/Model/ProtectedModel/UpdatableModel.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleInstances #-} 2 | -- | 3 | -- 4 | -- Copyright : (C) Keera Studios Ltd, 2013 5 | -- License : BSD3 6 | -- Maintainer : support@keera.co.uk 7 | module Hails.MVC.Model.ProtectedModel.UpdatableModel where 8 | 9 | import Hails.MVC.Model.ReactiveModel 10 | import Hails.MVC.Model.ProtectedModel 11 | 12 | import Data.ExtraVersion 13 | 14 | import Hails.MVC.Model.ProtectedModel.VersionedModel 15 | 16 | class VersionedBasicModel a => UpdatableBasicModel a where 17 | getBMUpdateURI :: a -> String 18 | getBMMaxVersionAvail :: a -> Maybe Version 19 | setBMMaxVersionAvail :: a -> Version -> a 20 | 21 | class VersionedProtectedModel a => UpdatableProtectedModel a where 22 | getUpdateURI :: a -> IO String 23 | getMaxVersionAvail :: a -> IO (Maybe Version) 24 | setMaxVersionAvail :: a -> Version -> IO () 25 | 26 | class Event a => UpdateNotifiableEvent a where 27 | updateNotificationEvent :: a 28 | 29 | instance (UpdatableBasicModel a, UpdateNotifiableEvent b) => UpdatableProtectedModel (ProtectedModel a b) where 30 | getUpdateURI = (`onReactiveModel` getRMUpdateURI) 31 | where getRMUpdateURI = getBMUpdateURI . basicModel 32 | getMaxVersionAvail = (`onReactiveModel` getRMMaxVersionAvail) 33 | where getRMMaxVersionAvail = getBMMaxVersionAvail . basicModel 34 | setMaxVersionAvail pm v = pm `applyToReactiveModel` setRMMaxVersionAvail 35 | where setRMMaxVersionAvail rm = let rm' = rm `onBasicModel` (`setBMMaxVersionAvail` v) 36 | in triggerEvent rm' updateNotificationEvent 37 | -------------------------------------------------------------------------------- /keera-hails-mvc-solutions-gtk3/src/Hails/MVC/Model/ProtectedModel/VersionedModel.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- 3 | -- Copyright : (C) Keera Studios Ltd, 2013 4 | -- License : BSD3 5 | -- Maintainer : support@keera.co.uk 6 | module Hails.MVC.Model.ProtectedModel.VersionedModel where 7 | 8 | import Data.ExtraVersion 9 | 10 | import Hails.MVC.Model.ProtectedModel 11 | import Hails.MVC.Model.ReactiveModel 12 | import Language.Haskell.TH.Syntax 13 | import Language.Haskell.TH.DeriveField 14 | 15 | class VersionedBasicModel a where 16 | getBMVersion :: a -> Version 17 | 18 | class VersionedProtectedModel a where 19 | getVersion :: a -> IO Version 20 | 21 | -- class VersionedReactiveModel a where 22 | -- getRMVersion :: a -> String 23 | -- 24 | -- instance VersionedBasicModel a => VersionedReactiveModel (ReactiveModel a) where 25 | -- getRMVersion = getBMVersion . basicModel 26 | 27 | instance (Event b, VersionedBasicModel a) => VersionedProtectedModel (ProtectedModel a b) where 28 | getVersion = (`onReactiveModel` getRMVersion) 29 | where getRMVersion = getBMVersion . basicModel 30 | 31 | deriveVersioned :: Name -> Q [Dec] 32 | deriveVersioned = 33 | deriveField "VersionedBasicModel" "getBMVersion" "version" 34 | -------------------------------------------------------------------------------- /keera-hails-mvc-solutions-gtk3/tests/HLint.hs: -------------------------------------------------------------------------------- 1 | import "hint" HLint.HLint 2 | 3 | -------------------------------------------------------------------------------- /keera-hails-mvc-view-gtk/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2013-2020, Keera Studios Ltd 2 | Copyright (c) 2010-2012, Ivan Perez 3 | 4 | All rights reserved. 5 | 6 | Redistribution and use in source and binary forms, with or without 7 | modification, are permitted provided that the following conditions are met: 8 | 9 | * Redistributions of source code must retain the above copyright 10 | notice, this list of conditions and the following disclaimer. 11 | 12 | * Redistributions in binary form must reproduce the above 13 | copyright notice, this list of conditions and the following 14 | disclaimer in the documentation and/or other materials provided 15 | with the distribution. 16 | 17 | * Neither the name of Ivan Perez, nor the name of Keera Studios, nor the 18 | names of other contributors may be used to endorse or promote products 19 | derived from this software without specific prior written permission. 20 | 21 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 22 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 23 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 24 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 25 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 26 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 27 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 28 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 29 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 30 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 31 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 32 | -------------------------------------------------------------------------------- /keera-hails-mvc-view-gtk/README.md: -------------------------------------------------------------------------------- 1 | MVC applications are structured as a model, a view and a controller. 2 | 3 | This package contains a Gtk+ implementation of keera-hails-mvc-view, an abstract 4 | interface for views in MVC applications. Keera Hails Views can be seen as 5 | collections of Reactive Values, which is sufficient to specify controller 6 | reactive rules and connections to the model in a GUI-agnostic way. 7 | 8 | For more details, see: 9 | https://github.com/keera-studios/keera-hails 10 | https://github.com/keera-studios/hails-mvc-view 11 | -------------------------------------------------------------------------------- /keera-hails-mvc-view-gtk/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /keera-hails-mvc-view-gtk/src/Hails/MVC/View/DefaultViewGtk.hs: -------------------------------------------------------------------------------- 1 | -- | Contains a basic UI definition 2 | -- 3 | -- Copyright : (C) Keera Studios Ltd, 2013 4 | -- License : BSD3 5 | -- Maintainer : support@keera.co.uk 6 | module Hails.MVC.View.DefaultViewGtk where 7 | 8 | -- External libraries 9 | import Graphics.UI.Gtk 10 | 11 | import Hails.MVC.View.GladeView 12 | 13 | -- | This datatype should hold the elements that we must track in the 14 | -- future (for instance, treeview models) 15 | data View = View 16 | { uiBuilder :: Builder } 17 | 18 | instance GladeView View where 19 | ui = uiBuilder 20 | -------------------------------------------------------------------------------- /keera-hails-mvc-view-gtk/src/Hails/MVC/View/GladeView.hs: -------------------------------------------------------------------------------- 1 | -- | The environment that contains both the view and the model. 2 | -- 3 | -- Copyright : (C) Keera Studios Ltd, 2013 4 | -- License : BSD3 5 | -- Maintainer : support@keera.co.uk 6 | module Hails.MVC.View.GladeView where 7 | 8 | -- Internal libraries 9 | import Graphics.UI.Gtk.Builder 10 | 11 | class GladeView a where 12 | ui :: a -> Builder 13 | -------------------------------------------------------------------------------- /keera-hails-mvc-view-gtk/src/Hails/MVC/View/Gtk/Builder.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- 3 | -- Copyright : (C) Keera Studios Ltd, 2013 4 | -- License : BSD3 5 | -- Maintainer : support@keera.co.uk 6 | module Hails.MVC.View.Gtk.Builder 7 | (loadDefaultInterface) 8 | where 9 | 10 | import Graphics.UI.Gtk 11 | import Graphics.UI.Gtk.Extra.Builder 12 | 13 | -- | Returns a builder from which the objects in this part of the interface 14 | -- can be accessed. 15 | loadDefaultInterface :: (String -> IO String) -> IO Builder 16 | loadDefaultInterface getDataFileName = 17 | loadInterface =<< getDataFileName "Interface.glade" 18 | 19 | -------------------------------------------------------------------------------- /keera-hails-mvc-view-gtk/src/Hails/MVC/View/GtkView.hs: -------------------------------------------------------------------------------- 1 | -- | Implements the generic view class for the Gtk GUI manager. 2 | -- 3 | -- Copyright : (C) Keera Studios Ltd, 2013 4 | -- License : BSD3 5 | -- Maintainer : support@keera.co.uk 6 | module Hails.MVC.View.GtkView where 7 | 8 | import Graphics.UI.Gtk 9 | import Hails.MVC.View 10 | 11 | -- | A GtkGUI is a collection of elements that may be initialised We use this 12 | -- class to make the Instantiation of View simpler. 13 | class GtkGUI a where 14 | initialise :: IO a 15 | 16 | -- | A GtkView simply encapsulates a GtkGUI. 17 | data GtkGUI a => GtkView a = GtkView a 18 | 19 | -- | Extracts the GUI from a GtkView 20 | getGUI :: GtkGUI a => GtkView a -> a 21 | getGUI (GtkView x) = x 22 | 23 | -- | Instantiates the generic View for Gtk views using the default GtkGUI 24 | -- initialiser and the default Gtk counterparts of the View class functions. 25 | instance GtkGUI a => View (GtkView a) where 26 | initView _ = initGUI >> return () 27 | createView = initialise >>= (return . GtkView) 28 | startView _ = mainGUI 29 | onViewSync _ = postGUISync 30 | onViewAsync _ = postGUIAsync 31 | destroyView _ = mainQuit 32 | -------------------------------------------------------------------------------- /keera-hails-mvc-view-gtk/src/Hails/MVC/View/GtkView.hs.fixed: -------------------------------------------------------------------------------- 1 | -- | Contains basic operations related to the GUI 2 | module Hails.MVC.View.GtkView where 3 | 4 | -- External libraries 5 | import Control.Monad 6 | import Graphics.UI.Gtk 7 | -- import Graphics.UI.Gtk.GtkView (GtkGUI(..)) 8 | -- import qualified Graphics.UI.Gtk.GtkView as GtkView 9 | -- import Language.Haskell.TH 10 | 11 | -- | Initialises the GUI. This must be called before 12 | -- any other GUI operation. 13 | initView :: IO () 14 | initView = void initGUI 15 | 16 | -- | Starts a thread for the view. 17 | startView :: IO () 18 | startView = mainGUI 19 | 20 | -- | Executes an operation on the view thread synchronously 21 | onViewSync :: IO a -> IO a 22 | onViewSync = postGUISync 23 | 24 | -- | Executes an operation on the view thread asynchronously 25 | onViewAsync :: IO () -> IO () 26 | onViewAsync = postGUIAsync 27 | 28 | -- | Destroys the view thread 29 | destroyView :: IO () 30 | destroyView = mainQuit -------------------------------------------------------------------------------- /keera-hails-mvc-view-gtk/tests/HLint.hs: -------------------------------------------------------------------------------- 1 | import "hint" HLint.HLint 2 | 3 | -------------------------------------------------------------------------------- /keera-hails-mvc-view-gtk/tests/HLintMain.hs: -------------------------------------------------------------------------------- 1 | ----------------------------------------------------------------------------- 2 | -- | 3 | -- Module : Main (hlint) 4 | -- Copyright : (C) 2013 Edward Kmett 5 | -- License : BSD-style (see the file LICENSE) 6 | -- Maintainer : Edward Kmett 7 | -- Stability : provisional 8 | -- Portability : portable 9 | -- 10 | -- This module runs HLint on the lens source tree. 11 | ----------------------------------------------------------------------------- 12 | module Main where 13 | 14 | import Control.Monad 15 | import Language.Haskell.HLint 16 | import System.Environment 17 | import System.Exit 18 | 19 | main :: IO () 20 | main = do 21 | args <- getArgs 22 | hints <- hlint $ ["src", "--cross", "--hint=tests/HLint.hs" ] ++ args 23 | unless (null hints) exitFailure 24 | -------------------------------------------------------------------------------- /keera-hails-mvc-view-gtk3/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2013-2020, Keera Studios Ltd 2 | Copyright (c) 2010-2012, Ivan Perez 3 | 4 | All rights reserved. 5 | 6 | Redistribution and use in source and binary forms, with or without 7 | modification, are permitted provided that the following conditions are met: 8 | 9 | * Redistributions of source code must retain the above copyright 10 | notice, this list of conditions and the following disclaimer. 11 | 12 | * Redistributions in binary form must reproduce the above 13 | copyright notice, this list of conditions and the following 14 | disclaimer in the documentation and/or other materials provided 15 | with the distribution. 16 | 17 | * Neither the name of Ivan Perez, nor the name of Keera Studios, nor the 18 | names of other contributors may be used to endorse or promote products 19 | derived from this software without specific prior written permission. 20 | 21 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 22 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 23 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 24 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 25 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 26 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 27 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 28 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 29 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 30 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 31 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 32 | -------------------------------------------------------------------------------- /keera-hails-mvc-view-gtk3/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /keera-hails-mvc-view-gtk3/src/Hails/MVC/View/DefaultViewGtk.hs: -------------------------------------------------------------------------------- 1 | -- | Contains a basic UI definition 2 | -- 3 | -- Copyright : (C) Keera Studios Ltd, 2013 4 | -- License : BSD3 5 | -- Maintainer : support@keera.co.uk 6 | module Hails.MVC.View.DefaultViewGtk where 7 | 8 | -- External libraries 9 | import Graphics.UI.Gtk 10 | 11 | import Hails.MVC.View.GladeView 12 | 13 | -- | This datatype should hold the elements that we must track in the 14 | -- future (for instance, treeview models) 15 | data View = View 16 | { uiBuilder :: Builder } 17 | 18 | instance GladeView View where 19 | ui = uiBuilder 20 | -------------------------------------------------------------------------------- /keera-hails-mvc-view-gtk3/src/Hails/MVC/View/GladeView.hs: -------------------------------------------------------------------------------- 1 | -- | The environment that contains both the view and the model. 2 | -- 3 | -- Copyright : (C) Keera Studios Ltd, 2013 4 | -- License : BSD3 5 | -- Maintainer : support@keera.co.uk 6 | module Hails.MVC.View.GladeView where 7 | 8 | -- Internal libraries 9 | import Graphics.UI.Gtk.Builder 10 | 11 | class GladeView a where 12 | ui :: a -> Builder 13 | -------------------------------------------------------------------------------- /keera-hails-mvc-view-gtk3/src/Hails/MVC/View/Gtk/Builder.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- 3 | -- Copyright : (C) Keera Studios Ltd, 2013 4 | -- License : BSD3 5 | -- Maintainer : support@keera.co.uk 6 | module Hails.MVC.View.Gtk.Builder 7 | (loadDefaultInterface) 8 | where 9 | 10 | import Graphics.UI.Gtk 11 | import Graphics.UI.Gtk.Extra.Builder 12 | 13 | -- | Returns a builder from which the objects in this part of the interface 14 | -- can be accessed. 15 | loadDefaultInterface :: (String -> IO String) -> IO Builder 16 | loadDefaultInterface getDataFileName = 17 | loadInterface =<< getDataFileName "Interface.glade" 18 | 19 | -------------------------------------------------------------------------------- /keera-hails-mvc-view-gtk3/src/Hails/MVC/View/GtkView.hs: -------------------------------------------------------------------------------- 1 | -- | Implements the generic view class for the Gtk GUI manager. 2 | -- 3 | -- Copyright : (C) Keera Studios Ltd, 2013 4 | -- License : BSD3 5 | -- Maintainer : support@keera.co.uk 6 | module Hails.MVC.View.GtkView where 7 | 8 | import Graphics.UI.Gtk 9 | import Hails.MVC.View 10 | 11 | -- | A GtkGUI is a collection of elements that may be initialised We use this 12 | -- class to make the Instantiation of View simpler. 13 | class GtkGUI a where 14 | initialise :: IO a 15 | 16 | -- | A GtkView simply encapsulates a GtkGUI. 17 | data GtkGUI a => GtkView a = GtkView a 18 | 19 | -- | Extracts the GUI from a GtkView 20 | getGUI :: GtkGUI a => GtkView a -> a 21 | getGUI (GtkView x) = x 22 | 23 | -- | Instantiates the generic View for Gtk views using the default GtkGUI 24 | -- initialiser and the default Gtk counterparts of the View class functions. 25 | instance GtkGUI a => View (GtkView a) where 26 | initView _ = initGUI >> return () 27 | createView = initialise >>= (return . GtkView) 28 | startView _ = mainGUI 29 | onViewSync _ = postGUISync 30 | onViewAsync _ = postGUIAsync 31 | destroyView _ = mainQuit 32 | -------------------------------------------------------------------------------- /keera-hails-mvc-view-gtk3/src/Hails/MVC/View/GtkView.hs.fixed: -------------------------------------------------------------------------------- 1 | -- | Contains basic operations related to the GUI 2 | module Hails.MVC.View.GtkView where 3 | 4 | -- External libraries 5 | import Control.Monad 6 | import Graphics.UI.Gtk 7 | -- import Graphics.UI.Gtk.GtkView (GtkGUI(..)) 8 | -- import qualified Graphics.UI.Gtk.GtkView as GtkView 9 | -- import Language.Haskell.TH 10 | 11 | -- | Initialises the GUI. This must be called before 12 | -- any other GUI operation. 13 | initView :: IO () 14 | initView = void initGUI 15 | 16 | -- | Starts a thread for the view. 17 | startView :: IO () 18 | startView = mainGUI 19 | 20 | -- | Executes an operation on the view thread synchronously 21 | onViewSync :: IO a -> IO a 22 | onViewSync = postGUISync 23 | 24 | -- | Executes an operation on the view thread asynchronously 25 | onViewAsync :: IO () -> IO () 26 | onViewAsync = postGUIAsync 27 | 28 | -- | Destroys the view thread 29 | destroyView :: IO () 30 | destroyView = mainQuit -------------------------------------------------------------------------------- /keera-hails-mvc-view-gtk3/tests/HLint.hs: -------------------------------------------------------------------------------- 1 | import "hint" HLint.HLint 2 | 3 | -------------------------------------------------------------------------------- /keera-hails-mvc-view/CHANGELOG: -------------------------------------------------------------------------------- 1 | 2022-04-05 Alexander Pavlenko 2 | 3 | * keera-hails-mvc-view.cabal: Add constraints on dependency on base. 4 | Version bump (0.8.0). Conform to new style guide. Add missing 5 | description. 6 | 7 | 2020-08-13 Alexander Pavlenko 8 | 9 | * CHANGELOG: Fix typo in 2020-05-27 entry. 10 | * keera-hails-mvc-view.cabal: Cleaning. Version bump (0.7.0). 11 | 12 | 2020-05-27 Alexander Pavlenko 13 | 14 | * keera-hails-mvc-view.cabal: Version bump (0.6.0). 15 | 16 | 2014-06-04 Ivan Perez 17 | 18 | * Adds project to hudson-backed continuous integration server. 19 | -------------------------------------------------------------------------------- /keera-hails-mvc-view/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2013-2020, Keera Studios Ltd 2 | Copyright (c) 2010-2012, Ivan Perez 3 | 4 | All rights reserved. 5 | 6 | Redistribution and use in source and binary forms, with or without 7 | modification, are permitted provided that the following conditions are met: 8 | 9 | * Redistributions of source code must retain the above copyright 10 | notice, this list of conditions and the following disclaimer. 11 | 12 | * Redistributions in binary form must reproduce the above 13 | copyright notice, this list of conditions and the following 14 | disclaimer in the documentation and/or other materials provided 15 | with the distribution. 16 | 17 | * Neither the name of Ivan Perez, nor the name of Keera Studios, nor the 18 | names of other contributors may be used to endorse or promote products 19 | derived from this software without specific prior written permission. 20 | 21 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 22 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 23 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 24 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 25 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 26 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 27 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 28 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 29 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 30 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 31 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 32 | -------------------------------------------------------------------------------- /keera-hails-mvc-view/README.md: -------------------------------------------------------------------------------- 1 | MVC applications are structured as a model, a view and a controller. 2 | 3 | This package contains a basic interface for views that is agnostic with respect 4 | to the backend. It should allow creating complete programs in which the controller 5 | and the model are fully GUI independent. 6 | 7 | GUIs can be seen as collections of Reactive Values, which is sufficient to specify 8 | controller reactive rules and connections to the model in a GUI-agnostic way. 9 | 10 | For more details, see: 11 | https://github.com/keera-studios/keera-hails 12 | 13 | For an implementation of this interface with a specific backend, see: 14 | https://github.com/keera-studios/hails-mvc-view-gtk 15 | -------------------------------------------------------------------------------- /keera-hails-mvc-view/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /keera-hails-mvc-view/tests/HLint.hs: -------------------------------------------------------------------------------- 1 | import "hint" HLint.HLint 2 | 3 | -------------------------------------------------------------------------------- /keera-hails-mvc-view/tests/HLintMain.hs: -------------------------------------------------------------------------------- 1 | ----------------------------------------------------------------------------- 2 | -- | 3 | -- Module : Main (hlint) 4 | -- Copyright : (C) 2013 Edward Kmett 5 | -- License : BSD-style (see the file LICENSE) 6 | -- Maintainer : Edward Kmett 7 | -- Stability : provisional 8 | -- Portability : portable 9 | -- 10 | -- This module runs HLint on the lens source tree. 11 | ----------------------------------------------------------------------------- 12 | module Main where 13 | 14 | import Control.Monad 15 | import Language.Haskell.HLint 16 | import System.Environment 17 | import System.Exit 18 | 19 | main :: IO () 20 | main = do 21 | args <- getArgs 22 | hints <- hlint $ ["src", "--cross", "--hint=tests/HLint.hs" ] ++ args 23 | unless (null hints) exitFailure 24 | -------------------------------------------------------------------------------- /keera-hails-reactive-cbmvar/README.md: -------------------------------------------------------------------------------- 1 | This library contains functions to make mutable variables (MVars) with 2 | callbacks into reactive values (RVs) that can be connected to other RVs and 3 | propagate changes. 4 | 5 | See also: 6 | - http://github.com/keera-studios/keera-hails 7 | - http://github.com/keera-studios/keera-callbacks 8 | -------------------------------------------------------------------------------- /keera-hails-reactive-cbmvar/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /keera-hails-reactive-cbmvar/src/Data/CBMVar/Reactive.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- Copyright : (C) Keera Studios Ltd, 2013 3 | -- License : BSD3 4 | -- Maintainer : support@keera.co.uk 5 | -- 6 | -- MVars as Reactive Values. 7 | -- 8 | -- CBMVars are MVars enriched with a notion of callbacks that are 9 | -- executed when the value in the MVar is altered. 10 | -- 11 | -- This module wraps CBMVars into reactive values, making it easy 12 | -- to use them as models of reactive applications. 13 | module Data.CBMVar.Reactive where 14 | 15 | import Data.CBMVar (CBMVar, installCallbackCBMVar, readCBMVar, 16 | writeCBMVar) 17 | import Data.ReactiveValue (ReactiveFieldRead(..), ReactiveFieldReadWrite(..)) 18 | 19 | -- | Return a read-only reactive value wrapping a CBMVar. 20 | cbmvarReactiveRO :: CBMVar a -> ReactiveFieldRead IO a 21 | cbmvarReactiveRO mvar = ReactiveFieldRead getter notifier 22 | where 23 | getter = readCBMVar mvar 24 | notifier n = installCallbackCBMVar mvar n 25 | 26 | -- | Return a read-write reactive value wrapping a CBMVar. 27 | cbmvarReactiveRW :: CBMVar a -> ReactiveFieldReadWrite IO a 28 | cbmvarReactiveRW mvar = ReactiveFieldReadWrite setter getter notifier 29 | where 30 | setter = writeCBMVar mvar 31 | getter = readCBMVar mvar 32 | notifier n = installCallbackCBMVar mvar n 33 | -------------------------------------------------------------------------------- /keera-hails-reactive-cbmvar/tests/HLintMain.hs: -------------------------------------------------------------------------------- 1 | ----------------------------------------------------------------------------- 2 | -- | 3 | -- Module : Main (hlint) 4 | -- Copyright : (C) 2013 Edward Kmett 5 | -- License : BSD-style (see the file LICENSE) 6 | -- Maintainer : Edward Kmett 7 | -- Stability : provisional 8 | -- Portability : portable 9 | -- 10 | -- This module runs HLint on the lens source tree. 11 | ----------------------------------------------------------------------------- 12 | module Main where 13 | 14 | import Control.Monad 15 | import Language.Haskell.HLint 16 | import System.Environment 17 | import System.Exit 18 | 19 | main :: IO () 20 | main = do 21 | args <- getArgs 22 | hints <- hlint $ ["src", "--cross", "--hint=tests/hlint.yaml" ] ++ args 23 | unless (null hints) exitFailure 24 | -------------------------------------------------------------------------------- /keera-hails-reactive-cbmvar/tests/hlint.yaml: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/keera-studios/keera-hails/dd88d71705524738f3f7a1800a30c723801e2dea/keera-hails-reactive-cbmvar/tests/hlint.yaml -------------------------------------------------------------------------------- /keera-hails-reactive-fs/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2013-2020, Keera Studios Ltd 2 | Copyright (c) 2010-2012, Ivan Perez 3 | 4 | All rights reserved. 5 | 6 | Redistribution and use in source and binary forms, with or without 7 | modification, are permitted provided that the following conditions are met: 8 | 9 | * Redistributions of source code must retain the above copyright 10 | notice, this list of conditions and the following disclaimer. 11 | 12 | * Redistributions in binary form must reproduce the above 13 | copyright notice, this list of conditions and the following 14 | disclaimer in the documentation and/or other materials provided 15 | with the distribution. 16 | 17 | * Neither the name of Ivan Perez, nor the name of Keera Studios, nor the 18 | names of other contributors may be used to endorse or promote products 19 | derived from this software without specific prior written permission. 20 | 21 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 22 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 23 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 24 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 25 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 26 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 27 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 28 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 29 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 30 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 31 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 32 | -------------------------------------------------------------------------------- /keera-hails-reactive-fs/README.md: -------------------------------------------------------------------------------- 1 | This library includes functions to turn a file into a reactive value. 2 | 3 | There are two functions: one to create a reactive value (one that notifies of 4 | changes to the file, regardless of their origin) and one to create a passive 5 | (reactive) value (one that acts as a source/sink, but whose changes are not 6 | notified). The latter is useful as a destination of information, for instance, 7 | or as a source when combined with a reactive value (see governance in Hails). 8 | 9 | This code is part of Keera Hails (a Haskell on (Gtk+) rails library). 10 | 11 | Find out more at: http://github.com/keera-studios/hails-reactivevalues 12 | -------------------------------------------------------------------------------- /keera-hails-reactive-fs/tests/HLint.hs: -------------------------------------------------------------------------------- 1 | import "hint" HLint.HLint 2 | 3 | -------------------------------------------------------------------------------- /keera-hails-reactive-fs/tests/HLintMain.hs: -------------------------------------------------------------------------------- 1 | ----------------------------------------------------------------------------- 2 | -- | 3 | -- Module : Main (hlint) 4 | -- Copyright : (C) 2013 Edward Kmett 5 | -- License : BSD-style (see the file LICENSE) 6 | -- Maintainer : Edward Kmett 7 | -- Stability : provisional 8 | -- Portability : portable 9 | -- 10 | -- This module runs HLint on the lens source tree. 11 | ----------------------------------------------------------------------------- 12 | module Main where 13 | 14 | import Control.Monad 15 | import Language.Haskell.HLint 16 | import System.Environment 17 | import System.Exit 18 | 19 | main :: IO () 20 | main = do 21 | args <- getArgs 22 | hints <- hlint $ ["src", "--cross", "--hint=tests/HLint.hs" ] ++ args 23 | unless (null hints) exitFailure 24 | -------------------------------------------------------------------------------- /keera-hails-reactive-gtk/CHANGELOG: -------------------------------------------------------------------------------- 1 | 2022-04-05 Alexander Pavlenko 2 | 3 | * keera-hails-reactive-gtk.cabal: Add constraints on dependency on base. 4 | Version bump (0.8.0). Conform to new style guide. 5 | * src/Graphics/UI/Gtk/Reactive/Property.hs: Avoid name shadowing. 6 | 7 | 2020-05-27 Alexander Pavlenko 8 | 9 | * CHANGELOG: Fix typo in 2020-05-27 entry. 10 | * keera-hails-reactive-gtk.cabal: Cleaning. Version bump (0.7.0). 11 | 12 | 2020-05-27 Alexander Pavlenko 13 | 14 | * keera-hails-reactive-gtk.cabal: Version bump (0.6.0). 15 | 16 | 2019-07-25 Alexander Pavlenko 17 | 18 | * hails-reactive-gtk.cabal: version bump (0.5) 19 | * src/Graphics/UI/Gtk/Reactive/Gtk2.hs: Add missing constraint. 20 | 21 | 2019-07-25 Alexander Pavlenko 22 | 23 | * hails-reactive-gtk.cabal: version bump (0.4) 24 | * src/Graphics/UI/Gtk/Reactive/Gtk2.hs: Hide definitions unavailable on Mac 25 | 26 | 2015-08-20 Ivan Perez 27 | 28 | * hails-reactive-gtk.cabal: version bump (0.3) 29 | * src/Graphics/UI/Gtk/Reactive.hs: export more submodules 30 | * src/Graphics/UI/Gtk/Reactive/Gtk2.hs: Bindings for 2072 reactive symbols. 31 | * src/Graphics/UI/Gtk/Reactive/Property.hs: adds new generic binding functions. 32 | 33 | 2015-06-18 Ivan Perez 34 | 35 | * hails-reactive-gtk.cabal: version bump (0.0.3.6) 36 | * src/Graphics/UI/Gtk/Reactive/Window.hs: Fixes bug. 37 | 38 | 2015-05-05 Ivan Perez 39 | 40 | * src/: Makes entry behave like text RV by default. 41 | * hails-reactive-gtk.cabal: version bump (0.0.3.4) 42 | -------------------------------------------------------------------------------- /keera-hails-reactive-gtk/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2013-2020, Keera Studios Ltd 2 | Copyright (c) 2010-2012, Ivan Perez 3 | 4 | All rights reserved. 5 | 6 | Redistribution and use in source and binary forms, with or without 7 | modification, are permitted provided that the following conditions are met: 8 | 9 | * Redistributions of source code must retain the above copyright 10 | notice, this list of conditions and the following disclaimer. 11 | 12 | * Redistributions in binary form must reproduce the above 13 | copyright notice, this list of conditions and the following 14 | disclaimer in the documentation and/or other materials provided 15 | with the distribution. 16 | 17 | * Neither the name of Ivan Perez, nor the name of Keera Studios, nor the 18 | names of other contributors may be used to endorse or promote products 19 | derived from this software without specific prior written permission. 20 | 21 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 22 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 23 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 24 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 25 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 26 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 27 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 28 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 29 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 30 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 31 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 32 | -------------------------------------------------------------------------------- /keera-hails-reactive-gtk/README.md: -------------------------------------------------------------------------------- 1 | Keera Hails is a collection of libraries to create MVC and reactive 2 | applications. 3 | 4 | This package contains bindings to make Gtk widgets reactive so that they can be 5 | connected to other reactive elements using Reactive Rules. 6 | 7 | For more details, see: https://github.com/keera-studios/keera-hails. 8 | 9 | The Haskell bindings to Gtk2 export 4560 functions (A little over 5000 symbols 10 | with types included). Of them, there are 2691 define interactive signals, 11 | attributes and/or event-handler installers. They are split as follows: 12 | 13 | | Element | Amount | 14 | |:--------------------------------|---------:| 15 | | Signals | 228 | 16 | | Event handler installers | 304 | 17 | | *Total signal/event handlers* | *532* | 18 | | Attributes | 677 | 19 | | Getters | 864 | 20 | | Setters | 628 | 21 | | *Total attribute access funcs.* | *2169* | 22 | | **Total** | **2691** | 23 | 24 | To simplify the explanation, we consider getters/setters to give access to 25 | underlying attributes, and signals to be equivalent to event-handler 26 | installers. 27 | 28 | Keera Hails, and this package in particular, provide both reactive bindings to 29 | specific Attribute-Signal combinations and a general API to connect to any 30 | signal-attribute pair (or, optionally, just a signal or just an attribute). 31 | This makes the most important part of the GTK+ interface (more than half the 32 | full API), available to reactive applications. 33 | -------------------------------------------------------------------------------- /keera-hails-reactive-gtk/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /keera-hails-reactive-gtk/src/Graphics/UI/Gtk/Reactive.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- 3 | -- Copyright : (C) Keera Studios Ltd, 2013 4 | -- License : BSD3 5 | -- Maintainer : support@keera.co.uk 6 | module Graphics.UI.Gtk.Reactive 7 | (module Exported) 8 | where 9 | 10 | import Graphics.UI.Gtk.Reactive.ColorButton as Exported 11 | import Graphics.UI.Gtk.Reactive.Button as Exported 12 | import Graphics.UI.Gtk.Reactive.Entry as Exported 13 | import Graphics.UI.Gtk.Reactive.CheckMenuItem as Exported 14 | import Graphics.UI.Gtk.Reactive.Image as Exported 15 | import Graphics.UI.Gtk.Reactive.Label as Exported 16 | import Graphics.UI.Gtk.Reactive.MenuItem as Exported 17 | import Graphics.UI.Gtk.Reactive.Scale as Exported 18 | import Graphics.UI.Gtk.Reactive.SpinButton as Exported 19 | import Graphics.UI.Gtk.Reactive.StatusIcon as Exported 20 | import Graphics.UI.Gtk.Reactive.TextView as Exported 21 | import Graphics.UI.Gtk.Reactive.ToolButton as Exported 22 | import Graphics.UI.Gtk.Reactive.ToggleButton as Exported 23 | import Graphics.UI.Gtk.Reactive.TreeView as Exported 24 | import Graphics.UI.Gtk.Reactive.Widget as Exported 25 | import Graphics.UI.Gtk.Reactive.Window as Exported 26 | -- import Graphics.UI.Gtk.Reactive.TypedComboBoxUnsafe as Exported 27 | -------------------------------------------------------------------------------- /keera-hails-reactive-gtk/src/Graphics/UI/Gtk/Reactive/Button.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE MultiParamTypeClasses #-} 2 | -- | Publishes the main elements of a menuitem 3 | -- 4 | -- Copyright : (C) Keera Studios Ltd, 2013 5 | -- License : BSD3 6 | -- Maintainer : support@keera.co.uk 7 | module Graphics.UI.Gtk.Reactive.Button where 8 | 9 | import Control.Monad 10 | import Graphics.UI.Gtk 11 | import Data.ReactiveValue 12 | 13 | buttonActivateField :: Button -> ReactiveFieldActivatable IO 14 | buttonActivateField b = mkActivatable op 15 | where op f = void (b `onClicked` f) 16 | 17 | instance ReactiveValueActivatable IO Button where 18 | defaultActivation = buttonActivateField 19 | -------------------------------------------------------------------------------- /keera-hails-reactive-gtk/src/Graphics/UI/Gtk/Reactive/CheckMenuItem.hs: -------------------------------------------------------------------------------- 1 | -- | Publishes the main elements of a checkmenuitem 2 | -- 3 | -- Copyright : (C) Keera Studios Ltd, 2013 4 | -- License : BSD3 5 | -- Maintainer : support@keera.co.uk 6 | module Graphics.UI.Gtk.Reactive.CheckMenuItem where 7 | 8 | import Control.Monad 9 | import Graphics.UI.Gtk 10 | import Data.ReactiveValue 11 | 12 | checkMenuItemActiveReactive :: CheckMenuItem -> ReactiveFieldReadWrite IO Bool 13 | checkMenuItemActiveReactive e = ReactiveFieldReadWrite setter getter notifier 14 | where getter = checkMenuItemGetActive e 15 | setter = checkMenuItemSetActive e 16 | notifier = void . (on e checkMenuItemToggled) 17 | -------------------------------------------------------------------------------- /keera-hails-reactive-gtk/src/Graphics/UI/Gtk/Reactive/Entry.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TypeSynonymInstances #-} 2 | {-# LANGUAGE FlexibleInstances #-} 3 | {-# LANGUAGE MultiParamTypeClasses #-} 4 | -- | Publishes the main elements of an entry as reactive fields 5 | -- 6 | -- Copyright : (C) Keera Studios Ltd, 2013 7 | -- License : BSD3 8 | -- Maintainer : support@keera.co.uk 9 | module Graphics.UI.Gtk.Reactive.Entry where 10 | 11 | import Data.ReactiveValue 12 | import Graphics.UI.Gtk 13 | import Graphics.UI.Gtk.Reactive.Property 14 | 15 | entryTextReactive :: (EditableClass e, EntryClass e) => e -> ReactiveFieldReadWrite IO String 16 | entryTextReactive e = reactiveProperty e editableChanged entryText 17 | 18 | -- import Control.Monad (void, when) 19 | -- entryTextReactive :: (EditableClass e, EntryClass e) => e -> ReactiveFieldReadWrite IO String 20 | -- entryTextReactive e = ReactiveFieldReadWrite setter getter notifier 21 | -- where getter = get e entryText 22 | -- setter v = postGUIAsync $ do 23 | -- p <- get e entryText 24 | -- when (p /= v) $ set e [entryText := v] 25 | -- notifier p = void (on e editableChanged p) 26 | 27 | instance ReactiveValueReadWrite Entry String IO where 28 | 29 | instance ReactiveValueRead Entry String IO where 30 | reactiveValueOnCanRead = reactiveValueOnCanRead . entryTextReactive 31 | reactiveValueRead = reactiveValueRead . entryTextReactive 32 | 33 | instance ReactiveValueWrite Entry String IO where 34 | reactiveValueWrite = reactiveValueWrite . entryTextReactive 35 | -------------------------------------------------------------------------------- /keera-hails-reactive-gtk/src/Graphics/UI/Gtk/Reactive/Image.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TypeSynonymInstances #-} 2 | {-# LANGUAGE FlexibleInstances #-} 3 | {-# LANGUAGE MultiParamTypeClasses #-} 4 | -- | Publishes the main elements of an entry as reactive fields 5 | -- 6 | -- Copyright : (C) Keera Studios Ltd, 2013 7 | -- License : BSD3 8 | -- Maintainer : support@keera.co.uk 9 | module Graphics.UI.Gtk.Reactive.Image where 10 | 11 | import Data.ReactiveValue 12 | import Graphics.UI.Gtk 13 | import Graphics.UI.Gtk.Reactive.Property 14 | 15 | imageFileReactive :: Image -> ReactiveFieldWrite IO FilePath 16 | imageFileReactive e = ReactiveFieldWrite (imageSetFromFile e) 17 | 18 | instance ReactiveValueWrite Image String IO where 19 | reactiveValueWrite = reactiveValueWrite . imageFileReactive 20 | -------------------------------------------------------------------------------- /keera-hails-reactive-gtk/src/Graphics/UI/Gtk/Reactive/Label.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TypeSynonymInstances #-} 2 | {-# LANGUAGE FlexibleInstances #-} 3 | {-# LANGUAGE MultiParamTypeClasses #-} 4 | -- | Publishes the main elements of an label as reactive fields 5 | -- 6 | -- Copyright : (C) Keera Studios Ltd, 2013 7 | -- License : BSD3 8 | -- Maintainer : support@keera.co.uk 9 | module Graphics.UI.Gtk.Reactive.Label where 10 | 11 | import Data.ReactiveValue 12 | import Graphics.UI.Gtk 13 | import Graphics.UI.Gtk.Reactive.Property 14 | 15 | labelTextReactive :: LabelClass e => e -> ReactiveFieldReadWrite IO String 16 | labelTextReactive e = passiveProperty e labelText 17 | 18 | instance ReactiveValueReadWrite Label String IO where 19 | 20 | instance ReactiveValueRead Label String IO where 21 | reactiveValueOnCanRead = reactiveValueOnCanRead . labelTextReactive 22 | reactiveValueRead = reactiveValueRead . labelTextReactive 23 | 24 | instance ReactiveValueWrite Label String IO where 25 | reactiveValueWrite = reactiveValueWrite . labelTextReactive 26 | -------------------------------------------------------------------------------- /keera-hails-reactive-gtk/src/Graphics/UI/Gtk/Reactive/MenuItem.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE MultiParamTypeClasses #-} 2 | -- | Publishes the main elements of a menuitem 3 | -- 4 | -- Copyright : (C) Keera Studios Ltd, 2013 5 | -- License : BSD3 6 | -- Maintainer : support@keera.co.uk 7 | module Graphics.UI.Gtk.Reactive.MenuItem where 8 | 9 | import Control.Monad 10 | import Control.Monad.Trans(liftIO) 11 | import Graphics.UI.Gtk 12 | import Data.ReactiveValue 13 | 14 | menuItemActivateField :: MenuItem -> ReactiveFieldActivatable IO 15 | menuItemActivateField m = mkActivatable op 16 | where op f = void (m `on` menuItemActivate $ liftIO f) 17 | 18 | instance ReactiveValueActivatable IO MenuItem where 19 | defaultActivation = menuItemActivateField 20 | -------------------------------------------------------------------------------- /keera-hails-reactive-gtk/src/Graphics/UI/Gtk/Reactive/Scale.hs: -------------------------------------------------------------------------------- 1 | -- | Publishes the main elements of a scale as reactive fields 2 | -- 3 | -- Copyright : (C) Keera Studios Ltd, 2013 4 | -- License : BSD3 5 | -- Maintainer : support@keera.co.uk 6 | module Graphics.UI.Gtk.Reactive.Scale where 7 | 8 | import Control.GFunctor 9 | import Data.ReactiveValue 10 | import GHC.Float 11 | import Graphics.UI.Gtk 12 | 13 | import Graphics.UI.Gtk.Reactive.Property 14 | 15 | scaleValueReactive :: RangeClass a => a -> ReactiveFieldReadWrite IO Float 16 | scaleValueReactive e = float_double <$$> reactiveProperty e valueChanged rangeValue 17 | where float_double = bijection (double2Float, float2Double) 18 | 19 | -- ReactiveFieldReadWrite setter getter notifier 20 | -- where getter = fmap double2Float $ get e rangeValue 21 | -- setter v = set e [ rangeValue := float2Double v ] 22 | -- notifier p = void (on e valueChanged p) 23 | -------------------------------------------------------------------------------- /keera-hails-reactive-gtk/src/Graphics/UI/Gtk/Reactive/SpinButton.hs: -------------------------------------------------------------------------------- 1 | -- | Publishes the main elements of a toggle button 2 | -- 3 | -- Copyright : (C) Keera Studios Ltd, 2013 4 | -- License : BSD3 5 | -- Maintainer : support@keera.co.uk 6 | module Graphics.UI.Gtk.Reactive.SpinButton where 7 | 8 | import Control.GFunctor 9 | import Data.ReactiveValue 10 | import Graphics.UI.Gtk 11 | import Graphics.UI.Gtk.Reactive.Property 12 | 13 | spinButtonValueIntReactive :: SpinButton -> ReactiveFieldReadWrite IO Int 14 | spinButtonValueIntReactive e = 15 | double_int <$$> reactivePropertyH e onValueSpinned spinButtonValue 16 | where double_int = bijection (round, fromIntegral) 17 | 18 | spinButtonAdjustmentReactive :: SpinButton -> ReactiveFieldReadWrite IO Adjustment 19 | spinButtonAdjustmentReactive = (`passiveProperty` spinButtonAdjustment) 20 | 21 | spinButtonValueIntEditReactive :: SpinButton -> ReactiveFieldReadWrite IO Int 22 | spinButtonValueIntEditReactive e = 23 | double_int <$$> reactivePropertyH e handler spinButtonValue 24 | where double_int = bijection (round, fromIntegral) 25 | handler = \s i -> do s `onValueSpinned` i 26 | s `onEditableChanged` i 27 | 28 | -- import Control.Monad 29 | -- spinButtonActiveReactive :: SpinButton -> ReactiveFieldReadWrite IO Int 30 | -- spinButtonActiveReactive e = ReactiveFieldReadWrite setter getter notifier 31 | -- where getter = spinButtonGetValueAsInt e 32 | -- setter = spinButtonSetValue e . fromIntegral 33 | -- notifier = void . (onValueSpinned e) 34 | -------------------------------------------------------------------------------- /keera-hails-reactive-gtk/src/Graphics/UI/Gtk/Reactive/StatusIcon.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE MultiParamTypeClasses #-} 2 | -- | Publishes the main elements of a status icon 3 | -- 4 | -- Copyright : (C) Keera Studios Ltd, 2013 5 | -- License : BSD3 6 | -- Maintainer : support@keera.co.uk 7 | module Graphics.UI.Gtk.Reactive.StatusIcon where 8 | 9 | import Control.Monad 10 | import Control.Monad.Trans(liftIO) 11 | import Data.ReactiveValue 12 | import Graphics.UI.Gtk 13 | 14 | statusIconActivateField :: StatusIcon -> ReactiveFieldActivatable IO 15 | statusIconActivateField m = mkActivatable op 16 | where op f = void (m `on` statusIconActivate $ liftIO f) 17 | 18 | instance ReactiveValueActivatable IO StatusIcon where 19 | defaultActivation = statusIconActivateField 20 | 21 | statusIconVisibleReactive :: StatusIcon -> ReactiveFieldReadWrite IO Bool 22 | statusIconVisibleReactive icon = ReactiveFieldReadWrite setter getter notifier 23 | where getter = statusIconGetVisible icon 24 | setter v = postGUIAsync $ do 25 | p <- getter 26 | when (p /= v) $ statusIconSetVisible icon v 27 | notifier _ = return () 28 | -------------------------------------------------------------------------------- /keera-hails-reactive-gtk/src/Graphics/UI/Gtk/Reactive/TextView.hs: -------------------------------------------------------------------------------- 1 | -- | Publishes the main elements of a text view as reactive fields 2 | -- 3 | -- Copyright : (C) Keera Studios Ltd, 2013 4 | -- License : BSD3 5 | -- Maintainer : support@keera.co.uk 6 | module Graphics.UI.Gtk.Reactive.TextView where 7 | 8 | import Control.Monad (void) 9 | import Graphics.UI.Gtk 10 | import Data.ReactiveValue 11 | 12 | textViewTextReactive :: TextView -> ReactiveFieldReadWrite IO String 13 | textViewTextReactive e = ReactiveFieldReadWrite setter getter notifier 14 | where getter = get e textViewBuffer >>= (`get` textBufferText) 15 | setter v = get e textViewBuffer >>= (\b -> set b [textBufferText := v]) 16 | notifier p = get e textViewBuffer >>= (\b -> void (on b bufferChanged p)) 17 | -------------------------------------------------------------------------------- /keera-hails-reactive-gtk/src/Graphics/UI/Gtk/Reactive/ToggleButton.hs: -------------------------------------------------------------------------------- 1 | -- | Publishes the main elements of a toggle button 2 | -- 3 | -- Copyright : (C) Keera Studios Ltd, 2013 4 | -- License : BSD3 5 | -- Maintainer : support@keera.co.uk 6 | module Graphics.UI.Gtk.Reactive.ToggleButton where 7 | 8 | import Control.Monad 9 | import Graphics.UI.Gtk 10 | import Data.ReactiveValue 11 | 12 | toggleButtonActiveReactive :: ToggleButtonClass t => t -> ReactiveFieldReadWrite IO Bool 13 | toggleButtonActiveReactive e = ReactiveFieldReadWrite setter getter notifier 14 | where getter = toggleButtonGetActive e 15 | setter = toggleButtonSetActive e 16 | notifier = void . (on e toggled) 17 | -------------------------------------------------------------------------------- /keera-hails-reactive-gtk/src/Graphics/UI/Gtk/Reactive/ToolButton.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE MultiParamTypeClasses #-} 2 | -- | Publishes the main elements of a menuitem 3 | -- 4 | -- Copyright : (C) Keera Studios Ltd, 2013 5 | -- License : BSD3 6 | -- Maintainer : support@keera.co.uk 7 | module Graphics.UI.Gtk.Reactive.ToolButton where 8 | 9 | import Control.Monad 10 | import Graphics.UI.Gtk 11 | import Data.ReactiveValue 12 | 13 | toolButtonActivateField :: ToolButton -> ReactiveFieldActivatable IO 14 | toolButtonActivateField b = mkActivatable op 15 | where op f = void (b `onToolButtonClicked` f) 16 | 17 | instance ReactiveValueActivatable IO ToolButton where 18 | defaultActivation = toolButtonActivateField 19 | -------------------------------------------------------------------------------- /keera-hails-reactive-gtk/src/Graphics/UI/Gtk/Reactive/TreeView.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- 3 | -- Copyright : (C) Keera Studios Ltd, 2013 4 | -- License : BSD3 5 | -- Maintainer : support@keera.co.uk 6 | module Graphics.UI.Gtk.Reactive.TreeView where 7 | 8 | import Control.Monad.IO.Class (liftIO) 9 | import Control.Monad (void) 10 | import Data.ReactiveValue 11 | import Graphics.UI.Gtk 12 | import Graphics.UI.Gtk.Helpers.TreeView 13 | 14 | -- treeViewSelectedRowsReactive :: TreeView -> ReactiveFieldRead IO [TreePath] 15 | -- treeViewSelectedRowsReactive tv = ReactiveFieldRead getter notifier 16 | -- where getter = treeSelectionGetSelectedRows =<< treeViewGetSelection tv 17 | -- notifier p = void (tv `on` cursorChanged $ liftIO p) 18 | 19 | treeViewSelectedRowsReactive :: TreeView -> ReactiveFieldRead IO [TreePath] 20 | treeViewSelectedRowsReactive tv = ReactiveFieldRead getter notifier 21 | where getter = treeViewGetSelectedPath tv 22 | notifier p = void (tv `on` cursorChanged $ liftIO p) 23 | 24 | treeViewGetSelectedReactive :: TreeView -> ListStore a -> ReactiveFieldRead IO (Maybe a) 25 | treeViewGetSelectedReactive tv ls = ReactiveFieldRead getter notifier 26 | where getter = treeViewGetSelected tv ls 27 | notifier p = void (tv `on` cursorChanged $ liftIO p) 28 | 29 | -------------------------------------------------------------------------------- /keera-hails-reactive-gtk/src/Graphics/UI/Gtk/Reactive/TypedComboBoxUnsafe.hs: -------------------------------------------------------------------------------- 1 | -- | Publishes the main elements of a toggle button 2 | -- 3 | -- Copyright : (C) Keera Studios Ltd, 2013 4 | -- License : BSD3 5 | -- Maintainer : support@keera.co.uk 6 | module Graphics.UI.Gtk.Reactive.TypedComboBoxUnsafe where 7 | 8 | import Control.Monad 9 | import Graphics.UI.Gtk 10 | import Graphics.UI.Gtk.Helpers.Combo 11 | import Data.ReactiveValue 12 | 13 | typedComboBoxUnsafeReactive :: (Eq a) => ListStore a -> ComboBox -> ReactiveFieldReadWrite IO a 14 | typedComboBoxUnsafeReactive ls e = ReactiveFieldReadWrite setter getter notifier 15 | where getter = typedComboBoxGetSelectedUnsafe (e, ls) 16 | setter = typedComboBoxSetSelected (e, ls) 17 | notifier = void . (on e changed) 18 | -------------------------------------------------------------------------------- /keera-hails-reactive-gtk/src/Graphics/UI/Gtk/Reactive/Widget.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- 3 | -- Copyright : (C) Keera Studios Ltd, 2013 4 | -- License : BSD3 5 | -- Maintainer : support@keera.co.uk 6 | module Graphics.UI.Gtk.Reactive.Widget where 7 | 8 | import Control.Monad.IO.Class (liftIO) 9 | import Control.Monad (void, when) 10 | import Data.ReactiveValue 11 | import Graphics.UI.Gtk 12 | 13 | widgetVisibleReactive :: WidgetClass self => self -> ReactiveFieldReadWrite IO Bool 14 | widgetVisibleReactive e = ReactiveFieldReadWrite setter getter notifier 15 | where getter = get e widgetVisible 16 | setter v = postGUIAsync $ do 17 | p <- getter 18 | when (p /= v) $ set e [ widgetVisible := v ] 19 | notifier p = void (e `on` mapEvent $ liftIO p >> return False) 20 | 21 | widgetSensitiveReactive :: WidgetClass self => self -> ReactiveFieldReadWrite IO Bool 22 | widgetSensitiveReactive e = ReactiveFieldReadWrite setter getter notifier 23 | where getter = get e widgetSensitive 24 | setter v = postGUIAsync $ do 25 | p <- getter 26 | when (p /= v) $ set e [ widgetSensitive := v ] 27 | notifier p = void (e `on` mapEvent $ liftIO p >> return False) 28 | -------------------------------------------------------------------------------- /keera-hails-reactive-gtk/src/Graphics/UI/Gtk/Reactive/Window.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- 3 | -- Copyright : (C) Keera Studios Ltd, 2013 4 | -- License : BSD3 5 | -- Maintainer : support@keera.co.uk 6 | module Graphics.UI.Gtk.Reactive.Window where 7 | 8 | import Control.Monad (void, when) 9 | import Control.Monad.IO.Class (liftIO) 10 | import Data.ReactiveValue 11 | import Graphics.UI.Gtk 12 | 13 | windowCloseReactive :: WindowClass self => self -> ReactiveFieldRead IO () 14 | windowCloseReactive self = ReactiveFieldRead getter notifier 15 | where getter = return () 16 | notifier p = void (self `on` deleteEvent $ liftIO p >> return True) 17 | 18 | windowVisibilityPassive :: WindowClass self => self -> ReactiveFieldReadWrite IO Bool 19 | windowVisibilityPassive self = ReactiveFieldReadWrite setter getter (const $ return ()) 20 | where setter x = do x' <- getter 21 | when (x /= x') $ 22 | if x then widgetShowAll self else widgetHide self 23 | getter = get self widgetVisible 24 | -------------------------------------------------------------------------------- /keera-hails-reactive-gtk/tests/HLint.hs: -------------------------------------------------------------------------------- 1 | import "hint" HLint.HLint 2 | 3 | -------------------------------------------------------------------------------- /keera-hails-reactive-gtk/tests/HLintMain.hs: -------------------------------------------------------------------------------- 1 | ----------------------------------------------------------------------------- 2 | -- | 3 | -- Module : Main (hlint) 4 | -- Copyright : (C) 2013 Edward Kmett 5 | -- License : BSD-style (see the file LICENSE) 6 | -- Maintainer : Edward Kmett 7 | -- Stability : provisional 8 | -- Portability : portable 9 | -- 10 | -- This module runs HLint on the lens source tree. 11 | ----------------------------------------------------------------------------- 12 | module Main where 13 | 14 | import Control.Monad 15 | import Language.Haskell.HLint 16 | import System.Environment 17 | import System.Exit 18 | 19 | main :: IO () 20 | main = do 21 | args <- getArgs 22 | hints <- hlint $ ["src", "--cross", "--hint=tests/HLint.hs" ] ++ args 23 | unless (null hints) exitFailure 24 | -------------------------------------------------------------------------------- /keera-hails-reactive-gtk3/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2013-2020, Keera Studios Ltd 2 | Copyright (c) 2010-2012, Ivan Perez 3 | 4 | All rights reserved. 5 | 6 | Redistribution and use in source and binary forms, with or without 7 | modification, are permitted provided that the following conditions are met: 8 | 9 | * Redistributions of source code must retain the above copyright 10 | notice, this list of conditions and the following disclaimer. 11 | 12 | * Redistributions in binary form must reproduce the above 13 | copyright notice, this list of conditions and the following 14 | disclaimer in the documentation and/or other materials provided 15 | with the distribution. 16 | 17 | * Neither the name of Ivan Perez, nor the name of Keera Studios, nor the 18 | names of other contributors may be used to endorse or promote products 19 | derived from this software without specific prior written permission. 20 | 21 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 22 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 23 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 24 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 25 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 26 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 27 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 28 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 29 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 30 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 31 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 32 | -------------------------------------------------------------------------------- /keera-hails-reactive-gtk3/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /keera-hails-reactive-gtk3/src/Graphics/UI/Gtk/Reactive.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- 3 | -- Copyright : (C) Keera Studios Ltd, 2013 4 | -- License : BSD3 5 | -- Maintainer : support@keera.co.uk 6 | module Graphics.UI.Gtk.Reactive 7 | (module Exported) 8 | where 9 | 10 | import Graphics.UI.Gtk.Reactive.Button as Exported 11 | import Graphics.UI.Gtk.Reactive.Entry as Exported 12 | import Graphics.UI.Gtk.Reactive.CheckMenuItem as Exported 13 | import Graphics.UI.Gtk.Reactive.Label as Exported 14 | import Graphics.UI.Gtk.Reactive.MenuItem as Exported 15 | import Graphics.UI.Gtk.Reactive.Scale as Exported 16 | import Graphics.UI.Gtk.Reactive.SpinButton as Exported 17 | import Graphics.UI.Gtk.Reactive.TextView as Exported 18 | import Graphics.UI.Gtk.Reactive.ToolButton as Exported 19 | import Graphics.UI.Gtk.Reactive.ToggleButton as Exported 20 | import Graphics.UI.Gtk.Reactive.TypedComboBoxUnsafe as Exported 21 | -------------------------------------------------------------------------------- /keera-hails-reactive-gtk3/src/Graphics/UI/Gtk/Reactive/Button.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE MultiParamTypeClasses #-} 2 | -- | Publishes the main elements of a menuitem 3 | -- 4 | -- Copyright : (C) Keera Studios Ltd, 2013 5 | -- License : BSD3 6 | -- Maintainer : support@keera.co.uk 7 | module Graphics.UI.Gtk.Reactive.Button where 8 | 9 | import Control.Monad 10 | import Graphics.UI.Gtk 11 | import Data.ReactiveValue 12 | 13 | buttonActivateField :: Button -> ReactiveFieldActivatable IO 14 | buttonActivateField b = mkActivatable op 15 | where op f = void (on b buttonActivated f) 16 | 17 | instance ReactiveValueActivatable IO Button where 18 | defaultActivation = buttonActivateField 19 | -------------------------------------------------------------------------------- /keera-hails-reactive-gtk3/src/Graphics/UI/Gtk/Reactive/CheckMenuItem.hs: -------------------------------------------------------------------------------- 1 | -- | Publishes the main elements of a checkmenuitem 2 | -- 3 | -- Copyright : (C) Keera Studios Ltd, 2013 4 | -- License : BSD3 5 | -- Maintainer : support@keera.co.uk 6 | module Graphics.UI.Gtk.Reactive.CheckMenuItem where 7 | 8 | import Control.Monad 9 | import Graphics.UI.Gtk 10 | import Data.ReactiveValue 11 | 12 | checkMenuItemActiveReactive :: CheckMenuItem -> ReactiveFieldReadWrite IO Bool 13 | checkMenuItemActiveReactive e = ReactiveFieldReadWrite setter getter notifier 14 | where getter = checkMenuItemGetActive e 15 | setter = checkMenuItemSetActive e 16 | notifier = void . (on e checkMenuItemToggled) 17 | -------------------------------------------------------------------------------- /keera-hails-reactive-gtk3/src/Graphics/UI/Gtk/Reactive/Entry.hs: -------------------------------------------------------------------------------- 1 | -- | Publishes the main elements of an entry as reactive fields 2 | -- 3 | -- Copyright : (C) Keera Studios Ltd, 2013 4 | -- License : BSD3 5 | -- Maintainer : support@keera.co.uk 6 | module Graphics.UI.Gtk.Reactive.Entry where 7 | 8 | import Control.Monad (void) 9 | import Graphics.UI.Gtk 10 | import Data.ReactiveValue 11 | 12 | entryTextReactive :: (EditableClass e, EntryClass e) => e -> ReactiveFieldReadWrite IO String 13 | entryTextReactive e = ReactiveFieldReadWrite setter getter notifier 14 | where getter = get e entryText 15 | setter v = postGUIAsync $ set e [entryText := v] 16 | notifier p = void (on e editableChanged p) 17 | -------------------------------------------------------------------------------- /keera-hails-reactive-gtk3/src/Graphics/UI/Gtk/Reactive/Label.hs: -------------------------------------------------------------------------------- 1 | -- | Publishes the main elements of an entry as reactive fields 2 | -- 3 | -- Copyright : (C) Keera Studios Ltd, 2013 4 | -- License : BSD3 5 | -- Maintainer : support@keera.co.uk 6 | module Graphics.UI.Gtk.Reactive.Label where 7 | 8 | import Control.Applicative 9 | import Graphics.Rendering.Pango as Pango 10 | import Graphics.UI.Gtk 11 | import Data.ReactiveValue 12 | 13 | labelTextReactive :: (LabelClass l) => l -> ReactiveFieldReadWrite IO String 14 | labelTextReactive l = ReactiveFieldReadWrite setter getter notifier 15 | where getter = get l labelText 16 | setter v = postGUIAsync $ set l [labelText := v] 17 | notifier _ = return () 18 | 19 | labelBackground :: Label -> ReactiveFieldReadWrite IO Pango.Color 20 | labelBackground lbl = ReactiveFieldReadWrite setter getter (const (return ())) 21 | where setter x = postGUIAsync $ labelSetAttributes lbl [AttrBackground 0 (-1) x] 22 | getter = postGUISync $ (\ls -> head [ x | AttrBackground _ _ x <- ls]) 23 | <$> labelGetAttributes lbl 24 | -------------------------------------------------------------------------------- /keera-hails-reactive-gtk3/src/Graphics/UI/Gtk/Reactive/MenuItem.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE MultiParamTypeClasses #-} 2 | -- | Publishes the main elements of a menuitem 3 | -- 4 | -- Copyright : (C) Keera Studios Ltd, 2013 5 | -- License : BSD3 6 | -- Maintainer : support@keera.co.uk 7 | module Graphics.UI.Gtk.Reactive.MenuItem where 8 | 9 | import Control.Monad 10 | import Control.Monad.Trans(liftIO) 11 | import Graphics.UI.Gtk 12 | import Data.ReactiveValue 13 | 14 | menuItemActivateField :: MenuItem -> ReactiveFieldActivatable IO 15 | menuItemActivateField m = mkActivatable op 16 | where op f = void (m `on` menuItemActivate $ liftIO f) 17 | 18 | instance ReactiveValueActivatable IO MenuItem where 19 | defaultActivation = menuItemActivateField 20 | -------------------------------------------------------------------------------- /keera-hails-reactive-gtk3/src/Graphics/UI/Gtk/Reactive/Scale.hs: -------------------------------------------------------------------------------- 1 | -- | Publishes the main elements of a scale as reactive fields 2 | -- 3 | -- Copyright : (C) Keera Studios Ltd, 2013 4 | -- License : BSD3 5 | -- Maintainer : support@keera.co.uk 6 | module Graphics.UI.Gtk.Reactive.Scale where 7 | 8 | import Control.Monad (void) 9 | import GHC.Float 10 | import Graphics.UI.Gtk 11 | import Data.ReactiveValue 12 | 13 | scaleValueReactive :: RangeClass a => a -> ReactiveFieldReadWrite IO Float 14 | scaleValueReactive e = ReactiveFieldReadWrite setter getter notifier 15 | where getter = fmap double2Float $ get e rangeValue 16 | setter v = set e [ rangeValue := float2Double v ] 17 | notifier p = void (on e valueChanged p) 18 | -------------------------------------------------------------------------------- /keera-hails-reactive-gtk3/src/Graphics/UI/Gtk/Reactive/SpinButton.hs: -------------------------------------------------------------------------------- 1 | -- | Publishes the main elements of a toggle button 2 | -- 3 | -- Copyright : (C) Keera Studios Ltd, 2013 4 | -- License : BSD3 5 | -- Maintainer : support@keera.co.uk 6 | module Graphics.UI.Gtk.Reactive.SpinButton where 7 | 8 | import Control.Monad 9 | import Graphics.UI.Gtk 10 | import Data.ReactiveValue 11 | 12 | spinButtonActiveReactive :: SpinButton -> ReactiveFieldReadWrite IO Int 13 | spinButtonActiveReactive e = ReactiveFieldReadWrite setter getter notifier 14 | where getter = spinButtonGetValueAsInt e 15 | setter = spinButtonSetValue e . fromIntegral 16 | notifier = void . (onValueSpinned e) 17 | -------------------------------------------------------------------------------- /keera-hails-reactive-gtk3/src/Graphics/UI/Gtk/Reactive/TextView.hs: -------------------------------------------------------------------------------- 1 | -- | Publishes the main elements of a text view as reactive fields 2 | -- 3 | -- Copyright : (C) Keera Studios Ltd, 2013 4 | -- License : BSD3 5 | -- Maintainer : support@keera.co.uk 6 | module Graphics.UI.Gtk.Reactive.TextView where 7 | 8 | import Control.Monad (void) 9 | import Graphics.UI.Gtk 10 | import Data.ReactiveValue 11 | 12 | textViewTextReactive :: TextView -> ReactiveFieldReadWrite IO String 13 | textViewTextReactive e = ReactiveFieldReadWrite setter getter notifier 14 | where getter = get e textViewBuffer >>= (`get` textBufferText) 15 | setter v = get e textViewBuffer >>= (\b -> set b [textBufferText := v]) 16 | notifier p = get e textViewBuffer >>= (\b -> void (on b bufferChanged p)) 17 | -------------------------------------------------------------------------------- /keera-hails-reactive-gtk3/src/Graphics/UI/Gtk/Reactive/ToggleButton.hs: -------------------------------------------------------------------------------- 1 | -- | Publishes the main elements of a toggle button 2 | -- 3 | -- Copyright : (C) Keera Studios Ltd, 2013 4 | -- License : BSD3 5 | -- Maintainer : support@keera.co.uk 6 | module Graphics.UI.Gtk.Reactive.ToggleButton where 7 | 8 | import Control.Monad 9 | import Graphics.UI.Gtk 10 | import Data.ReactiveValue 11 | 12 | toggleButtonActiveReactive :: ToggleButtonClass t => t -> ReactiveFieldReadWrite IO Bool 13 | toggleButtonActiveReactive e = ReactiveFieldReadWrite setter getter notifier 14 | where getter = toggleButtonGetActive e 15 | setter = toggleButtonSetActive e 16 | notifier = void . (on e toggled) 17 | -------------------------------------------------------------------------------- /keera-hails-reactive-gtk3/src/Graphics/UI/Gtk/Reactive/ToolButton.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE MultiParamTypeClasses #-} 2 | -- | Publishes the main elements of a menuitem 3 | -- 4 | -- Copyright : (C) Keera Studios Ltd, 2013 5 | -- License : BSD3 6 | -- Maintainer : support@keera.co.uk 7 | module Graphics.UI.Gtk.Reactive.ToolButton where 8 | 9 | import Control.Monad 10 | import Graphics.UI.Gtk 11 | import Data.ReactiveValue 12 | 13 | toolButtonActivateField :: ToolButton -> ReactiveFieldActivatable IO 14 | toolButtonActivateField b = mkActivatable op 15 | where op f = void (b `onToolButtonClicked` f) 16 | 17 | instance ReactiveValueActivatable IO ToolButton where 18 | defaultActivation = toolButtonActivateField 19 | -------------------------------------------------------------------------------- /keera-hails-reactive-gtk3/src/Graphics/UI/Gtk/Reactive/TypedComboBoxUnsafe.hs: -------------------------------------------------------------------------------- 1 | -- | Publishes the main elements of a toggle button 2 | -- 3 | -- Copyright : (C) Keera Studios Ltd, 2013 4 | -- License : BSD3 5 | -- Maintainer : support@keera.co.uk 6 | module Graphics.UI.Gtk.Reactive.TypedComboBoxUnsafe where 7 | 8 | import Control.Monad 9 | import Graphics.UI.Gtk 10 | import Graphics.UI.Gtk.Helpers.Combo 11 | import Data.ReactiveValue 12 | 13 | typedComboBoxUnsafeReactive :: (Eq a) => ListStore a -> ComboBox -> ReactiveFieldReadWrite IO a 14 | typedComboBoxUnsafeReactive ls e = ReactiveFieldReadWrite setter getter notifier 15 | where getter = typedComboBoxGetSelectedUnsafe (e, ls) 16 | setter = typedComboBoxSetSelected (e, ls) 17 | notifier = void . (on e changed) 18 | -------------------------------------------------------------------------------- /keera-hails-reactive-gtk3/tests/HLint.hs: -------------------------------------------------------------------------------- 1 | import "hint" HLint.HLint 2 | 3 | -------------------------------------------------------------------------------- /keera-hails-reactive-gtk3/tests/HLintMain.hs: -------------------------------------------------------------------------------- 1 | ----------------------------------------------------------------------------- 2 | -- | 3 | -- Module : Main (hlint) 4 | -- Copyright : (C) 2013 Edward Kmett 5 | -- License : BSD-style (see the file LICENSE) 6 | -- Maintainer : Edward Kmett 7 | -- Stability : provisional 8 | -- Portability : portable 9 | -- 10 | -- This module runs HLint on the lens source tree. 11 | ----------------------------------------------------------------------------- 12 | module Main where 13 | 14 | import Control.Monad 15 | import Language.Haskell.HLint 16 | import System.Environment 17 | import System.Exit 18 | 19 | main :: IO () 20 | main = do 21 | args <- getArgs 22 | hints <- hlint $ ["src", "--cross", "--hint=tests/HLint.hs" ] ++ args 23 | unless (null hints) exitFailure 24 | -------------------------------------------------------------------------------- /keera-hails-reactive-htmldom/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /keera-hails-reactive-htmldom/tests/HLint.hs: -------------------------------------------------------------------------------- 1 | import "hint" HLint.HLint 2 | 3 | -------------------------------------------------------------------------------- /keera-hails-reactive-htmldom/tests/HLintMain.hs: -------------------------------------------------------------------------------- 1 | ----------------------------------------------------------------------------- 2 | -- | 3 | -- Module : Main (hlint) 4 | -- Copyright : (C) 2013 Edward Kmett 5 | -- License : BSD-style (see the file LICENSE) 6 | -- Maintainer : Edward Kmett 7 | -- Stability : provisional 8 | -- Portability : portable 9 | -- 10 | -- This module runs HLint on the lens source tree. 11 | ----------------------------------------------------------------------------- 12 | module Main where 13 | 14 | import Control.Monad 15 | import Language.Haskell.HLint 16 | import System.Environment 17 | import System.Exit 18 | 19 | main :: IO () 20 | main = do 21 | args <- getArgs 22 | hints <- hlint $ ["src", "--cross", "--hint=tests/HLint.hs" ] ++ args 23 | unless (null hints) exitFailure 24 | -------------------------------------------------------------------------------- /keera-hails-reactive-network/README.md: -------------------------------------------------------------------------------- 1 | Reactive Values are mutable values with change propagation. They can be 2 | composed to create new RVs, and linked together so that changes to one 3 | propagate towards others. Reactive Values are typed (by the type of the 4 | contents and by their access properties); when they are connected, the type of 5 | the contents must match and the access properties must be compatible. 6 | 7 | This library contains functions to create RVs from Internet sockets, so 8 | that messages written to the values are sent out the socket, and messages 9 | read from the value are read from the socket. This allows connecting sockets 10 | to other elements using Reactive Rules and defining a networked Reactive 11 | application. 12 | 13 | Find out more at: http://github.com/keera-studios/keera-hails 14 | -------------------------------------------------------------------------------- /keera-hails-reactive-network/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /keera-hails-reactive-network/src/Hails/Network.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- 3 | -- Copyright : (C) Keera Studios Ltd, 2013 4 | -- License : BSD3 5 | -- Maintainer : support@keera.co.uk 6 | module Hails.Network where 7 | 8 | import Data.String (fromString) 9 | import Data.List 10 | import Data.ReactiveValue 11 | import Network.BSD 12 | import Network.Socket 13 | import Network.Socket.ByteString (sendTo) 14 | 15 | -- | Create a UDP sink (a write-only reactive value). 16 | udpSink :: HostName -> String -> IO (ReactiveFieldWrite IO String) 17 | udpSink hostname port = do 18 | -- Obtain server addr 19 | addrinfos <- getAddrInfo Nothing (Just hostname) (Just port) 20 | let serveraddr = head addrinfos 21 | 22 | -- Establish a socket for communication 23 | sock <- socket (addrFamily serveraddr) Datagram defaultProtocol 24 | 25 | -- Send command 26 | let sendstr :: String -> IO () 27 | sendstr [] = return () 28 | sendstr omsg = do let bsMsg = fromString omsg 29 | sent <- sendTo sock bsMsg (addrAddress serveraddr) 30 | sendstr (genericDrop sent omsg) 31 | 32 | return $ ReactiveFieldWrite sendstr 33 | -------------------------------------------------------------------------------- /keera-hails-reactive-network/tests/HLint.hs: -------------------------------------------------------------------------------- 1 | import "hint" HLint.HLint 2 | 3 | -------------------------------------------------------------------------------- /keera-hails-reactive-network/tests/HLintMain.hs: -------------------------------------------------------------------------------- 1 | ----------------------------------------------------------------------------- 2 | -- | 3 | -- Module : Main (hlint) 4 | -- Copyright : (C) 2013 Edward Kmett 5 | -- License : BSD-style (see the file LICENSE) 6 | -- Maintainer : Edward Kmett 7 | -- Stability : provisional 8 | -- Portability : portable 9 | -- 10 | -- This module runs HLint on the lens source tree. 11 | ----------------------------------------------------------------------------- 12 | module Main where 13 | 14 | import Control.Monad 15 | import Language.Haskell.HLint 16 | import System.Environment 17 | import System.Exit 18 | 19 | main :: IO () 20 | main = do 21 | args <- getArgs 22 | hints <- hlint $ ["src", "--cross", "--hint=tests/HLint.hs" ] ++ args 23 | unless (null hints) exitFailure 24 | -------------------------------------------------------------------------------- /keera-hails-reactive-polling/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2015-2020, Keera Studios Ltd 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of Keera Studios, nor the names of other contributors 17 | may be used to endorse or promote products derived from this software 18 | without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /keera-hails-reactive-polling/README.md: -------------------------------------------------------------------------------- 1 | This library contains functions to define RVs that do continuous 2 | polling. An optional delay can be specified. 3 | 4 | Note: This library makes use of threads. You should compile your 5 | executables using the threaded RTS (-threaded). 6 | 7 | See also: 8 | - http://github.com/keera-studios/keera-hails 9 | - http://github.com/keera-studios/hails-reactivevalues 10 | -------------------------------------------------------------------------------- /keera-hails-reactive-polling/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /keera-hails-reactive-polling/src/Hails/Polling.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- 3 | -- Copyright : (C) Keera Studios Ltd, 2015 4 | -- License : BSD3 5 | -- Maintainer : support@keera.co.uk 6 | module Hails.Polling where 7 | 8 | import Control.Concurrent (forkIO, threadDelay) 9 | import Control.Monad (forever, void) 10 | import Data.CBMVar 11 | import Data.ReactiveValue 12 | 13 | pollingReactive :: IO a 14 | -> Maybe Int 15 | -> IO (ReactiveFieldRead IO a) 16 | pollingReactive sensor delay = do 17 | initialV <- sensor 18 | mvar <- newCBMVar initialV 19 | 20 | forkIO $ forever $ do v <- sensor 21 | writeCBMVar mvar v 22 | maybe (return ()) (void . threadDelay) delay 23 | 24 | -- RV fields 25 | let getter = readCBMVar mvar 26 | notifier = installCallbackCBMVar mvar 27 | 28 | return $ ReactiveFieldRead getter notifier 29 | -------------------------------------------------------------------------------- /keera-hails-reactive-polling/tests/HLint.hs: -------------------------------------------------------------------------------- 1 | import "hint" HLint.HLint 2 | 3 | -------------------------------------------------------------------------------- /keera-hails-reactive-polling/tests/HLintMain.hs: -------------------------------------------------------------------------------- 1 | ----------------------------------------------------------------------------- 2 | -- | 3 | -- Module : Main (hlint) 4 | -- Copyright : (C) 2013 Edward Kmett 5 | -- License : BSD-style (see the file LICENSE) 6 | -- Maintainer : Edward Kmett 7 | -- Stability : provisional 8 | -- Portability : portable 9 | -- 10 | -- This module runs HLint on the lens source tree. 11 | ----------------------------------------------------------------------------- 12 | module Main where 13 | 14 | import Control.Monad 15 | import Language.Haskell.HLint 16 | import System.Environment 17 | import System.Exit 18 | 19 | main :: IO () 20 | main = do 21 | args <- getArgs 22 | hints <- hlint $ ["src", "--cross", "--hint=tests/HLint.hs" ] ++ args 23 | unless (null hints) exitFailure 24 | -------------------------------------------------------------------------------- /keera-hails-reactive-qt/.gitignore: -------------------------------------------------------------------------------- 1 | examples/* 2 | !examples/*.* 3 | -------------------------------------------------------------------------------- /keera-hails-reactive-qt/tests/HLint.hs: -------------------------------------------------------------------------------- 1 | import "hint" HLint.HLint 2 | 3 | -------------------------------------------------------------------------------- /keera-hails-reactive-qt/tests/HLintMain.hs: -------------------------------------------------------------------------------- 1 | ----------------------------------------------------------------------------- 2 | -- | 3 | -- Module : Main (hlint) 4 | -- Copyright : (C) 2013 Edward Kmett 5 | -- License : BSD-style (see the file LICENSE) 6 | -- Maintainer : Edward Kmett 7 | -- Stability : provisional 8 | -- Portability : portable 9 | -- 10 | -- This module runs HLint on the lens source tree. 11 | ----------------------------------------------------------------------------- 12 | module Main where 13 | 14 | import Control.Monad 15 | import Language.Haskell.HLint 16 | import System.Environment 17 | import System.Exit 18 | 19 | main :: IO () 20 | main = do 21 | args <- getArgs 22 | hints <- hlint $ ["src", "--cross", "--hint=tests/HLint.hs" ] ++ args 23 | unless (null hints) exitFailure 24 | -------------------------------------------------------------------------------- /keera-hails-reactive-wx/.gitignore: -------------------------------------------------------------------------------- 1 | !examples/*.* 2 | *~ 3 | examples/* 4 | -------------------------------------------------------------------------------- /keera-hails-reactive-wx/README.md: -------------------------------------------------------------------------------- 1 | This is an experimental layer for WX as reactive values. 2 | 3 | So far only buttons clicks and entry text texts work. The Haskell files in 'examples/' should demonstrate what this is all about. 4 | 5 | See also: 6 | 7 | http://github.com/keera-studios/keera-hails 8 | http://github.com/keera-studios/hails-reactivevalues 9 | -------------------------------------------------------------------------------- /keera-hails-reactive-wx/examples/Calc.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | import Control.Applicative 4 | import Control.Concurrent 5 | import Control.Concurrent.MVar 6 | import Control.GFunctor 7 | import Data.ReactiveValue 8 | import Graphics.UI.WX as WX 9 | import Graphics.UI.WXCore as WXCore 10 | import Graphics.UI.WX.Reactive 11 | 12 | main :: IO () 13 | main = start $ do 14 | -- View 15 | f <- frameLoadRes "test.xrc" "frame_1" [] 16 | 17 | -- Entry text 18 | txtT <- entryText =<< textCtrlRes f "text_ctrl_1" [] 19 | nBtns <- mapM (\x -> buttonRes f ("btn" ++ show x) [] >>= buttonClick) [0..9] 20 | btnDot <- buttonClick =<< buttonRes f "btnDot" [] 21 | 22 | -- Controller 23 | 24 | -- Numbers 25 | let addX :: String -> ReactiveFieldWrite IO () 26 | addX x = modRW (\s _ -> s ++ x) txtT 27 | mapM_ (\(b,n) -> b =:> addX n -- Rule 28 | ) $ zip nBtns $ map show [0..9] 29 | 30 | -- Dot 31 | let addDot :: ReactiveFieldWrite IO () 32 | addDot = modRW (\s () -> if '.' `elem` s then s else s ++ ".") txtT 33 | btnDot =:> addDot 34 | 35 | windowShow f 36 | return () 37 | 38 | -------------------------------------------------------------------------------- /keera-hails-reactive-wx/examples/Minimal.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | import Control.Applicative 4 | import Control.Concurrent 5 | import Control.Concurrent.MVar 6 | import Control.GFunctor 7 | import Data.ReactiveValue 8 | import Graphics.UI.WX as WX 9 | import Graphics.UI.WXCore as WXCore 10 | import Graphics.UI.WX.Reactive 11 | 12 | main :: IO () 13 | main = start $ do 14 | -- View 15 | f <- frame [text := "Hello!"] 16 | btn <- button f [text := "Quit"] 17 | txt1 <- entry f [text := ""] 18 | txt2 <- entry f [text := ""] 19 | txt1T <- entryText txt1 20 | txt2T <- entryText txt2 21 | btnC <- buttonClick btn 22 | set f [layout := margin 20 $ 23 | floatCentre $ 24 | column 3 [widget txt1, widget txt2, widget btn]] 25 | 26 | -- Controller 27 | (involution reverse <$$> txt1T) =:= txt2T 28 | btnC =:> modRW (\s _ -> s ++ "a") txt2T 29 | -------------------------------------------------------------------------------- /keera-hails-reactive-wx/src/Graphics/UI/WX/Reactive.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- 3 | -- Copyright : (C) Keera Studios Ltd, 2013 4 | -- License : BSD3 5 | -- Maintainer : support@keera.co.uk 6 | module Graphics.UI.WX.Reactive where 7 | 8 | import Control.Concurrent 9 | import Data.ReactiveValue 10 | import Graphics.UI.WX as WX 11 | import Graphics.UI.WXCore as WXCore 12 | 13 | buttonClick :: Button () -> IO (ReactiveFieldRead IO ()) 14 | buttonClick btn = do 15 | notifiers <- newMVar [] 16 | set btn [ on command := readMVar notifiers >>= sequence_ ] 17 | let getter = return () 18 | notifier p = modifyMVar_ notifiers (\x -> return (x ++ [p])) 19 | return $ ReactiveFieldRead getter notifier 20 | 21 | entryText :: TextCtrl () -> IO (ReactiveFieldReadWrite IO String) 22 | entryText entry = do 23 | notifiers <- notifiersNew 24 | 25 | set entry [ on onText :~ \kbd -> kbd >> runNotifiers notifiers ] 26 | 27 | let getter = get entry text 28 | setter v = do t <- get entry text 29 | when (t /= v) $ do set entry [ text := v ] 30 | runNotifiers notifiers 31 | notifier = addNotifier notifiers 32 | return $ ReactiveFieldReadWrite setter getter notifier 33 | 34 | -- Literally taken from Reactive Banana 35 | onText :: WX.Event (WXCore.Control a) (IO ()) 36 | onText = WX.newEvent "onText" WXCore.controlGetOnText WXCore.controlOnText 37 | 38 | type Notifiers = MVar [IO ()] 39 | 40 | notifiersNew :: IO Notifiers 41 | notifiersNew = newMVar [] 42 | 43 | runNotifiers :: Notifiers -> IO() 44 | runNotifiers ntfs = readMVar ntfs >>= sequence_ 45 | 46 | addNotifier :: Notifiers -> IO () -> IO() 47 | addNotifier ntfs p = modifyMVar_ ntfs (\x -> return (x ++ [p])) 48 | -------------------------------------------------------------------------------- /keera-hails-reactive-wx/tests/HLint.hs: -------------------------------------------------------------------------------- 1 | import "hint" HLint.HLint 2 | 3 | -------------------------------------------------------------------------------- /keera-hails-reactive-wx/tests/HLintMain.hs: -------------------------------------------------------------------------------- 1 | ----------------------------------------------------------------------------- 2 | -- | 3 | -- Module : Main (hlint) 4 | -- Copyright : (C) 2013 Edward Kmett 5 | -- License : BSD-style (see the file LICENSE) 6 | -- Maintainer : Edward Kmett 7 | -- Stability : provisional 8 | -- Portability : portable 9 | -- 10 | -- This module runs HLint on the lens source tree. 11 | ----------------------------------------------------------------------------- 12 | module Main where 13 | 14 | import Control.Monad 15 | import Language.Haskell.HLint 16 | import System.Environment 17 | import System.Exit 18 | 19 | main :: IO () 20 | main = do 21 | args <- getArgs 22 | hints <- hlint $ ["src", "--cross", "--hint=tests/HLint.hs" ] ++ args 23 | unless (null hints) exitFailure 24 | -------------------------------------------------------------------------------- /keera-hails-reactive-yampa/README.md: -------------------------------------------------------------------------------- 1 | This library contains functions to define RVs connected to Yampa signal 2 | functions. The main function is yampaReactiveDual, which returns two RVs (a 3 | readable end, or source, and a writable end, or sink). You can write values 4 | to the writable end, and changes will be processed by the SF and made 5 | available in the readable end. 6 | 7 | Yampa is a Functional Reactive Programming DSL. 8 | 9 | Note: This library makes use of threads. You should compile your 10 | executables using the threaded RTS (-threaded). 11 | 12 | See also: 13 | - http://github.com/keera-studios/keera-hails 14 | - http://github.com/ivanperez-keera/Yampa 15 | - http://github.com/keera-studios/hails-reactivevalues 16 | 17 | # TODO 18 | 19 | * Different update policies are possible. For instance, one could update only 20 | on demand, or update using a push policy. The yampa system could be running 21 | continuously, producing new outputs every time, and modifying the input only 22 | when it really changes. 23 | -------------------------------------------------------------------------------- /keera-hails-reactive-yampa/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /keera-hails-reactive-yampa/tests/HLint.hs: -------------------------------------------------------------------------------- 1 | import "hint" HLint.HLint 2 | 3 | -------------------------------------------------------------------------------- /keera-hails-reactive-yampa/tests/HLintMain.hs: -------------------------------------------------------------------------------- 1 | ----------------------------------------------------------------------------- 2 | -- | 3 | -- Module : Main (hlint) 4 | -- Copyright : (C) 2013 Edward Kmett 5 | -- License : BSD-style (see the file LICENSE) 6 | -- Maintainer : Edward Kmett 7 | -- Stability : provisional 8 | -- Portability : portable 9 | -- 10 | -- This module runs HLint on the lens source tree. 11 | ----------------------------------------------------------------------------- 12 | module Main where 13 | 14 | import Control.Monad 15 | import Language.Haskell.HLint 16 | import System.Environment 17 | import System.Exit 18 | 19 | main :: IO () 20 | main = do 21 | args <- getArgs 22 | hints <- hlint $ ["src", "--cross", "--hint=tests/HLint.hs" ] ++ args 23 | unless (null hints) exitFailure 24 | -------------------------------------------------------------------------------- /keera-hails-reactivelenses/README.md: -------------------------------------------------------------------------------- 1 | Reactive Values combined with Lenses 2 | ==================================== 3 | 4 | Lenses allow you to focus on a specific part of a reactive value. When 5 | you have a lens, you can use it to turn a reactive value into another that 6 | represents only a subpart of your original structure. 7 | 8 | Reactive Values 9 | =============== 10 | 11 | Reactive values are a form of mutable, reactive, thread-safe memory locations. 12 | They are great to create reactive anchors in your GUI and your model, and then 13 | write declarative rules that bridge them together during runtime. 14 | 15 | For more information, see: 16 | 17 | https://github.com/keera-studios/keera-hails 18 | http://keera.co.uk/blog/2014/05/24/reactive-programming-using-reactive-values/ 19 | 20 | And the article "Bridging the GUI gap", by Ivan Perez & Henrik Nilsson, 21 | part of TFP2014's draft pre-proceedings: 22 | http://www.staff.science.uu.nl/~hage0101/preproceedingstfp2014.pdf 23 | 24 | Support 25 | ======= 26 | 27 | Open a ticket or send me a message if you use this and have a problem. 28 | 29 | Also, I'd be happy to know (and publish a list of) programs that use 30 | hails-reactivevalues. Please, let me know if you write something that uses it. 31 | -------------------------------------------------------------------------------- /keera-hails-reactivelenses/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /keera-hails-reactivelenses/tests/HLint.hs: -------------------------------------------------------------------------------- 1 | import "hint" HLint.HLint 2 | 3 | -------------------------------------------------------------------------------- /keera-hails-reactivelenses/tests/HLintMain.hs: -------------------------------------------------------------------------------- 1 | ----------------------------------------------------------------------------- 2 | -- | 3 | -- Module : Main (hlint) 4 | -- Copyright : (C) 2015 Ivan Perez, 2013-2014 Edward Kmett 5 | -- License : BSD-style (see the file LICENSE) 6 | -- Maintainer : Ivan Perez 7 | -- Stability : provisional 8 | -- Portability : portable 9 | -- 10 | -- This module runs HLint on the source tree. 11 | ----------------------------------------------------------------------------- 12 | module Main where 13 | 14 | import Control.Monad 15 | import Language.Haskell.HLint 16 | import System.Environment 17 | import System.Exit 18 | 19 | main :: IO () 20 | main = do 21 | args <- getArgs 22 | hints <- hlint $ ["src"] ++ args 23 | unless (null hints) exitFailure 24 | -------------------------------------------------------------------------------- /keera-hails-reactivevalues/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /keera-hails-reactivevalues/src/Control/GFunctor.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleInstances #-} 2 | {-# LANGUAGE MultiParamTypeClasses #-} 3 | -- | 4 | -- Copyright : (C) Keera Studios Ltd, 2013 5 | -- License : BSD3 6 | -- Maintainer : support@keera.co.uk 7 | -- 8 | -- Functors parameterised over the morphisms in the source category. 9 | module Control.GFunctor where 10 | 11 | infixl 8 <$$> 12 | 13 | -- | A class for Functors in which the morphisms in the source category do not 14 | -- have to be of kind arrow '(->)', but can be anything (see the parameter 15 | -- 'm'). 16 | class GFunctor f m where 17 | -- | Map parameterised over the morphisms in the source category. 18 | gmap :: m a b -> f a -> f b 19 | 20 | -- | Trivial instance for the arrow morphism '(->)'. Anything 21 | -- that is a functor is also a GFunctor in the trivial way. 22 | instance Functor a => GFunctor a (->) where 23 | gmap = fmap 24 | 25 | -- | A more readable (ignorable) name for 'gmap'. 26 | (<$$>) :: GFunctor f m => m a b -> f a -> f b 27 | (<$$>) = gmap 28 | -------------------------------------------------------------------------------- /keera-hails-reactivevalues/tests/HLint.hs: -------------------------------------------------------------------------------- 1 | import "hint" HLint.HLint 2 | 3 | -------------------------------------------------------------------------------- /keera-hails-reactivevalues/tests/HLintMain.hs: -------------------------------------------------------------------------------- 1 | ----------------------------------------------------------------------------- 2 | -- | 3 | -- Module : Main (hlint) 4 | -- Copyright : (C) 2015 Ivan Perez, 2013-2014 Edward Kmett 5 | -- License : BSD-style (see the file LICENSE) 6 | -- Maintainer : Ivan Perez 7 | -- Stability : provisional 8 | -- Portability : portable 9 | -- 10 | -- This module runs HLint on the source tree. 11 | ----------------------------------------------------------------------------- 12 | module Main where 13 | 14 | import Control.Monad 15 | import Language.Haskell.HLint 16 | import System.Environment 17 | import System.Exit 18 | 19 | main :: IO () 20 | main = do 21 | args <- getArgs 22 | hints <- hlint $ ["src"] ++ args 23 | unless (null hints) exitFailure 24 | -------------------------------------------------------------------------------- /keera-hails-reactivevalues/tests/Tasty.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- Module : Main (Tasty) 3 | -- Copyright : (C) 2015 Ivan Perez 4 | -- License : BSD-style (see the file LICENSE) 5 | -- Maintainer : Ivan Perez 6 | -- Stability : provisional 7 | -- Portability : portable 8 | -- 9 | -- Test reactive value laws using Quickcheck/HUnit/Tasty. 10 | -- 11 | -- See the following links for instructions and documentation: 12 | -- https://github.com/feuerbach/tasty 13 | -- https://ocharles.org.uk/blog/posts/2013-12-03-24-days-of-hackage-tasty.html 14 | 15 | -- Testing libraries 16 | import Test.Tasty 17 | import Test.Tasty.QuickCheck 18 | -- import Test.QuickCheck 19 | -- import Test.Tasty.HUnit 20 | 21 | -- Tested libraries 22 | import Control.Monad.Identity 23 | import Data.ReactiveValue 24 | 25 | main :: IO () 26 | main = defaultMain $ 27 | testGroup "ReactiveValues" 28 | [ testGroup "GetSetLaws" 29 | [ testProperty "Getting after constant initialisation" getOnConst 30 | ] 31 | ] 32 | 33 | -- * Reactive Value laws 34 | 35 | -- ** Reactive Value get/set laws 36 | 37 | -- | Check that constR returns the value put in. 38 | getOnConst :: Int -> Bool 39 | getOnConst = 40 | \val -> let rv = constR (val :: Int) 41 | val' = runIdentity (reactiveValueRead rv) 42 | in val == val' 43 | 44 | -- NOTE: To check that the testing system and the integration with cabal are 45 | -- both working fine, you can use include this property in one of the tested 46 | -- groups; the test suite should fail. 47 | -- falseProperty = 48 | -- testProperty "False" $ 49 | -- \val -> not (val == (val :: Int)) 50 | -------------------------------------------------------------------------------- /keera-hails/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2013-2020, Keera Studios Ltd 2 | Copyright (c) 2010-2012, Ivan Perez 3 | 4 | All rights reserved. 5 | 6 | Redistribution and use in source and binary forms, with or without 7 | modification, are permitted provided that the following conditions are met: 8 | 9 | * Redistributions of source code must retain the above copyright 10 | notice, this list of conditions and the following disclaimer. 11 | 12 | * Redistributions in binary form must reproduce the above 13 | copyright notice, this list of conditions and the following 14 | disclaimer in the documentation and/or other materials provided 15 | with the distribution. 16 | 17 | * Neither the name of Ivan Perez, nor the name of Keera Studios, nor the 18 | names of other contributors may be used to endorse or promote products 19 | derived from this software without specific prior written permission. 20 | 21 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 22 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 23 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 24 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 25 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 26 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 27 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 28 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 29 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 30 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 31 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 32 | -------------------------------------------------------------------------------- /keera-hails/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /keera-hails/src/AppDataBasic.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveDataTypeable #-} 2 | -- | 3 | -- 4 | -- Copyright : (C) Keera Studios Ltd, 2013 5 | -- License : BSD3 6 | -- Maintainer : support@keera.co.uk 7 | module AppDataBasic where 8 | 9 | import Data.Data 10 | import Data.Default 11 | -- import Data.Typeable 12 | 13 | -- This is the CLI app definition : what we get from the user 14 | data AppDataBasic = AppDataBasic { 15 | action :: HailsAction 16 | , outputDir :: Maybe FilePath 17 | , overwrite :: Bool 18 | } 19 | deriving (Show, Data, Typeable) 20 | 21 | data HailsAction = HailsInit 22 | | HailsClean 23 | deriving (Show, Data, Typeable) 24 | 25 | instance Default HailsAction where 26 | def = HailsInit 27 | -------------------------------------------------------------------------------- /keera-hails/src/AppDataFull.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- 3 | -- Copyright : (C) Keera Studios Ltd, 2013 4 | -- License : BSD3 5 | -- Maintainer : support@keera.co.uk 6 | module AppDataFull where 7 | 8 | import AppDataBasic (HailsAction) 9 | 10 | -- This is the internal action definition. It should be a more 11 | -- complete version of the basic data. Some values can be read from 12 | -- existing files, for instance, from cabal files, from Haskell 13 | -- source, etc. 14 | data AppDataFull = AppDataFull 15 | { action :: HailsAction 16 | , outputDir :: FilePath 17 | , overwrite :: Bool 18 | } 19 | deriving (Show) 20 | 21 | -------------------------------------------------------------------------------- /keera-hails/src/HailsArgs.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- 3 | -- Copyright : (C) Keera Studios Ltd, 2013 4 | -- License : BSD3 5 | -- Maintainer : support@keera.co.uk 6 | module HailsArgs where 7 | 8 | -- External 9 | import System.Console.CmdArgs 10 | 11 | -- Internal 12 | import AppDataBasic 13 | 14 | -- This is the cmdArgs-based CLI interface definition 15 | sample :: AppDataBasic 16 | sample = AppDataBasic 17 | { action = enum [ HailsInit 18 | &= explicit 19 | &= name "init" 20 | &= help "(Re-)start a project" 21 | , HailsClean 22 | &= explicit 23 | &= name "clean" 24 | &= help "Delete unmodified templates" 25 | ] 26 | &= help "Hails action to execute (init)" 27 | &= typ "ACTION" 28 | , outputDir = def 29 | &= explicit 30 | &= name "output-dir" 31 | &= help "Directory where generated files will be placed" 32 | &= typ "DIR" 33 | , overwrite = def 34 | &= help "Overwrite existing files" 35 | } 36 | &= summary "Hails" 37 | &= program "hails" 38 | 39 | -------------------------------------------------------------------------------- /keera-hails/src/System/Application.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- 3 | -- Copyright : (C) Keera Studios Ltd, 2013 4 | -- License : BSD3 5 | -- Maintainer : support@keera.co.uk 6 | module System.Application where 7 | 8 | -- External imports 9 | import Control.Monad 10 | -- import Control.Monad.Extra 11 | import System.GIO.File.AppInfo 12 | import System.Process 13 | 14 | -- FIXME: This uses runProcess instead of appInfoLaunchUris because 15 | -- the latter segfaults in my machine 16 | openUrlBySystemTool :: String -> IO Bool 17 | openUrlBySystemTool url = do 18 | infos <- appInfoGetAllForType "text/html" 19 | unless (null infos) $ void $ do 20 | let exe = appInfoGetExecutable $ head infos 21 | runProcess exe [url] Nothing Nothing Nothing Nothing Nothing 22 | return (not (null infos)) 23 | -------------------------------------------------------------------------------- /keera-hails/templates/CombinedEnvironment.hs: -------------------------------------------------------------------------------- 1 | -- | The environment that contains both the view and the model. 2 | -- 3 | module CombinedEnvironment 4 | ( CEnv 5 | , module Exported 6 | ) 7 | where 8 | 9 | -- Generic libraries 10 | import qualified Hails.MVC.GenericCombinedEnvironment as GEnv 11 | import Hails.MVC.DefaultGtkEnvironment as Exported 12 | 13 | -- Internal libraries 14 | import Model.ReactiveModel.ModelEvents as Exported 15 | import Model.ProtectedModel as Exported 16 | import Model.Model 17 | import View as Exported 18 | import View.Objects as Exported 19 | 20 | -- The simplest definition: a view, a model, and a set of events 21 | type CEnv = GEnv.CEnv View Model ModelEvent 22 | -------------------------------------------------------------------------------- /keera-hails/templates/Controller/Conditions.hs: -------------------------------------------------------------------------------- 1 | module Controller.Conditions where 2 | 3 | import CombinedEnvironment 4 | 5 | installHandlers :: CEnv -> IO () 6 | installHandlers cenv = do 7 | return () 8 | -------------------------------------------------------------------------------- /keera-hails/templates/Main.hs: -------------------------------------------------------------------------------- 1 | -- | This is the main program with which the graphical app is launched. 2 | module Main where 3 | 4 | -- Internal imports 5 | import Controller 6 | 7 | -- |The app starts here. Here we simply call the controller, which 8 | -- takes control from now on. 9 | main :: IO () 10 | main = startController 11 | -------------------------------------------------------------------------------- /keera-hails/templates/Model/Model.hs: -------------------------------------------------------------------------------- 1 | module Model.Model where 2 | 3 | data Model = Model 4 | { 5 | } 6 | 7 | emptyBM :: Model 8 | emptyBM = Model 9 | -------------------------------------------------------------------------------- /keera-hails/templates/Model/ProtectedModel.hs: -------------------------------------------------------------------------------- 1 | module Model.ProtectedModel 2 | ( ProtectedModel 3 | , onEvent 4 | , waitFor 5 | , module Exported 6 | ) 7 | where 8 | 9 | import Model.ProtectedModel.ProtectedModelInternals 10 | import Model.ReactiveModel.ModelEvents as Exported 11 | import Model.ProtectedModel.ProtectedFields as Exported 12 | import Hails.MVC.Model.ProtectedModel.Initialisation as Exported -------------------------------------------------------------------------------- /keera-hails/templates/Model/ProtectedModel/ProtectedFields.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell #-} 2 | -- | This module holds the functions to access and modify the project name 3 | -- in a reactive model. 4 | module Model.ProtectedModel.ProtectedFields where 5 | 6 | -- Internal imports 7 | import Hails.MVC.Model.THFields 8 | import Hails.MVC.Model.ProtectedModel.Reactive 9 | 10 | import Model.Model 11 | import qualified Model.ReactiveModel as RM 12 | import Model.ReactiveModel.ModelEvents 13 | import Model.ProtectedModel.ProtectedModelInternals 14 | 15 | -- protectedField {- Model field -} {- Field type -} {- Model name -} {- event name -} 16 | -- protectedField "Language" [t|Maybe Language|] "Model" "ModelEvent" 17 | -------------------------------------------------------------------------------- /keera-hails/templates/Model/ProtectedModel/ProtectedModelInternals.hs: -------------------------------------------------------------------------------- 1 | -- | Contains the protected model definition used by other modules to 2 | -- declare the protected fields. 3 | -- 4 | module Model.ProtectedModel.ProtectedModelInternals 5 | ( ProtectedModel 6 | , GPM.onReactiveModel 7 | , GPM.fromReactiveModel 8 | , GPM.applyToReactiveModel 9 | , GPM.onEvent 10 | , GPM.onEvents 11 | , GPM.waitFor 12 | ) 13 | where 14 | 15 | import Model.Model 16 | import Model.ReactiveModel.ModelEvents 17 | import qualified Hails.MVC.Model.ProtectedModel as GPM 18 | 19 | type ProtectedModel = GPM.ProtectedModel Model ModelEvent 20 | -------------------------------------------------------------------------------- /keera-hails/templates/Model/ReactiveModel.hs: -------------------------------------------------------------------------------- 1 | -- | This module holds the reactive program model. It holds a program 2 | -- model, but includes events that other threads can listen to, so 3 | -- that a change in a part of the model is notified to other parts of 4 | -- the program. The reactive model is not necessarily concurrent (it 5 | -- doesn't have its own thread), although a facility is included to 6 | -- make it also concurrent (so that event handlers can be called as 7 | -- soon as they are present). 8 | module Model.ReactiveModel 9 | ( ReactiveModel 10 | -- * Construction 11 | , emptyRM 12 | -- * Access 13 | , pendingEvents 14 | , pendingHandlers 15 | -- * Modification 16 | , getPendingHandler 17 | , onEvent 18 | , module Exported 19 | ) 20 | where 21 | 22 | import Model.ReactiveModel.ReactiveModelInternals 23 | import Hails.MVC.Model.ReactiveModel.Initialisation as Exported 24 | import Model.ReactiveModel.ReactiveFields as Exported 25 | import Model.ReactiveModel.ModelEvents as Exported -------------------------------------------------------------------------------- /keera-hails/templates/Model/ReactiveModel/ModelEvents.hs: -------------------------------------------------------------------------------- 1 | module Model.ReactiveModel.ModelEvents where 2 | 3 | import qualified Hails.MVC.Model.ReactiveModel as GRM 4 | import Hails.MVC.Model.ReactiveModel.Events 5 | 6 | -- Implement this interface if you want automatic update notification 7 | -- import Hails.MVC.Model.ProtectedModel.UpdatableModel 8 | 9 | data ModelEvent = UncapturedEvent 10 | | Initialised 11 | -- | MaxVersionAvailable 12 | deriving (Eq,Ord) 13 | 14 | instance GRM.Event ModelEvent where 15 | undoStackChangedEvent = UncapturedEvent 16 | 17 | -- instance UpdateNotifiableEvent ModelEvent where 18 | -- updateNotificationEvent = MaxVersionAvailable 19 | 20 | instance InitialisedEvent ModelEvent where 21 | initialisedEvent = Initialised 22 | 23 | 24 | -------------------------------------------------------------------------------- /keera-hails/templates/Model/ReactiveModel/ReactiveFields.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell #-} 2 | module Model.ReactiveModel.ReactiveFields where 3 | 4 | -- External imports 5 | import qualified Hails.MVC.Model.ReactiveFields as RFs 6 | import Hails.MVC.Model.ReactiveFields 7 | (fieldGetter, fieldSetter, preTrue) 8 | import Hails.MVC.Model.THFields 9 | 10 | -- Internal imports 11 | import Model.Model 12 | import Model.ReactiveModel.ReactiveModelInternals 13 | import Model.ReactiveModel.ModelEvents 14 | 15 | -- A Field of type A lets us access a reactive field of type a from 16 | -- a Model, and it triggers a ModelEvent 17 | type Field a = RFs.Field a Model ModelEvent 18 | 19 | -- reactiveField {- Field name -} {- Field type -} 20 | -- reactiveField "Status" [t|Status|] 21 | -------------------------------------------------------------------------------- /keera-hails/templates/Model/ReactiveModel/ReactiveModelInternals.hs: -------------------------------------------------------------------------------- 1 | -- | This module has been generated by hails. 2 | -- 3 | -- This module holds the reactive program model. It holds a program model, 4 | -- but includes events that other threads can listen to, so that a change 5 | -- in a part of the model is notified to another part of the program. The 6 | -- reactive model is not necessarily concurrent (it doesn't have its own thread), 7 | -- although a facility is included to make it also concurrent (so that 8 | -- event handlers can be called as soon as they are present). 9 | module Model.ReactiveModel.ReactiveModelInternals 10 | ( ReactiveModel 11 | , GRM.basicModel 12 | -- * Construction 13 | , GRM.emptyRM 14 | -- * Access 15 | , GRM.pendingEvents 16 | , GRM.pendingHandlers 17 | -- * Modification 18 | , GRM.getPendingHandler 19 | , GRM.onEvent 20 | , GRM.onEvents 21 | , GRM.onBasicModel 22 | , GRM.triggerEvent 23 | ) 24 | where 25 | 26 | -- Internal imports 27 | -- import GenericModel.GenericReactiveModel 28 | import Model.Model 29 | import Model.ReactiveModel.ModelEvents 30 | import qualified Hails.MVC.Model.ReactiveModel as GRM 31 | 32 | type ReactiveModel = GRM.ReactiveModel Model ModelEvent (IO ()) 33 | -------------------------------------------------------------------------------- /keera-hails/templates/Paths/CustomPaths.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | module Paths.CustomPaths 3 | (module Paths_myapp 4 | #ifndef linux_HOST_OS 5 | , module Paths.CustomPaths 6 | #endif 7 | ) 8 | where 9 | 10 | import Paths_myapp 11 | 12 | #ifndef linux_HOST_OS 13 | vendorKey :: String 14 | vendorKey = "" 15 | 16 | programKey :: String 17 | programKey = "" 18 | #endif 19 | -------------------------------------------------------------------------------- /keera-hails/templates/View.hs: -------------------------------------------------------------------------------- 1 | -- | Contains basic operations related to the GUI 2 | -- 3 | module View (module Exported) where 4 | 5 | -- External libraries 6 | import Hails.MVC.View.DefaultViewGtk as Exported 7 | import Hails.MVC.View.GtkView (GtkGUI (..)) 8 | import Hails.MVC.View.GtkView as Exported 9 | 10 | -- Internal libraries 11 | import View.Objects 12 | 13 | -- | Add all initialisers to the initialise operation and store 14 | -- everything we'll need in the view. We need this operation here 15 | -- because the URL to the glade file depends on the application 16 | -- name. 17 | instance GtkGUI View where 18 | initialise = fmap View loadInterface 19 | -------------------------------------------------------------------------------- /keera-hails/templates/View/Objects.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell #-} 2 | module View.Objects where 3 | 4 | -- External imports 5 | import Graphics.UI.Gtk 6 | import Hails.MVC.View.Gtk.Builder 7 | 8 | -- Internal imports 9 | import Paths 10 | 11 | loadInterface :: IO Builder 12 | loadInterface = loadDefaultInterface getDataFileName 13 | 14 | -- gtkBuilderAccessor element name type name 15 | -- gtkBuilderAccessor "mainMenu" "Menu" 16 | 17 | -- You can use the following function to access objects obtained from the 18 | -- Glade file. 19 | -- 20 | -- onBuilder :: (GObjectClass cls) 21 | -- => (GObject -> cls) -> String -> Builder -> IO cls 22 | -- onBuilder f s b = builderGetObject b f s 23 | -- 24 | -- Normally, the main window will be called mainWindow and you can access 25 | -- it with the following definition. 26 | -- 27 | -- -- | Returns the IDE's main window. 28 | -- mainWindow :: Builder -> IO Window 29 | -- mainWindow = onBuilder castToWindow "mainWindow" 30 | -------------------------------------------------------------------------------- /keera-hails/tests/HLint.hs: -------------------------------------------------------------------------------- 1 | import "hint" HLint.HLint 2 | 3 | -------------------------------------------------------------------------------- /keera-hails/tests/HLintMain.hs: -------------------------------------------------------------------------------- 1 | ----------------------------------------------------------------------------- 2 | -- | 3 | -- Module : Main (hlint) 4 | -- Copyright : (C) 2013 Edward Kmett 5 | -- License : BSD-style (see the file LICENSE) 6 | -- Maintainer : Edward Kmett 7 | -- Stability : provisional 8 | -- Portability : portable 9 | -- 10 | -- This module runs HLint on the lens source tree. 11 | ----------------------------------------------------------------------------- 12 | module Main where 13 | 14 | import Control.Monad 15 | import Language.Haskell.HLint 16 | import System.Environment 17 | import System.Exit 18 | 19 | main :: IO () 20 | main = do 21 | args <- getArgs 22 | hints <- hlint $ ["src", "--cross", "--hint=tests/HLint.hs" ] ++ args 23 | unless (null hints) exitFailure 24 | --------------------------------------------------------------------------------