-- -*-haskell-*-
--  GIMP Toolkit (GTK) Widget ComboBox
--
--  Author : Duncan Coutts
--
--  Created: 25 April 2004
--
--  Copyright (C) 2004-2016 Duncan Coutts, Axel Simon, Hamish Mackenzie
--
--  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.

{-# LANGUAGE MonoLocalBinds #-}

-- |
-- Stability   : provisional
-- Portability : portable (depends on GHC)
--
-- A widget used to choose from a list of items.
--
-- * Module available since Gtk+ version 2.4
--
module Data.GI.Gtk.ComboBox (

-- * Detail
--
-- | A 'ComboBox' is a widget that allows the user to choose from a list of
-- valid choices. The 'ComboBox' displays the selected choice. When activated,
-- the 'ComboBox' displays a popup which allows the user to make a new choice.
-- The style in which the selected value is displayed, and the style of the
-- popup is determined by the current theme. It may be similar to a
-- 'OptionMenu', or similar to a Windows-style combo box.
--
-- Unlike its predecessors 'Combo' and 'OptionMenu', the 'ComboBox' uses the
-- model-view pattern; the list of valid choices is specified in the form of a
-- tree model, and the display of the choices can be adapted to the data in
-- the model by using cell renderers, as you would in a tree view. This is
-- possible since 'ComboBox' implements the 'CellLayout' interface. The tree
-- model holding the valid choices is not restricted to a flat list, it can be
-- a real tree, and the popup will reflect the tree structure.
--
-- In addition to the general model-view API, 'ComboBox' offers the function
-- 'comboBoxNewText' which creates a text-only combo box.

-- * Class Hierarchy
--
-- |
-- @
-- |  'GObject'
-- |   +----'Object'
-- |         +----'Widget'
-- |               +----'Container'
-- |                     +----'Bin'
-- |                           +----ComboBox
-- |                                 +----'ComboBoxEntry'
-- @

  module GI.Gtk.Objects.ComboBox,

-- ** Simple Text API
  comboBoxNewText,
  comboBoxSetModelText,
  comboBoxGetModelText,
  comboBoxAppendText,
  comboBoxInsertText,
  comboBoxPrependText,
  comboBoxRemoveText,
  comboBoxGetActiveText,

  ) where

import Prelude ()
import Prelude.Compat
import Control.Monad    (liftM)
import Control.Monad.IO.Class (MonadIO(..))
import Foreign.Ptr (FunPtr, Ptr, nullPtr)
import Foreign.StablePtr (newStablePtr, castStablePtrToPtr, deRefStablePtr, castPtrToStablePtr)
import Data.Text (Text)
import Data.Word (Word32)
import Data.Int (Int32)
import Data.GI.Base.BasicTypes (GObject)
import Data.GI.Base.ManagedPtr (unsafeManagedPtrCastPtr, touchManagedPtr, unsafeCastTo)
import Data.GI.Gtk.ModelView.Types (comboQuark)
import Data.GI.Gtk.ModelView.TreeModel (makeColumnIdString)
import Data.GI.Gtk.ModelView.CustomStore (customStoreSetColumn, customStoreGetRow)
import Data.GI.Gtk.ModelView.SeqStore ( SeqStore(..), seqStoreNew,
  seqStoreInsert, seqStorePrepend, seqStoreAppend, seqStoreRemove,
  seqStoreSafeGetValue )
import GI.Gtk.Objects.ComboBox
import Data.GI.Gtk.ModelView.CellLayout (CellLayout(..), cellLayoutClear, cellLayoutPackStart, cellLayoutSetDataFunction, cellLayoutGetCells)
import GI.Gtk.Objects.CellRendererText (CellRendererText(..), cellRendererTextNew, setCellRendererTextText)
import GI.GObject.Objects.Object (Object, toObject)

type GQuark = Word32

-- | The address of a function freeing a 'StablePtr'. See 'destroyFunPtr'.
foreign import ccall unsafe "&hs_free_stable_ptr" destroyStablePtr :: FunPtr(Ptr () -> IO ())

foreign import ccall "g_object_set_qdata" g_object_set_qdata ::
    Ptr Object -> GQuark -> Ptr () -> IO ()

foreign import ccall "g_object_set_qdata_full" g_object_set_qdata_full ::
    Ptr Object -> GQuark -> Ptr () -> FunPtr(Ptr () -> IO ()) -> IO ()

-- | Set the value of an association.
--
objectSetAttribute :: (MonadIO m, GObject o) => o -> GQuark -> Maybe a -> m ()
objectSetAttribute :: o -> GQuark -> Maybe a -> m ()
objectSetAttribute o
obj GQuark
attr Maybe a
Nothing = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
  Ptr Object
obj' <- o -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr o
obj
  Ptr Object -> GQuark -> Ptr () -> IO ()
g_object_set_qdata Ptr Object
obj' (GQuark -> GQuark
forall a b. (Integral a, Num b) => a -> b
fromIntegral GQuark
attr) Ptr ()
forall a. Ptr a
nullPtr
  o -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr o
