{-# LANGUAGE ExistentialQuantification #-}
-- -*-haskell-*-
--  GIMP Toolkit (GTK) Attributes interface
--
--  Author : Duncan Coutts
--
--  Created: 21 January 2005
--
--  Copyright (C) 2005 Duncan Coutts
--
--  Partially derived from the hs-fltk and wxHaskell projects which
--  are both under LGPL compatible licenses.
--
--  This library is free software; you can redistribute it and/or
--  modify it under the terms of the GNU Lesser General Public
--  License as published by the Free Software Foundation; either
--  version 2.1 of the License, or (at your option) any later version.
--
--  This library is distributed in the hope that it will be useful,
--  but WITHOUT ANY WARRANTY; without even the implied warranty of
--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
--  Lesser General Public License for more details.
--
-- |
-- Maintainer  : gtk2hs-users@lists.sourceforge.net
-- Stability   : experimental
-- Portability : portable
--
-- Attributes interface
--
-- Attributes of an object can be get and set. Getting the value of an
-- object's attribute is straingtforward. As an example consider a @button@
-- widget and an attribute called @buttonLabel@.
--
-- > value <- get button buttonLabel
--
-- The syntax for setting or updating an attribute is only slightly more
-- complex. At the simplest level it is just:
--
-- > set button [ buttonLabel := value ]
--
-- However as the list notation would indicate, you can set or update multiple
-- attributes of the same object in one go:
--
-- > set button [ buttonLabel := value, buttonFocusOnClick := False ]
--
-- You are not limited to setting the value of an attribute, you can also
-- apply an update function to an attribute's value. That is the function
-- receives the current value of the attribute and returns the new value.
--
-- > set spinButton [ spinButtonValue :~ (+1) ]
--
-- There are other variants of these operators, (see 'AttrOp'). ':=>' and
-- ':~>' and like ':=' and ':~' but operate in the 'IO' monad rather
-- than being pure. There is also '::=' and '::~' which take the object
-- as an extra parameter.
--
-- Attributes can be read only, write only or both read\/write.
--
module System.Glib.Attributes (
  -- * Attribute types
  Attr,
  ReadAttr,
  WriteAttr,
  ReadWriteAttr,

  -- * Interface for getting, setting and updating attributes
  AttrOp(..),
  get,
  set,

  -- * Internal attribute constructors
  newNamedAttr,
  readNamedAttr,
  writeNamedAttr,
  newAttr,
  readAttr,
  writeAttr,
  ) where

infixr 0 :=,:~,:=>,:~>,::=,::~

-- | An ordinary attribute. Most attributes have the same get and set types.
type Attr o a = ReadWriteAttr o a a

-- | A read-only attribute.
type ReadAttr o a = ReadWriteAttr o a ()

-- | A write-only attribute.
type WriteAttr o b = ReadWriteAttr o () b

-- | A generalised attribute with independent get and set types.
data ReadWriteAttr o a b = Attr String !(o -> IO a) !(o -> b -> IO ())

instance Show (ReadWriteAttr o a b) where
  show :: ReadWriteAttr o a b -> String
show (Attr String
str o -> IO a
_ o -> b -> IO ()
_) = String
str

-- | Create a new attribute with a getter and setter function.
newNamedAttr :: String -> (o -> IO a) -> (o -> b -> IO ()) -> ReadWriteAttr o a b
newNamedAttr :: forall o a b.
String -> (o -> IO a) -> (o -> b -> IO ()) -> ReadWriteAttr o a b
newNamedAttr String
prop o -> IO a
getter o -> b -> IO ()
setter = String -> (o -> IO a) -> (o -> b -> IO ()) -> ReadWriteAttr o a b
forall o a b.
String -> (o -> IO a) -> (o -> b -> IO ()) -> ReadWriteAttr o a b
Attr String
prop o -> IO a
getter o -> b -> IO ()
setter

-- | Create a new read-only attribute.
readNamedAttr :: String -> (o -> IO a) -> ReadAttr o a
readNamedAttr :: forall o a. String -> (o -> IO a) -> ReadAttr o a
readNamedAttr String
prop o -> IO a
getter = String -> (o -> IO a) -> (o -> () -> IO ()) -> ReadWriteAttr o a ()
forall o a b.
String -> (o -> IO a) -> (o -> b -> IO ()) -> ReadWriteAttr o a b
Attr String
prop o -> IO a
getter (\o
_ ()
_ -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ())

-- | Create a new write-only attribute.
writeNamedAttr :: String -> (o -> b -> IO ()) -> WriteAttr o b
writeNamedAttr :: forall o b. String -> (o -> b -> IO ()) -> WriteAttr o b
writeNamedAttr String
prop o -> b -> IO ()
setter = String -> (o -> IO ()) -> (o -> b -> IO ()) -> ReadWriteAttr o () b
forall o a b.
String -> (o -> IO a) -> (o -> b -> IO ()) -> ReadWriteAttr o a b
Attr String
prop (\o
_ -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) o -> b -> IO ()
setter

-- | Create a new attribute with a getter and setter function.
newAttr :: (o -> IO a) -> (o -> b -> IO ()) -> ReadWriteAttr o a b
newAttr :: forall o a b.
(o -> IO a) -> (o -> b -> IO ()) -> ReadWriteAttr o a b
newAttr o -> IO a
getter o -> b -> IO ()
setter = String -> (o -> IO a) -> (o -> b -> IO ()) -> ReadWriteAttr o a b
forall o a b.
String -> (o -> IO a) -> (o -> b -> IO ()) -> ReadWriteAttr o a b
Attr String
"unnamed attribute" o -> IO a
getter o -> b -> IO ()
setter

-- | Create a new read-only attribute.
readAttr :: (o -> IO a) -> ReadAttr o a
readAttr :: forall o a. (o -> IO a) -> ReadAttr o a
readAttr o -> IO a
getter = String -> (o -> IO a) -> (o -> () -> IO ()) -> ReadWriteAttr o a ()
forall o a b.
String -> (o -> IO a) -> (o -> b -> IO ()) -> ReadWriteAttr o a b
Attr String
"unnamed attribute" o -> IO a
getter (\o
_ ()
_ -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ())

-- | Create a new write-only attribute.
writeAttr :: (o -> b -> IO ()) -> WriteAttr o b
writeAttr :: forall o b. (o -> b -> IO ()) -> WriteAttr o b
writeAttr o -> b -> IO ()
setter = String -> (o -> IO ()) -> (o -> b -> IO ()) -> ReadWriteAttr o () b
forall o a b.
String -> (o -> IO a) -> (o -> b -> IO ()) -> ReadWriteAttr o a b
Attr String
"unnamed attribute" (\o
_ -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) o -> b -> IO ()
setter

-- | A set or update operation on an attribute.
data AttrOp o
  = forall a b.
      ReadWriteAttr o a b :=              b    -- ^ Assign a value to an
                                               --   attribute.
  | forall a b.
      ReadWriteAttr o a b :~   (  a ->    b)   -- ^ Apply an update function to
                                               --   an attribute.
  | forall a b.
      ReadWriteAttr o a b :=>  (       IO b)   -- ^ Assign the result of an IO
                                               --   action to an attribute.
  | forall a b.
      ReadWriteAttr o a b :~>  (  a -> IO b)   -- ^ Apply a IO update function
                                               --   to an attribute.
  | forall a b.
      ReadWriteAttr o a b ::=  (o      -> b)   -- ^ Assign a value to an
                                               --   attribute with the object as
                                               --   an argument.
  | forall a b.
      ReadWriteAttr o a b ::~  (o -> a -> b)   -- ^ Apply an update function to
                                               --   an attribute with the object
                                               --   as an argument.

-- | Set a number of properties for some object.
set :: o -> [AttrOp o] -> IO ()
set :: forall o. o -> [AttrOp o] -> IO ()
set o
obj = (AttrOp o -> IO ()) -> [AttrOp o] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ AttrOp o -> IO ()
app
 where
   app :: AttrOp o -> IO ()
app (Attr String
_ o -> IO a
getter o -> b -> IO ()
setter :=  b
x) = o -> b -> IO ()
setter o
obj b
x
   app (Attr String
_ o -> IO a
getter o -> b -> IO ()
setter :~  a -> b
f) = o -> IO a
getter o
obj IO a -> (a -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
v -> o -> b -> IO ()
setter o
obj (a -> b
f a
v)
   app (Attr String
_ o -> IO a
getter o -> b -> IO ()
setter :=> IO b
x) =                IO b
x IO b -> (b -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= o -> b -> IO ()
setter o
obj
   app (Attr String
_ o -> IO a
getter o -> b -> IO ()
setter :~> a -> IO b
f) = o -> IO a
getter o
obj IO a -> (a -> IO b) -> IO b
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> IO b
f IO b -> (b -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= o -> b -> IO ()
setter o
obj

   app (Attr String
_ o -> IO a
getter o -> b -> IO ()
setter ::= o -> b
f) = o -> b -> IO ()
setter o
obj (o -> b
f o
obj)
   app (Attr String
_ o -> IO a
getter o -> b -> IO ()
setter ::~ o -> a -> b
f) = o -> IO a
getter o
obj IO a -> (a -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
v -> o -> b -> IO ()
setter o
obj (o -> a -> b
f o
obj a
v)

-- | Get an Attr of an object.
get :: o -> ReadWriteAttr o a b -> IO a
get :: forall o a b. o -> ReadWriteAttr o a b -> IO a
get o
o (Attr String
_ o -> IO a
getter o -> b -> IO ()
setter) = o -> IO a
getter o
o