lgtk 0.5 → 0.5.1

raw patch · 10 files changed

+114/−47 lines, 10 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• lgtk.cabal +3/−3
• src/Control/Monad/EffRef.hs +19/−7
• src/Control/Monad/ExtRef.hs +29/−10
• src/Control/Monad/Restricted.hs +8/−5
• src/LGtk.hs +14/−4
• src/LGtk/ADTEditor.hs +36/−5
• src/LGtk/Demos/IntListEditor.hs +1/−1
• src/LGtk/Demos/Main.hs +2/−3
• src/LGtk/Demos/TEditor.hs +0/−3
• src/LGtk/Demos/Tri.hs +2/−6

@@ -1,16 +1,16 @@ name:               lgtk-version:            0.5+version:            0.5.1 category:           GUI synopsis:           lens-based API for Gtk description:     The main interface module of LGtk is "LGtk".     .-    See also <http://people.inf.elte.hu/divip/LGtk/index.html>+    See also <http://www.haskell.org/haskellwiki/LGtk> stability:          experimental license:            BSD3 license-file:       LICENSE author:             Péter Diviánszky-homepage:           http://people.inf.elte.hu/divip/LGtk/index.html+homepage:           http://www.haskell.org/haskellwiki/LGtk bug-reports:        http://hub.darcs.net/divip/lgtk/issues maintainer:         divipp@gmail.com cabal-version:      >= 1.8