obj
objectSetAttribute o
obj GQuark
attr (Just a
val) = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
  StablePtr a
sPtr <- a -> IO (StablePtr a)
forall a. a -> IO (StablePtr a)
newStablePtr a
val
  Ptr Object
obj' <- o -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr o
obj
  Ptr Object -> GQuark -> Ptr () -> FunPtr (Ptr () -> IO ()) -> IO ()
g_object_set_qdata_full Ptr Object
obj' GQuark
attr (StablePtr a -> Ptr ()
forall a. StablePtr a -> Ptr ()
castStablePtrToPtr StablePtr a
sPtr) FunPtr (Ptr () -> IO ())
destroyStablePtr
  o -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr o
obj

foreign import ccall "g_object_get_qdata" g_object_get_qdata ::
    Ptr Object -> GQuark -> IO (Ptr ())

-- | Get the value of an association.
--
-- * Note that this function may crash the Haskell run-time since the
--   returned type can be forced to be anything. See 'objectCreateAttribute'
--   for a safe wrapper around this funciton.
--
objectGetAttributeUnsafe :: (MonadIO m, GObject o) => o -> GQuark -> m (Maybe a)
objectGetAttributeUnsafe :: o -> GQuark -> m (Maybe a)
objectGetAttributeUnsafe o
obj GQuark
attr = IO (Maybe a) -> m (Maybe a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe a) -> m (Maybe a)) -> IO (Maybe a) -> m (Maybe a)
forall a b. (a -> b) -> a -> b
$ do
  Ptr Object
obj' <- o -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr o
obj
  Ptr ()
sPtr <- Ptr Object -> GQuark -> IO (Ptr ())
g_object_get_qdata Ptr Object
obj' GQuark
attr
  o -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr o
obj
  if Ptr ()
sPtrPtr () -> Ptr () -> Bool
forall a. Eq a => a -> a -> Bool
==Ptr ()
forall a. Ptr a
nullPtr then Maybe a -> IO (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing else
    (a -> Maybe a) -> IO a -> IO (Maybe a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM a -> Maybe a
forall a. a -> Maybe a
Just (IO a -> IO (Maybe a)) -> IO a -> IO (Maybe a)
forall a b. (a -> b) -> a -> b
$! StablePtr a -> IO a
forall a. StablePtr a -> IO a
deRefStablePtr (Ptr () -> StablePtr a
forall a. Ptr () -> StablePtr a
castPtrToStablePtr Ptr ()
sPtr)

--------------------
-- Constructors

-- | Convenience function which constructs a new text combo box that is a
-- 'ComboBox' just displaying strings. This function internally calls
-- 'comboBoxSetModelText' after creating a new combo box.
--
comboBoxNewText :: MonadIO m => m ComboBox
comboBoxNewText :: m ComboBox
comboBoxNewText = do
  ComboBox
combo <- m ComboBox
forall (m :: * -> *). (HasCallStack, MonadIO m) => m ComboBox
comboBoxNew
  ComboBox -> m (SeqStore Text)
forall (m :: * -> *) self.
(MonadIO m, IsComboBox self) =>
self -> m (SeqStore Text)
comboBoxSetModelText ComboBox
combo
  ComboBox -> m ComboBox
forall (m :: * -> *) a. Monad m => a -> m a
return ComboBox
combo

--------------------
-- Methods

-- the text API

-- | Create a combo box that holds strings.
--
-- This function stores a 'Data.GI.Gtk.ModelView.SeqStore' with the
-- widget and sets the model to the list store. The widget can contain only
-- strings. The model can be retrieved with 'comboBoxGetModel'. The list
-- store can be retrieved with 'comboBoxGetModelText'.
-- Any exisiting model or renderers are removed before setting the new text
-- model.
-- Note that the functions 'comboBoxAppendText', 'comboBoxInsertText',
-- 'comboBoxPrependText', 'comboBoxRemoveText' and 'comboBoxGetActiveText'
-- can be called on a combo box only once 'comboBoxSetModelText' is called.
--
comboBoxSetModelText :: (MonadIO m, IsComboBox self) => self -> m (SeqStore Text)
comboBoxSetModelText :: self -> m (SeqStore Text)
comboBoxSetModelText self
combo = IO (SeqStore Text) -> m (SeqStore Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (SeqStore Text) -> m (SeqStore Text))
-> IO (SeqStore Text) -> m (SeqStore Text)
forall a b. (a -> b) -> a -> b
$ do
  CellLayout
layout <- (ManagedPtr CellLayout -> CellLayout) -> self -> IO CellLayout
forall o o'.
(HasCallStack, ManagedPtrNewtype o, TypedObject o,
 ManagedPtrNewtype o', TypedObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
unsafeCastTo ManagedPtr CellLayout -> CellLayout
CellLayout self
combo
  CellLayout -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsCellLayout a) =>
a -> m ()
cellLayoutClear CellLayout
layout
  SeqStore Text
store <- [Text] -> IO (SeqStore Text)
forall (m :: * -> *) a.
(Applicative m, MonadIO m) =>
[a] -> m (SeqStore a)
seqStoreNew ([] :: [Text])
  self -> Maybe (SeqStore Text) -> IO ()
forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsComboBox a, IsTreeModel b) =>
a -> Maybe b -> m ()
comboBoxSetModel self
combo (SeqStore Text -> Maybe (SeqStore Text)
forall a. a -> Maybe a
Just SeqStore Text
store)
  let colId :: ColumnId row Text
colId = Int32 -> ColumnId row Text
forall row. Int32 -> ColumnId row Text
makeColumnIdString Int32
0
  SeqStore Text -> ColumnId Text Text -> (Text -> Text) -> IO ()
forall (m :: * -> *) (model :: * -> *) row ty.
(MonadIO m, IsTypedTreeModel model) =>
model row -> ColumnId row ty -> (row -> ty) -> m ()
customStoreSetColumn SeqStore Text
store ColumnId Text Text
forall row. ColumnId row Text
colId Text -> Text
forall a. a -> a
id
  self -> Int32 -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsComboBox a) =>
