-- GENERATED by C->Haskell Compiler, version 0.28.7 Switcheroo, 25 November 2017 (Haskell)
-- Edit the ORIGNAL .chs file instead!


{-# LINE 1 "src/Foreign/Libcdio/Types/Offsets.chs" #-}
{-|
Description:    c2hs-generated byte offsets for members of C structs.

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

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

Since this library already handles marshalling to and from C types itself, the
only remaining benefit to using c2hs for datatypes is not having to worry about
tracking the internal byte arrangement of C structs.  That can be done just as
easily externally here, with the added benefit of being able to analyze
coverage of the primary modules.  Just note that since this isn't exposed, it
/can not/ be used directly by any other c2hs-generated modules.
-}
module Foreign.Libcdio.Types.Offsets where
import qualified Foreign.C.Types as C2HSImp
import qualified System.IO.Unsafe as C2HSImp




import qualified Foreign.C.String as C
import qualified Foreign.Ptr as C

import qualified Foreign.Marshal.Array as M
import qualified Foreign.Storable as S


pokeCString :: String -> Int -> C.CString -> IO ()
pokeCString :: String -> Int -> CString -> IO ()
pokeCString String
s Int
l CString
p = String -> (CStringLen -> IO ()) -> IO ()
forall a. String -> (CStringLen -> IO a) -> IO a
C.withCStringLen (String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\NUL") ((CStringLen -> IO ()) -> IO ()) -> (CStringLen -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(CString
c, Int
cl) ->
    if Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
cl
    then CString -> CString -> Int -> IO ()
forall a. Storable a => Ptr a -> Ptr a -> Int -> IO ()
M.copyArray CString
p CString
c (Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Ptr Char -> Char -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
S.poke (CString -> Int -> Ptr Char
forall a b. Ptr a -> Int -> Ptr b
C.plusPtr CString
p (Int -> Ptr Char) -> Int -> Ptr Char
forall a b. (a -> b) -> a -> b
$ Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Char
'\NUL'
    else CString -> CString -> Int -> IO ()
forall a. Storable a => Ptr a -> Ptr a -> Int -> IO ()
M.copyArray CString
p CString
c Int
cl





iaSizeOf :: Int
iaSizeOf :: Int
iaSizeOf = Int
48
{-# LINE 39 "src/Foreign/Libcdio/Types/Offsets.chs" #-}


iaAlign :: Int
iaAlign = 4
{-# LINE 42 "src/Foreign/Libcdio/Types/Offsets.chs" #-}


iaJolietLevel :: Int
iaJolietLevel :: Int
iaJolietLevel = (Int
0)
{-# LINE 45 "src/Foreign/Libcdio/Types/Offsets.chs" #-}


iaLabel :: Int
iaLabel :: Int
iaLabel = (Int
4)
{-# LINE 48 "src/Foreign/Libcdio/Types/Offsets.chs" #-}


iaIsoSize :: Int
iaIsoSize :: Int
iaIsoSize = (Int
40)
{-# LINE 51 "src/Foreign/Libcdio/Types/Offsets.chs" #-}


iaUDFMajor :: Int
iaUDFMajor :: Int
iaUDFMajor = (Int
45)
{-# LINE 54 "src/Foreign/Libcdio/Types/Offsets.chs" #-}


iaUDFMinor :: Int
iaUDFMinor :: Int
iaUDFMinor = (Int
44)
{-# LINE 57 "src/Foreign/Libcdio/Types/Offsets.chs" #-}







hiSizeOf :: Int
hiSizeOf :: Int
hiSizeOf = Int
32
{-# LINE 65 "src/Foreign/Libcdio/Types/Offsets.chs" #-}


hiAlign :: Int
hiAlign :: Int
hiAlign = Int
1
{-# LINE 68 "src/Foreign/Libcdio/Types/Offsets.chs" #-}


hiVendor :: Int
hiVendor :: Int
hiVendor = (Int
0)
{-# LINE 71 "src/Foreign/Libcdio/Types/Offsets.chs" #-}


hiModel :: Int
hiModel :: Int
hiModel = (Int
9)
{-# LINE 74 "src/Foreign/Libcdio/Types/Offsets.chs" #-}


hiRevision :: Int
hiRevision :: Int
hiRevision = (Int
26)
{-# LINE 77 "src/Foreign/Libcdio/Types/Offsets.chs" #-}







leSizeOf :: Int
leSizeOf :: Int
leSizeOf = Int
24
{-# LINE 85 "src/Foreign/Libcdio/Types/Offsets.chs" #-}


leAlign :: Int
leAlign :: Int
leAlign = Int
8
{-# LINE 88 "src/Foreign/Libcdio/Types/Offsets.chs" #-}


leLevel :: Int
leLevel :: Int
leLevel = (Int
0)
{-# LINE 91 "src/Foreign/Libcdio/Types/Offsets.chs" #-}


leMessage :: Int
leMessage :: Int
leMessage = (Int
8)
{-# LINE 94 "src/Foreign/Libcdio/Types/Offsets.chs" #-}


lePrevious :: Int
lePrevious :: Int
lePrevious = (Int
16)
{-# LINE 97 "src/Foreign/Libcdio/Types/Offsets.chs" #-}







-- c2hs can't handle the packed datatype, so get the values from C itself.
msfSizeOf :: Int
msfSizeOf :: Int
msfSizeOf = CULong -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CULong -> Int) -> CULong -> Int
forall a b. (a -> b) -> a -> b
$ (IO CULong -> CULong
forall a. IO a -> a
C2HSImp.unsafePerformIO IO CULong
sizeof_msf)
{-# LINE 106 "src/Foreign/Libcdio/Types/Offsets.chs" #-}


msfAlign :: Int
msfAlign :: Int
msfAlign = Int
1
{-# LINE 109 "src/Foreign/Libcdio/Types/Offsets.chs" #-}


msfM :: Int
msfM :: Int
msfM = (Int
0)
{-# LINE 112 "src/Foreign/Libcdio/Types/Offsets.chs" #-}


msfS :: Int
msfS :: Int
msfS = (Int
1)
{-# LINE 115 "src/Foreign/Libcdio/Types/Offsets.chs" #-}


msfF :: Int
msfF :: Int
msfF = (Int
2)
{-# LINE 118 "src/Foreign/Libcdio/Types/Offsets.chs" #-}



{- Never used after definition.
adrSizeOf :: Int
adrSizeOf = {#sizeof cdio_cdrom_addr#}

adrAlign :: Int
adrAlign = {#alignof cdio_cdrom_addr#}
-}

foreign import ccall safe "Foreign/Libcdio/Types/Offsets.chs.h sizeof_msf"
  sizeof_msf :: (IO C2HSImp.CULong)