-- GENERATED by C->Haskell Compiler, version 0.13.13 (gtk2hs branch) "Bin IO", 27 May 2012 (Haskell)
-- Edit the ORIGINAL .chs file instead!


{-# LINE 1 "./System/Glib/GList.chs" #-}
-- -*-haskell-*-
--  GIMP Toolkit (GTK)
--
--  Author : Axel Simon
--
--  Created: 19 March 2002
--
--  Copyright (C) 2002 Axel Simon
--
--  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   : provisional
-- Portability : portable (depends on GHC)
--
-- Defines functions to extract data from a GList and to produce a GList from
-- a list of pointers.
--
-- * The same for GSList.
--
module System.Glib.GList (
  GList,
  readGList,
  fromGList,
  toGList,
  withGList,

  GSList,
  readGSList,
  fromGSList,
  fromGSListRev,
  toGSList,
  withGSList,
  ) where

import Foreign
import Control.Exception        (bracket)
import Control.Monad            (foldM)


{-# LINE 49 "./System/Glib/GList.chs" #-}

type GList = Ptr (())
{-# LINE 51 "./System/Glib/GList.chs" #-}
type GSList = Ptr (())
{-# LINE 52 "./System/Glib/GList.chs" #-}

-- methods

-- Turn a GList into a list of pointers but don't destroy the list.
--
readGList :: GList -> IO [Ptr a]
readGList :: forall a. GList -> IO [Ptr a]
readGList GList
glist
  | GList
glistGList -> GList -> Bool
forall a. Eq a => a -> a -> Bool
==GList
forall a. Ptr a
nullPtr = [Ptr a] -> IO [Ptr a]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return []
  | Bool
otherwise       = do
    GList
x <- (\GList
ptr -> do {GList -> Int -> IO GList
forall b. Ptr b -> Int -> IO GList
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff GList
ptr Int
0 ::IO (Ptr ())}) GList
glist
    GList
glist' <- (\GList
ptr -> do {GList -> Int -> IO GList
forall b. Ptr b -> Int -> IO GList
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff GList
ptr Int
8 ::IO (Ptr ())}) GList
glist
    [Ptr a]
xs <- GList -> IO [Ptr a]
forall a. GList -> IO [Ptr a]
readGList GList
glist'
    [Ptr a] -> IO [Ptr a]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (GList -> Ptr a
forall a b. Ptr a -> Ptr b
castPtr GList
xPtr a -> [Ptr a] -> [Ptr a]
forall a. a -> [a] -> [a]
:[Ptr a]
xs)

-- Turn a GList into a list of pointers (freeing the GList in the process).
--
fromGList :: GList -> IO [Ptr a]
fromGList :: forall a. GList -> IO [Ptr a]
fromGList GList
glist = do
    GList
glist' <- GList -> IO GList
g_list_reverse GList
glist
    GList -> [Ptr a] -> IO [Ptr a]
forall {b}. GList -> [Ptr b] -> IO [Ptr b]
extractList GList
glist' []
  where
    extractList :: GList -> [Ptr b] -> IO [Ptr b]
extractList GList
gl [Ptr b]
xs
      | GList
glGList -> GList -> Bool
forall a. Eq a => a -> a -> Bool
==GList
forall a. Ptr a
nullPtr = [Ptr b] -> IO [Ptr b]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Ptr b]
xs
      | Bool
otherwise   = do
        GList
x <- (\GList
ptr -> do {GList -> Int -> IO GList
forall b. Ptr b -> Int -> IO GList
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff GList
ptr Int
0 ::IO (Ptr ())}) GList
gl
        GList
gl' <- GList -> GList -> IO GList
g_list_delete_link GList
gl GList
gl
        GList -> [Ptr b] -> IO [Ptr b]
extractList GList
gl' (GList -> Ptr b
forall a b. Ptr a -> Ptr b
castPtr GList
xPtr b -> [Ptr b] -> [Ptr b]
forall a. a -> [a] -> [a]
:[Ptr b]
xs)

-- Turn a GSList into a list of pointers but don't destroy the list.
--
readGSList :: GSList -> IO [Ptr a]
readGSList :: forall a. GList -> IO [Ptr a]
readGSList GList
gslist
  | GList
gslistGList -> GList -> Bool
forall a. Eq a => a -> a -> Bool
==GList
forall a. Ptr a
nullPtr = [Ptr a] -> IO [Ptr a]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return []
  | Bool
otherwise       = do
    GList
x <- (\GList
ptr -> do {GList -> Int -> IO GList
forall b. Ptr b -> Int -> IO GList
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff GList
ptr Int
0 ::IO (Ptr ())}) GList
gslist
    GList
gslist' <- (\GList
ptr -> do {GList -> Int -> IO GList
forall b. Ptr b -> Int -> IO GList
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff GList
ptr Int
8 ::IO (Ptr ())}) GList
gslist
    [Ptr a]
