gi-gtk-declarative-app-simple 0.2.0 → 0.3.0

raw patch · 3 files changed

+34/−17 lines, 3 filesdep ~base

Dependency ranges changed: base

Files

• CHANGELOG.md +2/−0
• gi-gtk-declarative-app-simple.cabal +3/−2
• src/GI/Gtk/Declarative/App/Simple.hs +29/−15

@@ -1,3 +1,5 @@+* 0.3.0+    - Return last state from `run` and `runLoop` * 0.2.0     - Require GTK+ windows as top-level widget * 0.1.0

@@ -1,5 +1,5 @@ name:                 gi-gtk-declarative-app-simple-version:              0.2.0+version:              0.3.0 synopsis:             Declarative GTK+ programming in Haskell in the style of Pux. description:          Experimental application architecture in the style of                       PureScript Pux, built on top of gi-gtk-declarative. Learn@@ -13,10 +13,11 @@ build-type:           Simple cabal-version:        >=1.10 extra-source-files:   CHANGELOG.md+tested-with:          GHC == 8.6.3  library   exposed-modules:      GI.Gtk.Declarative.App.Simple-  build-depends:        base                    >=4.10    && <4.12+  build-depends:        base                    >=4.10    && <5                       , async                       , gi-gobject              >= 2      && <3                       , gi-glib

@@ -1,4 +1,6 @@-{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE LambdaCase       #-}+{-# LANGUAGE RecordWildCards  #-}  -- | A simple application architecture style inspired by PureScript's Pux -- framework.@@ -12,26 +14,28 @@ where  import           Control.Concurrent-import           Control.Concurrent.Async       (async)+import qualified Control.Concurrent.Async       as Async+import           Control.Exception              (Exception, throw) import           Control.Monad import           Data.Typeable import qualified GI.Gdk                         as Gdk import qualified GI.GLib.Constants              as GLib import qualified GI.Gtk                         as Gtk import           GI.Gtk.Declarative+import           GI.Gtk.Declarative.Bin import           GI.Gtk.Declarative.EventSource import           GI.Gtk.Declarative.State import           Pipes import           Pipes.Concurrent  -- | Describes an state reducer application.-data App state event =+data App window state event =   App     { update       :: state -> event -> Transition state event     -- ^ The update function of an application reduces the current state and     -- a new event to a 'Transition', which decides if and how to transition     -- to the next state.-    , view         :: state -> AppView event+    , view         :: state -> AppView window event     -- ^ The view renders a state value as a window, parameterized by the     -- 'App's event type.     , inputs       :: [Producer event IO ()]@@ -42,7 +46,7 @@  -- | The top-level widget for the 'view' function of an 'App', -- requiring a GTK+ 'Window'.-type AppView event = Bin Gtk.Window Widget event+type AppView window event = Bin window Widget event  -- | The result of applying the 'update' function, deciding if and how to -- transition to the next state.@@ -53,20 +57,30 @@   -- | Exit the application.   | Exit +-- | An exception thrown by the 'run' function when gtk's main loop exits+-- before event/state handling which should never happen but can be caused+-- by user code calling 'Gtk.mainQuit'+data GtkMainExitedException =+  GtkMainExitedException String deriving (Typeable, Show)++instance Exception GtkMainExitedException+ -- | Initialize GTK and run the application in it. This is a -- convenience function that is highly recommended. If you need more -- flexibility, e.g. to set up GTK+ yourself, use 'runLoop' instead. run-  :: Typeable event-  => App state event      -- ^ Application to run-  -> IO ()+  :: (Typeable event, BinChild window Widget)+  => App window state event      -- ^ Application to run+  -> IO state run app = do   void $ Gtk.init Nothing-  void . async $ do-    runLoop app-    -- In case the run loop exits, quit the main GTK loop.-    Gtk.mainQuit-  Gtk.main+  Async.withAsync (runLoop app <* Gtk.mainQuit) $ \lastState -> do+    Gtk.main+    Async.poll lastState >>= \case+      Nothing -> throw $+        GtkMainExitedException "gtk's main loop exited unexpectedly"+      Just (Right state) -> return state+      Just (Left exception) -> throw exception  -- | Run an 'App'. This IO action will loop, so run it in a separate thread -- using 'async' if you're calling it before the GTK main loop.@@ -79,7 +93,7 @@ --       Gtk.mainQuit --     Gtk.main -- @-runLoop :: Typeable event => App state event -> IO ()+runLoop :: (Typeable event, BinChild window Widget) => App window state event -> IO state runLoop App {..} = do   let firstMarkup = view initialState   events                  <- newChan@@ -124,7 +138,7 @@            -- Finally, we loop.           loop newState newMarkup events sub newModel-        Exit -> return ()+        Exit -> return oldModel  publishEvent :: Chan event -> event -> IO () publishEvent mvar = void . writeChan mvar