module Graphics.Exif.Internals (ExifData, ExifContent, ExifEntry, ExifTag,
dataFromFile, dataFromData,
dataFree,
dataGetContents, contentGetEntries,
entryGetTag, entryGetValue,
tagFromName, tagName, tagTitle, tagDescription
) where
import Foreign
import Foreign.C
import System.IO
data ExifData = ExifData
data ExifContent = ExifContent
data ExifEntry = ExifEntry
type ExifTag = CInt
foreign import ccall "exif_data_new_from_file"
exif_data_new_from_file :: CString -> IO (Ptr ExifData)
foreign import ccall "exif_data_new_from_data"
exif_data_new_from_data :: Ptr CUChar -> CUInt -> IO (Ptr ExifData)
foreign import ccall "&exif_data_free"
ptr_exif_data_free :: FunPtr (Ptr ExifData -> IO ())
foreign import ccall "exif_entry_get_value"
exif_entry_get_value :: Ptr ExifEntry -> Ptr CChar
-> CUInt -> IO (Ptr CChar)
foreign import ccall "exif_tag_from_name"
exif_tag_from_name :: CString -> IO ExifTag
foreign import ccall "exif_tag_get_name"
exif_tag_get_name :: ExifTag -> IO CString
foreign import ccall "exif_tag_get_title"
exif_tag_get_title :: ExifTag -> IO CString
foreign import ccall "exif_tag_get_description"
exif_tag_get_description :: ExifTag -> IO CString
tracingEnabled :: Bool
tracingEnabled = False
trace :: String -> IO ()
trace s = if tracingEnabled then hPutStrLn stderr s else return ()
dataFromFile :: FilePath -> IO (Ptr ExifData)
dataFromFile f = withCString f exif_data_new_from_file
dataFromData :: Ptr a -> Int -> IO (Ptr ExifData)
dataFromData p c = exif_data_new_from_data (castPtr p) (fromIntegral c)
dataFree :: FunPtr (Ptr ExifData -> IO ())
dataFree = ptr_exif_data_free
dataGetContents :: Ptr ExifData -> IO [Ptr ExifContent]
dataGetContents d | isNull d = fail "dataGetContents: NULL"
dataGetContents d = trace ("dataGetContents " ++ show d) >>
do let ifd = (\hsc_ptr -> hsc_ptr `plusPtr` 0) d
count = 5
cs <- peekArray count ifd
let r = filter (not . isNull) cs
trace ("dataGetContents " ++ show d ++ " = " ++ show r)
return r
contentGetEntries :: Ptr ExifContent -> IO [Ptr ExifEntry]
contentGetEntries d | isNull d = fail "contentGetEntries: NULL"
contentGetEntries c = trace ("contentGetEntries " ++ show c) >>
do count <- (\hsc_ptr -> peekByteOff hsc_ptr 4) c
entries <- (\hsc_ptr -> peekByteOff hsc_ptr 0) c
trace ("contentGetEntries " ++ show c ++ ", entries = " ++ show entries
++ ", count = " ++ show count)
r <- peekArray count entries
trace ("contentGetEntries " ++ show c ++ " = " ++ show r)
return r
entryGetTag :: Ptr ExifEntry -> IO ExifTag
entryGetTag e | isNull e = fail "entryGetTag: NULL"
entryGetTag e = trace ("entryGetTag " ++ show e) >> (\hsc_ptr -> peekByteOff hsc_ptr 0) e
entryGetValue :: Ptr ExifEntry -> IO String
entryGetValue e | isNull e = fail "entryGetValue: NULL"
entryGetValue e = trace ("entryGetValue " ++ show e) >> allocaArray bufSize f
where bufSize = 256
f buf = do exif_entry_get_value e buf (fromIntegral bufSize)
peekCString buf
tagFromName :: String -> IO ExifTag
tagFromName s = withCString s exif_tag_from_name
tagName :: ExifTag -> IO String
tagName t = exif_tag_get_name t >>= peekCString
tagTitle :: ExifTag -> IO String
tagTitle t = exif_tag_get_title t >>= peekCString
tagDescription :: ExifTag -> IO String
tagDescription t = exif_tag_get_description t >>= peekCString
isNull :: Ptr a -> Bool
isNull p = p == nullPtr