xs <- GList -> IO [Ptr a]
forall a. GList -> IO [Ptr a]
readGSList GList
gslist'
    [Ptr a] -> IO [Ptr a]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (GList -> Ptr a
forall a b. Ptr a -> Ptr b
castPtr GList
xPtr a -> [Ptr a] -> [Ptr a]
forall a. a -> [a] -> [a]
:[Ptr a]
xs)

-- Turn a GSList into a list of pointers (freeing the GSList in the process).
--
fromGSList :: GSList -> IO [Ptr a]
fromGSList :: forall a. GList -> IO [Ptr a]
fromGSList GList
gslist
  | GList
gslistGList -> GList -> Bool
forall a. Eq a => a -> a -> Bool
==GList
forall a. Ptr a
nullPtr = [Ptr a] -> IO [Ptr a]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return []
  | Bool
otherwise       = do
    GList
x <- (\GList
ptr -> do {GList -> Int -> IO GList
forall b. Ptr b -> Int -> IO GList
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff GList
ptr Int
0 ::IO (Ptr ())}) GList
gslist
    GList
gslist' <- GList -> GList -> IO GList
g_slist_delete_link GList
gslist GList
gslist
    [Ptr a]
xs <- GList -> IO [Ptr a]
forall a. GList -> IO [Ptr a]
fromGSList GList
gslist'
    [Ptr a] -> IO [Ptr a]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (GList -> Ptr a
forall a b. Ptr a -> Ptr b
castPtr GList
xPtr a -> [Ptr a] -> [Ptr a]
forall a. a -> [a] -> [a]
:[Ptr a]
xs)

-- Turn a GSList into a list of pointers and reverse it.
--
fromGSListRev :: GSList -> IO [Ptr a]
fromGSListRev :: forall a. GList -> IO [Ptr a]
fromGSListRev GList
gslist =
  GList -> [Ptr a] -> IO [Ptr a]
forall {b}. GList -> [Ptr b] -> IO [Ptr b]
extractList GList
gslist []
  where
    extractList :: GList -> [Ptr b] -> IO [Ptr b]
extractList GList
gslist [Ptr b]
xs
      | GList
gslistGList -> GList -> Bool
forall a. Eq a => a -> a -> Bool
==GList
forall a. Ptr a
nullPtr = [Ptr b] -> IO [Ptr b]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Ptr b]
xs
      | Bool
otherwise       = do
        GList
x <- (\GList
ptr -> do {GList -> Int -> IO GList
forall b. Ptr b -> Int -> IO GList
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff GList
ptr Int
0 ::IO (Ptr ())}) GList
gslist
        GList
gslist' <- GList -> GList -> IO GList
g_slist_delete_link GList
gslist GList
gslist
        GList -> [Ptr b] -> IO [Ptr b]
extractList GList
gslist' (GList -> Ptr b
forall a b. Ptr a -> Ptr b
castPtr GList
xPtr b -> [Ptr b] -> [Ptr b]
forall a. a -> [a] -> [a]
:[Ptr b]
xs)

