packages feed

lgtk 0.5.1 → 0.5.2

raw patch · 8 files changed

+58/−46 lines, 8 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

+ LGtk: class Reference r => EqReference r
+ LGtk: newEqRef :: (ExtRef m, Eq a) => a -> m (EqRef (Ref m) a)
- LGtk: entry :: EffRef m => Ref m String -> Widget m
+ LGtk: entry :: (EffRef m, Reference r, RefMonad r ~ RefMonad (Ref m)) => r String -> Widget m
- LGtk: entryShow :: (EffRef m, Show a, Read a) => Ref m a -> Widget m
+ LGtk: entryShow :: (EffRef m, Show a, Read a, Reference r, RefMonad r ~ RefMonad (Ref m)) => r a -> Widget m
- LGtk: hasEffect :: Reference r => EqRef r a -> (a -> a) -> ReadRefMonad r Bool
+ LGtk: hasEffect :: EqReference r => r a -> (a -> a) -> ReadRefMonad r Bool
- LGtk: smartButton :: EffRef m => ReadRef m String -> EqRef (Ref m) a -> (a -> a) -> Widget m
+ LGtk: smartButton :: (EffRef m, EqReference r, RefMonad r ~ RefMonad (Ref m)) => ReadRef m String -> r a -> (a -> a) -> Widget m

Files