a -> Int32 -> m ()
comboBoxSetEntryTextColumn self
combo Int32
0
  CellRendererText
ren <- IO CellRendererText
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
m CellRendererText
cellRendererTextNew
  CellLayout -> CellRendererText -> Bool -> IO ()
forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsCellLayout a, IsCellRenderer b) =>
a -> b -> Bool -> m ()
cellLayoutPackStart CellLayout
layout CellRendererText
ren Bool
True
  CellLayout
-> CellRendererText -> SeqStore Text -> (Text -> IO ()) -> IO ()
forall (m :: * -> *) self cell (model :: * -> *) row.
(MonadIO m, IsCellLayout self, IsCellRenderer cell,
 IsTreeModel (model row), IsTypedTreeModel model) =>
self -> cell -> model row -> (row -> IO ()) -> m ()
cellLayoutSetDataFunction CellLayout
layout CellRendererText
ren SeqStore Text
store (CellRendererText -> Text -> IO ()
forall (m :: * -> *) o.
(MonadIO m, IsCellRendererText o) =>
o -> Text -> m ()
setCellRendererTextText CellRendererText
ren)
  self -> GQuark -> Maybe (SeqStore Text) -> IO ()
forall (m :: * -> *) o a.
(MonadIO m, GObject o) =>
o -> GQuark -> Maybe a -> m ()
objectSetAttribute self
combo GQuark
comboQuark (SeqStore Text -> Maybe (SeqStore Text)
forall a. a -> Maybe a
Just SeqStore Text
store)
  SeqStore Text -> IO (SeqStore Text)
forall (m :: * -> *) a. Monad m => a -> m a
return SeqStore Text
store

-- | Retrieve the model that was created with 'comboBoxSetModelText'.
--
comboBoxGetModelText :: (MonadIO m, IsComboBox self) => self -> m (SeqStore Text)
comboBoxGetModelText :: self -> m (SeqStore Text)
comboBoxGetModelText self
self = do
  Maybe (SeqStore Text)
maybeStore <- self -> GQuark -> m (Maybe (SeqStore Text))
forall (m :: * -> *) o a.
(MonadIO m, GObject o) =>
o -> GQuark -> m (Maybe a)
objectGetAttributeUnsafe self
self GQuark
comboQuark
  case Maybe (SeqStore Text)
maybeStore of
    Just SeqStore Text
store -> SeqStore Text -> m (SeqStore Text)
forall (m :: * -> *) a. Monad m => a -> m a
return SeqStore Text
store
    Maybe (SeqStore Text)
Nothing -> [Char] -> m (SeqStore Text)
forall a. HasCallStack => [Char] -> a
error [Char]
"Could not get required attribute"

