gi-gtk-declarative 0.5.0 → 0.6.0

raw patch · 12 files changed

+158/−28 lines, 12 filesdep ~haskell-gidep ~haskell-gi-basePVP ok

version bump matches the API change (PVP)

Dependency ranges changed: haskell-gi, haskell-gi-base

API changes (from Hackage documentation)

Files

• CHANGELOG.md +3/−0
• gi-gtk-declarative.cabal +4/−3
• src/GI/Gtk/Declarative/Attributes/Internal.hs +0/−2
• src/GI/Gtk/Declarative/Attributes/Internal/EventHandler.hs +0/−1
• src/GI/Gtk/Declarative/Bin.hs +1/−4
• src/GI/Gtk/Declarative/Container.hs +2/−6
• src/GI/Gtk/Declarative/Container/Class.hs +0/−1
• src/GI/Gtk/Declarative/Container/MenuItem.hs +1/−6
• src/GI/Gtk/Declarative/Container/Paned.hs +1/−2
• src/GI/Gtk/Declarative/Container/Patch.hs +0/−1
• src/GI/Gtk/Declarative/SingleWidget.hs +0/−2
• test/GI/Gtk/Declarative/CustomWidgetTest.hs +146/−0

@@ -1,3 +1,6 @@+* 0.6.0+  - Allow dependency haskell-gi-0.23+  - Remove redundant code * 0.5.0   - New `CustomWidget` API:     - easier-to-use internal state

@@ -1,5 +1,5 @@ name:                 gi-gtk-declarative-version:              0.5.0+version:              0.6.0 synopsis:             Declarative GTK+ programming in Haskell description:          A declarative programming model for GTK+ user                       interfaces, implementing support for various widgets@@ -55,8 +55,8 @@                       , gi-gobject             >= 2    && <3                       , gi-glib                >= 2    && <3                       , gi-gtk                 >= 3    && <4-                      , haskell-gi             >= 0.21 && <0.23-                      , haskell-gi-base        >= 0.21 && <0.23+                      , haskell-gi             >= 0.21 && <0.24+                      , haskell-gi-base        >= 0.21 && <0.24                       , haskell-gi-overloading == 1.0                       , mtl                       , text@@ -85,3 +85,4 @@                    , unordered-containers   ghc-options:       -Wall -O2 -rtsopts -with-rtsopts=-N -threaded   default-language:  Haskell2010+  other-modules:     GI.Gtk.Declarative.CustomWidgetTest

