{-
 DpkgVersion.hs: Haskell bindings to libdpkg
   Copyright (C) 2011-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
-}

module Debian.Dpkg.DpkgVersion (
    peekDpkgVersion
  , getConfigVersion
  , DpkgVersion(DpkgVersion,vr_epoch,vr_version,vr_revision)
) where

import Data.ByteString.Char8 (unpack)
import Foreign.Ptr (Ptr)
import Foreign.Marshal.Utils (with)
import System.IO.Unsafe (unsafePerformIO)

import Debian.Dpkg.Types
import Debian.Dpkg.DB (c'parseversion, c'dpkg_version_compare)

import qualified Data.ByteString as BS

-- #starttype struct dpkg_version
-- #field epoch , CInt
-- #field version , CString
-- #field revision , CString
-- #stoptype

peekDpkgVersion :: C'dpkg_version -> IO DpkgVersion
peekDpkgVersion vr = do
        v <- BS.packCString (c'dpkg_version'version vr)
        r <- BS.packCString (c'dpkg_version'revision vr)
        return $ DpkgVersion (fromIntegral (c'dpkg_version'epoch vr)) v r

getConfigVersion :: C'pkginfo -> IO String
getConfigVersion p = do
		vr <- peekDpkgVersion (c'pkginfo'configversion p)
		let e = fromIntegral (vr_epoch vr)
		let v = vr_version vr
		let r = vr_revision vr
		return $ nonZeroEpoch e ++ (unpack v) ++ nonNativeRevision r
	where
		nonZeroEpoch e = if e == 0 then "" else (show e) ++ ":"
		nonNativeRevision r = if r == BS.empty then (unpack r) else "-" ++ (unpack r)

data DpkgVersion = DpkgVersion {
  vr_epoch :: Int,
  vr_version :: BS.ByteString,
  vr_revision :: BS.ByteString
} deriving (Eq,Show)

cvrpCompare :: Ptr C'dpkg_version -> Ptr C'dpkg_version -> IO Ordering
cvrpCompare x y = do
        r <- c'dpkg_version_compare x y
        case r of
                -1 -> return LT
                0  -> return EQ
                1  -> return GT

cvrCompare :: C'dpkg_version -> C'dpkg_version -> Ordering
cvrCompare = (unsafePerformIO .) . (. ((. cvrpCompare) . with)) . with

instance Ord C'dpkg_version where
  compare = cvrCompare