{-# LINE 1 "Debian/Dpkg/PkgSpec.hsc" #-}
{-
{-# LINE 2 "Debian/Dpkg/PkgSpec.hsc" #-}
 PkgSpec.hsc: Haskell bindings to libdpkg
   Copyright (C) 2012 Clint Adams

 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
 (at your option) 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, write to the Free Software
 Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301 USA
-}

{-# LANGUAGE CPP, ForeignFunctionInterface #-}


{-# LINE 23 "Debian/Dpkg/PkgSpec.hsc" #-}

module Debian.Dpkg.PkgSpec (
  pkgSpecParsePkg
) where
import Foreign.Ptr (Ptr,FunPtr,plusPtr)
import Foreign.Ptr (wordPtrToPtr,castPtrToFunPtr)
import Foreign.Storable
import Foreign.C.Types
import Foreign.C.String (CString,CStringLen,CWString,CWStringLen)
import Foreign.Marshal.Alloc (alloca)
import Foreign.Marshal.Array (peekArray,pokeArray)
import Data.Int
import Data.Word

{-# LINE 28 "Debian/Dpkg/PkgSpec.hsc" #-}

import Foreign.Ptr (nullPtr)
import Foreign.C.String (withCString, peekCString)
import Foreign.Marshal.Utils (with)
import Control.Monad (liftM, join)
import Control.Monad.Loops (unfoldrM)
import qualified Data.ByteString as BS
import Debian.Dpkg.Types


{-# LINE 38 "Debian/Dpkg/PkgSpec.hsc" #-}

type FIXME = C'dpkg_error
foreign import ccall unsafe "pkg_spec_parse_pkg" c'pkg_spec_parse_pkg
  :: CString -> Ptr FIXME -> IO (Ptr C'pkginfo)
foreign import ccall unsafe "&pkg_spec_parse_pkg" p'pkg_spec_parse_pkg
  :: FunPtr (CString -> Ptr FIXME -> IO (Ptr C'pkginfo))

{-# LINE 41 "Debian/Dpkg/PkgSpec.hsc" #-}

-- FIXME: if NULL return, handle error
pkgSpecParsePkg :: String -> IO C'pkginfo
pkgSpecParsePkg p = alloca $ \derr -> withCString p (\pcstr -> c'pkg_spec_parse_pkg pcstr derr) >>= peek