@@ -1,7 +1,5 @@ {-# LANGUAGE DataKinds  #-} {-# LANGUAGE ScopedTypeVariables  #-}-{-# LANGUAGE TypeApplications  #-}-{-# LANGUAGE RecordWildCards  #-} {-# LANGUAGE GADTs      #-} {-# LANGUAGE LambdaCase #-} 

@@ -3,7 +3,6 @@ {-# LANGUAGE DataKinds             #-} {-# LANGUAGE FlexibleInstances     #-} {-# LANGUAGE GADTs                 #-}-{-# LANGUAGE KindSignatures        #-} {-# LANGUAGE LambdaCase            #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeFamilies          #-}

@@ -3,7 +3,6 @@ {-# LANGUAGE FlexibleContexts      #-} {-# LANGUAGE FlexibleInstances     #-} {-# LANGUAGE GADTs                 #-}-{-# LANGUAGE LambdaCase            #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedLabels      #-} {-# LANGUAGE ScopedTypeVariables   #-}@@ -51,9 +50,7 @@  -- | Construct a /bin/ widget, i.e. a widget with exactly one child. bin-  :: ( Patchable (Bin widget)-     , Typeable widget-     , Typeable event+  :: ( Typeable widget      , Gtk.IsContainer widget      , Gtk.IsBin widget      , Gtk.IsWidget widget

@@ -59,10 +59,7 @@  -- | Construct a /container/ widget, i.e. a widget with zero or more children. container-  :: ( Patchable (Container widget (Children child))-     , Typeable widget-     , Typeable child-     , Typeable event+  :: ( Typeable widget      , Functor child      , Gtk.IsWidget widget      , Gtk.IsContainer widget@@ -117,7 +114,7 @@ -- EventSource -- -instance (Typeable child, EventSource child) =>+instance EventSource child =>          EventSource (Container widget (Children child)) where   subscribe (Container ctor props children) (SomeState st) cb =     case st of@@ -138,7 +135,6 @@          , Typeable children          , Patchable (Container widget children)          , EventSource (Container widget children)-         , Functor (Container widget children)          ) =>          FromWidget (Container widget children) Widget where   fromWidget = Widget

@@ -1,7 +1,6 @@ {-# LANGUAGE DefaultSignatures      #-} {-# LANGUAGE DeriveFunctor          #-} {-# LANGUAGE FunctionalDependencies #-}-{-# LANGUAGE MultiParamTypeClasses  #-} {-# LANGUAGE TypeFamilies           #-}  -- | Shared interfaces for containers.

@@ -55,7 +55,6 @@ -- | Construct a single menu item for a 'Gtk.Menu'. menuItem   :: ( Gtk.IsMenuItem item-     , Typeable event      , Typeable item      , Gtk.IsContainer item      , Gtk.IsBin item@@ -69,11 +68,7 @@  -- | Construct a sub menu for a 'Gtk.Menu', wit a text label and the -- child menu items.-subMenu-  :: (Typeable event)-  => Text-  -> Vector (MenuItem event)-  -> MenuItem event+subMenu :: Text -> Vector (MenuItem event) -> MenuItem event subMenu label = SubMenu label . container Gtk.Menu mempty  newSubMenuItem :: Text -> IO SomeState -> IO SomeState

@@ -26,7 +26,6 @@  import           Data.Coerce                        (coerce) import           Data.Default.Class                 (Default (def))-import           Data.Typeable import           Data.Vector                        (Vector) import qualified Data.Vector                        as Vector import           GHC.Ptr                            (nullPtr)@@ -75,7 +74,7 @@   subscribe Pane{..} = subscribe paneChild  -- | Construct a 'Gtk.Paned' based on attributes and two child 'Pane's.-paned :: Typeable event => Vector (Attribute Gtk.Paned event) -> Pane event -> Pane event -> Widget event+paned :: Vector (Attribute Gtk.Paned event) -> Pane event -> Pane event -> Widget event paned attrs p1 p2 = container Gtk.Paned attrs (Panes p1 p2)  data Panes child = Panes child child

@@ -6,7 +6,6 @@ {-# LANGUAGE GADTs                 #-} {-# LANGUAGE LambdaCase            #-} {-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE NamedFieldPuns        #-} {-# LANGUAGE OverloadedLabels      #-} {-# LANGUAGE OverloadedLists       #-} {-# LANGUAGE ScopedTypeVariables   #-}

@@ -79,8 +79,6 @@ -- | Construct a /leaf/ widget, i.e. one without any children. widget   :: ( Typeable widget-     , Typeable event-     , Functor (Attribute widget)      , Gtk.IsWidget widget      , FromWidget (SingleWidget widget) target      )

@@ -0,0 +1,146 @@+{-# LANGUAGE FlexibleContexts    #-}+{-# LANGUAGE OverloadedLabels    #-}+{-# LANGUAGE OverloadedLists     #-}+{-# LANGUAGE OverloadedStrings   #-}+{-# LANGUAGE RecordWildCards     #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TemplateHaskell     #-}++{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+module GI.Gtk.Declarative.CustomWidgetTest where++import           Control.Concurrent+import           Control.Concurrent.STM+import           Control.Exception.Safe+import           Control.Monad                  (replicateM_)+import           Control.Monad.IO.Class+import           Data.Function                  ((&))+import qualified Data.HashSet                   as HashSet+import qualified Data.Text                      as Text+import           Data.Vector                    (Vector)+import qualified GI.Gdk                         as Gdk+import qualified GI.GLib.Constants              as GLib+import qualified GI.GObject                     as GI+import qualified GI.Gtk                         as Gtk++import           Hedgehog+import qualified Hedgehog.Gen                   as Gen+import qualified Hedgehog.Range                 as Range++import           GI.Gtk.Declarative+import           GI.Gtk.Declarative.EventSource+import           GI.Gtk.Declarative.State++prop_sets_the_button_label = property $ do+  start       <- forAll (Gen.int (Range.linear 0 10))+  clicks      <- forAll (Gen.int (Range.linear 0 10))++  buttonLabel <- runUI . bracket (Gtk.new Gtk.Window []) #destroy $ \window ->+    do+      let markup = testWidget [] start+      first <- create markup+      btn <-+        someStateWidget first+        >>= Gtk.unsafeCastTo Gtk.Button+        &   liftIO+      #add window btn+      sub <- subscribe markup first (const (pure ()))+      Gtk.widgetShowAll window+      replicateM_ clicks (Gtk.buttonClicked btn)+      cancel sub+      Gtk.get btn #label++  let expectedLabel = Text.pack (show (start + clicks))+  expectedLabel === buttonLabel++prop_emits_correct_number_of_click_events = property $ do+  start       <- forAll (Gen.int (Range.linear 0 10))+  clicks      <- forAll (Gen.int (Range.linear 0 10))++  values       <- liftIO (newTBQueueIO (fromIntegral clicks))+  runUI . bracket (Gtk.new Gtk.Window []) #destroy $ \window ->+    do+      let markup = testWidget [] start+      first <- create markup+      btn <-+        someStateWidget first+        >>= Gtk.unsafeCastTo Gtk.Button+        &   liftIO+      #add window btn+      sub <- subscribe markup first (atomically . writeTBQueue values)+      Gtk.widgetShowAll window+      replicateM_ clicks (Gtk.buttonClicked btn)+      cancel sub++  let expectedValues = take clicks [succ start..]+  actualValues <- liftIO (atomically (flushTBQueue values))+  expectedValues === actualValues++prop_sets_classes = property $ do+  let genClasses =+        Gen.list (Range.linear 0 5) (Gen.text (Range.linear 1 5) Gen.alphaNum)+  initialClasses                <- forAll genClasses+  finalClasses                  <- forAll genClasses++  (classesBefore, classesAfter) <-+    runUI . bracket (Gtk.new Gtk.Window []) #destroy $ \window -> do+      let markup1 = testWidget [classes initialClasses] 0+          markup2 = testWidget [classes finalClasses] 0+      first <- create markup1+      btn   <- liftIO (someStateWidget first >>= Gtk.unsafeCastTo Gtk.Button)+      #add window btn+      Gtk.widgetShowAll window+      sc           <- #getStyleContext btn+      beforeUpdate <- #listClasses sc+      _second      <- patch' first markup1 markup2+      afterUpdate  <- #listClasses sc+      pure (beforeUpdate, afterUpdate)++  HashSet.fromList ("text-button" : initialClasses)+    === HashSet.fromList classesBefore+  HashSet.fromList ("text-button" : finalClasses)+    === HashSet.fromList classesAfter++-- * Test widget and helpers++testWidget :: Vector (Attribute Gtk.Button Int) -> Int -> Widget Int+testWidget customAttributes customParams = Widget (CustomWidget { .. })+ where+  customWidget = Gtk.Button+  customCreate start = do+    clicks <- newMVar start+    btn    <- Gtk.new Gtk.Button [#label Gtk.:= Text.pack (show start)]+    return (btn, clicks)++  customPatch :: Int -> Int -> MVar Int -> CustomPatch Gtk.Button (MVar Int)+  customPatch _ new clicks = CustomModify $ \btn -> do+    -- putMVar clicks new+    Gtk.set btn [#label Gtk.:= Text.pack (show new)]+    return clicks++  customSubscribe+    :: Int -> MVar Int -> Gtk.Button -> (Int -> IO ()) -> IO Subscription+  customSubscribe _params clicks btn cb = do+    h <- Gtk.on btn #clicked $ do+      current <- modifyMVar clicks $ \x -> pure (succ x, succ x)+      cb current+      Gtk.set btn [#label Gtk.:= Text.pack (show current)]+    return (fromCancellation (GI.signalHandlerDisconnect btn h))++runUI ma = do+  ret <- liftIO newEmptyMVar+  _ <- Gdk.threadsAddIdle GLib.PRIORITY_DEFAULT $ do+    ma >>= putMVar ret+    return False+  liftIO (takeMVar ret)++patch' state markup1 markup2 = case patch state markup1 markup2 of+  Keep      -> pure state+  Modify  f -> f+  Replace f -> f++-- * Test collection++tests :: IO Bool+tests =+  checkParallel $$(discover)