-- GENERATED by C->Haskell Compiler, version 0.16.0 Crystal Seed, 24 Jan 2009 (Haskell)
-- Edit the ORIGNAL .chs file instead!


{-# LINE 1 "./Gnome/Keyring/Attribute/Internal.chs" #-}-- Copyright (C) 2009 John Millikin <jmillikin@gmail.com>
-- 
-- This program is free software: you can redistribute it and/or modify
-- it under the terms of the GNU General Public License as published by
-- the Free Software Foundation, either version 3 of the License, or
-- any later version.
-- 
-- This program 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 General Public License for more details.
-- 
-- You should have received a copy of the GNU General Public License
-- along with this program.  If not, see <http://www.gnu.org/licenses/>.
-- 
{-# LANGUAGE ForeignFunctionInterface #-}

{-# LINE 18 "./Gnome/Keyring/Attribute/Internal.chs" #-}

module Gnome.Keyring.Attribute.Internal where
import Control.Exception (bracket)
import Data.Text.Lazy (Text)

import Foreign
import Foreign.C
import Gnome.Keyring.FFI

data AttributeType = ATTRIBUTE_TYPE_STRING
                   | ATTRIBUTE_TYPE_UINT32
                   deriving (Enum)

{-# LINE 28 "./Gnome/Keyring/Attribute/Internal.chs" #-}

data Attribute
	= TextAttribute Text Text
	| WordAttribute Text Word32
	deriving (Show, Eq)

attributeName :: Attribute -> Text
attributeName (TextAttribute n _) = n
attributeName (WordAttribute n _) = n

withAttributeList :: [Attribute] -> (Ptr () -> IO a) -> IO a
withAttributeList attrs io = bracket newList freeList buildList where
	newList = g_array_new 0 0 12
{-# LINE 41 "./Gnome/Keyring/Attribute/Internal.chs" #-}
	buildList list = sequence (map (append list) attrs) >> io list
	append list (TextAttribute n x) = appendString list n x
	append list (WordAttribute n x) = appendUInt32 list n x

appendString :: Ptr () -> Text -> Text -> IO (())
appendString a1 a2 a3 =
  let {a1' = id a1} in 
  withText a2 $ \a2' -> 
  withText a3 $ \a3' -> 
  appendString'_ a1' a2' a3' >>= \res ->
  let {res' = id res} in
  return (res')
{-# LINE 50 "./Gnome/Keyring/Attribute/Internal.chs" #-}

appendUInt32 :: Ptr () -> Text -> Word32 -> IO (())
appendUInt32 a1 a2 a3 =
  let {a1' = id a1} in 
  withText a2 $ \a2' -> 
  let {a3' = fromIntegral a3} in 
  appendUInt32'_ a1' a2' a3' >>= \res ->
  let {res' = id res} in
  return (res')
{-# LINE 56 "./Gnome/Keyring/Attribute/Internal.chs" #-}

peekAttributeList :: Ptr () -> IO [Attribute]
peekAttributeList array = do
	len <- (\ptr -> do {peekByteOff ptr 4 ::IO CUInt}) array
	start <- (\ptr -> do {peekByteOff ptr 0 ::IO (Ptr CChar)}) array
	peekAttributeList' (fromIntegral len) (castPtr start)

peekAttributeList' :: Integer -> Ptr () -> IO [Attribute]
peekAttributeList' 0   _ = return []
peekAttributeList' n ptr = do
	attr <- peekAttribute ptr
	attrs <- peekAttributeList' (n - 1) (plusPtr ptr 12)
	return $ attr : attrs

peekAttribute :: Ptr () -> IO Attribute
peekAttribute attr = do
	name <- peekText =<< (\ptr -> do {peekByteOff ptr 0 ::IO (Ptr CChar)}) attr
	cType <- (\ptr -> do {peekByteOff ptr 4 ::IO CInt}) attr
	case toEnum . fromIntegral $ cType of
		ATTRIBUTE_TYPE_STRING -> do
			value <- peekText =<< (\ptr -> do {peekByteOff ptr 8 ::IO (Ptr CChar)}) attr
			return $ TextAttribute name value
		ATTRIBUTE_TYPE_UINT32 -> do
			cValue <- (\ptr -> do {peekByteOff ptr 8 ::IO CUInt}) attr
			return $ WordAttribute name $ fromIntegral cValue

stealAttributeList :: Ptr (Ptr ()) -> IO [Attribute]
stealAttributeList ptr = bracket (peek ptr) freeList peekAttributeList

freeList :: Ptr () -> IO ()
freeList = gnome_keyring_attribute_list_free
{-# LINE 87 "./Gnome/Keyring/Attribute/Internal.chs" #-}

foreign import ccall unsafe "Gnome/Keyring/Attribute/Internal.chs.h g_array_new"
  g_array_new :: (CInt -> (CInt -> (CUInt -> (IO (Ptr ())))))

foreign import ccall unsafe "Gnome/Keyring/Attribute/Internal.chs.h gnome_keyring_attribute_list_append_string"
  appendString'_ :: ((Ptr ()) -> ((Ptr CChar) -> ((Ptr CChar) -> (IO ()))))

foreign import ccall unsafe "Gnome/Keyring/Attribute/Internal.chs.h gnome_keyring_attribute_list_append_uint32"
  appendUInt32'_ :: ((Ptr ()) -> ((Ptr CChar) -> (CUInt -> (IO ()))))

foreign import ccall unsafe "Gnome/Keyring/Attribute/Internal.chs.h gnome_keyring_attribute_list_free"
  gnome_keyring_attribute_list_free :: ((Ptr ()) -> (IO ()))