lgtk.cabal view
@@ -1,11 +1,9 @@ name:               lgtk-version:            0.5.1+version:            0.5.2 category:           GUI synopsis:           lens-based API for Gtk description:     The main interface module of LGtk is "LGtk".-    .-    See also <http://www.haskell.org/haskellwiki/LGtk> stability:          experimental license:            BSD3 license-file:       LICENSE
src/Control/Monad/ExtRef.hs view
@@ -26,10 +26,11 @@     , memoWrite      -- * References with equation+    , EqReference (..)     , EqRef     , eqRef+    , newEqRef     , toRef-    , hasEffect      -- * Auxiliary definitions     , Morph@@ -276,27 +277,43 @@     redo _ = Nothing  +{- | References with inherent equivalence.++-}+class Reference r => EqReference r where++    {- | @hasEffect r f@ returns @False@ iff @(modRef m f)@ === @(return ())@.++    @hasEffect@ is correct only if @eqRef@ is applied on a pure reference (a reference which is a pure lens on the hidden state).++    @hasEffect@ makes defining auto-sensitive buttons easier, for example.+    -}+    hasEffect+        :: r a+        -> (a -> a)+        -> ReadRefMonad r Bool++ data EqRef_ r a = forall b . Eq b => EqRef_ (r b) (Lens b a)  {- | References with inherent equivalence. -@EqRef r a@ === @ReadRefMonad r (forall b . Eq b => (Lens b a, r b))@+@EqRef r a@ === @ReadRefMonad r (exist b . Eq b => (Lens b a, r b))@  As a reference, @(m :: EqRef r a)@ behaves as  @joinRef $ liftM (uncurry lensMap) m@--@EqRef@ makes defining auto-sensitive buttons easier, see later. -} newtype EqRef r a = EqRef { runEqRef :: ReadRefMonad r (EqRef_ r a) }  {- | @EqRef@ construction.--@hasEffect@ is correct only if @eqRef@ is applied on a pure reference (a reference which is a pure lens on the hidden state). -} eqRef :: (Reference r, Eq a) => r a -> EqRef r a eqRef r = EqRef $ return $ EqRef_ r id +newEqRef :: (ExtRef m, Eq a) => a -> m (EqRef (Ref m) a) +newEqRef = liftM eqRef . newRef+ {- | An @EqRef@ is a normal reference if we forget about the equality.  @toRef m@ === @joinRef $ liftM (uncurry lensMap) m@@@ -304,13 +321,8 @@ toRef :: Reference r => EqRef r a -> r a toRef (EqRef m) = joinRef $ liftM (\(EqRef_ r k) -> k `lensMap` r) m --- | @hasEffect r f@ returns @False@ iff @(modRef m f)@ === @(return ())@.-hasEffect-    :: Reference r-    => EqRef r a-    -> (a -> a)-    -> ReadRefMonad r Bool-hasEffect m f = runEqRef m >>= \(EqRef_ r k) -> liftM (\x -> modL k f x /= x) $ readRef r+instance Reference r => EqReference (EqRef r) where+    hasEffect m f = runEqRef m >>= \(EqRef_ r k) -> liftM (\x -> modL k f x /= x) $ readRef r   instance Reference r => Reference (EqRef r) where
src/Control/Monad/Register/Basic.hs view
@@ -8,6 +8,7 @@     ) where  import Control.Monad+import Control.Monad.State import Control.Monad.RWS import Data.List import Prelude hiding ((.), id)@@ -45,10 +46,10 @@                             -- memo table, first item is the newest         tell $ t1 $ do             b <- rb-            join $ runMorphD memoref $ gets $ \memo -> case memo of-                Left b' | b' == b -> return ()+            join $ runMorphD memoref $ StateT $ \memo -> case memo of+                Left b' | b' == b -> return (return (), memo)                 Right ((b', (_, s1, s2, _, _)): _) | b' == b ->-                    runMonadMonoid $ s1 `mappend` s2+                    return (runMonadMonoid $ s1 `mappend` s2, memo)                 _ -> do                     case memo of                         Right ((_, (_, _, _, ureg1, ureg2)): _) ->@@ -60,9 +61,8 @@                             return (c, (), (s1, ureg1))                         _ -> runRWST (fb b) rr ()                     ((), (s2, ureg2)) <- execRWST c rr ()-                    runMorphD memoref $ state $ \memo ->-                        (,) () $ Right $ (:) (b, (c, s1, s2, ureg1, ureg2)) $ filter ((/= b) . fst) $ either (const []) id memo-                    runMonadMonoid $ s1 `mappend` s2+                    let memo' = Right $ (:) (b, (c, s1, s2, ureg1, ureg2)) $ filter ((/= b) . fst) $ either (const []) id memo+                    return (runMonadMonoid $ s1 `mappend` s2, memo')  t1 m = (MonadMonoid m, mempty) t2 m = (mempty, MonadMonoid . m)@@ -88,8 +88,8 @@     -> k a evalRegister_ m ch = do     vx <- newRef' $ error "evalRegister"-    (a, (), reg) <- runRWST m (ch . (>> join (runMorphD vx get))) ()-    runMorphD vx $ put $ runMonadMonoid $ fst reg+    (a, (), (reg, _)) <- runRWST m (ch . (>> join (runMorphD vx get))) ()+    runMorphD vx $ put $ runMonadMonoid reg     return a
src/Control/Monad/Restricted.hs view
@@ -73,6 +73,11 @@     r <- ask     lift $ runMorphD r m +unlift :: Monad m => ((Ext n m a -> m a) -> m b) -> Ext n m b+unlift f = Ext $ do+    r <- ask+    lift $ f $ flip runReaderT r . unExt+ runExt :: MorphD n m -> Ext n m a -> m a runExt v (Ext m) = runReaderT m v @@ -130,18 +135,17 @@     lookupEnv   = lift . lookupEnv  class Monad m => NewRef m where-    newRef' :: forall a . a -> m (MorphD (State a) m)+    newRef' :: forall a . a -> m (MorphD (StateT a m) m)  instance NewRef IO where     newRef' x = do         vx <- liftIO $ newMVar x-        return $ MorphD $ \m -> liftIO $ modifyMVar vx $ return . swap . runState m+        return $ MorphD $ \m -> modifyMVar vx $ liftM swap . runStateT m       where         swap (a, b) = (b, a)  instance NewRef m => NewRef (Ext n m) where-    newRef' a = liftM (\m -> MorphD $ lift . runMorphD m) $ lift $ newRef' a-+    newRef' = liftM (\m -> MorphD $ \k -> unlift $ runMorphD m . flip mapStateT k) . lift . newRef'  newtype MonadMonoid a = MonadMonoid { runMonadMonoid :: a () }
src/GUI/Gtk/Structures/IO.hs view
@@ -112,7 +112,7 @@             _ <- reg s $ \re -> on' w switchPage $ re             return'' ws w         Cell onCh f -> do-            let b = False+            let b = True --False             w <- liftIO' $ case b of                 True -> fmap castToContainer $ hBoxNew False 1                 False -> fmap castToContainer $ alignmentNew 0 0 1 1
src/LGtk.hs view
@@ -1,8 +1,5 @@ {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE ConstraintKinds #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE ExistentialQuantification #-} -- | Main LGtk interface. module LGtk     ( @@ -71,10 +68,11 @@     , memoRead     , undoTr +    , EqReference (..)     , EqRef     , eqRef+    , newEqRef     , toRef-    , hasEffect      -- * Dynamic networks     , EffRef@@ -224,13 +222,13 @@   smartButton-    :: EffRef m+    :: (EffRef m, EqReference r, RefMonad r ~ RefMonad (Ref m))      => ReadRef m String     -- ^ dynamic label of the button-    -> EqRef (Ref m) a              -- ^ underlying reference+    -> r a              -- ^ underlying reference     -> (a -> a)   -- ^ The button is active when this function is not identity on value of the reference. When the button is pressed, the value of the reference is modified with this function.     -> Widget m-smartButton s m f-    = button_ s (hasEffect m f) (modRef m f)+smartButton s r f+    = button_ s (hasEffect r f) (modRef r f)  -- | Checkbox. checkbox :: EffRef m => Ref m Bool -> Widget m@@ -241,11 +239,11 @@ combobox ss r = Combobox ss (rEffect True (readRef r), toReceive $ writeRef r)  -- | Text entry.-entry :: EffRef m => Ref m String -> Widget m+entry :: (EffRef m, Reference r, RefMonad r ~ RefMonad (Ref m))  => r String -> Widget m entry r = Entry (rEffect True (readRef r), toReceive $ writeRef r)  -- | Text entry.-entryShow :: (EffRef m, Show a, Read a) => Ref m a -> Widget m+entryShow :: (EffRef m, Show a, Read a, Reference r, RefMonad r ~ RefMonad (Ref m)) => r a -> Widget m entryShow r = entry $ showLens `lensMap` r  {- | Notebook (tabs).
src/LGtk/Demos/IntListEditor.hs view
@@ -19,7 +19,7 @@     return $ notebook         [ (,) "Editor" $ vcat             [ hcat-                [ entryShow $ toRef len+                [ entryShow len                 , smartButton (return "+1") len (+1)                 , smartButton (return "-1") len (+(-1))                 , smartButton (liftM (("DeleteAll " ++) . show) $ readRef len) len $ const 0
src/LGtk/Demos/Main.hs view
@@ -18,22 +18,22 @@     , (,) "Counters" $ notebook          [ (,) "Unbounded" $ action $ do-            c <- newRef 0+            c <- newEqRef 0             return $ vcat                 [ label $ liftM show $ readRef c                 , hcat-                    [ smartButton (return "+1") (eqRef c) (+1)-                    , smartButton (return "-1") (eqRef c) (+(-1))+                    [ smartButton (return "+1") c (+1)+                    , smartButton (return "-1") c (+(-1))                     ]                 ]          , (,) "1..3" $ action $ do-            c <- newRef 1+            c <- newEqRef 1             return $ vcat                 [ label $ liftM show $ readRef c                 , hcat-                    [ smartButton (return "+1") (eqRef c) $ min 3 . (+1)-                    , smartButton (return "-1") (eqRef c) $ max 1 . (+(-1))+                    [ smartButton (return "+1") c $ min 3 . (+1)+                    , smartButton (return "-1") c $ max 1 . (+(-1))                     ]                 ]