@@ -31,21 +31,33 @@      {- |     Let @r@ be an effectless action (@ReadRef@ guarantees this).-    @onChange r fmm@ has the following effect: +    @(onChange init r fmm)@ has the following effect:+     Whenever the value of @r@ changes (with respect to the given equality),     @fmm@ is called with the new value @a@.-    The value of the @fmm a@ action is memoized,+    The value of the @(fmm a)@ action is memoized,     but the memoized value is run again and again. +    The boolean parameter @init@ tells whether the action should+    be run in the beginning or not.+     For example, let @(k :: a -> m b)@ and @(h :: b -> m ())@,-    and suppose that @r@ will have values @a1@, @a2@, @a3@ = @a1@.+    and suppose that @r@ will have values @a1@, @a2@, @a3@ = @a1@, @a4@ = @a2@. -    @onChange r $ \\a -> k a >>= return . h@+    @onChange True r $ \\a -> k a >>= return . h@      has the effect -    @k a1 >>= \\b1 -> h b1 >> k a2 >>= \\b2 -> h b2 >> h b1@+    @k a1 >>= \\b1 -> h b1 >> k a2 >>= \\b2 -> h b2 >> h b1 >> h b2@++    and++    @onChange False r $ \\a -> k a >>= return . h@++    has the effect++    @k a2 >>= \\b2 -> h b2 >> k a1 >>= \\b1 -> h b1 >> h b2@     -}     onChange :: Eq a => Bool -> ReadRef m a -> (a -> m (m ())) -> m () @@ -78,7 +90,7 @@     asyncWrite :: Eq a => Int -> (a -> WriteRef m ()) -> a -> m ()      {- |-    @fileRef path@ returns a reference which holds the actual contents+    @(fileRef path)@ returns a reference which holds the actual contents     of the file accessed by @path@.      When the value of the reference changes, the file changes.@@ -97,7 +109,7 @@     putStr_    :: String -> m ()      {- | Read a line from the standard input device.-    @getLine_ f@ returns immediately. When the line @s@ is read,+    @(getLine_ f)@ returns immediately. When the line @s@ is read,     @f s@ is called.     -}     getLine_   :: (String -> WriteRef m ()) -> m ()

@@ -10,13 +10,14 @@      -- * Reference class     , Reference (..)+    , ReadRefMonad      -- * Ref construction class     , ExtRef (..)--    -- * Derived constructs     , ReadRef     , WriteRef++    -- * Derived constructs     , modRef     , liftReadRef     , readRef'@@ -68,7 +69,7 @@      Property derived from the 'HasReadPart' instance: -    @ReadPart (Refmonad r)@  ===  @Reader s@+    @ReadRefMonad r@ = @ReadPart (Refmonad r)@  ===  @Reader s@     -}     type RefMonad r :: * -> * @@ -78,7 +79,7 @@      @(readRef r >> return ())@ === @return ()@     -}-    readRef  :: r a -> ReadPart (RefMonad r) a+    readRef  :: r a -> ReadRefMonad r a      {- | @writeRef r@ === @modify . setL r@ @@ -104,11 +105,13 @@      @joinRef@ === @Lens . join . (runLens .) . runReader@     -}-    joinRef :: ReadPart (RefMonad r) (r a) -> r a+    joinRef :: ReadRefMonad r (r a) -> r a      -- | @unitRef@ === @lens (const ()) (const id)@     unitRef :: r () +type ReadRefMonad m = ReadPart (RefMonad m)+ infixr 8 `lensMap`  -- | @modRef r f@ === @liftReadPart (readRef r) >>= writeRef r . f@@@ -160,7 +163,7 @@  type WriteRef m = RefMonad (Ref m) -type ReadRef m = ReadPart (RefMonad (Ref m))+type ReadRef m = ReadRefMonad (Ref m)  {- | @ReadRef@ lifted to the reference creation class. @@ -275,13 +278,29 @@  data EqRef_ r a = forall b . Eq b => EqRef_ (r b) (Lens b a) --- | References with inherent equivalence-newtype EqRef r a = EqRef { runEqRef :: ReadPart (RefMonad r) (EqRef_ r a) }+{- | References with inherent equivalence. --- | @hasEffect@ is correct only if @eqRef@ is applied on a pure reference (a reference which is a pure lens on the hidden state).+@EqRef r a@ === @ReadRefMonad r (forall 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 +{- | An @EqRef@ is a normal reference if we forget about the equality.++@toRef m@ === @joinRef $ liftM (uncurry lensMap) m@+-} toRef :: Reference r => EqRef r a -> r a toRef (EqRef m) = joinRef $ liftM (\(EqRef_ r k) -> k `lensMap` r) m @@ -290,7 +309,7 @@     :: Reference r     => EqRef r a     -> (a -> a)-    -> ReadPart (RefMonad r) Bool+    -> ReadRefMonad r Bool hasEffect m f = runEqRef m >>= \(EqRef_ r k) -> liftM (\x -> modL k f x /= x) $ readRef r  

@@ -23,6 +23,7 @@ import Control.Monad.RWS import Control.Monad.Trans.Identity import qualified System.Environment as Env+import System.IO.Error (catchIOError, isDoesNotExistError)  {- | Monad morphism. Think as @m@ is a submonad of @n@.@@ -35,12 +36,12 @@ -} newtype MorphD m n = MorphD { runMorphD :: Morph m n } --- | @m@ is a monad which has a submonad @ReadPart m@ which is isomorphic to 'Reader'.+-- | @m@ has a submonad @(ReadPart m)@ which is isomorphic to 'Reader'. class (Monad m, Monad (ReadPart m)) => HasReadPart m where      {- | Law: @(ReadPart m)@  ===  @('Reader' x)@ for some @x@. -    Alternative laws which ensures this isomorphism (@r :: ReadPart m a@ is arbitrary):+    Alternative laws which ensures this isomorphism (@r :: (ReadPart m a)@ is arbitrary):       *  @(r >> return ())@ === @return ()@ @@ -50,7 +51,7 @@     -}     type ReadPart m :: * -> * -    -- | @ReadPart m@ is a submonad of @m@+    -- | @(ReadPart m)@ is a submonad of @m@     liftReadPart :: Morph (ReadPart m) m  -- | @ReadPart (StateT s m) = Reader s@ @@ -95,7 +96,7 @@     -- | The name of the program as it was invoked.     getProgName :: m String -    -- | @getEnv var@ returns the value of the environment variable @var@.+    -- | @(lookupEnv var)@ returns the value of the environment variable @var@.     lookupEnv   :: String -> m (Maybe String)  -- | This instance is used in the implementation, the end users do not need it.@@ -103,7 +104,9 @@      getArgs     = Env.getArgs     getProgName = Env.getProgName-    lookupEnv   = Env.lookupEnv+--    lookupEnv   = Env.lookupEnv -- does not work with Haskell Platform 2013.2.0.0+    lookupEnv v = catchIOError (liftM Just $ Env.getEnv v) $ \e ->+        if isDoesNotExistError e then return Nothing else ioError e  -- | This instance is used in the implementation, the end users do not need it. instance SafeIO m => SafeIO (Ext n m) where

@@ -6,10 +6,19 @@ -- | Main LGtk interface. module LGtk     ( -    -- * Categories+    -- * Re-export++    -- ** Category       Category (..)++    -- ** Tensor     , Tensor (..)++    -- ** Monad     , liftM+    , liftM2+    , liftM3+    , when      -- * Lenses     -- ** Construction@@ -40,6 +49,7 @@     -- ** Basic operations     , Reference     , RefMonad+    , ReadRefMonad     , readRef     , writeRef     , lensMap@@ -93,13 +103,13 @@      -- ** GUI descriptions     , label-    , button_-    , Color (..)     , checkbox     , combobox     , entry     , vcat     , hcat+    , button_+    , Color (..)     , notebook     , cell_     , action@@ -143,7 +153,7 @@ Construction of a @(w :: forall m . EffIORef m => Widget m)@ value is side-effect free, side-effects happen at running @('runWidget' w)@. -@Widget m@ should be abstract, but it is also safe to keep it as a type synonym because+@Widget@ should be abstract data type, but it is also safe to keep it as a type synonym because the operations of the revealed implementation are hidden. -} type Widget m = Gtk.Widget (EffectM m) m

@@ -1,11 +1,9 @@ {-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE KindSignatures #-}-{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE DataKinds #-}+-- | A generic ADT editor defined on top of the main LGtk interface, "LGtk". module LGtk.ADTEditor     ( List (..), Elems(..), ADTLens(..)     , adtEditor@@ -13,7 +11,6 @@  import LGtk -import Control.Monad import Prelude hiding ((.), id)  -- | Type-level lists@@ -24,9 +21,43 @@     ElemsNil :: Elems Nil     ElemsCons :: ADTLens a => a -> Elems as -> Elems (Cons a as) --- | Lens for editable ADTs+{- | Lens for editable ADTs with support of shared record fields between constructors.++Suppose we have the data type++@+data X+    = X1 { a :: Int, b :: Bool }+    | X2 { a :: Int, c :: Char }+@++We can build an editor which can switch between two editor for the constructors.+If the field @a@ is edited in one editor, it will be updated in the other.+-} class ADTLens a where++    {- | @ADTEls a@ is the list of types of the parts of the ADT.++    For example,++    @ADTEls X = Cons Int (Cons Bool (Cons Char Nil))@+    -}     type ADTEls a :: List *++    {- | The lens which defines an abstract editor.++    The first parameter defines the displayed constructor name and the parts of the constructor for each constructor.+    @Int@ is an index in the @ADTEls@ list.++    For example, in case of @X@,++    @fst3 adtLens = [(\"X1\", [0, 1]), (\"X2\", [0, 2])]@++    The second parameter is the list of default values for each part.++    The third parameter is a lens from the selected constructor index plus+    the values of the ADT parts to the ADT values.+    -}     adtLens :: ([(String, [Int])], Elems (ADTEls a), Lens (Int, Elems (ADTEls a)) a)  -- | A generic ADT editor

@@ -22,7 +22,7 @@                 [ entryShow $ toRef len                 , smartButton (return "+1") len (+1)                 , smartButton (return "-1") len (+(-1))-                , smartButton (liftM (("DeleteAll " ++) . show) $ readRef $ toRef len) len $ const 0+                , smartButton (liftM (("DeleteAll " ++) . show) $ readRef len) len $ const 0                 , button (return "undo") undo                 , button (return "redo") redo                 ]

@@ -2,8 +2,7 @@     ( main     ) where -import Control.Monad-import Data.Maybe+import Data.Maybe (isJust) import Prelude hiding (id, (.))  import LGtk@@ -43,7 +42,7 @@             let (a, b) = interval ab             c <- counter 0 ab             return $ vcat-                [ label $ liftM show $ readRef $ toRef c+                [ label $ liftM show $ readRef c                 , hcat                     [ smartButton (return "+1") c (+1)                     , smartButton (return "-1") c (+(-1))

@@ -1,11 +1,8 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE DataKinds #-}-{-# LANGUAGE ConstraintKinds #-}-{-# LANGUAGE FlexibleContexts #-} module LGtk.Demos.TEditor where -import Control.Monad import Prelude hiding ((.), id)  import LGtk

@@ -1,6 +1,3 @@-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE ConstraintKinds #-} {- | An editor for integers x, y, z such that x + y = z always hold and the last edited value change.@@ -9,7 +6,6 @@  import LGtk -import Control.Monad import Prelude hiding ((.), id)  -- | Information pieces: what is known?@@ -32,8 +28,8 @@ tri = action $ do     s <- newRef [X 0, Y 0]     return $ vcat-        [ hcat [entryShow $ lens getX setX `lensMap` s, label $ return "x"]-        , hcat [entryShow $ lens getY setY `lensMap` s, label $ return "y"]+        [ hcat [entryShow $ lens getX  setX  `lensMap` s, label $ return "x"]+        , hcat [entryShow $ lens getY  setY  `lensMap` s, label $ return "y"]         , hcat [entryShow $ lens getXY setXY `lensMap` s, label $ return "x + y"]         ]