{-# LANGUAGE ForeignFunctionInterface #-}

{-|
Description:    Objects used to determine which version of the C library is used.

Copyright:      (c) 2018-2021 Sam May
License:        GPL-3.0-or-later
Maintainer:     ag@eitilt.life

Stability:      stable
Portability:    non-portable (requires libcdio)

The values in this module are best treated as informational; it may be helpful
to use 'cdioVersionString' in printing copyright, for example, and
'libcdioVersionNum' does serve a purpose in the tests, but all are of little
value outside of such very particular situations.  Instead, an effort has been
made to have all version differences in the base library degrade gracefully,
and those fallback values are able to be handled transparently.  For example,
rather than explicitly testing whether libcdio is new enough to have exposed
@cdtext_data_init@, simply call 'Foreign.Libcdio.CdText.cdTextDataInit' and
have a plan for if it returns 'Nothing' rather than a @'Just'
'Foreign.Libcdio.CdText.CdText'@.


= @version.h@

== Defines
* @CDIO_VERSION@                    (removed; identical to 'cdioVersionString')
* @LIBCDIO_VERSION_NUM@             (removed; identical to 'libcdioVersionNum')

== Symbols
* @cdio_version_string@             -> 'cdioVersionString'
* @libcdio_version_num@             -> 'libcdioVersionNum'


= "Sound.Libcdio"
Re-exported unchanged as there is little reason for it to be a separate module,
and no changes need to be made to the types.
-}
module Foreign.Libcdio.Version
    ( V.Version
    , V.makeVersion
    , cdioVersionString
    , libcdioVersionNum
    , apiVersion
    ) where


import qualified Data.Version as V

import qualified Foreign.C.String as C
import qualified Foreign.C.Types as C

import qualified System.IO.Unsafe as IO.Unsafe


-- | The value of the preprocessor macro @CDIO_VERSION@, listing both the
-- SemVar-style version of libcdio and the full architecture of the system
-- which compiled it (e.g. @2.0.0 x86_64-pc-linux-gnu@).
cdioVersionString :: String
cdioVersionString :: String
cdioVersionString = IO String -> String
forall a. IO a -> a
IO.Unsafe.unsafePerformIO (IO String -> String) -> IO String -> String
forall a b. (a -> b) -> a -> b
$ CString -> IO String
C.peekCString CString
cdioVersionString'

foreign import ccall safe "cdio/compat/version.h get_cdio_version_string"
  cdioVersionString' :: C.CString


-- | The value of the preprocessor macro @LIBCDIO_VERSION_NUM@, containing a
-- numeric representation of the version suitable for arithmetic testing.
libcdioVersionNum :: V.Version
libcdioVersionNum :: Version
libcdioVersionNum
    | Int
v Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
94 = [Int] -> Version
V.makeVersion [Int
0, Int
v]
    | Int
v Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 = [Int] -> Version
V.makeVersion [Int
1]
    | Bool
otherwise = [Int] -> Version
V.makeVersion [Int
j, Int
n, Int
p]
  where v :: Int
v = CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CUInt
cdioVersionNum'
        (Int
j, Int
v') = Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
divMod Int
v Int
10000
        (Int
n, Int
p) = Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
divMod Int
v' Int
100

foreign import ccall safe "cdio/compat/version.h get_cdio_version_num"
  cdioVersionNum' :: C.CUInt


-- | The value of the preprocessor macro @CDIO_API_VERSION@, containing a
-- single, monotonically increasing constant representing changes to the public
-- interface.  However, as it's somewhat unclear what changes warrant bumping
-- this number, it is typically better to use 'libcdioVersionNum' instead.
apiVersion :: Word
apiVersion :: Word
apiVersion = CUInt -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral CUInt
apiVersion'

foreign import ccall safe "cdio/compat/version.h get_cdio_version_api"
  apiVersion' :: C.CUInt