Repository: Gabriel439/Haskell-Typed-Spreadsheet-Library Branch: main Commit: 76df0fbf9883 Files: 20 Total size: 42.2 KB Directory structure: gitextract_kdz7u747/ ├── .gitignore ├── .travis.yml ├── CHANGELOG.md ├── LICENSE ├── README.md ├── Setup.hs ├── default.nix ├── exec/ │ ├── Cell.hs │ ├── Graphics.hs │ └── Text.hs ├── nix/ │ ├── fetchNixpkgs.nix │ ├── readDirectory.nix │ └── typed-spreadsheet.nix ├── nixpkgs.json ├── osx.yaml ├── release.nix ├── shell.nix ├── src/ │ └── Typed/ │ └── Spreadsheet.hs ├── stack.yaml └── typed-spreadsheet.cabal ================================================ FILE CONTENTS ================================================ ================================================ FILE: .gitignore ================================================ .stack-work ================================================ FILE: .travis.yml ================================================ language: nix script: nix-build release.nix ================================================ FILE: CHANGELOG.md ================================================ 1.0.0 * Initial release 1.0.1 * Added `diagrams` backend * Added variations on controls that accept starting values 1.1 * Reverse coordinate system for `diagrams` output. The +y direction used to point down and now it points up 1.1.1 * Add new controls for vertical and horizontal scales 1.1.2 * Expose `ui` function 1.1.3 * Support GHC 8.4 1.1.4 * Increase upper bounds on dependencies 1.1.5 * Increase upper bounds on dependencies ================================================ FILE: LICENSE ================================================ Copyright (c) 2015 Gabriella Gonzalez All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of Gabriella Gonzalez nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. ================================================ FILE: README.md ================================================ # typed-spreadsheet v1.1.4 `typed-spreadsheet` provides a typed and composable API for building spreadsheets. This differs from traditional spreadsheets in a few important ways: * you specify the relationship between inputs and outputs at compile time, not runtime, so that the relationship can be type-checked * inputs of different types have different controls; for example, a `Bool` input creates a checkbox and a `Double` input creates a spin button * you can only output a single value; you simulate multiple outputs by emitting a tuple of values # Quick Start This project includes two example executables that you can build and tweak to test drive the library. To clone, build, and run the executable just follow these commands depending on your operating system: ## OS X ```bash $ # Installs the Gtk+ library $ brew install gtk $ # Creates a local copy of this repository $ git clone https://github.com/Gabriella439/Haskell-Typed-Spreadsheet-Library.git $ # Builds the executables $ stack build --stack-yaml=osx.yaml --install-ghc $ # Runs the text output example $ stack exec --stack-yaml=osx.yaml typed-spreadsheet-example-text $ # Runs the graphical example $ stack exec --stack-yaml=osx.yaml typed-spreadsheet-example-graphics ``` ## Debian These instructions will also probably work on other Linux distributions derived from Debian like Ubuntu or Mint: ```bash $ # Install the Gtk+ 2.0 development headers $ sudo apt-get install libgtk2.0-dev $ # Creates a local copy of this repository $ git clone https://github.com/Gabriella439/Haskell-Typed-Spreadsheet-Library.git $ # Builds the executables $ stack build --install-ghc $ # Runs the text output example $ stack exec typed-spreadsheet-example-text $ # Runs the graphical example $ stack exec typed-spreadsheet-example-graphics ``` ## Other operating systems If you would like to contribute build instructions for other operating systems, please submit a pull request. ## Examples The [executable code](https://github.com/Gabriella439/Haskell-Typed-Spreadsheet-Library/blob/master/exec/Text.hs) for first example is short: ```haskell {-# LANGUAGE ApplicativeDo #-} {-# LANGUAGE OverloadedStrings #-} import Typed.Spreadsheet main :: IO () main = textUI "Example program" $ do a <- checkBox "a" b <- spinButton "b" 1 c <- spinButton "c" 0.1 d <- entry "d" return (display (a, b + c, d)) ``` ... and translates to a spreadsheet with all inputs on the left-hand side and the output on the right-hand side: ![](http://i.imgur.com/TTxgSwN.png) You can also output updatable diagrams built using the `diagrams` library, such as [in this example](https://github.com/Gabriella439/Haskell-Typed-Spreadsheet-Library/blob/master/exec/Graphics.hs): ```haskell {-# LANGUAGE ApplicativeDo #-} {-# LANGUAGE OverloadedStrings #-} import Diagrams.Prelude import Typed.Spreadsheet data AColor = Red | Orange | Yellow | Green | Blue | Purple deriving (Enum, Bounded, Show) toColor :: AColor -> Colour Double toColor Red = red toColor Orange = orange toColor Yellow = yellow toColor Green = green toColor Blue = blue toColor Purple = purple main :: IO () main = graphicalUI "Example program" $ do color <- radioButton "Color" Red [Orange .. Purple] r <- spinButtonAt 100 "Radius" 1 x <- spinButton "X Coordinate" 1 y <- spinButton "Y Coordinate" 1 return (circle r # fc (toColor color) # translate (r2 (x, y))) ``` This produces a canvas that colors, resizes, and moves a circle in response to user input: ![](http://i.imgur.com/ddYoG46.png) To learn more about the library, read the [documentation on Hackage](http://hackage.haskell.org/package/typed-spreadsheet/docs/Typed-Spreadsheet.html). # Additional examples Mortgage calculator: ```haskell {-# LANGUAGE ApplicativeDo #-} {-# LANGUAGE OverloadedStrings #-} import Typed.Spreadsheet main :: IO () main = textUI "Mortgage payment" $ do mortgageAmount <- spinButton "Mortgage Amount" 1000 numberOfYears <- spinButton "Number of years" 1 yearlyInterestRate <- spinButton "Yearly interest rate (%)" 0.01 let n = truncate (numberOfYears * 12) let i = yearlyInterestRate / 12 / 100 return ("Monthly payment: $" <> display (mortgageAmount * (i * (1 + i) ^ n) / ((1 + i) ^ n - 1))) ``` Example input and output: ![Mortgage calculator program](http://i.imgur.com/nvRZ9HC.png) Mad libs: ```haskell {-# LANGUAGE OverloadedStrings #-} import Typed.Spreadsheet noun = entry "Noun" verb = entry "Verb" adjective = entry "Adjective" example = "I want to " <> verb <> " every " <> noun <> " because they are so " <> adjective main :: IO () main = textUI "Mad libs" example ``` Example input and output: ![Mad libs program](http://i.imgur.com/k22An4Y.png) Sinusoid plot: ```haskell {-# LANGUAGE OverloadedStrings #-} import Diagrams.Prelude import Typed.Spreadsheet main :: IO () main = graphicalUI "Example program" $ do amplitude <- spinButtonAt 50 "Amplitude (Pixels)" 0.1 frequency <- spinButtonAt 0.1 "Frequency (Pixels⁻¹)" 0.001 phase <- spinButtonAt 90 "Phase (Degrees)" 1 let axes = arrowBetween (p2 (0, 0)) (p2 ( 100, 0)) <> arrowBetween (p2 (0, 0)) (p2 (-100, 0)) <> arrowBetween (p2 (0, 0)) (p2 ( 0, 100)) <> arrowBetween (p2 (0, 0)) (p2 ( 0, -100)) let f x = amplitude * cos (frequency * x + phase * pi / 180) let points = map (\x -> p2 (x, f x)) [-100, -99 .. 100] return (strokeP (fromVertices points) <> axes) ``` Example input and output: ![Sinusoid plot](http://i.imgur.com/ueF0w7U.png) Factor diagram: ```haskell {-# LANGUAGE OverloadedStrings #-} import Diagrams.Prelude import Diagrams.TwoD.Factorization (factorDiagram') import Typed.Spreadsheet main :: IO () main = graphicalUI "Factor diagram" $ do x <- spinButtonAt 3 "Factor #1" 1 y <- spinButtonAt 3 "Factor #2" 1 z <- spinButtonAt 3 "Factor #3" 1 return (factorDiagram' [truncate x, truncate y, truncate z] # scale 10) ``` Example input and output: ![Factor diagram](http://i.imgur.com/eMvMtKk.png) # How to contribute The easiest way to contribute is to add new controls for user input. If you are feeling particularly adventurous, you can work on adding a `diagrams` output option instead of a text-based output. ## Development Status [![Build Status](https://travis-ci.org/Gabriella439/Haskell-Typed-Spreadsheet-Library.png)](https://travis-ci.org/Gabriella439/Haskell-Typed-Spreadsheet-Library) The high-level API for this library is unlikely to change. I expect most of the volatility early on will be in how much configuration for controls to expose to end users. For example, controls could be generalized to permit stateful operations, but it's not clear if that additional complexity is worth it. There might be new features added later such as `diagrams` output or new controls, but I expect those additions will not require any breaking changes to the API. ## LICENSE (BSD 3-Clause) Copyright (c) 2014 Gabriella Gonzalez All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of Gabriella Gonzalez nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. ================================================ FILE: Setup.hs ================================================ import Distribution.Simple main = defaultMain ================================================ FILE: default.nix ================================================ let fetchNixpkgs = import ./nix/fetchNixpkgs.nix; nixpkgs = fetchNixpkgs { rev = "6a7dea9330c3d1f1f53610e753aada029eb8b86e"; sha256 = "0i8nf8szg27vnha8l22k9wwj3fyya6mf4b6g05fi1kyv3mmazhq7"; }; readDirectory = import ./nix/readDirectory.nix; config = { packageOverrides = pkgs: { haskellPackages = pkgs.haskellPackages.override { overrides = let manualOverrides = haskellPackagesNew: haskellPackagesOld: { typed-spreadsheet = if pkgs.stdenv.isDarwin then pkgs.haskell.lib.addBuildDepend haskellPackagesOld.typed-spreadsheet pkgs.darwin.apple_sdk.frameworks.Cocoa else haskellPackagesOld.typed-spreadsheet; }; in pkgs.lib.composeExtensions (readDirectory ./nix) manualOverrides; }; }; }; pkgs = import nixpkgs { inherit config; }; in { inherit (pkgs.haskellPackages) typed-spreadsheet; shell = (pkgs.haskell.lib.doBenchmark pkgs.haskellPackages.typed-spreadsheet).env; } ================================================ FILE: exec/Cell.hs ================================================ {-# LANGUAGE ApplicativeDo #-} {-# LANGUAGE OverloadedStrings #-} import Typed.Spreadsheet main :: IO () main = cellUI "Example program" $ do a <- checkBox "a" b <- spinButton "b" 1 c <- spinButton "c" 0.1 d <- entry "d" return [ ("a" , display a ) , ("b + c", display (b + c)) , ("d" , display d ) ] ================================================ FILE: exec/Graphics.hs ================================================ {-# LANGUAGE ApplicativeDo #-} {-# LANGUAGE OverloadedStrings #-} import Diagrams.Prelude import Typed.Spreadsheet data AColor = Red | Orange | Yellow | Green | Blue | Purple deriving (Enum, Bounded, Show) toColor :: AColor -> Colour Double toColor Red = red toColor Orange = orange toColor Yellow = yellow toColor Green = green toColor Blue = blue toColor Purple = purple main :: IO () main = graphicalUI "Example program" $ do color <- radioButton "Color" Red [Orange .. Purple] r <- spinButtonAt 100 "Radius" 1 x <- hscaleWithRange (-200) 200 0 "X Coordinate" 10 y <- vscaleWithRange (-200) 200 0 "Y Coordinate" 10 return (circle r # fc (toColor color) # translate (r2 (x, y))) ================================================ FILE: exec/Text.hs ================================================ {-# LANGUAGE ApplicativeDo #-} {-# LANGUAGE OverloadedStrings #-} import Typed.Spreadsheet main :: IO () main = textUI "Example program" $ do a <- checkBox "a" b <- spinButton "b" 1 c <- spinButton "c" 0.1 d <- entry "d" return (display (a, b + c, d)) ================================================ FILE: nix/fetchNixpkgs.nix ================================================ { rev # The Git revision of nixpkgs to fetch , sha256 # The SHA256 hash of the unpacked archive , system ? builtins.currentSystem # This is overridable if necessary }: if (0 <= builtins.compareVersions builtins.nixVersion "1.12") # In Nix 1.12, we can just give a `sha256` to `builtins.fetchTarball`. then ( builtins.fetchTarball { url = "https://github.com/NixOS/nixpkgs/archive/${rev}.tar.gz"; inherit sha256; }) # This hack should at least work for Nix 1.11 else ( (rec { tarball = import { url = "https://github.com/NixOS/nixpkgs/archive/${rev}.tar.gz"; sha256 = null; }; builtin-paths = import ; script = builtins.toFile "nixpkgs-unpacker" '' "$coreutils/mkdir" "$out" cd "$out" "$gzip" --decompress < "$tarball" | "$tar" -x --strip-components=1 ''; nixpkgs = builtins.derivation ({ name = "nixpkgs-${builtins.substring 0 6 rev}"; builder = builtins.storePath builtin-paths.shell; args = [ script ]; inherit tarball system; tar = builtins.storePath builtin-paths.tar; gzip = builtins.storePath builtin-paths.gzip; coreutils = builtins.storePath builtin-paths.coreutils; } // (if null == sha256 then { } else { outputHashMode = "recursive"; outputHashAlgo = "sha256"; outputHash = sha256; })); }).nixpkgs) ================================================ FILE: nix/readDirectory.nix ================================================ directory: haskellPackagesNew: haskellPackagesOld: let haskellPaths = builtins.attrNames (builtins.readDir directory); toKeyVal = file: { name = builtins.replaceStrings [ ".nix" ] [ "" ] file; value = haskellPackagesNew.callPackage (directory + "/${file}") { }; }; in builtins.listToAttrs (map toKeyVal haskellPaths) ================================================ FILE: nix/typed-spreadsheet.nix ================================================ { mkDerivation, async, base, diagrams-cairo, diagrams-gtk , diagrams-lib, foldl, gtk, microlens, stdenv, stm, text , transformers }: mkDerivation { pname = "typed-spreadsheet"; version = "1.1.5"; src = ./..; isLibrary = true; isExecutable = true; libraryHaskellDepends = [ async base diagrams-cairo diagrams-gtk diagrams-lib foldl gtk microlens stm text transformers ]; executableHaskellDepends = [ base diagrams-lib text ]; description = "Typed and composable spreadsheets"; license = stdenv.lib.licenses.bsd3; } ================================================ FILE: nixpkgs.json ================================================ { "url": "https://github.com/NixOS/nixpkgs.git", "rev": "09e191c22bbfad965a9b5469d5e0ac25b693036f", "date": "2017-02-25T17:09:34+01:00", "sha256": "1454ysw5gy52kb08v1wd2f6incp2ccmf79ni7kp2gmwrgsm3rrmj" } ================================================ FILE: osx.yaml ================================================ resolver: lts-8.2 extra-deps: - gtk-0.14.6 flags: gtk: have-quartz-gtk: true ================================================ FILE: release.nix ================================================ let default = import ./default.nix; in { inherit (default) typed-spreadsheet; } ================================================ FILE: shell.nix ================================================ (import ./default.nix).shell ================================================ FILE: src/Typed/Spreadsheet.hs ================================================ {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ApplicativeDo #-} {-# LANGUAGE CPP #-} -- | The following program: -- -- > {-# LANGUAGE ApplicativeDo #-} -- > {-# LANGUAGE OverloadedStrings #-} -- > -- > import Typed.Spreadsheet -- > -- > main :: IO () -- > main = textUI "Example program" $ do -- > a <- checkBox "a" -- > b <- spinButton "b" 1 -- > c <- spinButton "c" 0.1 -- > d <- entry "d" -- > return (display (a, b + c, d)) -- -- ... creates a user interface that looks like this: -- -- <> -- -- Every time you update a control on the left panel, the right panel updates -- in response: -- -- <> -- -- This library also supports graphical output, like in the following program: -- -- > {-# LANGUAGE ApplicativeDo #-} -- > {-# LANGUAGE OverloadedStrings #-} -- > -- > import Diagrams.Prelude -- > import Typed.Spreadsheet -- > -- > data AColor = Red | Orange | Yellow | Green | Blue | Purple -- > deriving (Enum, Bounded, Show) -- > -- > toColor :: AColor -> Colour Double -- > toColor Red = red -- > toColor Orange = orange -- > toColor Yellow = yellow -- > toColor Green = green -- > toColor Blue = blue -- > toColor Purple = purple -- > -- > main :: IO () -- > main = graphicalUI "Example program" $ do -- > color <- radioButton "Color" Red [Orange .. Purple] -- > r <- spinButtonAt 100 "Radius" 1 -- > x <- spinButton "X Coordinate" 1 -- > y <- spinButton "Y Coordinate" 1 -- > return (circle r # fc (toColor color) # translate (r2 (x, y))) -- -- This produces a canvas that colors, resizes, and moves a circle in response -- to user input: -- -- <> -- -- The general workflow for this library is: -- -- * You build primitive `Updatable` values using `checkBox`, `spinButton`, -- `entry`, or `radioButton`, each of which corresponds to a control on the -- left panel of the user interface -- * Combine `Updatable` values using @ApplicativeDo@ notation. Composite values -- update whenever one of their substituent values update -- * You consume an @(`Updatable` `Text`)@ value using `textUI`, which displays -- the continuously updating value in the right panel of the user interface -- -- You can get started quickly by cloning and building this project: -- -- > $ git clone https://github.com/Gabriel439/Haskell-Typed-Spreadsheet-Library.git -- > $ stack build --install-ghc # Builds the executable -- > $ stack exec typed-spreadsheet-example # Runs the executable -- -- ... or if you are using OS X, then build the project using: -- -- > $ stack --stack-yaml=osx.yaml build --install-ghc -- -- That project includes the code for the above examples in the @exec/@ -- subdirectory. Just modify that file and rebuild to play with the example. -- -- NOTE: You must compile your program with the @-threaded@ flag. The example -- project takes care of this. -- -- See the \"Examples\" section at the bottom of this module for more examples. module Typed.Spreadsheet ( -- * Types Updatable , textUI , cellUI , graphicalUI , ui -- * Controls , checkBox , spinButton , entry , radioButton -- * Controls with Defaults , checkBoxAt , spinButtonAt , hscale , hscaleAt , hscaleWithRange , vscale , vscaleAt , vscaleWithRange , entryAt -- * Utilities , display -- * Examples -- $examples ) where import Control.Applicative import Control.Concurrent.STM (STM) import Control.Foldl (Fold(..)) import Control.Monad.IO.Class (liftIO) import Data.String (IsString(..)) import Data.Text (Text) import Diagrams.Backend.Cairo (Cairo) import Diagrams.Prelude (Diagram, r2, reflectY, translate, (#)) import Lens.Micro (_Left, _Right) import Graphics.UI.Gtk (AttrOp((:=))) import qualified Control.Concurrent import qualified Control.Concurrent.STM as STM import qualified Control.Concurrent.Async import qualified Control.Foldl import qualified Data.Text import qualified Diagrams.Backend.Gtk import qualified Graphics.UI.Gtk as Gtk data Cell a = forall e . Cell (IO (STM e, Fold e a)) instance Functor Cell where fmap f (Cell m) = Cell (fmap (fmap (fmap f)) m) instance Applicative Cell where pure a = Cell (pure (empty, pure a)) Cell mF <*> Cell mX = Cell (liftA2 helper mF mX) where helper (inputF, foldF) (inputX, foldX) = (input, fold ) where input = fmap Left inputF <|> fmap Right inputX fold = do f <- Control.Foldl.handles _Left foldF x <- Control.Foldl.handles _Right foldX return (f x) -- | An updatable input value data Updatable a = Updatable (Control -> Cell a) instance Functor Updatable where fmap f (Updatable m) = Updatable (fmap (fmap f) m) instance Applicative Updatable where pure a = Updatable (pure (pure a)) Updatable mf <*> Updatable mx = Updatable (liftA2 (<*>) mf mx) #if MIN_VERSION_base(4,11,0) instance Semigroup a => Semigroup (Updatable a) where (<>) = liftA2 (<>) instance Monoid a => Monoid (Updatable a) where mempty = pure mempty #else instance Monoid a => Monoid (Updatable a) where mempty = pure mempty mappend = liftA2 mappend #endif instance IsString a => IsString (Updatable a) where fromString str = pure (fromString str) instance Num a => Num (Updatable a) where fromInteger = pure . fromInteger negate = fmap negate abs = fmap abs signum = fmap signum (+) = liftA2 (+) (*) = liftA2 (*) (-) = liftA2 (-) instance Fractional a => Fractional (Updatable a) where fromRational = pure . fromRational recip = fmap recip (/) = liftA2 (/) instance Floating a => Floating (Updatable a) where pi = pure pi exp = fmap exp sqrt = fmap sqrt log = fmap log sin = fmap sin tan = fmap tan cos = fmap cos asin = fmap sin atan = fmap atan acos = fmap acos sinh = fmap sinh tanh = fmap tanh cosh = fmap cosh asinh = fmap asinh atanh = fmap atanh acosh = fmap acosh (**) = liftA2 (**) logBase = liftA2 logBase -- | Use a `Control` to obtain updatable input `Updatable`s data Control = Control { _checkBoxAt :: Bool -> Text -> Cell Bool , _spinButtonAt :: Double -> Text -> Double -> Cell Double , _hscaleWithRange :: Double -> Double -> Double -> Text -> Double -> Cell Double , _vscaleWithRange :: Double -> Double -> Double -> Text -> Double -> Cell Double , _entryAt :: Text -> Text -> Cell Text , _radioButton :: forall a . Show a => Text -> a -> [a] -> Cell a } -- | Build a `Text`-based user interface textUI :: Text -- ^ Window title -> Updatable Text -- ^ Program logic -> IO () textUI = ui textSetup processTextEvent where textSetup :: Gtk.HBox -> IO Gtk.TextBuffer textSetup hBox = do textView <- Gtk.textViewNew textBuffer <- Gtk.get textView Gtk.textViewBuffer Gtk.set textView [ Gtk.textViewEditable := False , Gtk.textViewCursorVisible := False ] hAdjust <- Gtk.textViewGetHadjustment textView vAdjust <- Gtk.textViewGetVadjustment textView scrolledWindow <- Gtk.scrolledWindowNew (Just hAdjust) (Just vAdjust) Gtk.set scrolledWindow [ Gtk.containerChild := textView , Gtk.scrolledWindowShadowType := Gtk.ShadowIn , Gtk.scrolledWindowHscrollbarPolicy := Gtk.PolicyAutomatic , Gtk.scrolledWindowVscrollbarPolicy := Gtk.PolicyAutomatic ] Gtk.boxPackStart hBox scrolledWindow Gtk.PackGrow 0 return textBuffer processTextEvent :: Gtk.TextBuffer -> Text -> IO () processTextEvent textBuffer txt = Gtk.set textBuffer [ Gtk.textBufferText := txt ] -- | Build a cell-based user interface cellUI :: Text -- ^ Window title -> Updatable [(Text, Text)] -- ^ Program logic -> IO () cellUI = ui cellSetup processCellEvent where cellSetup :: Gtk.HBox -> IO Gtk.VBox cellSetup hBox = do vbox <- Gtk.vBoxNew False 5 Gtk.boxPackStart hBox vbox Gtk.PackGrow 0 return vbox processCellEvent :: Gtk.VBox -> [(Text, Text)] -> IO () processCellEvent vbox keyVals = do cells <- Gtk.containerGetChildren vbox mapM_ (Gtk.containerRemove vbox) cells let createCell (key, val) = do textView <- Gtk.textViewNew textBuffer <- Gtk.get textView Gtk.textViewBuffer Gtk.set textView [ Gtk.textViewEditable := False , Gtk.textViewCursorVisible := False ] Gtk.set textBuffer [ Gtk.textBufferText := val ] hAdjust <- Gtk.textViewGetHadjustment textView vAdjust <- Gtk.textViewGetVadjustment textView scrolledWindow <- do Gtk.scrolledWindowNew (Just hAdjust) (Just vAdjust) Gtk.set scrolledWindow [ Gtk.containerChild := textView , Gtk.scrolledWindowShadowType := Gtk.ShadowIn , Gtk.scrolledWindowHscrollbarPolicy := Gtk.PolicyAutomatic , Gtk.scrolledWindowVscrollbarPolicy := Gtk.PolicyAutomatic ] frame <- Gtk.frameNew Gtk.set frame [ Gtk.containerChild := scrolledWindow , Gtk.frameLabel := key ] Gtk.boxPackStart vbox frame Gtk.PackNatural 0 mapM_ createCell keyVals Gtk.widgetShowAll vbox -- | Build a `Diagram`-based user interface graphicalUI :: Text -- ^ Window title -> Updatable (Diagram Cairo) -- ^ Program logic -> IO () graphicalUI = ui setupGraphical processGraphicalEvent where setupGraphical :: Gtk.HBox -> IO Gtk.DrawingArea setupGraphical hBox = do drawingArea <- Gtk.drawingAreaNew Gtk.boxPackStart hBox drawingArea Gtk.PackGrow 0 return drawingArea processGraphicalEvent :: Gtk.DrawingArea -> Diagram Cairo -> IO () processGraphicalEvent drawingArea diagram = do drawWindow <- Gtk.widgetGetDrawWindow drawingArea (w, h) <- Gtk.widgetGetSize drawingArea let w' = fromIntegral w / 2 let h' = fromIntegral h / 2 let diagram' = diagram # reflectY # translate (r2 (w', h')) Diagrams.Backend.Gtk.renderToGtk drawWindow diagram' -- | Underlying function for building custom user interfaces ui :: (Gtk.HBox -> IO resource) -- ^ Acquire initial resource -> (resource -> event -> IO ()) -- ^ Callback function to process each event -> Text -- ^ Window title -> Updatable event -- ^ Event stream -> IO () ui setup process title (Updatable k) = do _ <- Gtk.initGUI window <- Gtk.windowNew Gtk.set window [ Gtk.containerBorderWidth := 5 ] vBox <- Gtk.vBoxNew False 5 hBox <- Gtk.hBoxNew False 5 Gtk.boxPackStart hBox vBox Gtk.PackNatural 0 a <- setup hBox Gtk.set window [ Gtk.windowTitle := title , Gtk.containerChild := hBox , Gtk.windowDefaultWidth := 600 , Gtk.windowDefaultHeight := 400 ] let __spinButtonAt :: Double -> Text -> Double -> Cell Double __spinButtonAt s0 label stepX = Cell (do tmvar <- STM.newEmptyTMVarIO let minX = fromIntegral (minBound :: Int) let maxX = fromIntegral (maxBound :: Int) spinButton_ <- Gtk.spinButtonNewWithRange minX maxX stepX Gtk.set spinButton_ [ Gtk.spinButtonValue := s0 ] _ <- Gtk.onValueSpinned spinButton_ (do n <- Gtk.get spinButton_ Gtk.spinButtonValue STM.atomically (STM.putTMVar tmvar n) ) frame <- Gtk.frameNew Gtk.set frame [ Gtk.containerChild := spinButton_ , Gtk.frameLabel := label ] Gtk.boxPackStart vBox frame Gtk.PackNatural 0 Gtk.widgetShowAll vBox return (STM.takeTMVar tmvar, Control.Foldl.lastDef s0) ) let __hscaleWithRange :: Double -> Double -> Double -> Text -> Double -> Cell Double __hscaleWithRange minY maxY s0 label stepY = Cell (do tmvar <- STM.newEmptyTMVarIO slider <- Gtk.hScaleNewWithRange minY maxY stepY Gtk.set slider [ Gtk.rangeValue := s0 ] _ <- Gtk.onRangeValueChanged slider (do n <- Gtk.get slider Gtk.rangeValue STM.atomically (STM.putTMVar tmvar n) ) frame <- Gtk.frameNew Gtk.set frame [ Gtk.containerChild := slider , Gtk.frameLabel := label ] Gtk.boxPackStart vBox frame Gtk.PackNatural 0 Gtk.widgetShowAll vBox return (STM.takeTMVar tmvar, Control.Foldl.lastDef s0) ) let __vscaleWithRange :: Double -> Double -> Double -> Text -> Double -> Cell Double __vscaleWithRange minY maxY s0 label stepY = Cell (do tmvar <- STM.newEmptyTMVarIO slider <- Gtk.vScaleNewWithRange minY maxY stepY Gtk.set slider [ Gtk.rangeValue := (-s0) ] _ <- Gtk.onRangeValueChanged slider (do n <- Gtk.get slider Gtk.rangeValue STM.atomically (STM.putTMVar tmvar (-n)) ) frame <- Gtk.frameNew Gtk.set frame [ Gtk.containerChild := slider , Gtk.frameLabel := label ] Gtk.boxPackStart hBox frame Gtk.PackNatural 0 Gtk.widgetShowAll hBox return (STM.takeTMVar tmvar, Control.Foldl.lastDef s0) ) let __checkBoxAt :: Bool -> Text -> Cell Bool __checkBoxAt s0 label = Cell (do checkButton <- Gtk.checkButtonNewWithLabel label Gtk.set checkButton [ Gtk.toggleButtonActive := s0 ] tmvar <- STM.newEmptyTMVarIO _ <- Gtk.on checkButton Gtk.toggled (do pressed <- Gtk.get checkButton Gtk.toggleButtonActive STM.atomically (STM.putTMVar tmvar pressed) ) Gtk.boxPackStart vBox checkButton Gtk.PackNatural 0 Gtk.widgetShowAll vBox return (STM.takeTMVar tmvar, Control.Foldl.lastDef s0) ) let __entryAt :: Text -> Text -> Cell Text __entryAt s0 label = Cell (do entry_ <- Gtk.entryNew frame <- Gtk.frameNew Gtk.set frame [ Gtk.containerChild := entry_ , Gtk.frameLabel := label ] Gtk.set entry_ [ Gtk.entryText := s0 ] tmvar <- STM.newEmptyTMVarIO _ <- Gtk.on entry_ Gtk.editableChanged (do txt <- Gtk.get entry_ Gtk.entryText STM.atomically (STM.putTMVar tmvar txt) ) Gtk.boxPackStart vBox frame Gtk.PackNatural 0 Gtk.widgetShowAll frame return (STM.takeTMVar tmvar, Control.Foldl.lastDef s0) ) let __radioButton :: Show a => Text -> a -> [a] -> Cell a __radioButton label x xs = Cell (do tmvar <- STM.newEmptyTMVarIO vBoxRadio <- Gtk.vBoxNew False 5 let makeButton f y = do button <- f (show y) Gtk.boxPackStart vBoxRadio button Gtk.PackNatural 0 _ <- Gtk.on button Gtk.toggled (do active <- Gtk.get button Gtk.toggleButtonActive if active then STM.atomically (STM.putTMVar tmvar y) else return () ) return button button <- makeButton Gtk.radioButtonNewWithLabel x mapM_ (makeButton (Gtk.radioButtonNewWithLabelFromWidget button)) xs frame <- Gtk.frameNew Gtk.set frame [ Gtk.containerChild := vBoxRadio , Gtk.frameLabel := label ] Gtk.boxPackStart vBox frame Gtk.PackNatural 0 Gtk.widgetShowAll frame return (STM.takeTMVar tmvar, Control.Foldl.lastDef x) ) let control = Control { _checkBoxAt = __checkBoxAt , _spinButtonAt = __spinButtonAt , _hscaleWithRange = __hscaleWithRange , _vscaleWithRange = __vscaleWithRange , _entryAt = __entryAt , _radioButton = __radioButton } doneTMVar <- STM.newEmptyTMVarIO let run (Cell m) = do (stm, Fold step begin done) <- Gtk.postGUISync m -- I don't know why this delay is necessary for diagrams output Control.Concurrent.threadDelay 200000 let loop x = do let b = done x Gtk.postGUISync (process a b) let doneTransaction = do STM.takeTMVar doneTMVar return Nothing me <- STM.atomically (doneTransaction <|> fmap pure stm) case me of Nothing -> return () Just e -> loop (step x e) loop begin _ <- Gtk.on window Gtk.deleteEvent (liftIO (do STM.atomically (STM.putTMVar doneTMVar ()) Gtk.mainQuit return False )) Gtk.widgetShowAll window Control.Concurrent.Async.withAsync (run (k control)) (\s -> do Gtk.mainGUI Control.Concurrent.Async.wait s ) -- | A check box that returns `True` if selected and `False` if unselected checkBox :: Text -- ^ Label -> Updatable Bool checkBox = checkBoxAt False -- | A `Double` spin button spinButton :: Text -- ^ Label -> Double -- ^ Step size -> Updatable Double spinButton = spinButtonAt 0 -- | A `Double` horizontal slider hscale :: Text -- ^ Label -> Double -- ^ Step size -> Updatable Double hscale = hscaleAt 0 -- | A `Double` vertical slider vscale :: Text -- ^ Label -> Double -- ^ Step size -> Updatable Double vscale = vscaleAt 0 -- | A `Text` entry entry :: Text -- ^ Label -> Updatable Text entry = entryAt Data.Text.empty -- | A control that selects from one or more mutually exclusive choices radioButton :: Show a => Text -- ^ Label -> a -- ^ 1st choice (Default selection) -> [a] -- ^ Remaining choices -> Updatable a radioButton label a0 as = Updatable (\control -> _radioButton control label a0 as) -- | Same as `checkBox` except that you can specify the initial state checkBoxAt :: Bool -- ^ Initial state -> Text -- ^ Label -> Updatable Bool checkBoxAt s0 label = Updatable (\control -> _checkBoxAt control s0 label) -- | Same as `spinButton` except that you can specify the initial state spinButtonAt :: Double -- ^ Initial state -> Text -- ^ Label -> Double -- ^ Step size -> Updatable Double spinButtonAt s0 label x = Updatable (\control -> _spinButtonAt control s0 label x) -- | Same as `hscaleButton` except that you can specify the initial state hscaleAt :: Double -- ^ Initial state -> Text -- ^ Label -> Double -- ^ Step size -> Updatable Double hscaleAt = hscaleWithRange (fromIntegral (minBound :: Int)) (fromIntegral (maxBound :: Int)) -- | Same as `hscaleButton` except that you can specify the range and initial state hscaleWithRange :: Double -- ^ Minimum value -> Double -- ^ Maximum value -> Double -- ^ Initial state -> Text -- ^ Label -> Double -- ^ Step size -> Updatable Double hscaleWithRange b0 b1 s0 label x = Updatable (\control -> _hscaleWithRange control b0 b1 s0 label x) -- | Same as `vscaleButton` except that you can specify the initial state vscaleAt :: Double -- ^ Initial state -> Text -- ^ Label -> Double -- ^ Step size -> Updatable Double vscaleAt = vscaleWithRange (fromIntegral (minBound :: Int)) (fromIntegral (maxBound :: Int)) -- | Same as `vscaleButton` except that you can specify the range and initial state vscaleWithRange :: Double -- ^ Minimum value -> Double -- ^ Maximum value -> Double -- ^ Initial state -> Text -- ^ Label -> Double -- ^ Step size -> Updatable Double vscaleWithRange b0 b1 s0 label x = Updatable (\control -> _vscaleWithRange control b0 b1 s0 label x) -- | Same as `entry` except that you can specify the initial state entryAt :: Text -- ^ Initial state -> Text -- ^ Label -> Updatable Text entryAt s0 label = Updatable (\control -> _entryAt control s0 label) -- | Convert a `Show`able value to `Text` display :: Show a => a -> Text display = Data.Text.pack . show -- $examples -- -- Mortgage calculator: -- -- > {-# LANGUAGE ApplicativeDo #-} -- > {-# LANGUAGE OverloadedStrings #-} -- > -- > import Typed.Spreadsheet -- > -- > main :: IO () -- > main = textUI "Mortgage payment" $ do -- > mortgageAmount <- spinButton "Mortgage Amount" 1000 -- > numberOfYears <- spinButton "Number of years" 1 -- > yearlyInterestRate <- spinButton "Yearly interest rate (%)" 0.01 -- > let n = truncate (numberOfYears * 12) -- > let i = yearlyInterestRate / 12 / 100 -- > return ("Monthly payment: $" <> display (mortgageAmount * (i * (1 + i) ^ n) / ((1 + i) ^ n - 1))) -- -- Example input and output: -- -- <> -- -- Mad libs: -- -- > {-# LANGUAGE OverloadedStrings #-} -- > -- > import Typed.Spreadsheet -- > -- > noun = entry "Noun" -- > -- > verb = entry "Verb" -- > -- > adjective = entry "Adjective" -- > -- > example = -- > "I want to " <> verb <> " every " <> noun <> " because they are so " <> adjective -- > -- > main :: IO () -- > main = textUI "Mad libs" example -- -- The above program works because the `Updatable` type implements `IsString` -- and `Monoid`, so no `Applicative` operations are necessary -- -- Example input and output: -- -- <> -- -- Sinusoid plot: -- -- > {-# LANGUAGE OverloadedStrings #-} -- > -- > import Diagrams.Prelude -- > import Typed.Spreadsheet -- > -- > main :: IO () -- > main = graphicalUI "Example program" $ do -- > amplitude <- spinButtonAt 50 "Amplitude (Pixels)" 0.1 -- > frequency <- spinButtonAt 0.1 "Frequency (Pixels⁻¹)" 0.001 -- > phase <- spinButtonAt 90 "Phase (Degrees)" 1 -- > -- > let axes = arrowBetween (p2 (0, 0)) (p2 ( 100, 0)) -- > <> arrowBetween (p2 (0, 0)) (p2 (-100, 0)) -- > <> arrowBetween (p2 (0, 0)) (p2 ( 0, 100)) -- > <> arrowBetween (p2 (0, 0)) (p2 ( 0, -100)) -- > -- > let f x = amplitude * cos (frequency * x + phase * pi / 180) -- > -- > let points = map (\x -> p2 (x, f x)) [-100, -99 .. 100] -- > -- > return (strokeP (fromVertices points) <> axes) -- -- Example input and output: -- -- <> -- -- Factor diagram: -- -- > {-# LANGUAGE OverloadedStrings #-} -- > -- > import Diagrams.Prelude -- > import Diagrams.TwoD.Factorization (factorDiagram') -- > import Typed.Spreadsheet -- > -- > main :: IO () -- > main = graphicalUI "Factor diagram" $ do -- > x <- spinButtonAt 3 "Factor #1" 1 -- > y <- spinButtonAt 3 "Factor #2" 1 -- > z <- spinButtonAt 3 "Factor #3" 1 -- > return (factorDiagram' [truncate x, truncate y, truncate z] # scale 10) -- -- Example input and output: -- -- <> ================================================ FILE: stack.yaml ================================================ resolver: lts-8.2 ================================================ FILE: typed-spreadsheet.cabal ================================================ Name: typed-spreadsheet Version: 1.1.5 Cabal-Version: >=1.8.0.2 Build-Type: Simple License: BSD3 License-File: LICENSE Copyright: 2015 Gabriella Gonzalez Author: Gabriella Gonzalez Maintainer: GenuineGabriella@gmail.com Bug-Reports: https://github.com/Gabriella439/Haskell-Typed-Spreadsheet-Library/issues Synopsis: Typed and composable spreadsheets Tested-With: GHC == 8.0.2, GHC == 8.2.2 Description: This library provides a typed and composable API for building spreadsheets. This differs from traditional spreadsheets in a few important ways: . * you specify the relationship between inputs and outputs at compile time, not runtime, so that the relationship can be type-checked . * inputs of different types have different controls; for example, a `Bool` input creates a checkbox and a `Double` input creates a spin button . * you can only output a single value; you simulate multiple outputs by emitting a tuple of values . See the "Typed.Spreadsheet" module for full examples with code and pictures Category: GUI Source-Repository head Type: git Location: https://github.com/Gabriella439/Haskell-Typed-Spreadsheet-Library Library Hs-Source-Dirs: src Build-Depends: base >= 4.9 && < 5 , async >= 2.0 && < 2.3 , diagrams-cairo >= 1.3 && < 1.5 , diagrams-gtk >= 1.3 && < 1.5 , diagrams-lib >= 1.3 && < 1.5 , foldl >= 1.1 && < 1.5 , gtk >= 0.13 && < 0.16, microlens < 0.5 , stm < 2.6 , text < 1.3 , transformers >= 0.2.0.0 && < 0.6 if os(darwin) frameworks: Cocoa Exposed-Modules: Typed.Spreadsheet GHC-Options: -O2 -Wall Executable typed-spreadsheet-example-text Hs-Source-Dirs: exec Main-Is: Text.hs Build-Depends: base >= 4.9 && < 5 , text < 1.3, typed-spreadsheet if os(darwin) frameworks: Cocoa GHC-Options: -O2 -Wall -threaded Executable typed-spreadsheet-example-cell Hs-Source-Dirs: exec Main-Is: Cell.hs Build-Depends: base >= 4.9 && < 5 , text < 1.3, typed-spreadsheet if os(darwin) frameworks: Cocoa GHC-Options: -Wall -threaded Executable typed-spreadsheet-example-graphics Hs-Source-Dirs: exec Main-Is: Graphics.hs Build-Depends: base >= 4 && < 5 , diagrams-lib >= 1.3 && < 1.5, typed-spreadsheet if os(darwin) frameworks: Cocoa GHC-Options: -O2 -Wall -threaded