-- Turn a list of something into a GList.
--
toGList :: [Ptr a] -> IO GList
toGList :: forall a. [Ptr a] -> IO GList
toGList = (GList -> Ptr a -> IO GList) -> GList -> [Ptr a] -> IO GList
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM GList -> Ptr a -> IO GList
forall {a}. GList -> Ptr a -> IO GList
prepend GList
forall a. Ptr a
nullPtr ([Ptr a] -> IO GList)
-> ([Ptr a] -> [Ptr a]) -> [Ptr a] -> IO GList
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Ptr a] -> [Ptr a]
forall a. [a] -> [a]
reverse
  where
    -- prepend :: GList -> Ptr a -> IO GList
    prepend :: GList -> Ptr a -> IO GList
prepend GList
l Ptr a
x = GList -> GList -> IO GList
g_list_prepend GList
l (Ptr a -> GList
forall a b. Ptr a -> Ptr b
castPtr Ptr a
x)

-- Turn a list of something into a GSList.
--
toGSList :: [Ptr a] -> IO GSList
toGSList :: forall a. [Ptr a] -> IO GList
toGSList = (GList -> Ptr a -> IO GList) -> GList -> [Ptr a] -> IO GList
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM GList -> Ptr a -> IO GList
forall {a}. GList -> Ptr a -> IO GList
prepend GList
forall a. Ptr a
nullPtr ([Ptr a] -> IO GList)
-> ([Ptr a] -> [Ptr a]) -> [Ptr a] -> IO GList
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Ptr a] -> [Ptr a]
forall a. [a] -> [a]
reverse
  where
    -- prepend :: GSList -> Ptr a -> IO GList
    prepend :: GList -> Ptr a -> IO GList
prepend GList
l Ptr a
x = GList -> GList -> IO GList
g_slist_prepend GList
l (Ptr a -> GList
forall a b. Ptr a -> Ptr b
castPtr Ptr a
x)

-- Temporarily allocate a list of something
--
withGList :: [Ptr a] -> (GSList -> IO b) -> IO b
withGList :: forall a b. [Ptr a] -> (GList -> IO b) -> IO b
withGList [Ptr a]
xs = IO GList -> (GList -> IO ()) -> (GList -> IO b) -> IO b
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket ([Ptr a] -> IO GList
forall a. [Ptr a] -> IO GList
toGList [Ptr a]
xs) GList -> IO ()
g_list_free
{-# LINE 135 "./System/Glib/GList.chs" #-}

-- Temporarily allocate a list of something
--
withGSList :: [Ptr a] -> (GSList -> IO b) -> IO b
withGSList :: forall a b. [Ptr a] -> (GList -> IO b) -> IO b
withGSList [Ptr a]
xs = IO GList -> (GList -> IO ()) -> (GList -> IO b) -> IO b
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket ([Ptr a] -> IO GList
forall a. [Ptr a] -> IO GList
toGSList [Ptr a]
xs) GList -> IO ()
g_slist_free
{-# LINE 140 "./System/Glib/GList.chs" #-}


foreign import ccall unsafe "g_list_reverse"
  g_list_reverse :: ((Ptr ()) -> (IO (Ptr ())))

foreign import ccall unsafe "g_list_delete_link"
  g_list_delete_link :: ((Ptr ()) -> ((Ptr ()) -> (IO (Ptr ()))))

foreign import ccall unsafe "g_slist_delete_link"
  g_slist_delete_link :: ((Ptr ()) -> ((Ptr ()) -> (IO (Ptr ()))))

foreign import ccall unsafe "g_list_prepend"
  g_list_prepend :: ((Ptr ()) -> ((Ptr ()) -> (IO (Ptr ()))))

foreign import ccall unsafe "g_slist_prepend"
  g_slist_prepend :: ((Ptr ()) -> ((Ptr ()) -> (IO (Ptr ()))))

foreign import ccall unsafe "g_list_free"
  g_list_free :: ((Ptr ()) -> (IO ()))

foreign import ccall unsafe "g_slist_free"
  g_slist_free :: ((Ptr ()) -> (IO ()))