-- | Data.UniversalBinary is a module for parsing an OS X universal binary
-- into a list of its member objects.
module Data.UniversalBinary (parseUniversalBinary, Object(..)) where

import Data.Binary
import Data.Binary.Get
import Control.Monad
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as L

-- | A member of the universal binary. Usually a Mach-O object for a given architecture.
data Object = Object
    { cputype    :: Int          -- ^ CPU type from /usr/include/mach/machine.h.
    , cpusubtype :: Int          -- ^ CPU subtype from /usr/include/mach/machine.h.
    , align      :: Int          -- ^ Required file alignment of object.
    , object     :: B.ByteString -- ^ Byte string for object data.
    } deriving (Eq, Show)

getFatArch = do
    cputype    <- liftM fromIntegral getWord32be
    cpusubtype <- liftM fromIntegral getWord32be
    offset     <- liftM fromIntegral getWord32be
    size       <- liftM fromIntegral getWord32be
    align      <- liftM fromIntegral getWord32be
    return (cputype, cpusubtype, offset, size, align)

getFatHeader = do
    magic <- liftM fromIntegral getWord32be
    if magic /= 0xcafebabe then
        fail $ "Invalid magic number " ++ show magic
     else do
        num   <- liftM fromIntegral getWord32be
        archs <- sequence $ replicate num getFatArch
        return archs

processArch bs (cputype, cpusubtype, offset, size, align) = Object
    { cputype    = cputype
    , cpusubtype = cpusubtype
    , align      = align
    , object     = B.take size $ B.drop offset bs
    }

-- | Parse a universal binary ByteString into a list of contained objects. An
-- error is thrown for unexpected data.
parseUniversalBinary :: B.ByteString -> [Object]
parseUniversalBinary bs =
    let archs = runGet getFatHeader (L.fromChunks [bs])
    in map (processArch bs) archs