-- | Appends @string@ to the list of strings stored in @comboBox@. Note that
-- you can only use this function with combo boxes constructed with
-- 'comboBoxNewText'. Returns the index of the appended text.
--
comboBoxAppendText :: (MonadIO m, IsComboBox self) => self -> Text -> m Int32
comboBoxAppendText :: self -> Text -> m Int32
comboBoxAppendText self
self Text
text = do
  SeqStore Text
store <- self -> m (SeqStore Text)
forall (m :: * -> *) self.
(MonadIO m, IsComboBox self) =>
self -> m (SeqStore Text)
comboBoxGetModelText self
self
  SeqStore Text -> Text -> m Int32
forall (m :: * -> *) a. MonadIO m => SeqStore a -> a -> m Int32
seqStoreAppend SeqStore Text
store Text
text

-- %hash c:41de d:8ab0
-- | Inserts @string@ at @position@ in the list of strings stored in
-- @comboBox@. Note that you can only use this function with combo boxes
-- constructed with 'comboBoxNewText'.
--
comboBoxInsertText :: (MonadIO m, IsComboBox self) => self
 -> Int32  -- ^ @position@ - An index to insert @text@.
 -> Text   -- ^ @text@ - A string.
 -> m ()
comboBoxInsertText :: self -> Int32 -> Text -> m ()
comboBoxInsertText self
self Int32
position Text
text = do
  SeqStore Text
store <- self -> m (SeqStore Text)
forall (m :: * -> *) self.
(MonadIO m, IsComboBox self) =>
self -> m (SeqStore Text)
comboBoxGetModelText self
self
  SeqStore Text -> Int32 -> Text -> m ()
forall (m :: * -> *) a.
MonadIO m =>
SeqStore a -> Int32 -> a -> m ()
seqStoreInsert SeqStore Text
store Int32
position Text
text

-- | Prepends @string@ to the list of strings stored in @comboBox@. Note that
-- you can only use this function with combo boxes constructed with
-- 'comboBoxNewText'.
--
comboBoxPrependText :: (Applicative m, MonadIO m, IsComboBox self) => self -> Text -> m ()
comboBoxPrependText :: self -> Text -> m ()
comboBoxPrependText self
self Text
text = do
  SeqStore Text
store <- self -> m (SeqStore Text)
forall (m :: * -> *) self.
(MonadIO m, IsComboBox self) =>
self -> m (SeqStore Text)
comboBoxGetModelText self
self
  SeqStore Text -> Text -> m ()
forall (m :: * -> *) a.
(Applicative m, MonadIO m) =>
SeqStore a -> a -> m ()
seqStorePrepend SeqStore Text
store Text
text

-- | Removes the string at @position@ from @comboBox@. Note that you can only
-- use this function with combo boxes constructed with 'comboBoxNewText'.
--
comboBoxRemoveText :: (MonadIO m, IsComboBox self) => self
 -> Int32 -- ^ @position@ - Index of the item to remove.
 -> m ()
comboBoxRemoveText :: self -> Int32 -> m ()
comboBoxRemoveText self
self Int32
position = do
  SeqStore Text
store <- self -> m (SeqStore Text)
forall (m :: * -> *) self.
(MonadIO m, IsComboBox self) =>
self -> m (SeqStore Text)
comboBoxGetModelText self
self
  SeqStore Text -> Int32 -> m ()
forall (m :: * -> *) a. MonadIO m => SeqStore a -> Int32 -> m ()
seqStoreRemove SeqStore Text
store Int32
position

-- | Returns the currently active string in @comboBox@ or @Nothing@ if none is
-- selected. Note that you can only use this function with combo boxes
-- constructed with 'comboBoxNewText'.
--
comboBoxGetActiveText :: (MonadIO m, IsComboBox self) => self -> m (Maybe Text)
comboBoxGetActiveText :: self -> m (Maybe Text)
comboBoxGetActiveText self
self = do
  Int32
activeId <- self -> m Int32
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsComboBox a) =>
a -> m Int32
comboBoxGetActive self
self
  if Int32
activeId Int32 -> Int32 -> Bool
forall a. Ord a => a -> a -> Bool
< Int32
0
    then Maybe Text -> m (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
forall a. Maybe a
Nothing
    else do
      SeqStore Text
seqStore <- self -> m (SeqStore Text)
forall (m :: * -> *) self.
(MonadIO m, IsComboBox self) =>
self -> m (SeqStore Text)
comboBoxGetModelText self
self
      SeqStore Text -> Int32 -> m (Maybe Text)
forall (m :: * -> *) a.
MonadIO m =>
SeqStore a -> Int32 -> m (Maybe a)
seqStoreSafeGetValue SeqStore Text
seqStore (Int32 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
activeId)