diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,31 @@
+Copyright Péter Diviánszky 2013
+
+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 Péter Diviánszky 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.
+
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/lgtk.cabal b/lgtk.cabal
new file mode 100644
--- /dev/null
+++ b/lgtk.cabal
@@ -0,0 +1,81 @@
+name:               lgtk
+version:            0.1
+category:           GUI
+synopsis:           lens-based GUI with Gtk backend
+description:
+    Try the demo executable lgtkdemo and read the source.
+    .
+    Key ingredients:
+    .
+    * monadic lenses
+    .
+    * expandable state
+    .
+    * lens-based GUI
+stability:          alpha
+license:            BSD3
+license-file:       LICENSE
+author:             Péter Diviánszky
+maintainer:         divipp@gmail.com
+cabal-version:      >= 1.8
+build-type:         Simple
+
+
+library
+
+  hs-source-dirs:
+                    src
+  build-depends:
+                    base < 5
+                  , containers
+                  , directory
+
+                  , mtl
+                  , control-monad-free
+                  -- Control.Category.Product is used only
+                  , data-lens
+
+                  , gtk
+  exposed-modules:
+                    Data.MLens
+                    Data.MLens.Ref
+
+                    Control.MLens.NewRef
+                    Control.MLens.ExtRef
+                    Control.MLens.ExtRef.Pure
+                    Control.MLens.ExtRef.Pure.Test
+
+                    GUI.MLens.Gtk.Interface
+                    GUI.MLens.Gtk.IO
+                    GUI.MLens.Gtk
+                    GUI.MLens.Gtk.ADTEditor
+
+                    GUI.MLens.Gtk.Demos.Tri
+                    GUI.MLens.Gtk.Demos.IntListEditor
+                    GUI.MLens.Gtk.Demos.TEditor
+  ghc-options: 
+                    -Wall 
+                    -fno-warn-incomplete-patterns 
+                    -fno-warn-name-shadowing 
+                    -fno-warn-missing-signatures 
+                    -fno-warn-orphans
+                    -fno-warn-type-defaults
+
+executable lgtkdemo
+
+  build-depends:
+                    base < 5
+                  , mtl
+                  , lgtk
+  main-is:
+                    Main.hs
+  hs-source-dirs:
+                    main
+  ghc-options: 
+                    -Wall 
+                    -fno-warn-incomplete-patterns 
+                    -fno-warn-name-shadowing 
+                    -fno-warn-missing-signatures 
+                    -fno-warn-orphans
+                    -fno-warn-type-defaults
+
diff --git a/main/Main.hs b/main/Main.hs
new file mode 100644
--- /dev/null
+++ b/main/Main.hs
@@ -0,0 +1,27 @@
+{-# LANGUAGE RankNTypes #-}
+import Control.Monad
+import Control.Monad.Trans
+import Prelude hiding ((.), id)
+
+import Control.MLens.ExtRef.Pure
+import GUI.MLens.Gtk.IO
+import GUI.MLens.Gtk
+
+import GUI.MLens.Gtk.Demos.Tri
+import GUI.MLens.Gtk.Demos.IntListEditor
+import GUI.MLens.Gtk.Demos.TEditor
+
+realize :: (forall i . I (Ext i IO)) -> IO ()
+realize e = runExt_ mapI e >>= runI
+
+main :: IO ()
+main = realize $ Notebook
+    [ (,) "IntListEditor" $ Action $ do
+        state <- lift $ liftM (mapMLens lift) $ join $ liftM memoMLens $ fileRef "intListEditorState.txt"
+        settings <- lift $ liftM (mapMLens lift) $ join $ liftM memoMLens $ fileRef "intListEditorSettings.txt"
+        return $ intListEditor state settings
+    , (,) "Tri" tri
+    , (,) "T-Editor1" tEditor1
+    , (,) "T-Editor3" $ Action $ newRef (iterate (Node Leaf) Leaf !! 10) >>= tEditor3
+    ]
+
diff --git a/src/Control/MLens/ExtRef.hs b/src/Control/MLens/ExtRef.hs
new file mode 100644
--- /dev/null
+++ b/src/Control/MLens/ExtRef.hs
@@ -0,0 +1,70 @@
+{-# LANGUAGE RankNTypes #-}
+module Control.MLens.ExtRef
+    ( module Control.MLens.NewRef
+    -- * Monads with state expansion
+    , ExtRef (extRef)
+    -- * Applications
+    , undoTr
+    ) where
+
+--import Data.IORef
+import Control.Monad
+import Control.Category
+import Prelude hiding ((.), id)
+
+import Control.MLens.NewRef
+import Data.MLens
+import Data.MLens.Ref
+
+{- |
+Suppose that @k@ is a pure lens, and
+
+@s <- extRef r k a0@.
+
+The following laws should hold:
+
+ *  @s@ is a pure reference.
+
+ *  @(k . s)@ behaves exactly as @r@.
+
+ *  The initial value of @s@ is the result of @(readRef r >>= setL k a0)@.
+
+Moreover, @(extRef r k a0)@ should not change the value of @r@.
+
+The following two operations should be identical:
+
+@newRew x@
+
+@extRef unitLens unitLens x@
+
+For examples, see "Control.MLens.ExtRef.Pure.Test".
+-}
+class NewRef m => ExtRef m where
+    extRef :: Ref m b -> MLens m a b -> a -> m (Ref m a)
+
+
+-- | Undo-redo state transformation
+undoTr
+    :: ExtRef m =>
+       (a -> a -> Bool)     -- ^ equality on state
+    -> Ref m a              -- ^ reference of state
+    -> m ( m (Maybe (m ()))   
+         , m (Maybe (m ()))
+         )  -- ^ undo and redo actions
+undoTr eq r = do
+    ku <- extRef r undoLens ([], [])
+    let try f = liftM (fmap (writeRef ku) . f) $ readRef ku
+    return (try undo, try redo)
+  where
+    undoLens = lens get set where
+        get = head . fst
+        set x (x' : xs, ys) | eq x x' = (x: xs, ys)
+        set x (xs, _) = (x : xs, [])
+
+    undo (x: xs@(_:_), ys) = Just (xs, x: ys)
+    undo _ = Nothing
+
+    redo (xs, y: ys) = Just (y: xs, ys)
+    redo _ = Nothing
+
+
diff --git a/src/Control/MLens/ExtRef/Pure.hs b/src/Control/MLens/ExtRef/Pure.hs
new file mode 100644
--- /dev/null
+++ b/src/Control/MLens/ExtRef/Pure.hs
@@ -0,0 +1,111 @@
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE ExistentialQuantification #-}
+{-# LANGUAGE RankNTypes #-}
+{- |
+Pure reference implementation for the @ExtRef@ interface.
+
+The implementation use @unsafeCoerce@ internally, but its effect cannot escape.
+-}
+module Control.MLens.ExtRef.Pure
+    ( Ext, runExt, runExt_
+    ) where
+
+import Control.Monad.State
+import Control.Category
+import Control.Category.Product
+import Data.Sequence
+import Data.Foldable (toList)
+import Prelude hiding ((.), id, splitAt, length)
+
+import Unsafe.Coerce
+
+import Data.MLens
+import Data.MLens.Ref
+import Control.MLens.ExtRef
+
+
+data CC m x = forall a . CC a (a -> x -> m (a, x))
+
+ap_ :: Monad m => x -> CC m x -> m (x, CC m x)
+ap_ x (CC a set) = do
+    (a', x') <- set a x
+    return (x', CC a' set)
+
+unsafeData :: CC m x -> a
+unsafeData (CC x _) = unsafeCoerce x
+
+
+newtype ST m = ST (Seq (CC m (ST m)))
+
+initST :: ST m
+initST = ST empty
+
+extend_
+    :: Monad m
+    => (a -> ST m -> m (a, ST m))
+    -> (a -> ST m -> m (a, ST m))
+    -> a
+    -> ST m
+    -> ((ST m -> a, a -> ST m -> m (ST m)), ST m)
+extend_ rk kr a0 x0
+    = ((getM, setM), x0 ||> CC a0 kr)
+  where
+    getM = unsafeData . head . snd . limit x0
+
+    setM a x = case limit x0 x of
+        (zs, _ : ys) -> do
+            (a', re) <- rk a zs
+            foldM ((liftM (uncurry (||>)) .) . ap_) (re ||> CC a' kr) ys
+
+    ST x ||> c = ST (x |> c)
+
+    limit (ST x) (ST y) = ST *** toList $ splitAt (length x) y
+
+
+
+newtype Ext i m a = Ext { unExt :: StateT (ST m) m a }
+    deriving (Functor, Monad)
+
+instance MonadTrans (Ext i) where
+    lift = Ext . lift
+
+extRef_ :: Monad m => MLens (Ext i m) a x -> MLens (Ext i m) a x -> a -> Ext i m (Ref (Ext i m) a)
+extRef_ r1 r2 a0 = Ext $ do
+    a1 <- g a0
+    (t,z) <- state $ extend_ (runStateT . f) (runStateT . g) a1
+    return $ MLens $ \c -> Ext (gets t) >>= \x -> return
+            ( x
+            , \a -> Ext $ (StateT $ liftM ((,) ()) . z a) >> return c
+            )
+   where
+    f b = unExt $ getL r2 b >>= flip (setL r1) b
+    g b = unExt $ getL r1 b >>= flip (setL r2) b
+
+instance (Monad m) => NewRef (Ext i m) where
+    newRef = extRef_ unitLens unitLens
+
+instance (Monad m) => ExtRef (Ext i m) where
+    extRef = extRef_ . (. unitLens)
+
+-- | Basic running of the @(Ext i m)@ monad.
+runExt :: Monad m => (forall i . Ext i m a) -> m a
+runExt s = evalStateT (unExt s) initST
+
+{- |
+Advanced running of the @(Ext i m)@ monad.
+
+@Functor@ in contexts would not be needed if it were a superclass of @Monad@.
+-}
+runExt_
+    :: forall c m . (Functor m, NewRef m)
+    => (forall n . (Monad n, Functor n) => Morph m n -> Morph n m -> c n -> c m)
+    -> (forall i . c (Ext i m)) -> m (c m)
+runExt_ mapI int = do
+    vx <- newRef initST
+    let unlift f = do
+            x <- readRef vx
+            (b, x) <- runStateT (unExt f) x
+            writeRef vx x
+            return b
+    return $ mapI lift unlift int
+
diff --git a/src/Control/MLens/ExtRef/Pure/Test.hs b/src/Control/MLens/ExtRef/Pure/Test.hs
new file mode 100644
--- /dev/null
+++ b/src/Control/MLens/ExtRef/Pure/Test.hs
@@ -0,0 +1,112 @@
+{-# LANGUAGE RankNTypes #-}
+-- | Tests for the reference implementation of the @ExtRef@ interface.
+module Control.MLens.ExtRef.Pure.Test
+    ( -- * Basic test environment
+      Test, (==>), runTest
+    -- * Test suit 
+    , tests
+    ) where
+
+import Control.Monad.Writer
+import Control.Category
+import Prelude hiding ((.), id)
+
+import Data.MLens
+import Data.MLens.Ref
+import Control.MLens.ExtRef
+import Control.MLens.ExtRef.Pure
+
+-----------------------------------------------------------------
+
+-- | Tests use a writer monad to tell errors.
+type Test i = Ext i (Writer [String])
+
+-- | This operator checks the current value of a given reference.
+(==>) :: (Eq a, Show a) => Ref (Test i) a -> a -> Test i ()
+r ==> v = readRef r >>= \rv -> when (rv /= v) $ lift . tell . return $ "runTest failed: " ++ show rv ++ " /= " ++ show v
+
+infix 0 ==>
+
+-- | Test running results the list of error messages given by @(==>)@.
+runTest :: (forall i . Test i a) -> [String]
+runTest = execWriter . runExt 
+
+--------------------
+
+{- | 
+@tests@ contains error messages; it should be emtpy.
+
+Look inside the sources for the tests.
+-}
+tests :: [String] 
+tests = newRefTest
+     ++ writeRefTest
+     ++ writeRefsTest
+     ++ extRefTest
+     ++ joinTest
+     ++ joinTest2
+  where
+
+    newRefTest = runTest $ do
+        r <- newRef 3
+        r ==> 3
+
+    writeRefTest = runTest $ do
+        r <- newRef 3
+        r ==> 3
+        writeRef r 4
+        r ==> 4
+
+    writeRefsTest = runTest $ do
+        r1 <- newRef 3
+        r2 <- newRef 13
+        r1 ==> 3
+        r2 ==> 13
+        writeRef r1 4
+        r1 ==> 4
+        r2 ==> 13
+        writeRef r2 0
+        r1 ==> 4
+        r2 ==> 0
+
+    extRefTest = runTest $ do
+        r <- newRef $ Just 3
+        q <- extRef r maybeLens (False, 0)
+        let q1 = fstLens . q
+            q2 = sndLens . q
+        r ==> Just 3
+        q ==> (True, 3)
+        writeRef r Nothing
+        r ==> Nothing
+        q ==> (False, 3)
+        q1 ==> False
+        writeRef q1 True
+        r ==> Just 3
+        writeRef q2 1
+        r ==> Just 1
+
+    joinTest = runTest $ do
+        r2 <- newRef 5
+        r1 <- newRef 3
+        rr <- newRef r1
+        r1 ==> 3
+        let r = joinLens rr
+        r ==> 3
+        writeRef r1 4
+        r ==> 4
+        writeRef rr r2
+        r ==> 5
+        writeRef r1 4
+        r ==> 5
+        writeRef r2 14
+        r ==> 14
+
+    joinTest2 = runTest $ do
+        r1 <- newRef 3
+        rr <- newRef r1
+        r2 <- newRef 5
+        writeRef rr r2
+        joinLens rr ==> 5
+
+
+
diff --git a/src/Control/MLens/NewRef.hs b/src/Control/MLens/NewRef.hs
new file mode 100644
--- /dev/null
+++ b/src/Control/MLens/NewRef.hs
@@ -0,0 +1,66 @@
+{-# LANGUAGE RankNTypes #-}
+module Control.MLens.NewRef
+    ( -- * Monads with reference creation
+      NewRef (newRef)
+
+    -- * Memo operators
+    , memoMLens
+
+    -- * Auxiliary functions
+    , memoRead, memoWrite
+    ) where
+
+import Data.IORef
+import Control.Monad
+import Prelude hiding ((.), id)
+
+import Data.MLens
+import Data.MLens.Ref
+
+class (Monad m) => NewRef m where
+    newRef :: a -> m (Ref m a)
+
+instance NewRef IO where
+    newRef x = do
+        r <- newIORef x
+        return $ MLens $ \() -> do
+            x <- readIORef r
+            return (x, writeIORef r)
+
+
+-- | Memoise pure lenses
+memoMLens :: (NewRef m, Eq a, Eq b) => MLens m a b -> m (MLens m a b)
+memoMLens (MLens k) = do
+    s <- newRef Nothing
+    return $ MLens $ \a -> readRef s >>= \x -> do
+        (b, bf) <- case x of
+            Just (a', b, bf) | a' == a -> return (b, bf)
+            _ -> k a >>= \(b, bf) -> do
+                writeRef s $ Just (a, b, bf)
+                return (b, bf)
+        return (b
+            , \b -> readRef s >>= \x -> case x of
+                Just (a', b', _) | (a', b') == (a, b) -> return a
+                Just (_, _, bf) -> bf b >>= \a -> do
+                    writeRef s $ Just (a, b, bf)
+                    return a
+                _ -> bf b >>= \a -> do
+                    writeRef s $ Just (a, b, bf)
+                    return a
+            )
+
+
+memoRead :: NewRef m => m a -> m (m a)
+memoRead g = liftM ($ ()) $ memoWrite $ const g
+
+memoWrite :: (NewRef m, Eq b) => (b -> m a) -> m (b -> m a)
+memoWrite g = do
+    s <- newRef Nothing
+    return $ \b -> readRef s >>= \x -> case x of
+        Just (b', a) | b' == b -> return a
+        _ -> g b >>= \a -> do
+            writeRef s $ Just (b, a)
+            return a
+
+
+
diff --git a/src/Data/MLens.hs b/src/Data/MLens.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/MLens.hs
@@ -0,0 +1,173 @@
+{-# LANGUAGE RankNTypes #-}
+module Data.MLens
+    ( -- * Monadic lenses data type
+      MLens (MLens)
+
+    -- * Side-effect free lenses
+    , Lens
+    , fromLens, toLens
+
+    -- * Lens construction
+    , lens
+
+    -- * Lens operations
+    , getL, setL, modL
+
+    -- * Lens transformations
+    , mapMLens
+    , joinML, joinLens
+
+    -- * Pure lenses
+    , unitLens
+    , fstLens, sndLens
+    , maybeLens
+    , listLens
+    , ithLens
+
+    -- * Impure lenses
+    , forkLens
+    , justLens
+    , showLens
+
+    -- * Auxiliary definitions
+    , Morph
+    ) where
+
+import Data.Monoid
+import Control.Category
+import Control.Category.Product
+import Control.Monad
+import Control.Monad.Identity
+import Data.Maybe
+import Prelude hiding ((.), id)
+
+{-|
+Monadic lenses.
+
+The following representations would be also good for @(MLens m a b)@:
+
+ *  @a -> m (Store b (m a))@
+
+ *  @forall f . Functor f => (b -> m (f (m b))) -> a -> m (f (m a))@
+
+ *  @(a -> m b, b -> a -> m a)@
+
+The last representation has no efficient composition operation
+(the set operation on composition of n lenses use O(n * n) get operations with the last representation).
+
+Using lenses which do not fulfil the lens laws are safe,
+but one should take extra care when doing program transformations
+or reasoning about code with impure lenses.
+
+The following law is a minimum, but some lenses (which do logging) do not fulfil this:
+
+ *  @getL@ has no side effect, i.e. @(getL k a >> return ())@  can be replaced by  @(return ())@
+
+TODO: List laws, document which laws hold for each lenses.
+-}
+data MLens m a b
+    = MLens (a -> m (b, b -> m a))
+
+{-|
+Side-effect free lenses.
+
+The following representations would be also good for @(Lens a b)@:
+
+ *  @forall m . Monad m => MLens m a b@
+-}
+type Lens a b
+    = MLens Identity a b
+
+fromLens :: Monad m => Lens a b -> MLens m a b
+fromLens (MLens f) = MLens $ \x -> do
+    let (a, b) = runIdentity $ f x
+    return (a, \y -> return $ runIdentity $ b y)
+
+toLens :: (forall m . Monad m => MLens m a b) -> Lens a b
+toLens k = k
+
+lens :: Monad m => (a -> b) -> (b -> a -> a) -> MLens m a b
+lens get set = MLens $ \a -> return (get a, return . flip set a)
+
+getL :: Monad m => MLens m a b -> a -> m b
+getL (MLens f) a = f a >>= return . fst
+
+setL :: Monad m => MLens m a b -> b -> a -> m a
+setL (MLens f) b a = f a >>= ($ b) . snd
+
+modL :: Monad m => MLens m b a -> (a -> a) -> b -> m b
+modL (MLens g) f b = do
+    (x, h) <- g b
+    h (f x)
+
+instance Monad m => Category (MLens m) where
+    id = MLens $ \a -> return (a, return)
+    MLens r1 . MLens r2 = MLens $ \a -> do
+        (g2, s2) <- r2 a
+        (g1, s1) <- r1 g2
+        return (g1, s1 >=> s2)
+
+instance Monad m => Tensor (MLens m) where
+    MLens r1 *** MLens r2 = MLens $ \(a1, a2) -> do
+        (g1, s1) <- r1 a1
+        (g2, s2) <- r2 a2
+        return
+            ( (g1, g2)
+            , uncurry (liftM2 (,)) . (s1 *** s2)
+            )
+
+mapMLens :: (Monad m, Monad n) => Morph m n -> MLens m a b -> MLens n a b
+mapMLens f (MLens r) = MLens $ \a -> do
+    (x, s) <- f (r a)
+    return (x, f . s)
+
+joinML :: Monad m => (a -> m (MLens m a b)) -> MLens m a b
+joinML r = MLens $ \x -> do
+    MLens q <- r x
+    q x
+
+-- | It would be possible to define a @Monad@ instance for @(MLens m a)@ too, but monad laws would not hold.
+joinLens :: Monad m => MLens m a (MLens m a b) -> MLens m a b
+joinLens = joinML . getL
+
+unitLens :: Monad m => MLens m a ()
+unitLens = lens (const ()) (const id)
+
+fstLens :: Monad m => MLens m (a,b) a
+fstLens = MLens $ \(a,b) -> return (a, \a' -> return (a', b))
+
+sndLens :: Monad m => MLens m (a,b) b
+sndLens = MLens $ \(a,b) -> return (b, \b' -> return (a, b'))
+
+maybeLens :: Monad m => MLens m (Bool, a) (Maybe a)
+maybeLens = lens (\(b,a) -> if b then Just a else Nothing)
+              (\x (_,a) -> maybe (False, a) (\a' -> (True, a')) x)
+
+listLens :: Monad m => MLens m (Bool, (a, [a])) [a]
+listLens = lens get set where
+    get (False, _) = []
+    get (True, (l, r)) = l: r
+    set [] (_, x) = (False, x)
+    set (l: r) _ = (True, (l, r))
+
+-- | @ithLens@ is pure only with proper preconditions.
+ithLens :: Monad m => Int -> MLens m [a] a
+ithLens i = lens (!!i) $ \x xs -> take i xs ++ x : drop (i+1) xs
+
+forkLens :: (Monoid a, Monad m) => MLens m a (a, a)
+forkLens = MLens $ \a ->
+    return ((a, a), \(a1, a2) -> return $ a1 `mappend` a2)
+
+justLens :: Monad m => a -> MLens m (Maybe a) a
+justLens a = lens (maybe a id) (const . Just)
+
+showLens :: (Monad m, Show a, Read a) => MLens m a String
+showLens = lens show $ \s def -> maybe def fst $ listToMaybe $ reads s
+
+
+type Morph m n = forall a . m a -> n a
+
+
+
+
+
diff --git a/src/Data/MLens/Ref.hs b/src/Data/MLens/Ref.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/MLens/Ref.hs
@@ -0,0 +1,84 @@
+{-# LANGUAGE RankNTypes #-}
+module Data.MLens.Ref
+    ( -- * Data type for reference lenses
+      Ref
+
+    -- * Reference operations
+    , readRef, writeRef, modRef
+
+    -- * Some @IO@ referenceses
+    , fileRef, fileRef_
+    , logConsoleLens
+
+    -- * Auxiliary definitions
+    , logMLens, logFile
+    ) where
+
+import Control.Monad
+import Control.Category
+import System.Directory
+import Prelude hiding ((.), id)
+
+import Data.MLens
+
+{- |
+Note that references lenses can be composed with lenses.
+For example, if
+
+@r :: Ref m (a,b)@
+
+then
+
+@fstLens . r :: Ref m a@
+
+Reference laws for pure references:
+
+ *  @(readRef r)@ has no side effect.
+ *  @(readRef r >>= writeRef r)@ has no side effect.
+ *  @(writeRef r a >> readRef r)@ returns @a@.
+ *  @(writeRef r a >> writeRef r a)@ has the same effect as @(writeRef r a)@.
+-}
+type Ref m a = MLens m () a
+
+readRef :: Monad m => MLens m () a -> m a
+readRef k = getL k ()
+
+writeRef :: Monad m => Ref m a -> a -> m ()
+writeRef r a = setL r a ()
+
+modRef :: Monad m => Ref m a -> (a -> a) -> m ()
+k `modRef` f = modL k f ()
+
+-- | Using @fileRef@ is safe if the file is not used concurrently.
+fileRef :: FilePath -> IO (Ref IO String)
+fileRef f = liftM (justLens "" .) $ fileRef_ f
+
+-- | Note that if you write @Nothing@, the file is deleted.
+fileRef_ :: FilePath -> IO (Ref IO (Maybe String))
+fileRef_ f = return $ MLens $ \() -> do
+    b <- doesFileExist f
+    if b then do
+            xs <- readFile f
+            length xs `seq` return (Just xs, wr)
+         else return (Nothing, wr)
+ where wr = maybe (doesFileExist f >>= \b -> when b (removeFile f)) (writeFile f)
+
+logMLens :: Monad m => (a -> m ()) -> (a -> m ()) -> MLens m a a
+logMLens getLog setLog = MLens $ \a -> getLog a >> return (a, \b -> setLog b >> return b)
+
+{- |
+@logConsoleLens@ logs elementary get and set operations.
+
+Note that with the current representation of @MLens@, every set operation involves a get operation.
+-}
+logConsoleLens :: (Show a) => MLens IO a a
+logConsoleLens = logMLens (putStrLn . ("Get: " ++) . show) (putStrLn . ("Set: " ++) . show)
+
+logFile :: FilePath -> IO (String -> IO ())
+logFile f = do
+    b <- doesFileExist f
+    when (not b) $ writeFile f ""
+    return $ appendFile f
+
+
+
diff --git a/src/GUI/MLens/Gtk.hs b/src/GUI/MLens/Gtk.hs
new file mode 100644
--- /dev/null
+++ b/src/GUI/MLens/Gtk.hs
@@ -0,0 +1,60 @@
+{-# LANGUAGE ExistentialQuantification #-}
+{-# LANGUAGE RankNTypes #-}
+
+module GUI.MLens.Gtk -- --> GUI.MLens.Gtk.Interface
+    ( module Control.Category
+    , module Control.Category.Product
+    , module Data.MLens
+    , module Data.MLens.Ref
+    , module Control.MLens.ExtRef
+    , module GUI.MLens.Gtk.Interface
+
+    -- * Composed
+    , vcat, hcat
+    , smartButton
+
+    -- * Auxiliary functions
+    , mapI
+    , toFree
+    ) where
+
+import Control.Category
+import Control.Category.Product
+import Control.Monad.Free
+import Prelude hiding ((.), id)
+
+import Data.MLens
+import Data.MLens.Ref
+import Control.MLens.ExtRef
+import GUI.MLens.Gtk.Interface
+
+vcat :: [I m] -> I m
+vcat = List Vertical
+
+hcat :: [I m] -> I m
+hcat = List Horizontal
+
+smartButton
+  :: (Eq a, Monad m, Functor m) =>
+     Free m String -> (a -> m a) -> MLens m () a -> I m
+smartButton s f k =
+    Button s $ toFree $ readRef k >>= \x -> f x >>= \y -> 
+        if y == x then return Nothing else return $ Just ((readRef k >>= f) >>= writeRef k)
+
+
+mapI :: (Monad m, Functor m, Monad n, Functor n) => Morph n m -> Morph m n -> I m -> I n
+mapI _g f (Label s)     = Label $ mapFree f s
+mapI _g f (Button s m)  = Button (mapFree f s) (mapFree f $ fmap (fmap f) m)
+mapI _g f (Entry m)     = Entry $ mapMLens f m
+mapI _g f (Checkbox m)  = Checkbox $ mapMLens f m
+mapI _g f (Combobox ss m) = Combobox ss $ mapMLens f m
+mapI g f (List o is)    = List o $ map (mapI g f) is
+mapI g f (Notebook is)  = Notebook $ map (fmap $ mapI g f) is
+mapI g f (Cell b m k)   = Cell b (f m) $ mapI g f . k
+mapI g f (Action m)     = Action $ f $ liftM (mapI g f) m
+
+
+toFree :: (Functor m, Monad m) => m a -> Free m a
+toFree = Impure . fmap Pure
+
+
diff --git a/src/GUI/MLens/Gtk/ADTEditor.hs b/src/GUI/MLens/Gtk/ADTEditor.hs
new file mode 100644
--- /dev/null
+++ b/src/GUI/MLens/Gtk/ADTEditor.hs
@@ -0,0 +1,62 @@
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE DataKinds #-}
+module GUI.MLens.Gtk.ADTEditor
+    ( List (..), Elems(..), ADTLens(..)
+    , adtEditor
+    ) where
+
+import GUI.MLens.Gtk
+
+import Control.Monad
+import Prelude hiding ((.), id)
+
+-- | Type-level lists
+data List a = Nil | Cons a (List a)
+
+-- | Heterogeneous lists
+data Elems (xs :: List *) where
+    ElemsNil :: Elems Nil
+    ElemsCons :: ADTLens a => a -> Elems as -> Elems (Cons a as)
+
+-- | Lens for editable ADTs
+class ADTLens a where
+    type ADTEls a :: List *
+    adtLens :: ([(String, [Int])], Elems (ADTEls a), Lens (Int, Elems (ADTEls a)) a)
+
+-- | A generic ADT editor
+adtEditor :: (ExtRef m, ADTLens a) => Ref m a -> m (I m)
+adtEditor = liftM Action . memoRead . editor  where
+    editor r = do
+        q <- extRef r (fromLens k) (0, ls)
+        es <- mkEditors ls $ sndLens . q
+        return $ hcat
+            [ Combobox (map fst ss) $ fstLens . q
+            , Cell True (liftM fst $ readRef q) $ \i -> vcat [es !! j | j <- snd $ ss !! i]
+            ]
+      where
+        (ss, ls, k) = adtLens
+
+    mkEditors :: ExtRef m => Elems xs -> Ref m (Elems xs) -> m [I m]
+    mkEditors ElemsNil _ = return []
+    mkEditors (ElemsCons _ xs) r = do
+        i <- adtEditor $ lHead . r
+        is <- mkEditors xs $ lTail . r
+        return $ i : is
+      where
+        lHead = lens get set where
+            get :: Elems (Cons x xs) -> x
+            get (ElemsCons a _) = a
+            set :: x -> Elems (Cons x xs) -> Elems (Cons x xs)
+            set a (ElemsCons _ as) = ElemsCons a as
+
+        lTail = lens get set where
+            get :: Elems (Cons x xs) -> Elems xs
+            get (ElemsCons _ as) = as
+            set :: Elems xs -> Elems (Cons x xs) -> Elems (Cons x xs)
+            set as (ElemsCons a _) = ElemsCons a as
+
+
diff --git a/src/GUI/MLens/Gtk/Demos/IntListEditor.hs b/src/GUI/MLens/Gtk/Demos/IntListEditor.hs
new file mode 100644
--- /dev/null
+++ b/src/GUI/MLens/Gtk/Demos/IntListEditor.hs
@@ -0,0 +1,86 @@
+-- | An integer list editor
+module GUI.MLens.Gtk.Demos.IntListEditor where
+
+import GUI.MLens.Gtk
+
+import Control.Monad
+import Data.List
+import Data.Function (on)
+import Prelude hiding ((.), id)
+
+---------------
+
+intListEditor
+    :: (Functor m, ExtRef m)
+    => Ref m String         -- ^ state reference
+    -> Ref m String         -- ^ settings reference
+    -> I m
+intListEditor state settings = Action $ do
+    list <- extRef state showLens []
+    (undo, redo)  <- undoTr ((==) `on` map fst) list
+    range <- extRef settings showLens True
+    let safe = lens id (const . take maxi)
+        len = joinML $ \_ -> readRef range >>= \r -> return $ lens length $ extendList r . min maxi
+        sel = liftM (filter snd) $ readRef list
+    return $ Notebook
+        [ (,) "Editor" $ vcat
+            [ hcat
+                [ Entry $ showLens . len . list
+                , smartButton (return "+1") (modL len (+1))      list
+                , smartButton (return "-1") (modL len (+(-1)))   list
+                , smartButton (toFree $ liftM (("DeleteAll " ++) . show) $ readRef $ len . list) (modL len $ const 0) list
+                , Button (return "undo") $ toFree undo
+                , Button (return "redo") $ toFree redo
+                ]
+            , hcat
+                [ sbutton (return "+1")         (map $ mapFst (+1))           list
+                , sbutton (return "-1")         (map $ mapFst (+(-1)))        list
+                , sbutton (return "sort")       (sortBy (compare `on` fst))   list
+                , sbutton (return "SelectAll")  (map $ mapSnd $ const True)   list
+                , sbutton (return "SelectPos")  (map $ \(a,_) -> (a, a>0))    list
+                , sbutton (return "SelectEven") (map $ \(a,_) -> (a, even a)) list
+                , sbutton (return "InvertSel")  (map $ mapSnd not)            list
+                , sbutton (toFree $ liftM (("DelSel " ++) . show . length) sel) (filter $ not . snd) list
+                , smartButton (return "CopySel") (modL safe $ concatMap $ \(x,b) -> (x,b): [(x,False) | b]) list
+                , sbutton (return "+1 Sel")     (map $ mapSel (+1))           list
+                , sbutton (return "-1 Sel")     (map $ mapSel (+(-1)))        list
+                ]
+            , Label $ toFree $ liftM (("Sum: " ++) . show . sum . map fst) sel
+            , Action $ listEditor def (itemEditor list) list
+            ]
+        , (,) "Settings" $ hcat
+            [ Label $ return "Create range"
+            , Checkbox range
+            ]
+        ]
+ where
+    itemEditor list i r = return $ hcat
+        [ Label $ return $ show (i+1) ++ "."
+        , Entry $ showLens . fstLens . r
+        , Checkbox $ sndLens . r
+        , Button (return "Del")  $ return $ Just $ modRef list (\xs -> take i xs ++ drop (i+1) xs)
+        , Button (return "Copy") $ return $ Just $ modRef list (\xs -> take (i+1) xs ++ drop i xs) ]
+
+    extendList r n xs = take n $ (reverse . drop 1 . reverse) xs ++
+        (uncurry zip . ((if r then enumFrom else repeat) *** repeat)) (head $ reverse xs ++ [def])
+
+    def = (0, True)
+    maxi = 15
+
+    sbutton s f k = smartButton s (return . f) k
+
+    mapFst f (x, y) = (f x, y)
+    mapSnd f (x, y) = (x, f y)
+    mapSel f (x, y) = (if y then f x else x, y)
+
+
+listEditor :: ExtRef m => a -> (Int -> Ref m a -> m (I m)) -> Ref m [a] -> m (I m)
+listEditor def ed = editor 0 where
+  editor i r = liftM Action $ memoRead $ do
+    q <- extRef r listLens (False, (def, []))
+    t1 <- ed i $ fstLens . sndLens . q
+    t2 <- editor (i+1) $ sndLens . sndLens . q
+    return $ Cell True (liftM fst (readRef q)) $ \b -> vcat $ if b then [t1, t2] else []
+
+
+
diff --git a/src/GUI/MLens/Gtk/Demos/TEditor.hs b/src/GUI/MLens/Gtk/Demos/TEditor.hs
new file mode 100644
--- /dev/null
+++ b/src/GUI/MLens/Gtk/Demos/TEditor.hs
@@ -0,0 +1,69 @@
+--{-# LANGUAGE ExistentialQuantification #-}
+--{-# LANGUAGE MultiParamTypeClasses #-}
+--{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE DataKinds #-}
+module GUI.MLens.Gtk.Demos.TEditor where
+
+import Control.Monad
+import Prelude hiding ((.), id)
+
+import GUI.MLens.Gtk
+import GUI.MLens.Gtk.ADTEditor
+
+-- | Binary tree shapes
+data T
+    = Leaf
+    | Node T T
+        deriving Show
+
+-- | Lens for @T@
+tLens :: Monad m => MLens m (Bool, (T, T)) T
+tLens = lens get set where
+    get (False, _)     = Leaf
+    get (True, (l, r)) = Node l r
+    set Leaf (_, x)   = (False, x)
+    set (Node l r) _ = (True, (l, r))
+
+-- | @ADTLens@ instance for @T@
+instance ADTLens T where
+    type ADTEls T = Cons T (Cons T Nil)
+    adtLens = ([("Leaf",[]),("Node",[0,1])], ElemsCons Leaf (ElemsCons Leaf ElemsNil), lens get set) where
+        get :: (Int, Elems (ADTEls T)) -> T
+        get (0, _)     = Leaf
+        get (1, ElemsCons l (ElemsCons r ElemsNil)) = Node l r
+        set :: T -> (Int, Elems (ADTEls T)) -> (Int, Elems (ADTEls T))
+        set Leaf (_, x)   = (0, x)
+        set (Node l r) _ = (1, ElemsCons l (ElemsCons r ElemsNil))
+
+-- | @T@ editor with comboboxes, as an ADTEditor
+tEditor1 :: (Functor m, ExtRef m) => I m
+tEditor1 = Action $ newRef Leaf >>= adtEditor
+
+-- | @T@ editor with checkboxes, given directly
+tEditor2 :: ExtRef m => I m
+tEditor2 = Action $ liftM editor $ newRef Leaf  where
+
+    editor r = Action $ do
+        q <- extRef r tLens (False, (Leaf, Leaf))
+        return $ hcat
+            [ Checkbox $ fstLens . q
+            , Cell True (liftM fst (readRef q)) $ \b -> vcat $ 
+                  [ editor $ fstLens . sndLens . q | b ]
+               ++ [ editor $ sndLens . sndLens . q | b ]
+            ]
+
+-- | Another @T@ editor with checkboxes, given directly
+tEditor3 :: ExtRef m => Ref m T -> m (I m)
+tEditor3 = liftM Action . memoRead . editor' where
+    editor' r = do
+        q <- extRef r tLens (False, (Leaf, Leaf))
+        t1 <- tEditor3 $ fstLens . sndLens . q
+        t2 <- tEditor3 $ sndLens . sndLens . q
+        return $ hcat
+            [ Checkbox $ fstLens . q
+            , Cell True (liftM fst $ readRef q) $ \b -> vcat $ [t1 | b] ++ [t2 | b]
+            ]
+
+
diff --git a/src/GUI/MLens/Gtk/Demos/Tri.hs b/src/GUI/MLens/Gtk/Demos/Tri.hs
new file mode 100644
--- /dev/null
+++ b/src/GUI/MLens/Gtk/Demos/Tri.hs
@@ -0,0 +1,41 @@
+{- |
+An editor for integers x, y, z such that x + y = z always hold and
+the last edited value change.
+-}
+module GUI.MLens.Gtk.Demos.Tri where
+
+import GUI.MLens.Gtk
+
+import Control.Monad
+import Prelude hiding ((.), id)
+
+-- | Information pieces: what is known?
+data S = X Int | Y Int | XY Int
+
+-- | Getter
+getX, getY, getXY :: [S] -> Int
+getX s =  head $ [x | X  x <- s]  ++ [getXY s - getY s]
+getY s =  head $ [x | Y  x <- s]  ++ [getXY s - getX s]
+getXY s = head $ [x | XY x <- s]  ++ [getX  s + getY s]
+
+-- | Setter
+setX, setY, setXY :: Int -> [S] -> [S]
+setX  x s = take 2 $ X  x : filter (\x-> case x of X  _ -> False; _ -> True) s
+setY  x s = take 2 $ Y  x : filter (\x-> case x of Y  _ -> False; _ -> True) s
+setXY x s = take 2 $ XY x : filter (\x-> case x of XY _ -> False; _ -> True) s
+
+-- | The editor
+tri :: (Functor m, ExtRef m) => I m
+tri = Action $ do
+    s <- newRef [X 0, Y 0]
+    return $ vcat
+        [ hcat [Entry $ showLens . lens getX setX . s, Label $ return "x"]
+        , hcat [Entry $ showLens . lens getY setY . s, Label $ return "y"]
+        , hcat [Entry $ showLens . lens getXY setXY . s, Label $ return "x + y"]
+        ]
+
+
+
+
+
+
diff --git a/src/GUI/MLens/Gtk/IO.hs b/src/GUI/MLens/Gtk/IO.hs
new file mode 100644
--- /dev/null
+++ b/src/GUI/MLens/Gtk/IO.hs
@@ -0,0 +1,189 @@
+{-# LANGUAGE FlexibleInstances #-}
+module GUI.MLens.Gtk.IO
+    ( runI
+    ) where
+
+import Control.Category
+import Control.Monad
+import Control.Monad.Writer
+import Control.Monad.Free
+import Data.Maybe
+import Prelude hiding ((.), id)
+
+import Graphics.UI.Gtk
+
+import Data.MLens.Ref
+import Control.MLens.NewRef
+import GUI.MLens.Gtk.Interface
+
+------------------
+
+-- | (remove action, toggle action, show action)
+type WriterState = (IO (), IO (), IO ())
+
+type IOWriterState = WriterT WriterState IO
+
+-- | Run an @IO@ parametrized interface description with Gtk backend
+runI :: I IO -> IO ()
+runI i = do
+    _ <- initGUI
+    dca <- newRef []
+    rea <- newRef True
+    (c, _) <- runWriterT $ userr_ rea dca i
+    window <- windowNew
+    set window [ containerBorderWidth := 10, containerChild := c ]
+    _ <- window `on` deleteEvent $ liftIO (mainQuit) >> return False
+    widgetShowAll window
+    mainGUI
+ where
+    userr_ :: Ref IO Bool -> Ref IO [Ref IO (Maybe (Bool, IO ()))] -> I IO -> IOWriterState Widget
+    userr_ rea dca i = case i of
+        Button s m -> do
+            w <- lift'' buttonNew
+            lift $ evalFree (maybe (return ()) ((\x -> on w buttonActivated x >> return ()) . react))
+                        ((\x -> on w buttonActivated x >> return ()) . react . join . fmap (maybe (return ()) id) . join . fmap (induce id)) m
+            s >>=.. buttonSetLabel w
+            fmap isJust m >>=.. widgetSetSensitive w
+            return' w
+        Entry k -> do
+            w <- lift'' entryNew
+            _ <- lift $ on w entryActivate $ react $ entryGetText w >>= writeRef k
+            readRef k >>=. entrySetText w
+            return' w
+        Checkbox k -> do
+            w <- lift'' checkButtonNew
+            _ <- lift $ on w toggled $ react $ toggleButtonGetActive w >>= writeRef k
+            readRef k >>=. toggleButtonSetActive w
+            return' w
+        Combobox ss k -> do
+            w <- lift'' comboBoxNewText
+            lift $ flip mapM_ ss $ comboBoxAppendText w
+            _ <- lift $ on w changed $ react $ fmap (max 0) (comboBoxGetActive w) >>= writeRef k 
+            readRef k >>=. comboBoxSetActive w
+            return' w
+        List o xs -> do
+            w <- lift' $ case o of
+                Vertical -> fmap castToBox $ vBoxNew False 1
+                Horizontal -> fmap castToBox $ hBoxNew False 1
+            flip mapM_ xs $ flattenI' >=> containerAdd'' w
+            return' w
+        Notebook xs -> do
+            w <- lift' notebookNew
+            flip mapM_ xs $ \(s, i) ->
+                flattenI' i >>= lift . flip (notebookAppendPage w) s
+            return' w
+        Label s -> do
+            w <- lift'' $ labelNew Nothing
+            s >>=.. labelSetLabel w
+            return' w
+        Action m -> 
+            lift m >>= flattenI'
+        Cell False m f -> do
+            w <- lift' $ alignmentNew 0 0 1 1
+            cancelc <- lift $ newRef mempty
+            togglec <- lift $ newRef mempty
+            showc <- lift $ newRef mempty
+            let cc = (readRef cancelc >>= id) >> writeRef cancelc mempty >> writeRef togglec mempty >> writeRef showc mempty
+            let cc' = readRef togglec >>= id
+            let cc'' = readRef showc >>= id
+            tell (cc, cc', cc'')
+            m >>=. \new -> do
+                cc
+                containerForeach w $ containerRemove w
+                (x, (c1, c2, c3)) <- runWriterT $ flattenI' (f new)
+                writeRef cancelc c1
+                writeRef togglec c2
+                writeRef showc c3
+                containerAdd w x
+                widgetShowAll w
+            return' w
+        Cell True m f -> do
+            w <- lift' $ hBoxNew False 1
+            tri <- lift $ newRef []
+            cancelc <- lift $ newRef mempty
+            togglec <- lift $ newRef mempty
+            showc <- lift $ newRef mempty
+            let cc = (readRef cancelc >>= id) >> writeRef cancelc mempty >> writeRef togglec mempty >> writeRef showc mempty
+            let cc' = readRef togglec >>= id
+            let cc'' = readRef showc >>= id
+            tell (cc, cc', cc'')
+            m >>=. \new -> do
+                cc'
+                containerForeach w $ widgetHideAll
+                t <- readRef tri
+                case [b | (a,b) <-t, a == new] of
+                    [] -> do
+                        (x, (c1, c2, c3)) <- runWriterT $ flattenI' $ f new
+                        modRef cancelc (>> c1)
+                        containerAdd w x
+                        widgetShowAll x
+                        modRef tri ((new, (c2, c3)) :)
+                        writeRef togglec c2
+                        writeRef showc c3
+                    [(c2, c3)] -> do
+                        c2
+                        c3
+                        writeRef togglec c2
+                        writeRef showc c3
+            return' w
+      where
+        flattenI' = userr_ rea dca
+
+        infixl 1 >>=.., >>=.
+
+        m >>=.. f = evalFree (lift . f) ((>>=. f) . join . fmap (induce id)) m
+
+        (>>=.) :: (Eq a) => IO a -> (a -> IO ()) -> IOWriterState ()
+        get >>=. install = lift get >>= \x -> do
+            v <- lift $ newRef x
+            b <- lift $ newRef $ Just $ (,) True $ do
+                x <- readRef v
+                x' <- get
+                when (x /= x') $ do
+                    writeRef v x'
+                    install x'
+                    return ()
+            lift $ modRef dca (b :)
+            tell (writeRef b Nothing, modRef b $ fmap $ mapFst not, mempty)
+            lift $ install x
+
+        react :: IO () -> IO ()
+        react a = do
+            b <- readRef rea
+            when b $ do
+            writeRef rea False
+            a
+            xs <- readRef dca
+            writeRef dca ([] :: [Ref IO (Maybe (Bool, IO ()))])
+            let ff (Just (b, m)) = when b m >> return True
+                ff Nothing = return False
+            xs' <- filterM ((>>= ff) . readRef) . reverse $ xs
+            modRef dca (++ reverse xs') 
+            writeRef rea True
+
+    return' :: GObjectClass x => x -> IOWriterState Widget
+    return' = return . castToWidget
+
+    lift' m = do
+        x <- lift m
+        tell (mempty, mempty, widgetShow (castToWidget x))
+        return x
+
+    lift'' m = do
+        x <- lift m
+        tell (mempty, mempty, widgetShowAll (castToWidget x))
+        return x
+
+    containerAdd'' w x = do
+        a <- lift' $ alignmentNew 0 0 0 0
+        lift $ containerAdd a x
+        lift $ containerAdd w a
+        lift $ set w [ boxChildPacking a := PackNatural ]
+
+mapFst f (a, b) = (f a, b)
+
+instance Monoid (IO ()) where
+    mempty = return ()
+    mappend = (>>)
+
+
diff --git a/src/GUI/MLens/Gtk/Interface.hs b/src/GUI/MLens/Gtk/Interface.hs
new file mode 100644
--- /dev/null
+++ b/src/GUI/MLens/Gtk/Interface.hs
@@ -0,0 +1,32 @@
+{-# LANGUAGE ExistentialQuantification #-}
+-- | Lens-based Gtk interface
+module GUI.MLens.Gtk.Interface
+    ( I (..)
+    , ListLayout (..)
+    ) where
+
+import Control.Monad.Free
+
+import Data.MLens.Ref
+
+-- | Interface description parametrized by a monad
+data I m
+    = Label (Free m String)     -- ^ label
+    | Button { label_  :: Free m String
+             , action_ :: Free m (Maybe (m ()))     -- ^ when the @Maybe@ value is @Nothing@, the button is inactive
+             }  -- ^ button
+    | Checkbox (Ref m Bool)         -- ^ checkbox
+    | Combobox [String] (Ref m Int) -- ^ combo box
+    | Entry (Ref m String)          -- ^ entry field
+    | List ListLayout [I m]         -- ^ group interfaces into row or column
+    | Notebook [(String, I m)]      -- ^ tabs
+    | forall a . Eq a 
+    => Cell { remember_content_   :: Bool       -- ^ remember the content or not? (info for the renderer)
+            , underlying_value_   :: m a
+            , dynamic_interface_  :: a -> I m
+            }     -- ^ dynamic interface
+    | Action (m (I m))              -- ^ do an action before giving the interface
+
+data ListLayout
+    = Horizontal | Vertical
+