packages feed

typed-spreadsheet (empty) → 1.0.0

raw patch · 5 files changed

+535/−0 lines, 5 filesdep +asyncdep +basedep +foldlsetup-changed

Dependencies added: async, base, foldl, gtk3, microlens, stm, text, transformers, typed-spreadsheet

Files

+ LICENSE view
@@ -0,0 +1,24 @@+Copyright (c) 2015 Gabriel 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 Gabriel 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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ exec/Main.hs view
@@ -0,0 +1,14 @@+{-# LANGUAGE OverloadedStrings #-}++import Control.Applicative+import Typed.Spreadsheet++main :: IO ()+main = textUI "Example program" logic+  where+    logic = combine <$> checkBox   "a"+                    <*> spinButton "b" 1+                    <*> spinButton "c" 0.1+                    <*> entry      "d"++    combine a b c d = display (a, b + c, d)
+ src/Typed/Spreadsheet.hs view
@@ -0,0 +1,443 @@+{-# LANGUAGE ExistentialQuantification  #-}+{-# LANGUAGE RankNTypes                 #-}++-- | The following program:+--+-- > {-# LANGUAGE OverloadedStrings #-}+-- > +-- > import Control.Applicative+-- > import Typed.Spreadsheet+-- > +-- > main :: IO ()+-- > main = textUI "Example program" logic+-- >   where+-- >     logic = combine <$> checkBox   "a"+-- >                     <*> spinButton "b" 1+-- >                     <*> spinButton "c" 0.1+-- >                     <*> entry      "d"+-- > +-- >     combine a b c d = display (a, b + c, d)+--+-- ... creates a user interface that looks like this:+--+-- <<http://i.imgur.com/xPifEtA.png User interface on startup>>+--+-- Every time you update a control on the left panel, the right panel updates+-- in response:+--+-- <<http://i.imgur.com/TTxgSwN.png User interface after user input>>+--+-- Once @ghc-8.0@ is out then you can simplify the above program even further+-- using the `ApplicativeDo` extension:+--+-- > {-# 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)) )+--+-- 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+-- * You transform or combine `Updatable` values using `Functor` and+--   `Applicative` operations.  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+--+-- That project includes the code for the above example in @exec/Main.hs@.  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++    -- * Controls+    , checkBox+    , spinButton+    , entry+    , radioButton++    -- * 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.Monoid+import Data.String (IsString(..))+import Data.Text (Text)+import Lens.Micro (_Left, _Right)+import Graphics.UI.Gtk (AttrOp((:=)))++import qualified Control.Concurrent.STM   as STM+import qualified Control.Concurrent.Async as Async+import qualified Control.Foldl            as Fold+import qualified Data.Text                as Text+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 = Fold.handles _Left foldF <*> Fold.handles _Right foldX++-- | 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)++instance Monoid a => Monoid (Updatable a) where+    mempty = pure mempty++    mappend = liftA2 mappend++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+    { _checkBox    :: Text -> Cell Bool+    , _spinButton  :: Text -> Double -> Cell Double+    , _entry       :: 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 title (Updatable k) = do+    _ <- Gtk.initGUI++    window <- Gtk.windowNew+    Gtk.set window+        [ Gtk.containerBorderWidth := 5+        ]++    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+        ]++    vBox <- Gtk.vBoxNew False 5++    hBox <- Gtk.hBoxNew False 5+    Gtk.boxPackStart hBox vBox           Gtk.PackNatural 0+    Gtk.boxPackStart hBox scrolledWindow Gtk.PackGrow    0++    Gtk.set window+        [ Gtk.windowTitle         := title+        , Gtk.containerChild      := hBox+        , Gtk.windowDefaultWidth  := 600+        , Gtk.windowDefaultHeight := 400+        ]++    let __spinButton :: Text -> Double -> Cell Double+        __spinButton 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    := 0+                ]+            _  <- 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, Fold.lastDef 0) )++    let __checkBox :: Text -> Cell Bool+        __checkBox label = Cell (do+            checkButton <- Gtk.checkButtonNewWithLabel label++            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, Fold.lastDef False) )++    let __entry :: Text -> Cell Text+        __entry label = Cell (do+            entry_ <- Gtk.entryNew++            frame <- Gtk.frameNew+            Gtk.set frame+                [ Gtk.containerChild := entry_+                , Gtk.frameLabel     := label+                ]++            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, Fold.lastDef Text.empty) )++    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 a = do+                    button <- f (show a)+                    Gtk.boxPackStart vBoxRadio button Gtk.PackNatural 0+                    _ <- Gtk.on button Gtk.toggled (do+                        mode <- Gtk.get button Gtk.toggleButtonMode+                        if mode+                            then STM.atomically (STM.putTMVar tmvar a)+                            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, Fold.lastDef x) )++    let control = Control+            { _checkBox    = __checkBox+            , _spinButton  = __spinButton+            , _entry       = __entry+            , _radioButton = __radioButton+            }++    doneTMVar <- STM.newEmptyTMVarIO++    let run :: Cell Text -> IO ()+        run (Cell m) = do+            (stm, Fold step begin done) <- Gtk.postGUISync m+            let loop x = do+                    let txt = done x+                    Gtk.postGUISync+                        (Gtk.set textBuffer [ Gtk.textBufferText := txt ])+                    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+    Async.withAsync (run (k control)) (\a -> do+        Gtk.mainGUI+        Async.wait a )++-- | A check box that returns `True` if selected and `False` if unselected+checkBox+    :: Text+    -- ^ Label+    -> Updatable Bool+checkBox label = Updatable (\control -> _checkBox control label)++-- | A `Double` spin button+spinButton+    :: Text+    -- ^ Label+    -> Double+    -- ^ Step size+    -> Updatable Double+spinButton label x = Updatable (\control -> _spinButton control label x)++-- | A `Text` entry+entry+    :: Text+    -- ^ Label+    -> Updatable Text+entry label = Updatable (\control -> _entry control label)++-- | 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)++-- | Convert a `Show`able value to `Text`+display :: Show a => a -> Text+display = Text.pack . show++-- $examples+--+-- Mortgage calculator:+--+-- > {-# LANGUAGE OverloadedStrings #-}+-- > +-- > import Control.Applicative+-- > import Data.Monoid+-- > import Data.Text (Text)+-- > import Typed.Spreadsheet+-- > +-- > payment :: Double -> Double -> Double -> Text+-- > payment mortgageAmount numberOfYears yearlyInterestRate+-- >     =  "Monthly payment: $"+-- >     <> display (mortgageAmount * (i * (1 + i) ^ n) / ((1 + i) ^ n - 1))+-- >   where+-- >     n = truncate (numberOfYears * 12)+-- >     i = yearlyInterestRate / 12 / 100+-- > +-- > logic :: Updatable Text+-- > logic = payment <$> spinButton "Mortgage Amount"          1000+-- >                 <*> spinButton "Number of years"             1+-- >                 <*> spinButton "Yearly interest rate (%)"    0.01+-- > +-- > main :: IO ()+-- > main = textUI "Mortgage payment" logic+--+-- Example input and output:+--+-- <<http://i.imgur.com/nvRZ9HC.png Mortgage calculator program>>+--+-- Mad libs:+--+-- > {-# LANGUAGE OverloadedStrings #-}+-- > +-- > import Data.Monoid+-- > 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:+--+-- <<http://i.imgur.com/k22An4Y.png Mad libs program>>
+ typed-spreadsheet.cabal view
@@ -0,0 +1,52 @@+Name: typed-spreadsheet+Version: 1.0.0+Cabal-Version: >=1.8.0.2+Build-Type: Simple+License: BSD3+License-File: LICENSE+Copyright: 2015 Gabriel Gonzalez+Author: Gabriel Gonzalez+Maintainer: Gabriel439@gmail.com+Bug-Reports: https://github.com/Gabriel439/Haskell-Typed-Spreadsheet-Library/issues+Synopsis: Typed and composable spreadsheets+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/Gabriel439/Haskell-Typed-Spreadsheet-Library++Library+    Hs-Source-Dirs: src+    Build-Depends:+        base          >= 4      && < 5   ,+        async         >= 2.0    && < 2.1 ,+        foldl         >= 1.1    && < 1.2 ,+        gtk3          >= 0.14.0 && < 0.15,+        microlens                  < 0.4 ,+        stm                        < 2.5 ,+        text                       < 1.3 ,+        transformers >= 0.2.0.0 && < 0.5+    Exposed-Modules: Typed.Spreadsheet+    GHC-Options: -O2 -Wall++Executable typed-spreadsheet-example+    Hs-Source-Dirs: exec+    Main-Is: Main.hs+    Build-Depends:+        base    >= 4     && < 5  ,+        typed-spreadsheet        ,+        text                < 1.3+    GHC-Options: -O2 -Wall -threaded