1{-# LANGUAGE ExistentialQuantification #-}
2-- -*-haskell-*-
3--  GIMP Toolkit (GTK) Attributes interface
4--
5--  Author : Duncan Coutts
6--
7--  Created: 21 January 2005
8--
9--  Copyright (C) 2005 Duncan Coutts
10--
11--  Partially derived from the hs-fltk and wxHaskell projects which
12--  are both under LGPL compatible licenses.
13--
14--  This library is free software; you can redistribute it and/or
15--  modify it under the terms of the GNU Lesser General Public
16--  License as published by the Free Software Foundation; either
17--  version 2.1 of the License, or (at your option) any later version.
18--
19--  This library is distributed in the hope that it will be useful,
20--  but WITHOUT ANY WARRANTY; without even the implied warranty of
21--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
22--  Lesser General Public License for more details.
23--
24-- |
25-- Maintainer  : gtk2hs-users@lists.sourceforge.net
26-- Stability   : experimental
27-- Portability : portable
28--
29-- Attributes interface
30--
31-- Attributes of an object can be get and set. Getting the value of an
32-- object's attribute is straingtforward. As an example consider a @button@
33-- widget and an attribute called @buttonLabel@.
34--
35-- > value <- get button buttonLabel
36--
37-- The syntax for setting or updating an attribute is only slightly more
38-- complex. At the simplest level it is just:
39--
40-- > set button [ buttonLabel := value ]
41--
42-- However as the list notation would indicate, you can set or update multiple
43-- attributes of the same object in one go:
44--
45-- > set button [ buttonLabel := value, buttonFocusOnClick := False ]
46--
47-- You are not limited to setting the value of an attribute, you can also
48-- apply an update function to an attribute's value. That is the function
49-- receives the current value of the attribute and returns the new value.
50--
51-- > set spinButton [ spinButtonValue :~ (+1) ]
52--
53-- There are other variants of these operators, (see 'AttrOp'). ':=>' and
54-- ':~>' and like ':=' and ':~' but operate in the 'IO' monad rather
55-- than being pure. There is also '::=' and '::~' which take the object
56-- as an extra parameter.
57--
58-- Attributes can be read only, write only or both read\/write.
59--
60module System.Glib.Attributes (
61  -- * Attribute types
62  Attr,
63  ReadAttr,
64  WriteAttr,
65  ReadWriteAttr,
66
67  -- * Interface for getting, setting and updating attributes
68  AttrOp(..),
69  get,
70  set,
71
72  -- * Internal attribute constructors
73  newNamedAttr,
74  readNamedAttr,
75  writeNamedAttr,
76  newAttr,
77  readAttr,
78  writeAttr,
79  ) where
80
81infixr 0 :=,:~,:=>,:~>,::=,::~
82
83-- | An ordinary attribute. Most attributes have the same get and set types.
84type Attr o a = ReadWriteAttr o a a
85
86-- | A read-only attribute.
87type ReadAttr o a = ReadWriteAttr o a ()
88
89-- | A write-only attribute.
90type WriteAttr o b = ReadWriteAttr o () b
91
92-- | A generalised attribute with independent get and set types.
93data ReadWriteAttr o a b = Attr String !(o -> IO a) !(o -> b -> IO ())
94
95instance Show (ReadWriteAttr o a b) where
96  show (Attr str _ _) = str
97
98-- | Create a new attribute with a getter and setter function.
99newNamedAttr :: String -> (o -> IO a) -> (o -> b -> IO ()) -> ReadWriteAttr o a b
100newNamedAttr prop getter setter = Attr prop getter setter
101
102-- | Create a new read-only attribute.
103readNamedAttr :: String -> (o -> IO a) -> ReadAttr o a
104readNamedAttr prop getter = Attr prop getter (\_ _ -> return ())
105
106-- | Create a new write-only attribute.
107writeNamedAttr :: String -> (o -> b -> IO ()) -> WriteAttr o b
108writeNamedAttr prop setter = Attr prop (\_ -> return ()) setter
109
110-- | Create a new attribute with a getter and setter function.
111newAttr :: (o -> IO a) -> (o -> b -> IO ()) -> ReadWriteAttr o a b
112newAttr getter setter = Attr "unnamed attribute" getter setter
113
114-- | Create a new read-only attribute.
115readAttr :: (o -> IO a) -> ReadAttr o a
116readAttr getter = Attr "unnamed attribute" getter (\_ _ -> return ())
117
118-- | Create a new write-only attribute.
119writeAttr :: (o -> b -> IO ()) -> WriteAttr o b
120writeAttr setter = Attr "unnamed attribute" (\_ -> return ()) setter
121
122-- | A set or update operation on an attribute.
123data AttrOp o
124  = forall a b.
125      ReadWriteAttr o a b :=              b    -- ^ Assign a value to an
126                                               --   attribute.
127  | forall a b.
128      ReadWriteAttr o a b :~   (  a ->    b)   -- ^ Apply an update function to
129                                               --   an attribute.
130  | forall a b.
131      ReadWriteAttr o a b :=>  (       IO b)   -- ^ Assign the result of an IO
132                                               --   action to an attribute.
133  | forall a b.
134      ReadWriteAttr o a b :~>  (  a -> IO b)   -- ^ Apply a IO update function
135                                               --   to an attribute.
136  | forall a b.
137      ReadWriteAttr o a b ::=  (o      -> b)   -- ^ Assign a value to an
138                                               --   attribute with the object as
139                                               --   an argument.
140  | forall a b.
141      ReadWriteAttr o a b ::~  (o -> a -> b)   -- ^ Apply an update function to
142                                               --   an attribute with the object
143                                               --   as an argument.
144
145-- | Set a number of properties for some object.
146set :: o -> [AttrOp o] -> IO ()
147set obj = mapM_ app
148 where
149   app (Attr _ getter setter :=  x) = setter obj x
150   app (Attr _ getter setter :~  f) = getter obj >>= \v -> setter obj (f v)
151   app (Attr _ getter setter :=> x) =                x >>= setter obj
152   app (Attr _ getter setter :~> f) = getter obj >>= f >>= setter obj
153
154   app (Attr _ getter setter ::= f) = setter obj (f obj)
155   app (Attr _ getter setter ::~ f) = getter obj >>= \v -> setter obj (f obj v)
156
157-- | Get an Attr of an object.
158get :: o -> ReadWriteAttr o a b -> IO a
159get o (Attr _ getter setter) = getter o
160