Hi,

1) You have a copy-paste error on the following line (s/bitrate/track)
 track <- ((#peek struct music_metadata, bitrate) a) :: IO Int

2) By looking at the values you get in hexadecimal, you are reading 64bits values when your C struct contains 32 bits values. If you use: peek ... :: IO Int32, it should be ok.

3) From a style point of view, you could use Applicative operators (from Control.Applicative) to avoid temporary names:
peek a = MusicMetaData
        <$> liftM constantToCodec $ (((#peek struct music_metadata, codec) a) :: IO Int32)
        <*> fmap fromIntegral (((#peek struct music_metadata, length) a) :: IO Int32)
        <*> fmap fromIntegral (((#peek struct music_metadata, bitrate) a) :: IO Int32)
        <*> fmap fromIntegral (((#peek struct music_metadata, channels) a) :: IO Int32)
        <*> fmap fromIntegral (((#peek struct music_metadata, track) a) :: IO Int32)
        <*> (peekCString =<< (#peek struct music_metadata, title) a)
        ...

4) In your constantToCodec function, you don't need the temporary names for all the constants.

Best regards,
Sylvain

PS : recently I have been working on rewriting the FFI page on the wiki to make it more beginner-friendly ;-). It is not totally finished but I'm open to any comment. https://www.haskell.org/wiki/Foreign_Function_Interface

2015-02-28 14:20 GMT+01:00 Thomas Jakway <tjakway@nyu.edu>:
I'm very new to Haskell and am trying to write a "real" program to motivate myself to learn it better (so far I've only gotten through Project Euler problems after reading LYAH and most of RWH).  I'm using Taglib (https://github.com/taglib/taglib) to read the metadata from a music file and print it.  I have a struct C-side (with C linkage) serving as the bridge between Taglib's C++ and Haskell's FFI.  A small demo program (compiled with gcc and linked against the C++ object files) gives the correct results, but Haskell is weirdly only getting some of it right.  Specifically, the C string fields are working but ints are not.

The output from the C demo (what Haskell should be printing):

music_metadata
title: It's My Life,    artist: Bon Jovi,    album: Bon Jovi Greatest Hits - The Ultimate Collection
comment: ,    genre: Rock,    track: 3,
length: 224,    bitrate: 256,    channels: 2,
codec: 768

The output from Haskell:

MusicMetadata {codec = UNKNOWN, length = 1099511628000, bitrate = 8589934848, channels = 12884901890, track = 8589934848, title = "It's My Life", artist = "Bon Jovi", album = "Bon Jovi Greatest Hits - The Ultimate Collection", comment = "", genre = "Rock"}

I would have expected it to work or not work at all, but did not anticipate getting only some of it right.

I was going to include snippets from my hsc file but given how new I am to Haskell I don't trust myself to assume where the problem is, so sorry if this is way too long:

{-# LANGUAGE CPP, ForeignFunctionInterface #-}

module MusicReader
( Codec,
  MusicMetadata,
  readMusicMetadata
) where

import Control.Monad
import Foreign
import Foreign.C.Types
import Foreign.C.String
import System.IO.Unsafe as Unsafe

#include "CodecDefines.h"
#include "MusicReader.h"

constantToCodec code
                    | code == mp3 = MP3
                    | code == flac = FLAC
                    | code == ogg = OGG_VORBIS
                    | code == mp4 = MP4
                    | code == mpeg = MPEG
                    | code == none = NONE
                    | code == unknown = UNKNOWN
                    | otherwise = UNKNOWN
                       where mp3 = #const MP3_CODEC
                             flac = #const FLAC_CODEC
                             ogg = #const OGG_VORBIS_CODEC
                             mp4 = #const MP4_CODEC
                             mpeg = #const MPEG_CODEC
                             none = #const NO_EXTENSION
                             unknown = #const UNKNOWN_EXTENSION

data Codec = MP3 | FLAC | OGG_VORBIS | MP4 | MPEG | NONE | UNKNOWN deriving (Show)

data MusicMetadata = MusicMetadata { codec :: Codec,
                      length :: Int,
                      bitrate :: Int,
                      channels :: Int,
                      track :: Int,
                      title :: String,
                      artist :: String,
                      album :: String,
                      comment :: String,
                      genre :: String } deriving (Show)

instance Storable MusicMetadata where
    sizeOf _ = (#size struct music_metadata)
    alignment _ = alignment (undefined::CDouble)
    peek a = do
        codec <- liftM constantToCodec $ (((#peek struct music_metadata, codec) a) :: IO Int)
        length <- ((#peek struct music_metadata, length) a) :: IO Int
        bitrate <- ((#peek struct music_metadata, bitrate) a) :: IO Int
        channels <- ((#peek struct music_metadata, channels) a) :: IO Int
        track <- ((#peek struct music_metadata, bitrate) a) :: IO Int
        title <-  ((#peek struct music_metadata, title) a) :: IO CString
        artist <- ((#peek struct music_metadata, artist) a) :: IO CString
        album <- ((#peek struct music_metadata, album) a) :: IO CString
        comment <- ((#peek struct music_metadata, comment) a) :: IO CString
        genre <- ((#peek struct music_metadata, genre) a) :: IO CString
        --FIXME: find replacement for temporary names
        marshalledTitle <- peekCString title
        marshalledArtist <- peekCString artist
        marshalledAlbum <- peekCString album
        marshalledComment <- peekCString comment
        marshalledGenre <- peekCString genre
        return (MusicMetadata codec length bitrate channels track marshalledTitle marshalledArtist marshalledAlbum marshalledComment marshalledGenre)
    poke a = undefined

--This is the "primitive" FFI call--calls the C function and gets a pointer
--in return
--TODO: write a higher level function this module should export that calls
--primReadMusicMetadata and converts the C Pointer into the Haskell data
--MusicMetadata
foreign import ccall unsafe "read_metadata" primReadMusicMetadata :: CString -> IO (Ptr MusicMetadata)

--convert the Haskell string to a CString, call into the FFI then
--dereference the resulting pointer
readMusicMetadata a = join $ withCString a $ \cs -> ((liftM peek) $ primReadMusicMetadata cs)



Here's the struct in MusicReader.h (in an extern C block):
    struct music_metadata
    {
        int codec;
        int length,
                bitrate,
                channels;
        int track;
        char *title,
             *artist,
             *album,
             *comment,
             *genre;
    };


with the corresponding call:
    struct music_metadata* read_metadata(char*);


I've tried playing around with the alignment but it didn't do anything.  I also tried declaring the struct's fields as int32_t which also did nothing.

The C demo in question is a very simple:

#include <stdio.h>
#include "MusicReader.h"

#define FILENAME "Its_My_Life.m4a"

int main()
{
    struct music_metadata* metadata = read_metadata(FILENAME);  
    printf("music_metadata\ntitle: %s,\tartist: %s,\talbum: %s\n",
            metadata->title, metadata->artist, metadata->album);
    printf("comment: %s,\tgenre: %s,\ttrack: %d,\n",
            metadata->comment, metadata->genre, metadata->track);
    printf("length: %d,\tbitrate: %d,\tchannels: %d,\n",
            metadata->length, metadata->bitrate, metadata->channels);
    printf("codec: %d\n");

}

It just reads the metadata into the struct and prints the fields.

I've gotten the impression of the Haskell FFI being very beginner-unfriendly, which isn't surprising but still disappointing because it would be a great opportunity to replace some projects with Haskell.

Any help is appreciated, including general feedback on my code!

_______________________________________________
Beginners mailing list
Beginners@haskell.org
http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners